-- | This module is the core of Haxible.
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)

-- $setup
-- >>> let mkTask attrs = BaseTask {name = Nothing, module_ = "", params = Module "", attrs}
-- >>> let mkRes name = Resource (Binder name) (Register name)

-- | A definition is like a function, to represent a play, a role, or a list of tasks.
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 = []}

-- | An expression is a single instruction.
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)

-- | A term is the expression value.
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)

-- | A resource is a global object such as a registered result or a file path.
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)

-- | A binder is a haskell variable name.
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

-- | A binder can match multiple resources, for example:
--
--   - stat:
--       path: /etc/zuul
--     register: etc_zuul
--
--   -> the binder matches (Register "etc_zuul") and (Path "/etc/zuul").
--
-- A definition produces a list of binder too, for example:
--
--   - include_role:
--       name: adder
--
--   -> the binder matches each task
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 ->
    -- a fake variable that is used to force the dependency relationship
    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

-- | The requirements indicates what binders are used by an expression.
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)])

-- | propagate binders to sub expression to set the requirements
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)

        -- Look for available requirement in the direct binders (e.g. from task register)
        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})

        -- Look for available rqeuirement in nested binders (e.g. from other play)
        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 = []

-- | Create a unique name:
-- >>> evalState (traverse (freshName "play") ["host", "host"]) emptyEnv
-- [Binder "playHost0",Binder "playHost1"]
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

-- | Convert to ascii title
-- >>> cleanName <$> ["create host", "start:network"]
-- ["CreateHost","StartNetwork"]
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)

-- | Extract requirements from a task value
-- >>> getRequirements (mkRes <$> ["hostname", "file_stat"]) [[json|{"ping": "{{ hostname }}"}|]]
-- [Resource {name = Binder "hostname", dep = Register "hostname"}]
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

  -- Look for requirements and provides
  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})

  -- Create the expr
  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
  -- exprs
  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})
  -- expr <- moduleExpr task value
  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}

-- | Extract the hosts from a play attributes:
-- >>> playName BasePlay {tasks = [], attrs = [("hosts", [json|"localhost"|])]}
-- "localhost"
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)

-- | Extract the vars from a task object:
-- >>> getTaskVars (mkTask [("vars", [json|{"test": null}|])])
-- [("test",Null)]
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

-- | Transform a list of 'Play' into a list of 'Definition'.
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}