-- | A model for Hydra transformation workflows

module Hydra.Workflow where

import qualified Hydra.Compute as Compute
import qualified Hydra.Core as Core
import qualified Hydra.Graph as Graph
import qualified Hydra.Module as Module
import Data.Int
import Data.List as L
import Data.Map as M
import Data.Set as S

-- | The specification of a Hydra schema, provided as a set of modules and a distinguished type
data HydraSchemaSpec = 
  HydraSchemaSpec {
    -- | The modules to include in the schema graph
    HydraSchemaSpec -> [Module]
hydraSchemaSpecModules :: [Module.Module],
    -- | The name of the top-level type; all data which passes through the workflow will be instances of this type
    HydraSchemaSpec -> Name
hydraSchemaSpecTypeName :: Core.Name}
  deriving (HydraSchemaSpec -> HydraSchemaSpec -> Bool
(HydraSchemaSpec -> HydraSchemaSpec -> Bool)
-> (HydraSchemaSpec -> HydraSchemaSpec -> Bool)
-> Eq HydraSchemaSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
== :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
$c/= :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
/= :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
Eq, Eq HydraSchemaSpec
Eq HydraSchemaSpec =>
(HydraSchemaSpec -> HydraSchemaSpec -> Ordering)
-> (HydraSchemaSpec -> HydraSchemaSpec -> Bool)
-> (HydraSchemaSpec -> HydraSchemaSpec -> Bool)
-> (HydraSchemaSpec -> HydraSchemaSpec -> Bool)
-> (HydraSchemaSpec -> HydraSchemaSpec -> Bool)
-> (HydraSchemaSpec -> HydraSchemaSpec -> HydraSchemaSpec)
-> (HydraSchemaSpec -> HydraSchemaSpec -> HydraSchemaSpec)
-> Ord HydraSchemaSpec
HydraSchemaSpec -> HydraSchemaSpec -> Bool
HydraSchemaSpec -> HydraSchemaSpec -> Ordering
HydraSchemaSpec -> HydraSchemaSpec -> HydraSchemaSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HydraSchemaSpec -> HydraSchemaSpec -> Ordering
compare :: HydraSchemaSpec -> HydraSchemaSpec -> Ordering
$c< :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
< :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
$c<= :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
<= :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
$c> :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
> :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
$c>= :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
>= :: HydraSchemaSpec -> HydraSchemaSpec -> Bool
$cmax :: HydraSchemaSpec -> HydraSchemaSpec -> HydraSchemaSpec
max :: HydraSchemaSpec -> HydraSchemaSpec -> HydraSchemaSpec
$cmin :: HydraSchemaSpec -> HydraSchemaSpec -> HydraSchemaSpec
min :: HydraSchemaSpec -> HydraSchemaSpec -> HydraSchemaSpec
Ord, ReadPrec [HydraSchemaSpec]
ReadPrec HydraSchemaSpec
Int -> ReadS HydraSchemaSpec
ReadS [HydraSchemaSpec]
(Int -> ReadS HydraSchemaSpec)
-> ReadS [HydraSchemaSpec]
-> ReadPrec HydraSchemaSpec
-> ReadPrec [HydraSchemaSpec]
-> Read HydraSchemaSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS HydraSchemaSpec
readsPrec :: Int -> ReadS HydraSchemaSpec
$creadList :: ReadS [HydraSchemaSpec]
readList :: ReadS [HydraSchemaSpec]
$creadPrec :: ReadPrec HydraSchemaSpec
readPrec :: ReadPrec HydraSchemaSpec
$creadListPrec :: ReadPrec [HydraSchemaSpec]
readListPrec :: ReadPrec [HydraSchemaSpec]
Read, Int -> HydraSchemaSpec -> ShowS
[HydraSchemaSpec] -> ShowS
HydraSchemaSpec -> String
(Int -> HydraSchemaSpec -> ShowS)
-> (HydraSchemaSpec -> String)
-> ([HydraSchemaSpec] -> ShowS)
-> Show HydraSchemaSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HydraSchemaSpec -> ShowS
showsPrec :: Int -> HydraSchemaSpec -> ShowS
$cshow :: HydraSchemaSpec -> String
show :: HydraSchemaSpec -> String
$cshowList :: [HydraSchemaSpec] -> ShowS
showList :: [HydraSchemaSpec] -> ShowS
Show)

_HydraSchemaSpec :: Name
_HydraSchemaSpec = (String -> Name
Core.Name String
"hydra/workflow.HydraSchemaSpec")

_HydraSchemaSpec_modules :: Name
_HydraSchemaSpec_modules = (String -> Name
Core.Name String
"modules")

_HydraSchemaSpec_typeName :: Name
_HydraSchemaSpec_typeName = (String -> Name
Core.Name String
"typeName")

