    {-# 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 Str Str -> IO Ninja
    parse file :: FilePath
    file env :: Env Str Str
    env = FilePath -> Env Str Str -> Ninja -> IO Ninja
    parseFile FilePath
    file Env Str Str
    env Ninja
    newNinja

    parseFile :: FilePath -> Env Str Str -> Ninja -> IO Ninja
    parseFile :: FilePath -> Env Str Str -> Ninja -> IO Ninja
    parseFile file :: FilePath
    file env :: Env Str Str
    env ninja :: 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
    == "-" then Maybe FilePath
    forall a. Maybe a
    Nothing else FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    file
        (Ninja -> (Lexeme, [(Str, Expr)]) -> IO Ninja)
    -> Ninja -> [(Lexeme, [(Str, Expr)])] -> IO Ninja
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (Env Str Str -> Ninja -> (Lexeme, [(Str, Expr)]) -> IO Ninja
    applyStmt Env Str Str
    env) Ninja
    ninja{sources :: [FilePath]
    sources=FilePath
    fileFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :Ninja -> [FilePath]
    sources Ninja
    ninja} ([(Lexeme, [(Str, Expr)])] -> IO Ninja)
    -> [(Lexeme, [(Str, Expr)])] -> IO Ninja
    forall a b. (a -> b) -> a -> b
    $ [Lexeme] -> [(Lexeme, [(Str, Expr)])]
    withBinds [Lexeme]
    lexes

    withBinds :: [Lexeme] -> [(Lexeme, [(Str,Expr)])]
    withBinds :: [Lexeme] -> [(Lexeme, [(Str, Expr)])]
    withBinds [] = []
    withBinds (x :: Lexeme
    x:xs :: [Lexeme]
    xs) = (Lexeme
    x,[(Str, Expr)]
    a) (Lexeme, [(Str, Expr)])
    -> [(Lexeme, [(Str, Expr)])] -> [(Lexeme, [(Str, Expr)])]
    forall a. a -> [a] -> [a]
    : [Lexeme] -> [(Lexeme, [(Str, Expr)])]
    withBinds [Lexeme]
    b
        where
            (a :: [(Str, Expr)]
    a,b :: [Lexeme]
    b) = [Lexeme] -> ([(Str, Expr)], [Lexeme])
    f [Lexeme]
    xs
            f :: [Lexeme] -> ([(Str, Expr)], [Lexeme])
    f (LexBind a :: Str
    a b :: Expr
    b : rest :: [Lexeme]
    rest) = let (as :: [(Str, Expr)]
    as,bs :: [Lexeme]
    bs) = [Lexeme] -> ([(Str, Expr)], [Lexeme])
    f [Lexeme]
    rest in ((Str
    a,Expr
    b)(Str, Expr) -> [(Str, Expr)] -> [(Str, Expr)]
    forall a. a -> [a] -> [a]
    :[(Str, Expr)]
    as, [Lexeme]
    bs)
            f xs :: [Lexeme]
    xs = ([], [Lexeme]
    xs)

    applyStmt :: Env Str Str -> Ninja -> (Lexeme, [(Str,Expr)]) -> IO Ninja
    applyStmt :: Env Str Str -> Ninja -> (Lexeme, [(Str, Expr)]) -> IO Ninja
    applyStmt env :: Env Str Str
    env ninja :: Ninja
    ninja@Ninja{..} (key :: Lexeme
    key, binds :: [(Str, Expr)]
    binds) = case Lexeme
    key of
        LexBuild outputs :: [Expr]
    outputs rule :: Str
    rule deps :: [Expr]
    deps -> do
            [Str]
    outputs <- (Expr -> IO Str) -> [Expr] -> IO [Str]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Env Str Str -> Expr -> IO Str
    askExpr Env Str Str
    env) [Expr]
    outputs
            [Str]
    deps <- (Expr -> IO Str) -> [Expr] -> IO [Str]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Env Str Str -> Expr -> IO Str
    askExpr Env Str Str
    env) [Expr]
    deps
            [(Str, Str)]
    binds <- ((Str, Expr) -> IO (Str, Str)) -> [(Str, Expr)] -> IO [(Str, Str)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\(a :: Str
    a,b :: Expr
    b) -> (Str
    a,) (Str -> (Str, Str)) -> IO Str -> IO (Str, Str)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Env Str Str -> Expr -> IO Str
    askExpr Env Str Str
    env Expr
    b) [(Str, Expr)]
    binds
            let (normal :: [Str]
    normal,implicit :: [Str]
    implicit,orderOnly :: [Str]
    orderOnly) = [Str] -> ([Str], [Str], [Str])
    splitDeps [Str]
    deps
            let build :: Build
    build = Str
    -> Env Str Str -> [Str] -> [Str] -> [Str] -> [(Str, Str)] -> Build
    Build Str
    rule Env Str Str
    env [Str]
    normal [Str]
    implicit [Str]
    orderOnly [(Str, Str)]
    binds
            Ninja -> IO Ninja
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ninja -> IO Ninja) -> Ninja -> IO Ninja
    forall a b. (a -> b) -> a -> b
    $
                if Str
    rule Str -> Str -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath -> Str
    BS.pack "phony" then Ninja
    ninja{phonys :: [(Str, [Str])]
    phonys = [(Str
    x, [Str]
    normal [Str] -> [Str] -> [Str]
    forall a. [a] -> [a] -> [a]
    ++ [Str]
    implicit [Str] -> [Str] -> [Str]
    forall a. [a] -> [a] -> [a]
    ++ [Str]
    orderOnly) | Str
    x <- [Str]
    outputs] [(Str, [Str])] -> [(Str, [Str])] -> [(Str, [Str])]
    forall a. [a] -> [a] -> [a]
    ++ [(Str, [Str])]
    phonys}
                else if [Str] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Str]
    outputs Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 then Ninja
    ninja{singles :: [(Str, Build)]
    singles = ([Str] -> Str
    forall a. [a] -> a
    head [Str]
    outputs, Build
    build) (Str, Build) -> [(Str, Build)] -> [(Str, Build)]
    forall a. a -> [a] -> [a]
    : [(Str, Build)]
    singles}
                else Ninja
    ninja{multiples :: [([Str], Build)]
    multiples = ([Str]
    outputs, Build
    build) ([Str], Build) -> [([Str], Build)] -> [([Str], Build)]
    forall a. a -> [a] -> [a]
    : [([Str], Build)]
    multiples}
        LexRule name :: Str
    name ->
            Ninja -> IO Ninja
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Ninja
    ninja{rules :: [(Str, Rule)]
    rules = (Str
    name, [(Str, Expr)] -> Rule
    Rule [(Str, Expr)]
    binds) (Str, Rule) -> [(Str, Rule)] -> [(Str, Rule)]
    forall a. a -> [a] -> [a]
    : [(Str, Rule)]
    rules}
        LexDefault xs :: [Expr]
    xs -> do
            [Str]
    xs <- (Expr -> IO Str) -> [Expr] -> IO [Str]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Env Str Str -> Expr -> IO Str
    askExpr Env Str Str
    env) [Expr]
    xs
            Ninja -> IO Ninja
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Ninja
    ninja{defaults :: [Str]
    defaults = [Str]
    xs [Str] -> [Str] -> [Str]
    forall a. [a] -> [a] -> [a]
    ++ [Str]
    defaults}
        LexPool name :: Str
    name -> do
            Int
    depth <- Env Str Str -> [(Str, Expr)] -> IO Int
    getDepth Env Str Str
    env [(Str, Expr)]
    binds
            Ninja -> IO Ninja
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Ninja
    ninja{pools :: [(Str, Int)]
    pools = (Str
    name, Int
    depth) (Str, Int) -> [(Str, Int)] -> [(Str, Int)]
    forall a. a -> [a] -> [a]
    : [(Str, Int)]
    pools}
        LexInclude expr :: Expr
    expr -> do
            Str
    file <- Env Str Str -> Expr -> IO Str
    askExpr Env Str Str
    env Expr
    expr
            FilePath -> Env Str Str -> Ninja -> IO Ninja
    parseFile (Str -> FilePath
    BS.unpack Str
    file) Env Str Str
    env Ninja
    ninja
        LexSubninja expr :: Expr
    expr -> do
            Str
    file <- Env Str Str -> Expr -> IO Str
    askExpr Env Str Str
    env Expr
    expr
            Env Str Str
    e <- Env Str Str -> IO (Env Str Str)
    forall k v. Env k v -> IO (Env k v)
    scopeEnv Env Str Str
    env
            FilePath -> Env Str Str -> Ninja -> IO Ninja
    parseFile (Str -> FilePath
    BS.unpack Str
    file) Env Str Str
    e Ninja
    ninja
        LexDefine a :: Str
    a b :: Expr
    b -> do
            Env Str Str -> Str -> Expr -> IO ()
    addBind Env Str Str
    env Str
    a Expr
    b
            Ninja -> IO Ninja
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Ninja
    ninja
        LexBind a :: Str
    a _ ->
            FilePath -> IO Ninja
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> IO Ninja) -> FilePath -> IO Ninja
    forall a b. (a -> b) -> a -> b
    $ "Ninja parsing, unexpected binding defining " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Str -> FilePath
    BS.unpack Str
    a

    splitDeps :: [Str] -> ([Str], [Str], [Str])
    splitDeps :: [Str] -> ([Str], [Str], [Str])
    splitDeps (x :: Str
    x:xs :: [Str]
    xs) | Str
    x Str -> Str -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath -> Str
    BS.pack "|" = ([],[Str]
    a[Str] -> [Str] -> [Str]
    forall a. [a] -> [a] -> [a]
    ++[Str]
    b,[Str]
    c)
                     | Str
    x Str -> Str -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath -> Str
    BS.pack "||" = ([],[Str]
    b,[Str]
    a[Str] -> [Str] -> [Str]
    forall a. [a] -> [a] -> [a]
    ++[Str]
    c)
                     | Bool
    otherwise = (Str
    xStr -> [Str] -> [Str]
    forall a. a -> [a] -> [a]
    :[Str]
    a,[Str]
    b,[Str]
    c)
        where (a :: [Str]
    a,b :: [Str]
    b,c :: [Str]
    c) = [Str] -> ([Str], [Str], [Str])
    splitDeps [Str]
    xs
    splitDeps [] = ([], [], [])

    getDepth :: Env Str Str -> [(Str, Expr)] -> IO Int
    getDepth :: Env Str Str -> [(Str, Expr)] -> IO Int
    getDepth env :: Env Str Str
    env xs :: [(Str, Expr)]
    xs = case Str -> [(Str, Expr)] -> Maybe Expr
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (FilePath -> Str
    BS.pack "depth") [(Str, Expr)]
    xs of
        Nothing -> Int -> IO Int
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure 1
        Just x :: Expr
    x -> do
            Str
    x <- Env Str Str -> Expr -> IO Str
    askExpr Env Str Str
    env Expr
    x
            case Str -> Maybe (Int, Str)
    BS.readInt Str
    x of
                Just (i :: Int
    i, n :: Str
    n) | Str -> Bool
    BS.null Str
    n -> Int -> IO Int
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    i
                _ -> FilePath -> IO Int
    forall a. HasCallStack => FilePath -> a
    error (FilePath -> IO Int) -> FilePath -> IO Int
    forall a b. (a -> b) -> a -> b
    $ "Ninja parsing, could not parse depth field in pool, got: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Str -> FilePath
    BS.unpack Str
    x