{-# LANGUAGE ScopedTypeVariables #-}

module Parse
  ( getValidMakeFile,
    parsecMakeFile,
    parseMakeFile,
    regularParse,
    testMakeFileParse,
  )
where

import Control.Applicative (many, (<|>))
import Control.Exception (SomeException)
import Control.Exception.Safe (try)
import Control.Monad (guard, void)
import Data.List (nub)
import qualified Data.Set as Set
import System.Directory (getCurrentDirectory)
import Text.Parsec (ParseError, parse)
import Text.Parsec.Char
  ( char,
    letter,
    newline,
    noneOf,
    oneOf,
    string,
  )
import Text.Parsec.Combinator (many1)
import Text.Parsec.String (Parser)
-- Internal Imports
import Types

-- | Top level code

--------------------------------------------------------------------
parseMakeFile :: String -> Either ParseError MakeFile
parseMakeFile :: String -> Either ParseError MakeFile
parseMakeFile = Parser MakeFile -> String -> Either ParseError MakeFile
forall a. Parser a -> String -> Either ParseError a
regularParse Parser MakeFile
parsecMakeFile

-- | Parsec Stuff

--------------------------------------------------------------------
parsecMakeFile :: Parser MakeFile
parsecMakeFile :: Parser MakeFile
parsecMakeFile = do
  Set String
srcFiles <- Parser (Set String)
parsecSrcFiles
  (MakeRule
drule : [MakeRule]
rules) :: [MakeRule] <- ParsecT String () Identity MakeRule
-> ParsecT String () Identity [MakeRule]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity MakeRule
 -> ParsecT String () Identity [MakeRule])
-> ParsecT String () Identity MakeRule
-> ParsecT String () Identity [MakeRule]
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity MakeRule
-> ParsecT String () Identity MakeRule
forall a. Parser a -> Parser a
wspaceWrap ParsecT String () Identity MakeRule
parsecRule
  MakeFile -> Parser MakeFile
forall (m :: * -> *) a. Monad m => a -> m a
return (MakeFile -> Parser MakeFile) -> MakeFile -> Parser MakeFile
forall a b. (a -> b) -> a -> b
$
    MakeFile :: Set String -> MakeRule -> Set MakeRule -> MakeFile
MakeFile
      { sourceFiles :: Set String
sourceFiles = Set String
srcFiles,
        defaultGoal :: MakeRule
defaultGoal = MakeRule
drule,
        allrules :: Set MakeRule
allrules = [MakeRule] -> Set MakeRule
forall a. Ord a => [a] -> Set a
Set.fromList (MakeRule
drule MakeRule -> [MakeRule] -> [MakeRule]
forall a. a -> [a] -> [a]
: [MakeRule]
rules)
      }

parsecSrcFiles :: Parser (Set.Set SourceFile)
parsecSrcFiles :: Parser (Set String)
parsecSrcFiles = do
  Parser ()
whitespace
  ParsecT String () Identity String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String -> Parser ())
-> ParsecT String () Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"source-files:"
  String
rest <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\n'])
  let srcFiles :: [String]
srcFiles = String -> [String]
words String
rest
  ParsecT String () Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> Parser ())
-> ParsecT String () Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline -- at the end
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
srcFiles Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
srcFiles)
  let sources :: Set String
sources = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
srcFiles
  Set String -> Parser (Set String)
forall (m :: * -> *) a. Monad m => a -> m a
return Set String
sources

parsecRule :: Parser MakeRule
parsecRule :: ParsecT String () Identity MakeRule
parsecRule = do
  String
targetFile <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
  ParsecT String () Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> Parser ())
-> ParsecT String () Identity Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
  String
depStr <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\n'])
  let deps :: [String]
deps = String -> [String]
words String
depStr
  Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
deps Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub [String]
deps)
  let buildSet :: Set String
buildSet = [String] -> Set String
forall a. Ord a => [a] -> Set a
Set.fromList [String]
deps
  ParsecT String () Identity Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  String
command <- ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf [Char
'\n'])
  MakeRule -> ParsecT String () Identity MakeRule
forall (m :: * -> *) a. Monad m => a -> m a
return (MakeRule -> ParsecT String () Identity MakeRule)
-> MakeRule -> ParsecT String () Identity MakeRule
forall a b. (a -> b) -> a -> b
$ String -> Set String -> String -> MakeRule
MakeRule String
targetFile Set String
buildSet String
command

-- Taken from the parsec tutorial:
regularParse :: Parser a -> String -> Either ParseError a
regularParse :: Parser a -> String -> Either ParseError a
regularParse Parser a
p = Parser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser a
p String
""

wspaceWrap :: Parser a -> Parser a
wspaceWrap :: Parser a -> Parser a
wspaceWrap Parser a
p = do
  Parser ()
