{-# LANGUAGE TupleSections #-}

-- | The IO in this module is only to evaluate an envrionment variable,
--   the 'Env' itself it passed around purely.
module Development.Ninja.Type(
    Str, FileStr,
    Expr(..), Env, newEnv, askVar, askExpr, addEnv, addBind, addBinds,
    Ninja(..), newNinja, Build(..), Rule(..),
    ) where

import Development.Ninja.Env
import qualified Data.ByteString.Char8 as BS
import Data.Maybe


type Str = BS.ByteString
type FileStr = Str


---------------------------------------------------------------------
-- EXPRESSIONS AND BINDINGS

data Expr = Exprs [Expr] | Lit Str | Var Str deriving (Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show,Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq)

askExpr :: Env Str Str -> Expr -> IO Str
askExpr :: Env Str Str -> Expr -> IO Str
askExpr Env Str Str
e = Expr -> IO Str
f
    where f :: Expr -> IO Str
f (Exprs [Expr]
xs) = [Str] -> Str
BS.concat ([Str] -> Str) -> IO [Str] -> IO Str
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> IO Str) -> [Expr] -> IO [Str]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> IO Str
f [Expr]
xs
          f (Lit Str
x) = Str -> IO Str
forall (f :: * -> *) a. Applicative f => a -> f a
pure Str
x
          f (Var Str
x) = Env Str Str -> Str -> IO Str
askVar Env Str Str
e Str
x

askVar :: Env Str Str -> Str -> IO Str
askVar :: Env Str Str -> Str -> IO Str
askVar Env Str Str
e Str
x = Str -> Maybe Str -> Str
forall a. a -> Maybe a -> a
fromMaybe Str
BS.empty (Maybe Str -> Str) -> IO (Maybe Str) -> IO Str
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env Str Str -> Str -> IO (Maybe Str)
forall k v. (Eq k, Hashable k) => Env k v -> k -> IO (Maybe v)
askEnv Env Str Str
e Str
x

addBind :: Env Str Str -> Str -> Expr -> IO ()
addBind :: Env Str Str -> Str -> Expr -> IO ()
addBind Env Str Str
e Str
k Expr
v = Env Str Str -> Str -> Str -> IO ()
forall k v. (Eq k, Hashable k) => Env k v -> k -> v -> IO ()
addEnv Env Str Str
e Str
k (Str -> IO ()) -> IO Str -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env Str Str -> Expr -> IO Str
askExpr Env Str Str
e Expr
v

addBinds :: Env Str Str -> [(Str, Expr)] -> IO ()
addBinds :: Env Str Str -> [(Str, Expr)] -> IO ()
addBinds Env Str Str
e [(Str, Expr)]
bs = do
    [(Str, Str)]
bs <- ((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 (\(Str
a,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
e Expr
b) [(Str, Expr)]
bs
    ((Str, Str) -> IO ()) -> [(Str, Str)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Str -> Str -> IO ()) -> (Str, Str) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Str -> Str -> IO ()) -> (Str, Str) -> IO ())
-> (Str -> Str -> IO ()) -> (Str, Str) -> IO ()
forall a b. (a -> b) -> a -> b
$ Env Str Str -> Str -> Str -> IO ()
forall k v. (Eq k, Hashable k) => Env k v -> k -> v -> IO ()
addEnv Env Str Str
e) [(Str, Str)]
bs


---------------------------------------------------------------------
-- STRUCTURE

data Ninja = Ninja
    {Ninja -> [String]
sources :: [FilePath]
    ,Ninja -> [(Str, Rule)]
rules :: [(Str,Rule)]
    ,Ninja -> [(Str, Build)]
singles :: [(FileStr,Build)]
    ,Ninja -> [([Str], Build)]
multiples :: [([FileStr], Build)]
    ,Ninja -> [(Str, [Str])]
phonys :: [(Str, [FileStr])]
    ,Ninja -> [Str]
defaults :: [FileStr]
    ,Ninja -> [(Str, Int)]
pools :: [(Str, Int)]
    }
    deriving Int -> Ninja -> ShowS
[Ninja] -> ShowS
Ninja -> String
(Int -> Ninja -> ShowS)
-> (Ninja -> String) -> ([Ninja] -> ShowS) -> Show Ninja
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ninja] -> ShowS
$cshowList :: [Ninja] -> ShowS
show :: Ninja -> String
$cshow :: Ninja -> String
showsPrec :: Int -> Ninja -> ShowS
$cshowsPrec :: Int -> Ninja -> ShowS
Show

newNinja :: Ninja
newNinja :: Ninja
newNinja = [String]
-> [(Str, Rule)]
-> [(Str, Build)]
-> [([Str], Build)]
-> [(Str, [Str])]
-> [Str]
-> [(Str, Int)]
-> Ninja
Ninja [] [] [] [] [] [] []

data Build = Build
    {Build -> Str
ruleName :: Str
    ,Build -> Env Str Str
env :: Env Str Str
    ,Build -> [Str]
depsNormal :: [FileStr]
    ,Build -> [Str]
depsImplicit :: [FileStr]
    ,Build -> [Str]
depsOrderOnly :: [FileStr]
    ,Build -> [(Str, Str)]
buildBind :: [(Str,Str)]
    } deriving Int -> Build -> ShowS
[Build] -> ShowS
Build -> String
(Int -> Build -> ShowS)
-> (Build -> String) -> ([Build] -> ShowS) -> Show Build
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Build] -> ShowS
$cshowList :: [Build] -> ShowS
show :: Build -> String
$cshow :: Build -> String
showsPrec :: Int -> Build -> ShowS
$cshowsPrec :: Int -> Build -> ShowS
Show

newtype Rule = Rule
    {Rule -> [(Str, Expr)]
ruleBind :: [(Str,Expr)]
    } deriving Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> String
(Int -> Rule -> ShowS)
-> (Rule -> String) -> ([Rule] -> ShowS) -> Show Rule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rule] -> ShowS
$cshowList :: [Rule] -> ShowS
show :: Rule -> String
$cshow :: Rule -> String
showsPrec :: Int -> Rule -> ShowS
$cshowsPrec :: Int -> Rule -> ShowS
Show