-- | The last mile of a transformation, which encodes and serializes terms to a file
data LastMile s a = 
  LastMile {
    -- | An encoder for terms to a list of output objects
    forall s a.
LastMile s a -> Type -> Flow s (Term -> Graph -> Flow s [a])
lastMileEncoder :: (Core.Type -> Compute.Flow s (Core.Term -> Graph.Graph -> Compute.Flow s [a])),
    -- | A function which serializes a list of output objects to a string representation
    forall s a. LastMile s a -> [a] -> Flow s String
lastMileSerializer :: ([a] -> Compute.Flow s String),
    -- | A file extension for the generated file(s)
    forall s a. LastMile s a -> String
lastMileFileExtension :: String}

_LastMile :: Name
_LastMile = (String -> Name
Core.Name String
"hydra/workflow.LastMile")

_LastMile_encoder :: Name
_LastMile_encoder = (String -> Name
Core.Name String
"encoder")

_LastMile_serializer :: Name
_LastMile_serializer = (String -> Name
Core.Name String
"serializer")

_LastMile_fileExtension :: Name
_LastMile_fileExtension = (String -> Name
Core.Name String
"fileExtension")

-- | The specification of a schema at the source end of a workflow
data SchemaSpec = 
  -- | A native Hydra schema
  SchemaSpecHydra HydraSchemaSpec |
  -- | A schema provided as a file, available at the given file path
  SchemaSpecFile String |
  -- | A schema which will be provided within the workflow
  SchemaSpecProvided 
  deriving (SchemaSpec -> SchemaSpec -> Bool
(SchemaSpec -> SchemaSpec -> Bool)
-> (SchemaSpec -> SchemaSpec -> Bool) -> Eq SchemaSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaSpec -> SchemaSpec -> Bool
== :: SchemaSpec -> SchemaSpec -> Bool
$c/= :: SchemaSpec -> SchemaSpec -> Bool
/= :: SchemaSpec -> SchemaSpec -> Bool
Eq, Eq SchemaSpec
Eq SchemaSpec =>
(SchemaSpec -> SchemaSpec -> Ordering)
-> (SchemaSpec -> SchemaSpec -> Bool)
-> (SchemaSpec -> SchemaSpec -> Bool)
-> (SchemaSpec -> SchemaSpec -> Bool)
-> (SchemaSpec -> SchemaSpec -> Bool)
-> (SchemaSpec -> SchemaSpec -> SchemaSpec)
-> (SchemaSpec -> SchemaSpec -> SchemaSpec)
-> Ord SchemaSpec
SchemaSpec -> SchemaSpec -> Bool
SchemaSpec -> SchemaSpec -> Ordering
SchemaSpec -> SchemaSpec -> SchemaSpec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SchemaSpec -> SchemaSpec -> Ordering
compare :: SchemaSpec -> SchemaSpec -> Ordering
$c< :: SchemaSpec -> SchemaSpec -> Bool
< :: SchemaSpec -> SchemaSpec -> Bool
$c<= :: SchemaSpec -> SchemaSpec -> Bool
<= :: SchemaSpec -> SchemaSpec -> Bool
$c> :: SchemaSpec -> SchemaSpec -> Bool
> :: SchemaSpec -> SchemaSpec -> Bool
$c>= :: SchemaSpec -> SchemaSpec -> Bool
>= :: SchemaSpec -> SchemaSpec -> Bool
$cmax :: SchemaSpec -> SchemaSpec -> SchemaSpec
max :: SchemaSpec -> SchemaSpec -> SchemaSpec
$cmin :: SchemaSpec -> SchemaSpec -> SchemaSpec
min :: SchemaSpec -> SchemaSpec -> SchemaSpec
Ord, ReadPrec [SchemaSpec]
ReadPrec SchemaSpec
Int -> ReadS SchemaSpec
ReadS [SchemaSpec]
(Int -> ReadS SchemaSpec)
-> ReadS [SchemaSpec]
-> ReadPrec SchemaSpec
-> ReadPrec [SchemaSpec]
-> Read SchemaSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SchemaSpec
readsPrec :: Int -> ReadS SchemaSpec
$creadList :: ReadS [SchemaSpec]
readList :: ReadS [SchemaSpec]
$creadPrec :: ReadPrec SchemaSpec
readPrec :: ReadPrec SchemaSpec
$creadListPrec :: ReadPrec [SchemaSpec]
readListPrec :: ReadPrec [SchemaSpec]
Read, Int -> SchemaSpec -> ShowS
[SchemaSpec] -> ShowS
SchemaSpec -> String
(Int -> SchemaSpec -> ShowS)
-> (SchemaSpec -> String)
-> ([SchemaSpec] -> ShowS)
-> Show SchemaSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SchemaSpec -> ShowS
showsPrec :: Int -> SchemaSpec -> ShowS
$cshow :: SchemaSpec -> String
show :: SchemaSpec -> String
$cshowList :: [SchemaSpec] -> ShowS
showList :: [SchemaSpec] -> ShowS
Show)

_SchemaSpec :: Name
_SchemaSpec = (String -> Name
Core.Name String
"hydra/workflow.SchemaSpec")

_SchemaSpec_hydra :: Name
_SchemaSpec_hydra = (String -> Name
Core.Name String
"hydra")

_SchemaSpec_file :: Name
_SchemaSpec_file = (String -> Name
Core.Name String
"file")

_SchemaSpec_provided :: Name
_SchemaSpec_provided = (String -> Name
Core.Name String
"provided")

