module Scientific.Workflow.Internal.Builder.Types where
import Control.Lens (makeLenses)
import Control.Monad.State (State)
import Data.Aeson.Types (defaultOptions,
genericParseJSON,
genericToEncoding)
import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.Serialize (Serialize)
import Data.Serialize.Text ()
import Data.Text (Text)
import Data.Yaml (FromJSON (..), ToJSON (..))
import GHC.Generics (Generic)
import Instances.TH.Lift ()
import Language.Haskell.TH (ExpQ, Name, varE)
import Language.Haskell.TH.Lift (deriveLift)
data Node = Node
{ _nodePid :: Text
, _nodeFunction :: ExpQ
, _nodeAttr :: Attribute
}
data Edge = Edge
{ _edgeFrom :: Text
, _edgeTo :: Text
, _edgeOrd :: EdgeOrd
}
type EdgeOrd = Int
type Builder = State ([Node], [Edge])
data Attribute = Attribute
{ _label :: Text
, _note :: Text
, _submitToRemote :: Maybe Bool
, _remoteParam :: String
, _functionConfig :: FunctionConfig
} deriving (Generic)
data FunctionConfig = FunctionConfig ParallelMode FunctionType deriving (Generic)
data ParallelMode = None
| Standard Int
| ShareData Int
deriving (Generic)
data FunctionType = Pure
| IOAction
| Stateful
deriving (Generic)
instance Serialize Attribute
instance Serialize FunctionConfig
instance Serialize ParallelMode
instance Serialize FunctionType
deriveLift ''FunctionConfig
deriveLift ''ParallelMode
deriveLift ''FunctionType
deriveLift ''Attribute
makeLenses ''Attribute
defaultAttribute :: Attribute
defaultAttribute = Attribute
{ _label = ""
, _note = ""
, _submitToRemote = Nothing
, _remoteParam = ""
, _functionConfig = FunctionConfig None IOAction
}
type AttributeSetter = State Attribute ()
type DAG = Gr Node EdgeOrd
class ToExpQ a where
toExpQ :: a -> ExpQ
instance ToExpQ Name where
toExpQ = varE
instance ToExpQ ExpQ where
toExpQ = id
data ContextData context dat = ContextData
{ _context :: context
, _data :: dat
} deriving (Generic)
instance (FromJSON c, FromJSON d) => FromJSON (ContextData c d) where
parseJSON = genericParseJSON defaultOptions
instance (ToJSON c, ToJSON d) => ToJSON (ContextData c d) where
toEncoding = genericToEncoding defaultOptions
instance (Serialize c, Serialize d) => Serialize (ContextData c d)