{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
module Language.Ninja.AST.Build
(
Build, makeBuild
, buildRule, buildEnv, buildDeps, buildBind
, BuildConstraint
) where
import qualified Control.Lens as Lens
import Flow ((.>), (|>))
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Control.DeepSeq (NFData)
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import qualified Test.QuickCheck as QC
import Test.QuickCheck.Instances ()
import qualified Test.SmallCheck.Series as SC
import GHC.Exts (Constraint)
import Data.Aeson ((.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Language.Ninja.AST.Deps as AST
import qualified Language.Ninja.AST.Env as AST
import qualified Language.Ninja.Misc as Misc
data Build ann
= MkBuild
{ _buildAnn :: !ann
, _buildRule :: !Text
, _buildEnv :: !(AST.Env Text Text)
, _buildDeps :: !(AST.Deps ann)
, _buildBind :: !(HashMap Text Text)
}
deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
{-# INLINE makeBuild #-}
makeBuild :: (Monoid ann)
=> Text
-> AST.Env Text Text
-> Build ann
makeBuild rule env = MkBuild
{ _buildAnn = mempty
, _buildRule = rule
, _buildEnv = env
, _buildDeps = AST.makeDeps
, _buildBind = mempty
}
{-# INLINE buildRule #-}
buildRule :: Lens.Lens' (Build ann) Text
buildRule = Lens.lens _buildRule
$ \(MkBuild {..}) x -> MkBuild { _buildRule = x, .. }
{-# INLINE buildEnv #-}
buildEnv :: Lens.Lens' (Build ann) (AST.Env Text Text)
buildEnv = Lens.lens _buildEnv
$ \(MkBuild {..}) x -> MkBuild { _buildEnv = x, .. }
{-# INLINE buildDeps #-}
buildDeps :: Lens.Lens' (Build ann) (AST.Deps ann)
buildDeps = Lens.lens _buildDeps
$ \(MkBuild {..}) x -> MkBuild { _buildDeps = x, .. }
{-# INLINE buildBind #-}
buildBind :: Lens.Lens' (Build ann) (HashMap Text Text)
buildBind = Lens.lens _buildBind
$ \(MkBuild {..}) x -> MkBuild { _buildBind = x, .. }
instance Misc.Annotated Build where
annotation' f = Lens.lens (helper .> fst) (helper .> snd)
where
helper (MkBuild {..})
= ( _buildAnn
, \x -> MkBuild { _buildAnn = x, _buildDeps = f <$> _buildDeps, .. } )
instance (Aeson.ToJSON ann) => Aeson.ToJSON (Build ann) where
toJSON (MkBuild {..})
= [ "ann" .= _buildAnn
, "rule" .= _buildRule
, "env" .= _buildEnv
, "deps" .= _buildDeps
, "bind" .= _buildBind
] |> Aeson.object
instance (Aeson.FromJSON ann) => Aeson.FromJSON (Build ann) where
parseJSON = (Aeson.withObject "Build" $ \o -> do
_buildAnn <- (o .: "ann") >>= pure
_buildRule <- (o .: "rule") >>= pure
_buildEnv <- (o .: "env") >>= pure
_buildDeps <- (o .: "deps") >>= pure
_buildBind <- (o .: "bind") >>= pure
pure (MkBuild {..}))
instance (QC.Arbitrary ann) => QC.Arbitrary (Build ann) where
arbitrary = MkBuild
<$> QC.arbitrary
<*> QC.arbitrary
<*> QC.arbitrary
<*> QC.arbitrary
<*> QC.arbitrary
instance (Hashable ann) => Hashable (Build ann)
instance (NFData ann) => NFData (Build ann)
instance ( Monad m, BuildConstraint (SC.Serial m) ann
) => SC.Serial m (Build ann)
instance ( Monad m, BuildConstraint (SC.CoSerial m) ann
) => SC.CoSerial m (Build ann)
type BuildConstraint (c :: * -> Constraint) (ann :: *)
= ( AST.DepsConstraint c ann
, c Text
, c (HashMap Text Text)
, c (AST.Maps Text Text)
, c ann
)