{-# LANGUAGE RecordWildCards, TupleSections #-} module Development.Ninja.Parse(parse) where import qualified Data.ByteString.Char8 as BS import Development.Ninja.Env import Development.Ninja.Type import Development.Ninja.Lexer import Control.Monad parse :: FilePath -> Env Str Str -> IO Ninja parse :: FilePath -> Env ByteString ByteString -> IO Ninja parse FilePath file Env ByteString ByteString env = FilePath -> Env ByteString ByteString -> Ninja -> IO Ninja parseFile FilePath file Env ByteString ByteString env Ninja newNinja parseFile :: FilePath -> Env Str Str -> Ninja -> IO Ninja parseFile :: FilePath -> Env ByteString ByteString -> Ninja -> IO Ninja parseFile FilePath file Env ByteString ByteString env Ninja ninja = do [Lexeme] lexes <- Maybe FilePath -> IO [Lexeme] lexerFile forall a b. (a -> b) -> a -> b $ if FilePath file forall a. Eq a => a -> a -> Bool == FilePath "-" then forall a. Maybe a Nothing else forall a. a -> Maybe a Just FilePath file forall (t :: * -> *) (m :: * -> *) b a. (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b foldM (Env ByteString ByteString -> Ninja -> (Lexeme, [(ByteString, Expr)]) -> IO Ninja applyStmt Env ByteString ByteString env) Ninja ninja{sources :: [FilePath] sources=FilePath fileforall a. a -> [a] -> [a] :Ninja -> [FilePath] sources Ninja ninja} forall a b. (a -> b) -> a -> b $ [Lexeme] -> [(Lexeme, [(ByteString, Expr)])] withBinds [Lexeme] lexes withBinds :: [Lexeme] -> [(Lexeme, [(Str,Expr)])] withBinds :: [Lexeme] -> [(Lexeme, [(ByteString, Expr)])] withBinds [] = [] withBinds (Lexeme x:[Lexeme] xs) = (Lexeme x,[(ByteString, Expr)] a) forall a. a -> [a] -> [a] : [Lexeme] -> [(Lexeme, [(ByteString, Expr)])] withBinds [Lexeme] b where ([(ByteString, Expr)] a,[Lexeme] b) = [Lexeme] -> ([(ByteString, Expr)], [Lexeme]) f [Lexeme] xs f :: [Lexeme] -> ([(ByteString, Expr)], [Lexeme]) f (LexBind ByteString a Expr b : [Lexeme] rest) = let ([(ByteString, Expr)] as,[Lexeme] bs) = [Lexeme] -> ([(ByteString, Expr)], [Lexeme]) f [Lexeme] rest in ((ByteString a,Expr b)forall a. a -> [a] -> [a] :[(ByteString, Expr)] as, [Lexeme] bs) f [Lexeme] xs = ([], [Lexeme] xs) applyStmt :: Env Str Str -> Ninja -> (Lexeme, [(Str,Expr)]) -> IO Ninja applyStmt :: Env ByteString ByteString -> Ninja -> (Lexeme, [(ByteString, Expr)]) -> IO Ninja applyStmt Env ByteString ByteString env ninja :: Ninja ninja@Ninja{[FilePath] [([ByteString], Build)] [(ByteString, Int)] [(ByteString, [ByteString])] [(ByteString, Rule)] [(ByteString, Build)] [ByteString] pools :: Ninja -> [(ByteString, Int)] defaults :: Ninja -> [ByteString] phonys :: Ninja -> [(ByteString, [ByteString])] multiples :: Ninja -> [([ByteString], Build)] singles :: Ninja -> [(ByteString, Build)] rules :: Ninja -> [(ByteString, Rule)] pools :: [(ByteString, Int)] defaults :: [ByteString] phonys :: [(ByteString, [ByteString])] multiples :: [([ByteString], Build)] singles :: [(ByteString, Build)] rules :: [(ByteString, Rule)] sources :: [FilePath] sources :: Ninja -> [FilePath] ..} (Lexeme key, [(ByteString, Expr)] binds) = case Lexeme key of LexBuild [Expr] outputs ByteString rule [Expr] deps -> do [ByteString] outputs <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env) [Expr] outputs [ByteString] deps <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env) [Expr] deps [(ByteString, ByteString)] binds <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (\(ByteString a,Expr b) -> (ByteString a,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env Expr b) [(ByteString, Expr)] binds let ([ByteString] normal,[ByteString] implicit,[ByteString] orderOnly) = [ByteString] -> ([ByteString], [ByteString], [ByteString]) splitDeps [ByteString] deps let build :: Build build = ByteString -> Env ByteString ByteString -> [ByteString] -> [ByteString] -> [ByteString] -> [(ByteString, ByteString)] -> Build Build ByteString rule Env ByteString ByteString env [ByteString] normal [ByteString] implicit [ByteString] orderOnly [(ByteString, ByteString)] binds forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ if ByteString rule forall a. Eq a => a -> a -> Bool == FilePath -> ByteString BS.pack FilePath "phony" then Ninja ninja{phonys :: [(ByteString, [ByteString])] phonys = [(ByteString x, [ByteString] normal forall a. [a] -> [a] -> [a] ++ [ByteString] implicit forall a. [a] -> [a] -> [a] ++ [ByteString] orderOnly) | ByteString x <- [ByteString] outputs] forall a. [a] -> [a] -> [a] ++ [(ByteString, [ByteString])] phonys} else if forall (t :: * -> *) a. Foldable t => t a -> Int length [ByteString] outputs forall a. Eq a => a -> a -> Bool == Int 1 then Ninja ninja{singles :: [(ByteString, Build)] singles = (forall a. [a] -> a head [ByteString] outputs, Build build) forall a. a -> [a] -> [a] : [(ByteString, Build)] singles} else Ninja ninja{multiples :: [([ByteString], Build)] multiples = ([ByteString] outputs, Build build) forall a. a -> [a] -> [a] : [([ByteString], Build)] multiples} LexRule ByteString name -> forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja{rules :: [(ByteString, Rule)] rules = (ByteString name, [(ByteString, Expr)] -> Rule Rule [(ByteString, Expr)] binds) forall a. a -> [a] -> [a] : [(ByteString, Rule)] rules} LexDefault [Expr] xs -> do [ByteString] xs <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env) [Expr] xs forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja{defaults :: [ByteString] defaults = [ByteString] xs forall a. [a] -> [a] -> [a] ++ [ByteString] defaults} LexPool ByteString name -> do Int depth <- Env ByteString ByteString -> [(ByteString, Expr)] -> IO Int getDepth Env ByteString ByteString env [(ByteString, Expr)] binds forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja{pools :: [(ByteString, Int)] pools = (ByteString name, Int depth) forall a. a -> [a] -> [a] : [(ByteString, Int)] pools} LexInclude Expr expr -> do ByteString file <- Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env Expr expr FilePath -> Env ByteString ByteString -> Ninja -> IO Ninja parseFile (ByteString -> FilePath BS.unpack ByteString file) Env ByteString ByteString env Ninja ninja LexSubninja Expr expr -> do ByteString file <- Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env Expr expr Env ByteString ByteString e <- forall k v. Env k v -> IO (Env k v) scopeEnv Env ByteString ByteString env FilePath -> Env ByteString ByteString -> Ninja -> IO Ninja parseFile (ByteString -> FilePath BS.unpack ByteString file) Env ByteString ByteString e Ninja ninja LexDefine ByteString a Expr b -> do Env ByteString ByteString -> ByteString -> Expr -> IO () addBind Env ByteString ByteString env ByteString a Expr b forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja LexBind ByteString a Expr _ -> forall a. HasCallStack => FilePath -> a error forall a b. (a -> b) -> a -> b $ FilePath "Ninja parsing, unexpected binding defining " forall a. [a] -> [a] -> [a] ++ ByteString -> FilePath BS.unpack ByteString a splitDeps :: [Str] -> ([Str], [Str], [Str]) splitDeps :: [ByteString] -> ([ByteString], [ByteString], [ByteString]) splitDeps (ByteString x:[ByteString] xs) | ByteString x forall a. Eq a => a -> a -> Bool == FilePath -> ByteString BS.pack FilePath "|" = ([],[ByteString] aforall a. [a] -> [a] -> [a] ++[ByteString] b,[ByteString] c) | ByteString x forall a. Eq a => a -> a -> Bool == FilePath -> ByteString BS.pack FilePath "||" = ([],[ByteString] b,[ByteString] aforall a. [a] -> [a] -> [a] ++[ByteString] c) | Bool otherwise = (ByteString xforall a. a -> [a] -> [a] :[ByteString] a,[ByteString] b,[ByteString] c) where ([ByteString] a,[ByteString] b,[ByteString] c) = [ByteString] -> ([ByteString], [ByteString], [ByteString]) splitDeps [ByteString] xs splitDeps [] = ([], [], []) getDepth :: Env Str Str -> [(Str, Expr)] -> IO Int getDepth :: Env ByteString ByteString -> [(ByteString, Expr)] -> IO Int getDepth Env ByteString ByteString env [(ByteString, Expr)] xs = case forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup (FilePath -> ByteString BS.pack FilePath "depth") [(ByteString, Expr)] xs of Maybe Expr Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure Int 1 Just Expr x -> do ByteString x <- Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env Expr x case ByteString -> Maybe (Int, ByteString) BS.readInt ByteString x of Just (Int i, ByteString n) | ByteString -> Bool BS.null ByteString n -> forall (f :: * -> *) a. Applicative f => a -> f a pure Int i Maybe (Int, ByteString) _ -> forall a. HasCallStack => FilePath -> a error forall a b. (a -> b) -> a -> b $ FilePath "Ninja parsing, could not parse depth field in pool, got: " forall a. [a] -> [a] -> [a] ++ ByteString -> FilePath BS.unpack ByteString x