-- | The specification of a workflow which takes a schema specification, reads data from a directory, and writes data to another directory
data TransformWorkflow = 
  TransformWorkflow {
    -- | A descriptive name for the workflow
    TransformWorkflow -> String
transformWorkflowName :: String,
    -- | The schema specification
    TransformWorkflow -> SchemaSpec
transformWorkflowSchemaSpec :: SchemaSpec,
    -- | The source directory
    TransformWorkflow -> String
transformWorkflowSrcDir :: String,
    -- | The destination directory
    TransformWorkflow -> String
transformWorkflowDestDir :: String}
  deriving (TransformWorkflow -> TransformWorkflow -> Bool
(TransformWorkflow -> TransformWorkflow -> Bool)
-> (TransformWorkflow -> TransformWorkflow -> Bool)
-> Eq TransformWorkflow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransformWorkflow -> TransformWorkflow -> Bool
== :: TransformWorkflow -> TransformWorkflow -> Bool
$c/= :: TransformWorkflow -> TransformWorkflow -> Bool
/= :: TransformWorkflow -> TransformWorkflow -> Bool
Eq, Eq TransformWorkflow
Eq TransformWorkflow =>
(TransformWorkflow -> TransformWorkflow -> Ordering)
-> (TransformWorkflow -> TransformWorkflow -> Bool)
-> (TransformWorkflow -> TransformWorkflow -> Bool)
-> (TransformWorkflow -> TransformWorkflow -> Bool)
-> (TransformWorkflow -> TransformWorkflow -> Bool)
-> (TransformWorkflow -> TransformWorkflow -> TransformWorkflow)
-> (TransformWorkflow -> TransformWorkflow -> TransformWorkflow)
-> Ord TransformWorkflow
TransformWorkflow -> TransformWorkflow -> Bool
TransformWorkflow -> TransformWorkflow -> Ordering
TransformWorkflow -> TransformWorkflow -> TransformWorkflow
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TransformWorkflow -> TransformWorkflow -> Ordering
compare :: TransformWorkflow -> TransformWorkflow -> Ordering
$c< :: TransformWorkflow -> TransformWorkflow -> Bool
< :: TransformWorkflow -> TransformWorkflow -> Bool
$c<= :: TransformWorkflow -> TransformWorkflow -> Bool
<= :: TransformWorkflow -> TransformWorkflow -> Bool
$c> :: TransformWorkflow -> TransformWorkflow -> Bool
> :: TransformWorkflow -> TransformWorkflow -> Bool
$c>= :: TransformWorkflow -> TransformWorkflow -> Bool
>= :: TransformWorkflow -> TransformWorkflow -> Bool
$cmax :: TransformWorkflow -> TransformWorkflow -> TransformWorkflow
max :: TransformWorkflow -> TransformWorkflow -> TransformWorkflow
$cmin :: TransformWorkflow -> TransformWorkflow -> TransformWorkflow
min :: TransformWorkflow -> TransformWorkflow -> TransformWorkflow
Ord, ReadPrec [TransformWorkflow]
ReadPrec TransformWorkflow
Int -> ReadS TransformWorkflow
ReadS [TransformWorkflow]
(Int -> ReadS TransformWorkflow)
-> ReadS [TransformWorkflow]
-> ReadPrec TransformWorkflow
-> ReadPrec [TransformWorkflow]
-> Read TransformWorkflow
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TransformWorkflow
readsPrec :: Int -> ReadS TransformWorkflow
$creadList :: ReadS [TransformWorkflow]
readList :: ReadS [TransformWorkflow]
$creadPrec :: ReadPrec TransformWorkflow
readPrec :: ReadPrec TransformWorkflow
$creadListPrec :: ReadPrec [TransformWorkflow]
readListPrec :: ReadPrec [TransformWorkflow]
Read, Int -> TransformWorkflow -> ShowS
[TransformWorkflow] -> ShowS
TransformWorkflow -> String
(Int -> TransformWorkflow -> ShowS)
-> (TransformWorkflow -> String)
-> ([TransformWorkflow] -> ShowS)
-> Show TransformWorkflow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransformWorkflow -> ShowS
showsPrec :: Int -> TransformWorkflow -> ShowS
$cshow :: TransformWorkflow -> String
show :: TransformWorkflow -> String
$cshowList :: [TransformWorkflow] -> ShowS
showList :: [TransformWorkflow] -> ShowS
Show)

_TransformWorkflow :: Name
_TransformWorkflow = (String -> Name
Core.Name String
"hydra/workflow.TransformWorkflow")

_TransformWorkflow_name :: Name
_TransformWorkflow_name = (String -> Name
Core.Name String
"name")

_TransformWorkflow_schemaSpec :: Name
_TransformWorkflow_schemaSpec = (String -> Name
Core.Name String
"schemaSpec")

_TransformWorkflow_srcDir :: Name
_TransformWorkflow_srcDir = (String -> Name
Core.Name String
"srcDir")

_TransformWorkflow_destDir :: Name
_TransformWorkflow_destDir = (String -> Name
Core.Name String
"destDir")