    {-# 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 (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 :: [FilePath]
    sources=FilePath
    fileFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :Ninja -> [FilePath]
    sources Ninja
    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 :: [(ByteString, [ByteString])]
    phonys = [(ByteString
    x, [ByteString]
    normal [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [ByteString]
    implicit [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [ByteString]
    orderOnly) | ByteString
    x <- [ByteString]
    outputs] [(ByteString, [ByteString])]
    -> [(ByteString, [ByteString])] -> [(ByteString, [ByteString])]
    forall a. [a] -> [a] -> [a]
    ++ [(ByteString, [ByteString])]
    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 :: [(ByteString, Build)]
    singles = ([ByteString] -> ByteString
    forall a. HasCallStack => [a] -> a
    head [ByteString]
    outputs, Build
    build) (ByteString, Build)
    -> [(ByteString, Build)] -> [(ByteString, Build)]
    forall a. a -> [a] -> [a]
    : [(ByteString, Build)]
    singles}
                else Ninja
    ninja{multiples :: [([ByteString], Build)]
    multiples = ([ByteString]
    outputs, Build
    build) ([ByteString], Build)
    -> [([ByteString], Build)] -> [([ByteString], Build)]
    forall a. a -> [a] -> [a]
    : [([ByteString], 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 :: [(ByteString, Rule)]
    rules = (ByteString
    name, [(ByteString, Expr)] -> Rule
    Rule [(ByteString, Expr)]
    binds) (ByteString, Rule) -> [(ByteString, Rule)] -> [(ByteString, Rule)]
    forall a. a -> [a] -> [a]
    : [(ByteString, Rule)]
    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 :: [ByteString]
    defaults = [ByteString]
    xs [ByteString] -> [ByteString] -> [ByteString]
    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
            Ninja -> IO Ninja
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Ninja
    ninja{pools :: [(ByteString, Int)]
    pools = (ByteString
    name, Int
    depth) (ByteString, Int) -> [(ByteString, Int)] -> [(ByteString, Int)]
    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 <- 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