module Haxible.Normalize
( normalizePlaybook,
Definition (..),
Expr (..),
Term (..),
CallModule (..),
CallDefinition (..),
Origin (..),
Requirement (..),
)
where
import Data.Char qualified
import Data.Map qualified as Map
import Data.Text qualified as Text
import Haxible.Import
import Haxible.Prelude
import Haxible.Syntax (propagableAttrs)
data Definition = Definition
{ Definition -> Text
name :: Text,
Definition -> [Resource]
requires :: [Resource],
Definition -> [Resource]
provides :: [Resource],
Definition -> Environment
outputs :: Environment,
Definition -> [(Text, Value)]
playAttrs :: Vars,
Definition -> [Expr]
exprs :: [Expr]
}
deriving (Int -> Definition -> ShowS
[Definition] -> ShowS
Definition -> String
(Int -> Definition -> ShowS)
-> (Definition -> String)
-> ([Definition] -> ShowS)
-> Show Definition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Definition] -> ShowS
$cshowList :: [Definition] -> ShowS
show :: Definition -> String
$cshow :: Definition -> String
showsPrec :: Int -> Definition -> ShowS
$cshowsPrec :: Int -> Definition -> ShowS
Show, Definition -> Definition -> Bool
(Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool) -> Eq Definition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c== :: Definition -> Definition -> Bool
Eq)
emptyDefinition :: Text -> Definition
emptyDefinition :: Text -> Definition
emptyDefinition Text
name =
Definition {Text
name :: Text
$sel:name:Definition :: Text
name, $sel:requires:Definition :: [Resource]
requires = [], $sel:provides:Definition :: [Resource]
provides = [], $sel:outputs:Definition :: Environment
outputs = [(Binder, Either Environment [Resource])] -> Environment
Environment [], $sel:playAttrs:Definition :: [(Text, Value)]
playAttrs = [], $sel:exprs:Definition :: [Expr]
exprs = []}
data Expr = Expr
{ Expr -> Binder
binder :: Binder,
Expr -> [Resource]
requires :: [Resource],
Expr -> [Resource]
provides :: [Resource],
Expr -> Either Environment [Resource]
outputs :: Either Environment [Resource],
Expr -> [Requirement]
requirements :: [Requirement],
Expr -> Maybe Value
loop :: Maybe Value,
Expr -> Term
term :: Term
}
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)
data Term
= ModuleCall CallModule
| DefinitionCall CallDefinition
| BlockRescueCall CallDefinition
deriving (Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show, Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq)
data CallModule = CallModule {CallModule -> Text
module_ :: Text, CallModule -> Value
params :: Value, CallModule -> [(Text, Value)]
taskAttrs :: Vars}
deriving (Int -> CallModule -> ShowS
[CallModule] -> ShowS
CallModule -> String
(Int -> CallModule -> ShowS)
-> (CallModule -> String)
-> ([CallModule] -> ShowS)
-> Show CallModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallModule] -> ShowS
$cshowList :: [CallModule] -> ShowS
show :: CallModule -> String
$cshow :: CallModule -> String
showsPrec :: Int -> CallModule -> ShowS
$cshowsPrec :: Int -> CallModule -> ShowS
Show, CallModule -> CallModule -> Bool
(CallModule -> CallModule -> Bool)
-> (CallModule -> CallModule -> Bool) -> Eq CallModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallModule -> CallModule -> Bool
$c/= :: CallModule -> CallModule -> Bool
== :: CallModule -> CallModule -> Bool
$c== :: CallModule -> CallModule -> Bool
Eq)
data CallDefinition = CallDefinition {CallDefinition -> Text
name :: Text, CallDefinition -> [(Text, Value)]
taskAttrs :: Vars, CallDefinition -> [(Text, Value)]
taskVars :: Vars}
deriving (Int -> CallDefinition -> ShowS
[CallDefinition] -> ShowS
CallDefinition -> String
(Int -> CallDefinition -> ShowS)
-> (CallDefinition -> String)
-> ([CallDefinition] -> ShowS)
-> Show CallDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallDefinition] -> ShowS
$cshowList :: [CallDefinition] -> ShowS
show :: CallDefinition -> String
$cshow :: CallDefinition -> String
showsPrec :: Int -> CallDefinition -> ShowS
$cshowsPrec :: Int -> CallDefinition -> ShowS
Show, CallDefinition -> CallDefinition -> Bool
(CallDefinition -> CallDefinition -> Bool)
-> (CallDefinition -> CallDefinition -> Bool) -> Eq CallDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallDefinition -> CallDefinition -> Bool
$c/= :: CallDefinition -> CallDefinition -> Bool
== :: CallDefinition -> CallDefinition -> Bool
$c== :: CallDefinition -> CallDefinition -> Bool
Eq)
data Resource = Resource
{ Resource -> Binder
name :: Binder,
Resource -> Dependency
dep :: Dependency
}
deriving (Resource -> Resource -> Bool
(Resource -> Resource -> Bool)
-> (Resource -> Resource -> Bool) -> Eq Resource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Resource -> Resource -> Bool
$c/= :: Resource -> Resource -> Bool
== :: Resource -> Resource -> Bool
$c== :: Resource -> Resource -> Bool
Eq, Int -> Resource -> ShowS
[Resource] -> ShowS
Resource -> String
(Int -> Resource -> ShowS)
-> (Resource -> String) -> ([Resource] -> ShowS) -> Show Resource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resource] -> ShowS
$cshowList :: [Resource] -> ShowS
show :: Resource -> String
$cshow :: Resource -> String
showsPrec :: Int -> Resource -> ShowS
$cshowsPrec :: Int -> Resource -> ShowS
Show)
data Dependency
= Register Text
| Path Text
deriving (Dependency -> Dependency -> Bool
(Dependency -> Dependency -> Bool)
-> (Dependency -> Dependency -> Bool) -> Eq Dependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dependency -> Dependency -> Bool
$c/= :: Dependency -> Dependency -> Bool
== :: Dependency -> Dependency -> Bool
$c== :: Dependency -> Dependency -> Bool
Eq, Int -> Dependency -> ShowS
[Dependency] -> ShowS
Dependency -> String
(Int -> Dependency -> ShowS)
-> (Dependency -> String)
-> ([Dependency] -> ShowS)
-> Show Dependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dependency] -> ShowS
$cshowList :: [Dependency] -> ShowS
show :: Dependency -> String
$cshow :: Dependency -> String
showsPrec :: Int -> Dependency -> ShowS
$cshowsPrec :: Int -> Dependency -> ShowS
Show)
newtype Binder = Binder Text deriving (Binder -> Binder -> Bool
(Binder -> Binder -> Bool)
-> (Binder -> Binder -> Bool) -> Eq Binder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binder -> Binder -> Bool
$c/= :: Binder -> Binder -> Bool
== :: Binder -> Binder -> Bool
$c== :: Binder -> Binder -> Bool
Eq, Int -> Binder -> ShowS
[Binder] -> ShowS
Binder -> String
(Int -> Binder -> ShowS)
-> (Binder -> String) -> ([Binder] -> ShowS) -> Show Binder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binder] -> ShowS
$cshowList :: [Binder] -> ShowS
show :: Binder -> String
$cshow :: Binder -> String
showsPrec :: Int -> Binder -> ShowS
$cshowsPrec :: Int -> Binder -> ShowS
Show)
instance From Binder Text where from :: Binder -> Text
from (Binder Text
b) = Text
b
newtype Environment = Environment {Environment -> [(Binder, Either Environment [Resource])]
getEnv :: [(Binder, Either Environment [Resource])]}
deriving (Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
(Int -> Environment -> ShowS)
-> (Environment -> String)
-> ([Environment] -> ShowS)
-> Show Environment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show, Environment -> Environment -> Bool
(Environment -> Environment -> Bool)
-> (Environment -> Environment -> Bool) -> Eq Environment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq)
dependencyValue, dependencyName :: Dependency -> Text
dependencyName :: Dependency -> Text
dependencyName = \case
Register Text
n -> Text
n
Path Text
p ->
Text -> Text -> Text -> Text
Text.replace Text
"/" Text
"_" Text
p
dependencyValue :: Dependency -> Text
dependencyValue = \case
Register Text
n -> Text
n
Path Text
p -> Text
p
data Requirement = Requirement {Requirement -> Text
name :: Text, Requirement -> Origin
origin :: Origin} deriving (Int -> Requirement -> ShowS
[Requirement] -> ShowS
Requirement -> String
(Int -> Requirement -> ShowS)
-> (Requirement -> String)
-> ([Requirement] -> ShowS)
-> Show Requirement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Requirement] -> ShowS
$cshowList :: [Requirement] -> ShowS
show :: Requirement -> String
$cshow :: Requirement -> String
showsPrec :: Int -> Requirement -> ShowS
$cshowsPrec :: Int -> Requirement -> ShowS
Show, Requirement -> Requirement -> Bool
(Requirement -> Requirement -> Bool)
-> (Requirement -> Requirement -> Bool) -> Eq Requirement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Requirement -> Requirement -> Bool
$c/= :: Requirement -> Requirement -> Bool
== :: Requirement -> Requirement -> Bool
$c== :: Requirement -> Requirement -> Bool
Eq)
data Origin = Direct Binder | LoopVar | Nested Binder Int deriving (Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
(Int -> Origin -> ShowS)
-> (Origin -> String) -> ([Origin] -> ShowS) -> Show Origin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Origin] -> ShowS
$cshowList :: [Origin] -> ShowS
show :: Origin -> String
$cshow :: Origin -> String
showsPrec :: Int -> Origin -> ShowS
$cshowsPrec :: Int -> Origin -> ShowS
Show, Origin -> Origin -> Bool
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c== :: Origin -> Origin -> Bool
Eq)
data Env = Env
{ Env -> [Text]
names :: [Text],
Env -> [Definition]
definitions :: [Definition],
Env -> [Resource]
availables :: [Resource]
}
deriving ((forall x. Env -> Rep Env x)
-> (forall x. Rep Env x -> Env) -> Generic Env
forall x. Rep Env x -> Env
forall x. Env -> Rep Env x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Env x -> Env
$cfrom :: forall x. Env -> Rep Env x
Generic)
emptyEnv :: Env
emptyEnv :: Env
emptyEnv = [Text] -> [Definition] -> [Resource] -> Env
Env [] [] []
type ReqAcc = ([(Binder, [Resource])], [(Binder, Environment)])
solveRequirements :: [Definition] -> [Definition]
solveRequirements :: [Definition] -> [Definition]
solveRequirements [Definition]
defs = (Definition -> Definition) -> [Definition] -> [Definition]
forall a b. (a -> b) -> [a] -> [b]
map Definition -> Definition
updateCallEnv [Definition]
defs
where
updateCallEnv :: Definition -> Definition
updateCallEnv :: Definition -> Definition
updateCallEnv Definition
def = Definition
def {$sel:exprs:Definition :: [Expr]
exprs = [Expr] -> [Expr]
forall a. [a] -> [a]
reverse ([Expr] -> [Expr]) -> ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Expr], ReqAcc) -> [Expr]
forall a b. (a, b) -> a
fst (([Expr], ReqAcc) -> [Expr])
-> ([Expr] -> ([Expr], ReqAcc)) -> [Expr] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Expr], ReqAcc) -> Expr -> ([Expr], ReqAcc))
-> ([Expr], ReqAcc) -> [Expr] -> ([Expr], ReqAcc)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Expr], ReqAcc) -> Expr -> ([Expr], ReqAcc)
setCallEnv ([], ([], [])) ([Expr] -> [Expr]) -> [Expr] -> [Expr]
forall a b. (a -> b) -> a -> b
$ Definition
def.exprs}
outputs :: Map Text Environment
outputs = [(Text, Environment)] -> Map Text Environment
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((\Definition
def -> (Definition
def.name, Definition
def.outputs)) (Definition -> (Text, Environment))
-> [Definition] -> [(Text, Environment)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Definition]
defs)
getOutputs :: Text -> Environment
getOutputs Text
name = Environment -> Maybe Environment -> Environment
forall a. a -> Maybe a -> a
fromMaybe (String -> Environment
forall a. HasCallStack => String -> a
error (String -> Environment) -> String -> Environment
forall a b. (a -> b) -> a -> b
$ Text -> String
forall source target. From source target => source -> target
from Text
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": Unknown def?!") (Text -> Map Text Environment -> Maybe Environment
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Map Text Environment
outputs)
setCallEnv :: ([Expr], ReqAcc) -> Expr -> ([Expr], ReqAcc)
setCallEnv :: ([Expr], ReqAcc) -> Expr -> ([Expr], ReqAcc)
setCallEnv ([Expr]
acc, ([(Binder, [Resource])]
avail, [(Binder, Environment)]
nested)) Expr
expr = (Expr
newExpr Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
acc, ([(Binder, [Resource])]
newAvail, [(Binder, Environment)]
newNested))
where
([(Binder, [Resource])]
newAvail, [(Binder, Environment)]
newNested) = case Expr
expr.term of
ModuleCall CallModule
_ -> ((Expr
expr.binder, Expr
expr.provides) (Binder, [Resource])
-> [(Binder, [Resource])] -> [(Binder, [Resource])]
forall a. a -> [a] -> [a]
: [(Binder, [Resource])]
avail, [(Binder, Environment)]
nested)
DefinitionCall CallDefinition
dc -> ([(Binder, [Resource])]
avail, (Expr
expr.binder, Text -> Environment
getOutputs CallDefinition
dc.name) (Binder, Environment)
-> [(Binder, Environment)] -> [(Binder, Environment)]
forall a. a -> [a] -> [a]
: [(Binder, Environment)]
nested)
BlockRescueCall CallDefinition
rc -> ([(Binder, [Resource])]
avail, (Expr
expr.binder, Text -> Environment
getOutputs (CallDefinition
rc.name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Rescue")) (Binder, Environment)
-> [(Binder, Environment)] -> [(Binder, Environment)]
forall a. a -> [a] -> [a]
: [(Binder, Environment)]
nested)
newExpr :: Expr
newExpr = Expr
expr {$sel:requirements:Expr :: [Requirement]
requirements = Expr
expr.requirements [Requirement] -> [Requirement] -> [Requirement]
forall a. Semigroup a => a -> a -> a
<> [Requirement]
directRequirement [Requirement] -> [Requirement] -> [Requirement]
forall a. Semigroup a => a -> a -> a
<> [Requirement]
nestedRequirement}
reMatch :: [Resource] -> Bool
reMatch :: [Resource] -> Bool
reMatch = (Resource -> Bool) -> [Resource] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Resource -> [Resource] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Expr
expr.requires)
directRequirement :: [Requirement]
directRequirement :: [Requirement]
directRequirement = ((Binder, [Resource]) -> [Requirement])
-> [(Binder, [Resource])] -> [Requirement]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Binder -> [Resource] -> [Requirement])
-> (Binder, [Resource]) -> [Requirement]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Binder -> [Resource] -> [Requirement]
toReq) ([(Binder, [Resource])] -> [Requirement])
-> [(Binder, [Resource])] -> [Requirement]
forall a b. (a -> b) -> a -> b
$ ((Binder, [Resource]) -> Bool)
-> [(Binder, [Resource])] -> [(Binder, [Resource])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Resource] -> Bool
reMatch ([Resource] -> Bool)
-> ((Binder, [Resource]) -> [Resource])
-> (Binder, [Resource])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binder, [Resource]) -> [Resource]
forall a b. (a, b) -> b
snd) [(Binder, [Resource])]
avail
where
toReq :: Binder -> [Resource] -> [Requirement]
toReq :: Binder -> [Resource] -> [Requirement]
toReq Binder
name = (Resource -> Requirement) -> [Resource] -> [Requirement]
forall a b. (a -> b) -> [a] -> [b]
map (\Resource
x -> Requirement {$sel:name:Requirement :: Text
name = Dependency -> Text
dependencyName Resource
x.dep, $sel:origin:Requirement :: Origin
origin = Binder -> Origin
Direct Binder
name})
nestedRequirement :: [Requirement]
nestedRequirement :: [Requirement]
nestedRequirement = ((Binder, Environment) -> [Requirement])
-> [(Binder, Environment)] -> [Requirement]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Binder -> Environment -> [Requirement])
-> (Binder, Environment) -> [Requirement]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Int -> Binder -> Environment -> [Requirement]
go Int
0)) [(Binder, Environment)]
nested
where
go :: Int -> Binder -> Environment -> [Requirement]
go :: Int -> Binder -> Environment -> [Requirement]
go Int
binderPos Binder
binder =
((Int, Either Environment [Resource]) -> [Requirement])
-> [(Int, Either Environment [Resource])] -> [Requirement]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
envPos, Either Environment [Resource]
binderResources) -> Int -> Binder -> Either Environment [Resource] -> [Requirement]
toReq (Int
binderPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
envPos) Binder
binder Either Environment [Resource]
binderResources)
([(Int, Either Environment [Resource])] -> [Requirement])
-> (Environment -> [(Int, Either Environment [Resource])])
-> Environment
-> [Requirement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> [Either Environment [Resource]]
-> [(Int, Either Environment [Resource])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..]
([Either Environment [Resource]]
-> [(Int, Either Environment [Resource])])
-> (Environment -> [Either Environment [Resource]])
-> Environment
-> [(Int, Either Environment [Resource])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Binder, Either Environment [Resource])
-> Either Environment [Resource])
-> [(Binder, Either Environment [Resource])]
-> [Either Environment [Resource]]
forall a b. (a -> b) -> [a] -> [b]
map (Binder, Either Environment [Resource])
-> Either Environment [Resource]
forall a b. (a, b) -> b
snd
([(Binder, Either Environment [Resource])]
-> [Either Environment [Resource]])
-> (Environment -> [(Binder, Either Environment [Resource])])
-> Environment
-> [Either Environment [Resource]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [(Binder, Either Environment [Resource])]
getEnv
toReq :: Int -> Binder -> Either Environment [Resource] -> [Requirement]
toReq :: Int -> Binder -> Either Environment [Resource] -> [Requirement]
toReq Int
resourcePos Binder
binder = \case
Right [Resource]
resources
| [Resource] -> Bool
reMatch [Resource]
resources -> ((Int, Resource) -> [Requirement])
-> [(Int, Resource)] -> [Requirement]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Binder -> (Int, Resource) -> [Requirement]
toNestedReq Int
resourcePos Binder
binder) ([Int] -> [Resource] -> [(Int, Resource)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Resource]
resources)
| Bool
otherwise -> []
Left Environment
env -> Int -> Binder -> Environment -> [Requirement]
go Int
resourcePos Binder
binder Environment
env
toNestedReq :: Int -> Binder -> (Int, Resource) -> [Requirement]
toNestedReq :: Int -> Binder -> (Int, Resource) -> [Requirement]
toNestedReq Int
resourcePos Binder
binder (Int
pos, Resource
res)
| Resource
res Resource -> [Resource] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Expr
expr.requires =
[Requirement {$sel:name:Requirement :: Text
name = Dependency -> Text
dependencyName Resource
res.dep, $sel:origin:Requirement :: Origin
origin = Binder -> Int -> Origin
Nested Binder
binder (Int
resourcePos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pos)}]
| Bool
otherwise = []
freshName :: Text -> Text -> State Env Binder
freshName :: Text -> Text -> State Env Binder
freshName Text
base Text
identifier = do
[Text]
names <- (Env -> [Text]) -> StateT Env Identity [Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> [Text]
names
let name :: Text
name = Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanName Text
identifier
newName :: Text
newName = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
name (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
isFresh ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
forall source target. From source target => source -> target
from (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show @Int) [Int
0 ..]
isFresh :: Text -> Bool
isFresh Text
x = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
names
(Env -> Env) -> StateT Env Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env {$sel:names:Env :: [Text]
names = Text
newName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
names})
Binder -> State Env Binder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Binder -> State Env Binder) -> Binder -> State Env Binder
forall a b. (a -> b) -> a -> b
$ Text -> Binder
Binder Text
newName
cleanName :: Text -> Text
cleanName :: Text -> Text
cleanName = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.toTitle ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
Text.split (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Data.Char.isAlphaNum)
getRequirements :: [Resource] -> [Value] -> [Resource]
getRequirements :: [Resource] -> [Value] -> [Resource]
getRequirements [Resource]
availables = (Value -> [Resource]) -> [Value] -> [Resource]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Resource]
findRequirements
where
findRequirements :: Value -> [Resource]
findRequirements :: Value -> [Resource]
findRequirements Value
v = case Value
v of
String Text
x -> case (Resource -> Bool) -> [Resource] -> [Resource]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Resource
n -> Dependency -> Text
dependencyValue (Resource
n.dep) Text -> Text -> Bool
`Text.isInfixOf` Text
x) [Resource]
availables of
[] -> []
[Resource]
requirement -> [Resource]
requirement
Object Object
x -> (Value -> [Resource]) -> Object -> [Resource]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Resource]
findRequirements Object
x
Array Array
x -> (Value -> [Resource]) -> Array -> [Resource]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Resource]
findRequirements Array
x
Value
_ -> []
moduleExpr :: Task -> Value -> State Env Expr
moduleExpr :: Task -> Value -> State Env Expr
moduleExpr Task
task Value
value = do
Binder
binder <- Text -> Text -> State Env Binder
freshName Task
task.module_ (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Task
task.name)
[Resource]
availables <- (Env -> [Resource]) -> StateT Env Identity [Resource]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> [Resource]
availables
let requires :: [Resource]
requires = [Resource] -> [Value] -> [Resource]
getRequirements [Resource]
availables (Value
value Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
attrs)
provides :: [Resource]
provides = Binder -> Dependency -> Resource
Resource Binder
binder (Dependency -> Resource) -> [Dependency] -> [Resource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Dependency -> [Dependency]
forall a. Maybe a -> [a]
maybeToList Maybe Dependency
register [Dependency] -> [Dependency] -> [Dependency]
forall a. Semigroup a => a -> a -> a
<> Maybe Dependency -> [Dependency]
forall a. Maybe a -> [a]
maybeToList Maybe Dependency
destPath
(Env -> Env) -> StateT Env Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env {$sel:availables:Env :: [Resource]
availables = [Resource]
provides [Resource] -> [Resource] -> [Resource]
forall a. Semigroup a => a -> a -> a
<> [Resource]
availables})
let term :: Term
term = CallModule -> Term
ModuleCall CallModule {$sel:module_:CallModule :: Text
module_ = Task
task.module_, $sel:params:CallModule :: Value
params = Value
value, [(Text, Value)]
taskAttrs :: [(Text, Value)]
$sel:taskAttrs:CallModule :: [(Text, Value)]
taskAttrs}
requirements :: [a]
requirements = []
outputs :: Either Environment [Resource]
outputs = [Resource] -> Either Environment [Resource]
forall a b. b -> Either a b
Right [Resource]
provides
Expr -> State Env Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> State Env Expr) -> Expr -> State Env Expr
forall a b. (a -> b) -> a -> b
$ Expr {Binder
binder :: Binder
$sel:binder:Expr :: Binder
binder, [Resource]
requires :: [Resource]
$sel:requires:Expr :: [Resource]
requires, [Resource]
provides :: [Resource]
$sel:provides:Expr :: [Resource]
provides, Either Environment [Resource]
outputs :: Either Environment [Resource]
$sel:outputs:Expr :: Either Environment [Resource]
outputs, [Requirement]
forall a. [a]
requirements :: forall a. [a]
$sel:requirements:Expr :: [Requirement]
requirements, $sel:loop:Expr :: Maybe Value
loop = Maybe Value
forall a. Maybe a
Nothing, Term
term :: Term
$sel:term:Expr :: Term
term}
where
destPath :: Maybe Dependency
destPath = Text -> Dependency
Path (Text -> Dependency) -> Maybe Text -> Maybe Dependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Text
getAttr Text
"path" Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
getAttr Text
"dest")
register :: Maybe Dependency
register = Text -> Dependency
Register (Text -> Dependency) -> Maybe Text -> Maybe Dependency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String (Value -> Maybe Text) -> Maybe Value -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"register" Task
task.attrs)
getAttr :: Text -> Maybe Text
getAttr Text
n = Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
n ((Value -> Const (First Text) Value)
-> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String) Value
value
attrs :: [Value]
attrs = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Maybe Value -> Value) -> (Text -> Maybe Value) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [(Text, Value)] -> Maybe Value)
-> [(Text, Value)] -> Text -> Maybe Value
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Task
task.attrs (Text -> Value) -> [Text] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
"vars" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
propagableAttrs)
elemFst :: (Text, b) -> [Text] -> Bool
elemFst = Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Text -> [Text] -> Bool)
-> ((Text, b) -> Text) -> (Text, b) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, b) -> Text
forall a b. (a, b) -> a
fst
taskAttrs :: [(Text, Value)]
taskAttrs = ((Text, Value) -> Bool) -> [(Text, Value)] -> [(Text, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text, Value) -> [Text] -> Bool
forall {b}. (Text, b) -> [Text] -> Bool
`elemFst` [Text]
propagableAttrs) Task
task.attrs
roleExpr :: Task -> RoleValue -> State Env Expr
roleExpr :: Task -> RoleValue -> State Env Expr
roleExpr Task
task RoleValue
role = do
Bool -> StateT Env Identity () -> StateT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"register" Task
task.attrs) (String -> StateT Env Identity ()
forall a. HasCallStack => String -> a
error String
"Register include_role is not supported")
Definition
roleDef <- Text -> [Task] -> State Env Definition
normalizeDefinition Text
name RoleValue
role.tasks
(Env -> Env) -> StateT Env Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter Env Env [Definition] [Definition]
#definitions ASetter Env Env [Definition] [Definition]
-> ([Definition] -> [Definition]) -> Env -> Env
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definition
roleDef :))
Expr
expr <- Task -> Value -> State Env Expr
moduleExpr Task
task Value
Null
Binder
binder <- Text -> Text -> State Env Binder
freshName Text
"role" RoleValue
role.name
Expr -> State Env Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> State Env Expr) -> Expr -> State Env Expr
forall a b. (a -> b) -> a -> b
$ Expr
expr {Binder
binder :: Binder
$sel:binder:Expr :: Binder
binder, $sel:term:Expr :: Term
term = CallDefinition -> Term
DefinitionCall CallDefinition {Text
name :: Text
$sel:name:CallDefinition :: Text
name, [(Text, Value)]
taskVars :: [(Text, Value)]
$sel:taskVars:CallDefinition :: [(Text, Value)]
taskVars, [(Text, Value)]
taskAttrs :: [(Text, Value)]
$sel:taskAttrs:CallDefinition :: [(Text, Value)]
taskAttrs}}
where
taskAttrs :: [(Text, Value)]
taskAttrs = Task -> [(Text, Value)]
getTaskAttrs Task
task
taskVars :: [(Text, Value)]
taskVars = Task -> [(Text, Value)]
getTaskVars Task
task [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> RoleValue
role.defaults
name :: Text
name = Text
"role" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanName RoleValue
role.name
tasksExpr :: Task -> Text -> [Task] -> State Env Expr
tasksExpr :: Task -> Text -> [Task] -> State Env Expr
tasksExpr Task
task Text
includeName [Task]
tasks = do
Bool -> StateT Env Identity () -> StateT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"register" Task
task.attrs) (String -> StateT Env Identity ()
forall a. HasCallStack => String -> a
error String
"Register include_tasks is not supported")
Definition
tasksDef <- Text -> [Task] -> State Env Definition
normalizeDefinition Text
name [Task]
tasks
(Env -> Env) -> StateT Env Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter Env Env [Definition] [Definition]
#definitions ASetter Env Env [Definition] [Definition]
-> ([Definition] -> [Definition]) -> Env -> Env
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definition
tasksDef :))
Expr
expr <- Task -> Value -> State Env Expr
moduleExpr Task
task Value
Null
Binder
binder <- Text -> Text -> State Env Binder
freshName Text
"tasks" Text
name
let outputs :: Either Environment [Resource]
outputs = Environment -> Either Environment [Resource]
forall a b. a -> Either a b
Left Definition
tasksDef.outputs
Expr -> State Env Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> State Env Expr) -> Expr -> State Env Expr
forall a b. (a -> b) -> a -> b
$ Expr
expr {Binder
binder :: Binder
$sel:binder:Expr :: Binder
binder, Either Environment [Resource]
outputs :: Either Environment [Resource]
$sel:outputs:Expr :: Either Environment [Resource]
outputs, $sel:term:Expr :: Term
term = CallDefinition -> Term
DefinitionCall CallDefinition {Text
name :: Text
$sel:name:CallDefinition :: Text
name, [(Text, Value)]
taskVars :: [(Text, Value)]
$sel:taskVars:CallDefinition :: [(Text, Value)]
taskVars, [(Text, Value)]
taskAttrs :: [(Text, Value)]
$sel:taskAttrs:CallDefinition :: [(Text, Value)]
taskAttrs}}
where
taskVars :: [(Text, Value)]
taskVars = Task -> [(Text, Value)]
getTaskVars Task
task
taskAttrs :: [(Text, Value)]
taskAttrs = Task -> [(Text, Value)]
getTaskAttrs Task
task
name :: Text
name = Text
"tasks" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
cleanName Text
includeName
factsExpr :: Task -> Maybe Value -> Text -> Value -> State Env Expr
factsExpr :: Task -> Maybe Value -> Text -> Value -> State Env Expr
factsExpr Task
task Maybe Value
cacheable Text
name Value
value = do
Binder
binder <- Text -> Text -> State Env Binder
freshName Text
"facts" (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Task
task.name)
[Resource]
availables <- (Env -> [Resource]) -> StateT Env Identity [Resource]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Env -> [Resource]
availables
let requires :: [Resource]
requires = [Resource] -> [Value] -> [Resource]
getRequirements [Resource]
availables [Value
value]
resource :: Resource
resource = Resource {$sel:name:Resource :: Binder
name = Binder
binder, $sel:dep:Resource :: Dependency
dep = Text -> Dependency
Register Text
name}
provides :: [Resource]
provides = [Resource
resource]
outputs :: Either Environment [Resource]
outputs = [Resource] -> Either Environment [Resource]
forall a b. b -> Either a b
Right [Resource]
provides
params :: Value
params = [(Text, Value)] -> Value
mkObj ([(Text, Value)] -> Value) -> [(Text, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ [(Text
name, Value
value)] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
-> (Value -> [(Text, Value)]) -> Maybe Value -> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
v -> [(Text
"cacheable", Value
v)]) Maybe Value
cacheable
term :: Term
term = CallModule -> Term
ModuleCall CallModule {$sel:module_:CallModule :: Text
module_ = Text
"set_fact", Value
params :: Value
$sel:params:CallModule :: Value
params, $sel:taskAttrs:CallModule :: [(Text, Value)]
taskAttrs = []}
loop :: Maybe a
loop = Maybe a
forall a. Maybe a
Nothing
requirements :: [a]
requirements = []
(Env -> Env) -> StateT Env Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\Env
env -> Env
env {$sel:availables:Env :: [Resource]
availables = Resource
resource Resource -> [Resource] -> [Resource]
forall a. a -> [a] -> [a]
: [Resource]
availables})
Bool -> StateT Env Identity () -> StateT Env Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"loop" Task
task.attrs)) (StateT Env Identity () -> StateT Env Identity ())
-> StateT Env Identity () -> StateT Env Identity ()
forall a b. (a -> b) -> a -> b
$ String -> StateT Env Identity ()
forall a. HasCallStack => String -> a
error String
"set_fact loop is not supported"
Expr -> State Env Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> State Env Expr) -> Expr -> State Env Expr
forall a b. (a -> b) -> a -> b
$ Expr {Binder
binder :: Binder
$sel:binder:Expr :: Binder
binder, [Resource]
requires :: [Resource]
$sel:requires:Expr :: [Resource]
requires, [Resource]
provides :: [Resource]
$sel:provides:Expr :: [Resource]
provides, Either Environment [Resource]
outputs :: Either Environment [Resource]
$sel:outputs:Expr :: Either Environment [Resource]
outputs, [Requirement]
forall a. [a]
requirements :: forall a. [a]
$sel:requirements:Expr :: [Requirement]
requirements, Maybe Value
forall a. Maybe a
loop :: forall a. Maybe a
$sel:loop:Expr :: Maybe Value
loop, Term
term :: Term
$sel:term:Expr :: Term
term}
blockExpr :: Task -> BlockValue -> State Env Expr
blockExpr :: Task -> BlockValue -> State Env Expr
blockExpr Task
task BlockValue
block = do
Binder
binder <- Text -> Text -> State Env Binder
freshName Text
"block" (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Task
task.name)
let name :: Text
name = Binder -> Text
forall source target. From source target => source -> target
from Binder
binder
(Environment
outs, CallDefinition -> Term
dc) <- case BlockValue
block.rescues of
[] -> do
Definition
blockDef <- Text -> [Task] -> State Env Definition
normalizeDefinition Text
name BlockValue
block.tasks
(Env -> Env) -> StateT Env Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter Env Env [Definition] [Definition]
#definitions ASetter Env Env [Definition] [Definition]
-> ([Definition] -> [Definition]) -> Env -> Env
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Definition
blockDef :))
(Environment, CallDefinition -> Term)
-> StateT Env Identity (Environment, CallDefinition -> Term)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Definition
blockDef.outputs, CallDefinition -> Term
DefinitionCall)
[Task]
_ -> do
Definition
blockDef <- Text -> [Task] -> State Env Definition
normalizeDefinition (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Main") BlockValue
block.tasks
Definition
rescueDef <- Text -> [Task] -> State Env Definition
normalizeDefinition (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Rescue") BlockValue
block.rescues
(Env -> Env) -> StateT Env Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (ASetter Env Env [Definition] [Definition]
#definitions ASetter Env Env [Definition] [Definition]
-> ([Definition] -> [Definition]) -> Env -> Env
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Definition
rescueDef, Definition
blockDef] <>))
(Environment, CallDefinition -> Term)
-> StateT Env Identity (Environment, CallDefinition -> Term)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Definition
rescueDef.outputs, CallDefinition -> Term
BlockRescueCall)
Expr
expr <- Task -> Value -> State Env Expr
moduleExpr Task
task Value
Null
let outputs :: Either Environment [Resource]
outputs = Environment -> Either Environment [Resource]
forall a b. a -> Either a b
Left Environment
outs
taskVars :: [(Text, Value)]
taskVars = Task -> [(Text, Value)]
getTaskVars Task
task
taskAttrs :: [(Text, Value)]
taskAttrs = Task -> [(Text, Value)]
getTaskAttrs Task
task
Expr -> State Env Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> State Env Expr) -> Expr -> State Env Expr
forall a b. (a -> b) -> a -> b
$ Expr
expr {Binder
binder :: Binder
$sel:binder:Expr :: Binder
binder, Either Environment [Resource]
outputs :: Either Environment [Resource]
$sel:outputs:Expr :: Either Environment [Resource]
outputs, $sel:term:Expr :: Term
term = CallDefinition -> Term
dc CallDefinition {Text
name :: Text
$sel:name:CallDefinition :: Text
name, [(Text, Value)]
taskVars :: [(Text, Value)]
$sel:taskVars:CallDefinition :: [(Text, Value)]
taskVars, [(Text, Value)]
taskAttrs :: [(Text, Value)]
$sel:taskAttrs:CallDefinition :: [(Text, Value)]
taskAttrs}}
normalizeTask :: Task -> State Env [Expr]
normalizeTask :: Task -> State Env [Expr]
normalizeTask Task
task = do
[Expr]
exprs <- case Task
task.params of
Module Value
v -> (Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: []) (Expr -> [Expr]) -> State Env Expr -> State Env [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Task -> Value -> State Env Expr
moduleExpr Task
task Value
v
Role RoleValue
r -> (Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: []) (Expr -> [Expr]) -> State Env Expr -> State Env [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Task -> RoleValue -> State Env Expr
roleExpr Task
task RoleValue
r
Tasks Text
name [Task]
xs -> (Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: []) (Expr -> [Expr]) -> State Env Expr -> State Env [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Task -> Text -> [Task] -> State Env Expr
tasksExpr Task
task Text
name [Task]
xs
Facts [(Text, Value)]
vars -> ((Text, Value) -> State Env Expr)
-> [(Text, Value)] -> State Env [Expr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> Value -> State Env Expr)
-> (Text, Value) -> State Env Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Task -> Maybe Value -> Text -> Value -> State Env Expr
factsExpr Task
task Maybe Value
forall a. Maybe a
Nothing)) [(Text, Value)]
vars
CacheableFacts Value
cacheable [(Text, Value)]
vars -> ((Text, Value) -> State Env Expr)
-> [(Text, Value)] -> State Env [Expr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> Value -> State Env Expr)
-> (Text, Value) -> State Env Expr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Task -> Maybe Value -> Text -> Value -> State Env Expr
factsExpr Task
task (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
cacheable))) [(Text, Value)]
vars
Block BlockValue
bv -> (Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: []) (Expr -> [Expr]) -> State Env Expr -> State Env [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Task -> BlockValue -> State Env Expr
blockExpr Task
task BlockValue
bv
[Expr] -> State Env [Expr]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Expr] -> State Env [Expr]) -> [Expr] -> State Env [Expr]
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr) -> [Expr] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Expr
addLoopReq [Expr]
exprs
where
addLoopReq :: Expr -> Expr
addLoopReq Expr
expr = Expr
expr {Maybe Value
loop :: Maybe Value
$sel:loop:Expr :: Maybe Value
loop, $sel:requirements:Expr :: [Requirement]
requirements = [Requirement]
extraReq [Requirement] -> [Requirement] -> [Requirement]
forall a. Semigroup a => a -> a -> a
<> Expr
expr.requirements}
(Maybe Value
loop, [Requirement]
extraReq) = case Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"loop" Task
task.attrs of
Just Value
v -> (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v, [Text -> Origin -> Requirement
Requirement Text
"item" Origin
LoopVar])
Maybe Value
Nothing -> (Maybe Value
forall a. Maybe a
Nothing, [])
normalizeDefinition :: Text -> [Task] -> State Env Definition
normalizeDefinition :: Text -> [Task] -> State Env Definition
normalizeDefinition Text
name [Task]
tasks = do
[Expr]
exprs <- [[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr])
-> StateT Env Identity [[Expr]] -> State Env [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Task -> State Env [Expr])
-> [Task] -> StateT Env Identity [[Expr]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Task -> State Env [Expr]
normalizeTask [Task]
tasks
let provides :: [Resource]
provides = [Resource] -> [Resource]
forall a. Eq a => [a] -> [a]
nub ([Resource] -> [Resource]) -> [Resource] -> [Resource]
forall a b. (a -> b) -> a -> b
$ (Expr -> [Resource]) -> [Expr] -> [Resource]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (.provides) [Expr]
exprs
requires :: [Resource]
requires = [Resource] -> [Resource]
forall a. Eq a => [a] -> [a]
nub ([Resource] -> [Resource]) -> [Resource] -> [Resource]
forall a b. (a -> b) -> a -> b
$ (Resource -> Bool) -> [Resource] -> [Resource]
forall a. (a -> Bool) -> [a] -> [a]
filter (Resource -> [Resource] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Resource]
provides) ([Resource] -> [Resource]) -> [Resource] -> [Resource]
forall a b. (a -> b) -> a -> b
$ (Expr -> [Resource]) -> [Expr] -> [Resource]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (.requires) [Expr]
exprs
outputs :: Environment
outputs = [(Binder, Either Environment [Resource])] -> Environment
Environment ([(Binder, Either Environment [Resource])] -> Environment)
-> [(Binder, Either Environment [Resource])] -> Environment
forall a b. (a -> b) -> a -> b
$ (\Expr
e -> (Expr
e.binder, Expr
e.outputs)) (Expr -> (Binder, Either Environment [Resource]))
-> [Expr] -> [(Binder, Either Environment [Resource])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expr]
exprs
Definition -> State Env Definition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Definition -> State Env Definition)
-> Definition -> State Env Definition
forall a b. (a -> b) -> a -> b
$ Definition {Text
name :: Text
$sel:name:Definition :: Text
name, [Expr]
exprs :: [Expr]
$sel:exprs:Definition :: [Expr]
exprs, [Resource]
requires :: [Resource]
$sel:requires:Definition :: [Resource]
requires, [Resource]
provides :: [Resource]
$sel:provides:Definition :: [Resource]
provides, Environment
outputs :: Environment
$sel:outputs:Definition :: Environment
outputs, $sel:playAttrs:Definition :: [(Text, Value)]
playAttrs = []}
normalizePlay :: Play -> State Env Definition
normalizePlay :: Play -> State Env Definition
normalizePlay Play
play = do
Binder Text
name <- Text -> Text -> State Env Binder
freshName Text
"play" (Play -> Text
playName Play
play)
Definition -> Definition
addPlayAttrs (Definition -> Definition)
-> State Env Definition -> State Env Definition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Task] -> State Env Definition
normalizeDefinition Text
name Play
play.tasks
where
addPlayAttrs :: Definition -> Definition
addPlayAttrs Definition
def = Definition
def {$sel:playAttrs:Definition :: [(Text, Value)]
playAttrs = Play
play.attrs}
playName :: Play -> Text
playName :: Play -> Text
playName Play
play = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String (Value -> Maybe Text) -> Maybe Value -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"hosts" Play
play.attrs)
getTaskVars :: Task -> Vars
getTaskVars :: Task -> [(Text, Value)]
getTaskVars Task
task = IndexedGetting Text (Endo [(Text, Value)]) Value Value
-> Value -> [(Text, Value)]
forall i a s. IndexedGetting i (Endo [(i, a)]) s a -> s -> [(i, a)]
itoListOf IndexedGetting Text (Endo [(Text, Value)]) Value Value
forall t. AsValue t => IndexedTraversal' Text t Value
members (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"vars" Task
task.attrs)
getTaskAttrs :: Task -> Vars
getTaskAttrs :: Task -> [(Text, Value)]
getTaskAttrs Task
task = ((Text, Value) -> Bool) -> [(Text, Value)] -> [(Text, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text
k, Value
_) -> Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
propagableAttrs) Task
task.attrs
normalizePlaybook :: [Play] -> [Definition]
normalizePlaybook :: [Play] -> [Definition]
normalizePlaybook [Play]
plays =
let ([Definition]
xs, Env
env) = (State Env [Definition] -> Env -> ([Definition], Env))
-> Env -> State Env [Definition] -> ([Definition], Env)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Env [Definition] -> Env -> ([Definition], Env)
forall s a. State s a -> s -> (a, s)
runState Env
emptyEnv do
[Definition]
defs <- (Play -> State Env Definition) -> [Play] -> State Env [Definition]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Play -> State Env Definition
normalizePlay [Play]
plays
[Expr]
exprs <- ((Play, Definition) -> State Env Expr)
-> [(Play, Definition)] -> State Env [Expr]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Play, Definition) -> State Env Expr
forall {r}.
(HasField "name" r Text, HasField "requires" r [Resource],
HasField "provides" r [Resource]) =>
(Play, r) -> State Env Expr
topLevelCall ([Play] -> [Definition] -> [(Play, Definition)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Play]
plays [Definition]
defs)
[Definition] -> State Env [Definition]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Definition] -> State Env [Definition])
-> [Definition] -> State Env [Definition]
forall a b. (a -> b) -> a -> b
$ [Expr] -> Definition
topLevel [Expr]
exprs Definition -> [Definition] -> [Definition]
forall a. a -> [a] -> [a]
: [Definition]
defs
in [Definition] -> [Definition]
solveRequirements ([Definition]
xs [Definition] -> [Definition] -> [Definition]
forall a. Semigroup a => a -> a -> a
<> Env
env.definitions)
where
topLevelCall :: (Play, r) -> State Env Expr
topLevelCall (Play
play, r
def) = do
Binder
binder <- Text -> Text -> State Env Binder
freshName Text
"results" (Play -> Text
playName Play
play)
let term :: Term
term = CallDefinition -> Term
DefinitionCall CallDefinition {$sel:name:CallDefinition :: Text
name = r
def.name, $sel:taskVars:CallDefinition :: [(Text, Value)]
taskVars = [], $sel:taskAttrs:CallDefinition :: [(Text, Value)]
taskAttrs = []}
outputs :: Either a [a]
outputs = [a] -> Either a [a]
forall a b. b -> Either a b
Right []
Expr -> State Env Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr -> State Env Expr) -> Expr -> State Env Expr
forall a b. (a -> b) -> a -> b
$ Expr {Binder
binder :: Binder
$sel:binder:Expr :: Binder
binder, $sel:requires:Expr :: [Resource]
requires = r
def.requires, $sel:provides:Expr :: [Resource]
provides = r
def.provides, Either Environment [Resource]
forall {a} {a}. Either a [a]
outputs :: forall {a} {a}. Either a [a]
$sel:outputs:Expr :: Either Environment [Resource]
outputs, $sel:requirements:Expr :: [Requirement]
requirements = [], $sel:loop:Expr :: Maybe Value
loop = Maybe Value
forall a. Maybe a
Nothing, Term
term :: Term
$sel:term:Expr :: Term
term}
topLevel :: [Expr] -> Definition
topLevel :: [Expr] -> Definition
topLevel [Expr]
exprs = (Text -> Definition
emptyDefinition Text
"playbook") {[Expr]
exprs :: [Expr]
$sel:exprs:Definition :: [Expr]
exprs}