{-# 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 import General.Extra 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 (Maybe FilePath -> IO [Lexeme]) -> Maybe FilePath -> IO [Lexeme] forall a b. (a -> b) -> a -> b $ if FilePath file FilePath -> FilePath -> Bool forall a. Eq a => a -> a -> Bool == FilePath "-" then Maybe FilePath forall a. Maybe a Nothing else FilePath -> Maybe FilePath forall a. a -> Maybe a Just FilePath file (Ninja -> (Lexeme, [(ByteString, Expr)]) -> IO Ninja) -> Ninja -> [(Lexeme, [(ByteString, Expr)])] -> IO Ninja 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=file:sources ninja} ([(Lexeme, [(ByteString, Expr)])] -> IO Ninja) -> [(Lexeme, [(ByteString, Expr)])] -> IO 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) (Lexeme, [(ByteString, Expr)]) -> [(Lexeme, [(ByteString, Expr)])] -> [(Lexeme, [(ByteString, Expr)])] 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)(ByteString, Expr) -> [(ByteString, Expr)] -> [(ByteString, Expr)] 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] sources :: Ninja -> [FilePath] sources :: [FilePath] rules :: [(ByteString, Rule)] singles :: [(ByteString, Build)] multiples :: [([ByteString], Build)] phonys :: [(ByteString, [ByteString])] defaults :: [ByteString] pools :: [(ByteString, Int)] rules :: Ninja -> [(ByteString, Rule)] singles :: Ninja -> [(ByteString, Build)] multiples :: Ninja -> [([ByteString], Build)] phonys :: Ninja -> [(ByteString, [ByteString])] defaults :: Ninja -> [ByteString] pools :: Ninja -> [(ByteString, Int)] ..} (Lexeme key, [(ByteString, Expr)] binds) = case Lexeme key of LexBuild [Expr] outputs ByteString rule [Expr] deps -> do [ByteString] outputs <- (Expr -> IO ByteString) -> [Expr] -> IO [ByteString] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b] mapM (Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env) [Expr] outputs [ByteString] deps <- (Expr -> IO ByteString) -> [Expr] -> IO [ByteString] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b] mapM (Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env) [Expr] deps [(ByteString, ByteString)] binds <- ((ByteString, Expr) -> IO (ByteString, ByteString)) -> [(ByteString, Expr)] -> IO [(ByteString, ByteString)] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b] mapM (\(ByteString a,Expr b) -> (ByteString a,) (ByteString -> (ByteString, ByteString)) -> IO ByteString -> IO (ByteString, ByteString) 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 Ninja -> IO Ninja forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Ninja -> IO Ninja) -> Ninja -> IO Ninja forall a b. (a -> b) -> a -> b $ if ByteString rule ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == FilePath -> ByteString BS.pack FilePath "phony" then Ninja ninja{phonys = [(x, normal ++ implicit ++ orderOnly) | x <- outputs] ++ phonys} else if [ByteString] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [ByteString] outputs Int -> Int -> Bool forall a. Eq a => a -> a -> Bool == Int 1 then Ninja ninja{singles = (headErr outputs, build) : singles} else Ninja ninja{multiples = (outputs, build) : multiples} LexRule ByteString name -> Ninja -> IO Ninja forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja{rules = (name, Rule binds) : rules} LexDefault [Expr] xs -> do [ByteString] xs <- (Expr -> IO ByteString) -> [Expr] -> IO [ByteString] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b] mapM (Env ByteString ByteString -> Expr -> IO ByteString askExpr Env ByteString ByteString env) [Expr] xs Ninja -> IO Ninja forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja{defaults = xs ++ defaults} LexPool ByteString name -> do Int depth <- Env ByteString ByteString -> [(ByteString, Expr)] -> IO Int getDepth Env ByteString ByteString env [(ByteString, Expr)] binds Ninja -> IO Ninja forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja{pools = (name, depth) : 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 <- Env ByteString ByteString -> IO (Env ByteString ByteString) 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 Ninja -> IO Ninja forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Ninja ninja LexBind ByteString a Expr _ -> FilePath -> IO Ninja forall a. HasCallStack => FilePath -> a error (FilePath -> IO Ninja) -> FilePath -> IO Ninja forall a b. (a -> b) -> a -> b $ FilePath "Ninja parsing, unexpected binding defining " FilePath -> FilePath -> FilePath 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 ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == FilePath -> ByteString BS.pack FilePath "|" = ([],[ByteString] a[ByteString] -> [ByteString] -> [ByteString] forall a. [a] -> [a] -> [a] ++[ByteString] b,[ByteString] c) | ByteString x ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == FilePath -> ByteString BS.pack FilePath "||" = ([],[ByteString] b,[ByteString] a[ByteString] -> [ByteString] -> [ByteString] forall a. [a] -> [a] -> [a] ++[ByteString] c) | Bool otherwise = (ByteString xByteString -> [ByteString] -> [ByteString] forall 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 ByteString -> [(ByteString, Expr)] -> Maybe Expr forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup (FilePath -> ByteString BS.pack FilePath "depth") [(ByteString, Expr)] xs of Maybe Expr Nothing -> Int -> IO Int forall a. a -> IO a 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 -> Int -> IO Int forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Int i Maybe (Int, ByteString) _ -> FilePath -> IO Int forall a. HasCallStack => FilePath -> a error (FilePath -> IO Int) -> FilePath -> IO Int forall a b. (a -> b) -> a -> b $ FilePath "Ninja parsing, could not parse depth field in pool, got: " FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++ ByteString -> FilePath BS.unpack ByteString x