module Hydra.Langs.Yaml.Modules (moduleToYaml) where

import Hydra.Kernel
import Hydra.Adapters
import Hydra.Langs.Yaml.Serde
import Hydra.Langs.Yaml.Language
import qualified Hydra.Langs.Yaml.Model as YM
import qualified Hydra.Dsl.Types as Types

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M


constructModule ::
  Module
  -> M.Map (Type) (Coder (Graph) (Graph) (Term) YM.Node)
  -> [(Element, TypedTerm)]
  -> Flow (Graph) YM.Node
constructModule :: Module
-> Map Type (Coder Graph Graph Term Node)
-> [(Element, TypedTerm)]
-> Flow Graph Node
constructModule Module
mod Map Type (Coder Graph Graph Term Node)
coders [(Element, TypedTerm)]
pairs = do
    [(Node, Node)]
keyvals <- FilePath -> Flow Graph [(Node, Node)] -> Flow Graph [(Node, Node)]
forall s a. FilePath -> Flow s a -> Flow s a
withTrace FilePath
"encoding terms" (((Element, TypedTerm) -> Flow Graph (Node, Node))
-> [(Element, TypedTerm)] -> Flow Graph [(Node, Node)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (Element, TypedTerm) -> Flow Graph (Node, Node)
toYaml [(Element, TypedTerm)]
pairs)
    Node -> Flow Graph Node
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Node -> Flow Graph Node) -> Node -> Flow Graph Node
forall a b. (a -> b) -> a -> b
$ Map Node Node -> Node
YM.NodeMapping (Map Node Node -> Node) -> Map Node Node -> Node
forall a b. (a -> b) -> a -> b
$ [(Node, Node)] -> Map Node Node
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Node, Node)]
keyvals
  where
    toYaml :: (Element, TypedTerm) -> Flow Graph (Node, Node)
toYaml (Element
el, (TypedTerm Term
term Type
typ)) = FilePath -> Flow Graph (Node, Node) -> Flow Graph (Node, Node)
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"element " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
unName (Element -> Name
elementName Element
el)) (Flow Graph (Node, Node) -> Flow Graph (Node, Node))
-> Flow Graph (Node, Node) -> Flow Graph (Node, Node)
forall a b. (a -> b) -> a -> b
$ do
      Term -> Flow Graph Node
encode <- case Type
-> Map Type (Coder Graph Graph Term Node)
-> Maybe (Coder Graph Graph Term Node)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Type
typ Map Type (Coder Graph Graph Term Node)
coders of
        Maybe (Coder Graph Graph Term Node)
Nothing -> FilePath -> Flow Graph (Term -> Flow Graph Node)
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph (Term -> Flow Graph Node))
-> FilePath -> Flow Graph (Term -> Flow Graph Node)
forall a b. (a -> b) -> a -> b
$ FilePath
"no coder found for type " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
typ
        Just Coder Graph Graph Term Node
coder -> (Term -> Flow Graph Node) -> Flow Graph (Term -> Flow Graph Node)
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Flow Graph Node) -> Flow Graph (Term -> Flow Graph Node))
-> (Term -> Flow Graph Node)
-> Flow Graph (Term -> Flow Graph Node)
forall a b. (a -> b) -> a -> b
$ Coder Graph Graph Term Node -> Term -> Flow Graph Node
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder Graph Graph Term Node
coder
      Node
node <- Term -> Flow Graph Node
encode Term
term
      (Node, Node) -> Flow Graph (Node, Node)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Scalar -> Node
YM.NodeScalar (Scalar -> Node) -> Scalar -> Node
forall a b. (a -> b) -> a -> b
$ FilePath -> Scalar
YM.ScalarStr (FilePath -> Scalar) -> FilePath -> Scalar
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
localNameOf (Name -> FilePath) -> Name -> FilePath
forall a b. (a -> b) -> a -> b
$ Element -> Name
elementName Element
el, Node
node)
    ns :: FilePath
ns = Namespace -> FilePath
unNamespace (Namespace -> FilePath) -> Namespace -> FilePath
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod
    localNameOf :: Name -> FilePath
localNameOf Name
name = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
L.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length FilePath
ns) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> FilePath
unName Name
name

moduleToYaml :: Module -> Flow (Graph) (M.Map FilePath String)
moduleToYaml :: Module -> Flow Graph (Map FilePath FilePath)
moduleToYaml Module
mod = FilePath
-> Flow Graph (Map FilePath FilePath)
-> Flow Graph (Map FilePath FilePath)
forall s a. FilePath -> Flow s a -> Flow s a
withTrace (FilePath
"print module " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Namespace -> FilePath
unNamespace (Namespace -> FilePath) -> Namespace -> FilePath
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod)) (Flow Graph (Map FilePath FilePath)
 -> Flow Graph (Map FilePath FilePath))
-> Flow Graph (Map FilePath FilePath)
-> Flow Graph (Map FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ do
    Node
node <- Language
-> (Term -> Flow Graph Node)
-> (Module
    -> Map Type (Coder Graph Graph Term Node)
    -> [(Element, TypedTerm)]
    -> Flow Graph Node)
-> Module
-> Flow Graph Node
forall e d.
Language
-> (Term -> Flow Graph e)
-> (Module
    -> Map Type (Coder Graph Graph Term e)
    -> [(Element, TypedTerm)]
    -> Flow Graph d)
-> Module
-> Flow Graph d
transformModule Language
yamlLanguage Term -> Flow Graph Node
forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
encodeTerm Module
-> Map Type (Coder Graph Graph Term Node)
-> [(Element, TypedTerm)]
-> Flow Graph Node
constructModule Module
mod
    Map FilePath FilePath -> Flow Graph (Map FilePath FilePath)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath FilePath -> Flow Graph (Map FilePath FilePath))
-> Map FilePath FilePath -> Flow Graph (Map FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FilePath
path, Node -> FilePath
hydraYamlToString Node
node)]
  where
    path :: FilePath
path = Bool -> FileExtension -> Namespace -> FilePath
namespaceToFilePath Bool
False (FilePath -> FileExtension
FileExtension FilePath
"yaml") (Namespace -> FilePath) -> Namespace -> FilePath
forall a b. (a -> b) -> a -> b
$ Module -> Namespace
moduleNamespace Module
mod
    encodeTerm :: p -> m a
encodeTerm p
_ = FilePath -> m a
forall a. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> m a) -> FilePath -> m a
forall a b. (a -> b) -> a -> b
$ FilePath
"only type definitions are expected in this mapping to YAML"