1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
{-# LANGUAGE RecordWildCards #-}
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 file env = parseFile file env newNinja
parseFile :: FilePath -> Env Str Str -> Ninja -> IO Ninja
parseFile file env ninja = do
lexes <- lexerFile $ if file == "-" then Nothing else Just file
foldM (applyStmt env) ninja $ withBinds lexes
withBinds :: [Lexeme] -> [(Lexeme, [(Str,Expr)])]
withBinds [] = []
withBinds (x:xs) = (x,a) : withBinds b
where
(a,b) = f xs
f (LexBind a b : rest) = let (as,bs) = f rest in ((a,b):as, bs)
f xs = ([], xs)
applyStmt :: Env Str Str -> Ninja -> (Lexeme, [(Str,Expr)]) -> IO Ninja
applyStmt env ninja@Ninja{..} (key, binds) = case key of
LexBuild outputs rule deps -> do
outputs <- mapM (askExpr env) outputs
deps <- mapM (askExpr env) deps
let (normal,implicit,orderOnly) = splitDeps deps
let build = Build rule env normal implicit orderOnly binds
return $
if rule == BS.pack "phony" then ninja{phonys = [(x, normal) | x <- outputs] ++ phonys}
else if length outputs == 1 then ninja{singles = (head outputs, build) : singles}
else ninja{multiples = (outputs, build) : multiples}
LexRule name ->
return ninja{rules = (name, Rule binds) : rules}
LexDefault xs -> do
xs <- mapM (askExpr env) xs
return ninja{defaults = xs ++ defaults}
LexPool name -> do
depth <- getDepth env binds
return ninja{pools = (name, depth) : pools}
LexInclude file ->
parseFile (BS.unpack file) env ninja
LexSubninja file -> do
e <- scopeEnv env
parseFile (BS.unpack file) e ninja
LexDefine a b -> do
addBind env a b
return ninja
LexBind a b ->
error $ "Unexpected binding defining " ++ BS.unpack a
splitDeps :: [Str] -> ([Str], [Str], [Str])
splitDeps (x:xs) | x == BS.pack "|" = ([],a++b,c)
| x == BS.pack "||" = ([],b,a++c)
| otherwise = (x:a,b,c)
where (a,b,c) = splitDeps xs
splitDeps [] = ([], [], [])
getDepth :: Env Str Str -> [(Str, Expr)] -> IO Int
getDepth env xs = case lookup (BS.pack "depth") xs of
Nothing -> return 1
Just x -> do
x <- askExpr env x
case BS.readInt x of
Just (i, n) | BS.null n -> return i
_ -> error $ "Could not parse depth field in pool, got: " ++ BS.unpack x
|