whitespace
  a
a <- Parser a
p
  Parser ()
whitespace
  a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- Taken from the parsec tutorial:
whitespace :: Parser ()
whitespace :: Parser ()
whitespace = ParsecT String () Identity String -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String -> Parser ())
-> ParsecT String () Identity String -> Parser ()
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
" \n\t"

--------------------------------------------------------------------

-- | Extract valid makefile at given path, else @$PWD/Makefile@
--   Result is either a @Left@-wrapped error message or a @Right@-wrapped result.
getValidMakeFile :: Maybe FilePath -> IO (Either MakeFile MFError)
getValidMakeFile :: Maybe String -> IO (Either MakeFile MFError)
getValidMakeFile Maybe String
optDir = do
  Either String String
readEither <- Maybe String -> IO (Either String String)
tryReadMakeFile Maybe String
optDir
  case Either String String
readEither of
    Left String
errMsg ->
      Either MakeFile MFError -> IO (Either MakeFile MFError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MakeFile MFError -> IO (Either MakeFile MFError))
-> Either MakeFile MFError -> IO (Either MakeFile MFError)
forall a b. (a -> b) -> a -> b
$ MFError -> Either MakeFile MFError
forall a b. b -> Either a b
Right (MFError -> Either MakeFile MFError)
-> MFError -> Either MakeFile MFError
forall a b. (a -> b) -> a -> b
$ String -> MFError
MFError String
errMsg
    Right String
fileRead ->
      case String -> Either ParseError MakeFile
parseMakeFile String
fileRead of
        Left ParseError
errorMsg ->
          Either MakeFile MFError -> IO (Either MakeFile MFError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MakeFile MFError -> IO (Either MakeFile MFError))
-> Either MakeFile MFError -> IO (Either MakeFile MFError)
forall a b. (a -> b) -> a -> b
$ MFError -> Either MakeFile MFError
forall a b. b -> Either a b
Right (MFError -> Either MakeFile MFError)
-> MFError -> Either MakeFile MFError
forall a b. (a -> b) -> a -> b
$ String -> MFError
MFError (String -> MFError) -> String -> MFError
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
errorMsg
        Right MakeFile
mkFile ->
          -- for now, ignoring checking it's valid
          Either MakeFile MFError -> IO (Either MakeFile MFError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MakeFile MFError -> IO (Either MakeFile MFError))
-> Either MakeFile MFError -> IO (Either MakeFile MFError)
forall a b. (a -> b) -> a -> b
$ MakeFile -> Either MakeFile MFError
forall a b. a -> Either a b
Left MakeFile
mkFile

-- Attempt to parse Makefile at given path, else @$PWD/Makefile@
-- Result is either a @Left@-wrapped error message or a @Right@-wrapped result.
tryReadMakeFile :: Maybe FilePath -> IO (Either String String)
tryReadMakeFile :: Maybe String -> IO (Either String String)
tryReadMakeFile Maybe String
optDir = do
  String
dir <- Maybe String -> IO String
dirOrCwd Maybe String
optDir
  let makeFileLoc :: String
makeFileLoc = String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/Makefile"
  Either SomeException String
tryRead <- IO String -> IO (Either SomeException String)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (IO String -> IO (Either SomeException String))
-> IO String -> IO (Either SomeException String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
makeFileLoc
  case Either SomeException String
tryRead of
    Left (SomeException
_ :: SomeException) -> Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
makeFileLoc)
    Right String
file -> Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. b -> Either a b
Right String
file)

-- IO context of given path, else $PWD
dirOrCwd :: Maybe FilePath -> IO FilePath
dirOrCwd :: Maybe String -> IO String
dirOrCwd Maybe String
Nothing = IO String
getCurrentDirectory
dirOrCwd (Just String
d) = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
d

-- | Strictly testing

--------------------------------------------------------------------------------
testMakeFileParse :: Maybe FilePath -> IO ()
testMakeFileParse :: Maybe String -> IO ()
testMakeFileParse Maybe String
optDir = do
  Right String
mkfilestr <- Maybe String -> IO (Either String String)
tryReadMakeFile Maybe String
optDir
  String -> IO ()
putStrLn String
"Testing make file parsing:"
  String -> IO ()
putStrLn String
"Readfile:"
  String -> IO ()
putStrLn String
mkfilestr
  String -> IO ()
putStrLn String
"Parsing:"
  Either ParseError MakeFile -> IO ()
forall a. Show a => a -> IO ()
print (Either ParseError MakeFile -> IO ())
-> Either ParseError MakeFile -> IO ()
forall a b. (a -> b) -> a -> b
$ Parser MakeFile -> String -> Either ParseError MakeFile
forall a. Parser a -> String -> Either ParseError a
regularParse Parser MakeFile
parsecMakeFile String
mkfilestr