{-# 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
    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
    foldM (applyStmt env) ninja{sources=file:sources ninja} $ withBinds 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)]
pools :: Ninja -> [(ByteString, Int)]
defaults :: Ninja -> [ByteString]
phonys :: Ninja -> [(ByteString, [ByteString])]
multiples :: Ninja -> [([ByteString], Build)]
singles :: Ninja -> [(ByteString, Build)]
rules :: Ninja -> [(ByteString, Rule)]
..} (Lexeme
key, [(ByteString, Expr)]
binds) = case Lexeme
key of
    LexBuild [Expr]
outputs ByteString
rule [Expr]
deps -> do
        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
        deps <- mapM (askExpr env) deps
        binds <- 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) binds
        let (normal,implicit,orderOnly) = splitDeps deps
        let 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
        pure $
            if rule == BS.pack "phony" then ninja{phonys = [(x, normal ++ implicit ++ orderOnly) | x <- outputs] ++ phonys}
            else if length outputs == 1 then ninja{singles = (headErr outputs, build) : singles}
            else 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
        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
        pure ninja{defaults = xs ++ defaults}
    LexPool ByteString
name -> do
        depth <- Env ByteString ByteString -> [(ByteString, Expr)] -> IO Int
getDepth Env ByteString ByteString
env [(ByteString, Expr)]
binds
        pure ninja{pools = (name, depth) : pools}
    LexInclude Expr
expr -> do
        file <- Env ByteString ByteString -> Expr -> IO ByteString
askExpr Env ByteString ByteString
env Expr
expr
        parseFile (BS.unpack file) env ninja
    LexSubninja Expr
expr -> do
        file <- Env ByteString ByteString -> Expr -> IO ByteString
askExpr Env ByteString ByteString
env Expr
expr
        e <- scopeEnv env
        parseFile (BS.unpack file) e 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
        x <- Env ByteString ByteString -> Expr -> IO ByteString
askExpr Env ByteString ByteString
env Expr
x
        case BS.readInt 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