fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(workflows): more on types

Browse Source
This commit is contained in:
Sarah Vaupel 2020-04-07 19:26:46 +02:00 committed by Gregor Kleen
parent 857ab74525
commit e1261761a2
2 changed files with 73 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
models/workflows.model
View File

@ -11,4 +11,5 @@ Workflow
instance WorkflowInstance instance WorkflowInstance
graph (WorkflowGraph UserId FileId) graph (WorkflowGraph UserId FileId)
initiator UserId Maybe initiator UserId Maybe
payload (WorkflowPayload FileId) payload (WorkflowPayload UserId FileId)
currentNode WorkflowGraphNodeLabel Maybe

120
src/Model/Types/Workflow.hs
View File

@ -6,6 +6,7 @@ import Model.Types.Security (AuthDNF)
import qualified Data.Set as Set (toList, fromList) import qualified Data.Set as Set (toList, fromList)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import Data.Scientific import Data.Scientific
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
@ -14,7 +15,7 @@ import Data.Aeson.Types (Parser)
data WorkflowRole userid = WorkflowRoleUser userid data WorkflowRole userid = WorkflowRoleUser userid
| WorkflowRoleAuthorized AuthDNF | WorkflowRoleAuthorized AuthDNF
| WorkflowRoleInitiator userid | WorkflowRoleInitiator
deriving (Eq, Ord, Show, Read, Generic, Typeable) deriving (Eq, Ord, Show, Read, Generic, Typeable)
@ -30,7 +31,7 @@ data WorkflowGraphNode = WGN
} }
deriving (Eq, Ord, Show, Read, Data, Generic, Typeable) deriving (Eq, Ord, Show, Read, Data, Generic, Typeable)
data WorkflowGraphNode' userid fileid = WGN' data WorkflowGraphNode' userid fileid = WGN'
{ wgn'Node :: WorkflowGraphNode { wgn'Status :: WorkflowGraphNodeStatus
, wgn'Edges :: Set (WorkflowGraphEdge userid fileid) , wgn'Edges :: Set (WorkflowGraphEdge userid fileid)
} }
deriving (Eq, Ord, Show, Generic, Typeable) deriving (Eq, Ord, Show, Generic, Typeable)
@ -45,6 +46,13 @@ data WorkflowEdgePayload userid fileid (payload :: *) where
WEPFile :: fileid -> WorkflowEdgePayload userid fileid fileid WEPFile :: fileid -> WorkflowEdgePayload userid fileid fileid
WEPUser :: userid -> WorkflowEdgePayload userid fileid userid WEPUser :: userid -> WorkflowEdgePayload userid fileid userid
instance (Show userid, Show fileid) => Show (WorkflowEdgePayload userid fileid payload) where
show (WEPText txt) = "WEPText " <> show txt
show (WEPNumber num) = "WEPNumber " <> show num
show (WEPBool b ) = "WEPBool " <> show b
show (WEPFile fid) = "WEPFile " <> show fid
show (WEPUser uid) = "WEPUser " <> show uid
data WorkflowEdgePayload' = WEPText' | WEPNumber' | WEPBool' | WEPFile' | WEPUser' data WorkflowEdgePayload' = WEPText' | WEPNumber' | WEPBool' | WEPFile' | WEPUser'
deriving (Eq, Ord, Enum, Show, Read, Data, Generic, Typeable) deriving (Eq, Ord, Enum, Show, Read, Data, Generic, Typeable)
@ -57,11 +65,16 @@ data WorkflowEdgePayloadField fileid userid (payload :: *) where
, wepftPlaceholder :: Text , wepftPlaceholder :: Text
, wepftTooltip :: Maybe Text , wepftTooltip :: Maybe Text
, wepftDefault :: Maybe Text , wepftDefault :: Maybe Text
, wepftOptional :: Maybe Bool
} -> WorkflowEdgePayloadField fileid userid Text } -> WorkflowEdgePayloadField fileid userid Text
WorkflowEdgePayloadFieldNumber :: { wepfnLabel :: Text WorkflowEdgePayloadFieldNumber :: { wepfnLabel :: Text
, wepfnPlaceholder :: Text , wepfnPlaceholder :: Text
, wepfnTooltip :: Maybe Text , wepfnTooltip :: Maybe Text
, wepfnDefault :: Maybe Scientific , wepfnDefault :: Maybe Scientific
, wepfnMin :: Maybe Scientific
, wepfnMax :: Maybe Scientific
, wepfnStep :: Scientific
, wepfnOptional :: Maybe Bool
} -> WorkflowEdgePayloadField fileid userid Scientific } -> WorkflowEdgePayloadField fileid userid Scientific
WorkflowEdgePayloadFieldBool :: { wepfbLabel :: Text WorkflowEdgePayloadFieldBool :: { wepfbLabel :: Text
, wepfbTooltip :: Maybe Text , wepfbTooltip :: Maybe Text
@ -70,12 +83,15 @@ data WorkflowEdgePayloadField fileid userid (payload :: *) where
WorkflowEdgePayloadFieldFile :: { wepffLabel :: Text WorkflowEdgePayloadFieldFile :: { wepffLabel :: Text
, wepffTooltip :: Maybe Text , wepffTooltip :: Maybe Text
, wepffDefault :: Maybe fileid , wepffDefault :: Maybe fileid
, wepffOptional :: Maybe Bool
} -> WorkflowEdgePayloadField fileid userid FileInfo } -> WorkflowEdgePayloadField fileid userid FileInfo
WorkflowEdgePayloadFieldUser :: { wepfuLabel :: Text WorkflowEdgePayloadFieldUser :: { wepfuLabel :: Text
, wepfuTooltip :: Maybe Text , wepfuTooltip :: Maybe Text
, wepfuDefault :: Maybe userid , wepfuDefault :: Maybe userid
, wepfuOptional :: Maybe Bool
} -> WorkflowEdgePayloadField fileid userid userid } -> WorkflowEdgePayloadField fileid userid userid
-- TODO
instance (Show fileid, Show userid) => Show (WorkflowEdgePayloadField fileid userid payload) where instance (Show fileid, Show userid) => Show (WorkflowEdgePayloadField fileid userid payload) where
show (WorkflowEdgePayloadFieldText{..} ) = show wepftLabel show (WorkflowEdgePayloadFieldText{..} ) = show wepftLabel
show (WorkflowEdgePayloadFieldNumber{..}) = show wepfnLabel show (WorkflowEdgePayloadFieldNumber{..}) = show wepfnLabel
@ -91,33 +107,33 @@ instance (Show fileid, Show userid) => Show (WorkflowEdgePayloadSpecification fi
show (WorkflowEdgePayloadSpecification payloadField) = show payloadField show (WorkflowEdgePayloadSpecification payloadField) = show payloadField
instance (Eq fileid, Eq userid) => Eq (WorkflowEdgePayloadSpecification fileid userid) where instance (Eq fileid, Eq userid) => Eq (WorkflowEdgePayloadSpecification fileid userid) where
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldText{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldText{}) = wepftLabel f1 == wepftLabel f2 && wepftPlaceholder f1 == wepftPlaceholder f2 && wepftTooltip f1 == wepftTooltip f2 && wepftDefault f1 == wepftDefault f2 (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldText{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldText{}) = wepftLabel f1 == wepftLabel f2 && wepftPlaceholder f1 == wepftPlaceholder f2 && wepftTooltip f1 == wepftTooltip f2 && wepftDefault f1 == wepftDefault f2 && wepftOptional f1 == wepftOptional f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldNumber{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = wepfnLabel f1 == wepfnLabel f2 && wepfnPlaceholder f1 == wepfnPlaceholder f2 && wepfnTooltip f1 == wepfnTooltip f2 && wepfnDefault f1 == wepfnDefault f2 (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldNumber{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = wepfnLabel f1 == wepfnLabel f2 && wepfnPlaceholder f1 == wepfnPlaceholder f2 && wepfnTooltip f1 == wepfnTooltip f2 && wepfnDefault f1 == wepfnDefault f2 && wepfnOptional f1 == wepfnOptional f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldBool{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldBool{}) = wepfbLabel f1 == wepfbLabel f2 && wepfbTooltip f1 == wepfbTooltip f2 && wepfbDefault f1 == wepfbDefault f2 (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldBool{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldBool{}) = wepfbLabel f1 == wepfbLabel f2 && wepfbTooltip f1 == wepfbTooltip f2 && wepfbDefault f1 == wepfbDefault f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldFile{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldFile{}) = wepffLabel f1 == wepffLabel f2 && wepffTooltip f1 == wepffTooltip f2 && wepffDefault f1 == wepffDefault f2 (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldFile{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldFile{}) = wepffLabel f1 == wepffLabel f2 && wepffTooltip f1 == wepffTooltip f2 && wepffDefault f1 == wepffDefault f2 && wepffOptional f1 == wepffOptional f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldUser{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldUser{}) = wepfuLabel f1 == wepfuLabel f2 && wepfuTooltip f1 == wepfuTooltip f2 && wepfuDefault f1 == wepfuDefault f2 (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldUser{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldUser{}) = wepfuLabel f1 == wepfuLabel f2 && wepfuTooltip f1 == wepfuTooltip f2 && wepfuDefault f1 == wepfuDefault f2 && wepfuOptional f1 == wepfuOptional f2
_ == _ = False _ == _ = False
instance (Ord fileid, Ord userid) => Ord (WorkflowEdgePayloadSpecification fileid userid) where instance (Ord fileid, Ord userid) => Ord (WorkflowEdgePayloadSpecification fileid userid) where
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldText{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldText{}) = wepftLabel f1 <= wepftLabel f2 && wepftPlaceholder f1 <= wepftPlaceholder f2 && wepftTooltip f1 <= wepftTooltip f2 && wepftDefault f1 <= wepftDefault f2 compare (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldText{}) (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldText{}) = mconcat [comparing wepftLabel, comparing wepftPlaceholder, comparing wepftTooltip, comparing wepftDefault, comparing wepftOptional] f1 f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldNumber{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = wepfnLabel f1 <= wepfnLabel f2 && wepfnPlaceholder f1 <= wepfnPlaceholder f2 && wepfnTooltip f1 <= wepfnTooltip f2 && wepfnDefault f1 <= wepfnDefault f2 compare (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldNumber{}) (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = mconcat [comparing wepfnLabel, comparing wepfnPlaceholder, comparing wepfnTooltip, comparing wepfnDefault, comparing wepfnMin, comparing wepfnMax, comparing wepfnStep, comparing wepfnOptional] f1 f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldBool{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldBool{}) = wepfbLabel f1 <= wepfbLabel f2 && wepfbTooltip f1 <= wepfbTooltip f2 && wepfbDefault f1 <= wepfbDefault f2 compare (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldBool{}) (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldBool{}) = mconcat [comparing wepfbLabel, comparing wepfbTooltip, comparing wepfbDefault] f1 f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldFile{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldFile{}) = wepffLabel f1 <= wepffLabel f2 && wepffTooltip f1 <= wepffTooltip f2 && wepffDefault f1 <= wepffDefault f2 compare (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldFile{}) (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldFile{}) = mconcat [comparing wepffLabel, comparing wepffTooltip, comparing wepffDefault, comparing wepffOptional] f1 f2
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldUser{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldUser{}) = wepfuLabel f1 <= wepfuLabel f2 && wepfuTooltip f1 <= wepfuTooltip f2 && wepfuDefault f1 <= wepfuDefault f2 compare (WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldUser{}) (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldUser{}) = mconcat [comparing wepfuLabel, comparing wepfuTooltip, comparing wepfuDefault, comparing wepfuOptional] f1 f2
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{} ) <= _ = False compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{} ) _ = LT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = True compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = GT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) <= _ = False compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) _ = LT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = True compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = GT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) = True compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) = GT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) <= _ = False compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) _ = LT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = True compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = GT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) = True compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) = GT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) = True compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) = GT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= _ = False compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) _ = LT
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{}) <= _ = False compare (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{}) _ = LT
data WorkflowPayload userid fileid = forall payload. Map WorkflowEdgePayloadLabel (WorkflowEdgePayload userid fileid payload) type WorkflowPayload userid fileid = forall payload. Map WorkflowEdgePayloadLabel (Seq (WorkflowEdgePayload userid fileid payload, Maybe userid, UTCTime))
data WorkflowGraphEdge userid fileid = WGE data WorkflowGraphEdge userid fileid = WGE
@ -159,9 +175,8 @@ instance (ToJSON userid) => ToJSON (WorkflowRole userid) where
[ "tag" JSON..= ("authorized" :: Text) [ "tag" JSON..= ("authorized" :: Text)
, "authorized" JSON..= authDNF , "authorized" JSON..= authDNF
] ]
toJSON (WorkflowRoleInitiator uid) = JSON.object toJSON WorkflowRoleInitiator = JSON.object
[ "tag" JSON..= ("initiator" :: Text) [ "tag" JSON..= ("initiator" :: Text)
, "initiator" JSON..= uid
] ]
instance (FromJSON userid) => FromJSON (WorkflowRole userid) where instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
parseJSON = JSON.withObject "WorkflowRole" $ \o -> do parseJSON = JSON.withObject "WorkflowRole" $ \o -> do
@ -173,15 +188,13 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
"authorized" -> do "authorized" -> do
adnf <- o JSON..: "authorized" adnf <- o JSON..: "authorized"
return $ WorkflowRoleAuthorized adnf return $ WorkflowRoleAuthorized adnf
"initiator" -> do "initiator" -> return $ WorkflowRoleInitiator
iid <- o JSON..: "initiator"
return $ WorkflowRoleInitiator iid
_ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> fieldTag _ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> fieldTag
instance (ToJSON userid, ToJSON fileid, Ord userid) => ToJSON (WorkflowGraph userid fileid) where instance (ToJSON userid, ToJSON fileid, Ord userid) => ToJSON (WorkflowGraph userid fileid) where
toJSON WorkflowGraph{..} = JSON.object toJSON WorkflowGraph{..} = JSON.object
[ "tag" JSON..= ("workflow" :: Text) [ "tag" JSON..= ("workflow" :: Text)
, "nodes" JSON..= Map.map (\(wgn'Node,wgn'Edges) -> WGN'{..}) wgNodes , "nodes" JSON..= Map.map (\(WGN{..},wgn'Edges) -> WGN'{wgn'Status=wgnStatus,wgn'Edges=wgn'Edges}) wgNodes
] ]
instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraph userid fileid) where instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraph userid fileid) where
parseJSON = JSON.withObject "WorkflowGraph" $ \o -> do parseJSON = JSON.withObject "WorkflowGraph" $ \o -> do
@ -189,7 +202,7 @@ instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON
case fieldTag of case fieldTag of
"workflow" -> do "workflow" -> do
wgNodes' <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel (WorkflowGraphNode' userid fileid))) wgNodes' <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel (WorkflowGraphNode' userid fileid)))
let wgNodes = Map.map (\WGN'{..} -> (wgn'Node, wgn'Edges)) wgNodes' let wgNodes = Map.map (\WGN'{..} -> (WGN{wgnStatus=wgn'Status}, wgn'Edges)) wgNodes'
return WorkflowGraph{..} return WorkflowGraph{..}
_ -> terror $ "WorkflowGraph parseJSON error: expected tag workflow, but got " <> fieldTag _ -> terror $ "WorkflowGraph parseJSON error: expected tag workflow, but got " <> fieldTag
@ -220,6 +233,9 @@ instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadSpecificat
, "placeholder" JSON..= wepfnPlaceholder , "placeholder" JSON..= wepfnPlaceholder
, "tooltip" JSON..= wepfnTooltip , "tooltip" JSON..= wepfnTooltip
, "default" JSON..= wepfnDefault , "default" JSON..= wepfnDefault
, "min" JSON..= wepfnMin
, "max" JSON..= wepfnMax
, "step" JSON..= wepfnStep
] ]
toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}) = JSON.object toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}) = JSON.object
[ "tag" JSON..= ("bool" :: Text) [ "tag" JSON..= ("bool" :: Text)
@ -254,6 +270,9 @@ instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpec
wepfnPlaceholder <- o JSON..: "placeholder" wepfnPlaceholder <- o JSON..: "placeholder"
wepfnTooltip <- o JSON..:? "tooltip" wepfnTooltip <- o JSON..:? "tooltip"
wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe Scientific)) wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe Scientific))
wepfnMin <- o JSON..:? "min"
wepfnMax <- o JSON..:? "max"
wepfnStep <- o JSON..: "step"
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..} return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..}
"bool" -> do "bool" -> do
wepfbLabel <- o JSON..: "label" wepfbLabel <- o JSON..: "label"
@ -272,19 +291,19 @@ instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpec
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{..} return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{..}
_ -> terror $ "WorkflowEdgePayloadSpecification parseJSON error: expected field tag (text|number|bool|file|user), but got " <> fieldTag _ -> terror $ "WorkflowEdgePayloadSpecification parseJSON error: expected field tag (text|number|bool|file|user), but got " <> fieldTag
instance ToJSON WorkflowGraphNode where --instance ToJSON WorkflowGraphNode where
toJSON WGN{..} = JSON.object -- toJSON WGN{..} = JSON.object
[ "tag" JSON..= ("node" :: Text) -- [ "tag" JSON..= ("node" :: Text)
, "status" JSON..= wgnStatus -- , "status" JSON..= wgnStatus
] -- ]
instance FromJSON WorkflowGraphNode where --instance FromJSON WorkflowGraphNode where
parseJSON = JSON.withObject "WorkflowGraphNode" $ \o -> do -- parseJSON = JSON.withObject "WorkflowGraphNode" $ \o -> do
fieldTag <- o JSON..: "tag" -- fieldTag <- o JSON..: "tag"
case fieldTag of -- case fieldTag of
"node" -> do -- "node" -> do
wgnStatus <- o JSON..: "status" -- wgnStatus <- o JSON..: "status"
return WGN{..} -- return WGN{..}
_ -> terror $ "WorkflowGraphNode parseJSON error: expected tag node, but got " <> fieldTag -- _ -> terror $ "WorkflowGraphNode parseJSON error: expected tag node, but got " <> fieldTag
deriveJSON defaultOptions deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1 { fieldLabelModifier = camelToPathPiece' 1
@ -292,16 +311,19 @@ deriveJSON defaultOptions
instance (ToJSON userid, ToJSON fileid, Ord userid) => ToJSON (WorkflowGraphNode' userid fileid) where instance (ToJSON userid, ToJSON fileid, Ord userid) => ToJSON (WorkflowGraphNode' userid fileid) where
toJSON WGN'{..} = JSON.object toJSON WGN'{..} = JSON.object
[ "node" JSON..= wgn'Node [ "status" JSON..= wgn'Status
, "edges" JSON..= wgn'Edges , "edges" JSON..= wgn'Edges
] ]
instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraphNode' userid fileid) where instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraphNode' userid fileid) where
parseJSON = JSON.withObject "WorkflowGraphNode'" $ \o -> do parseJSON = JSON.withObject "WorkflowGraphNode'" $ \o -> do
wgn'Node <- o JSON..: "node" wgn'Status <- o JSON..: "status"
wgn'Edges <- o JSON..: "edges" wgn'Edges <- o JSON..: "edges"
return WGN'{..} return WGN'{..}
testGraph :: WorkflowGraph Text Text testGraph :: WorkflowGraph Text Text
testGraph = WorkflowGraph $ Map.fromList [("node1", (WGN (WGNS "id" True (Just "someLabel")), Set.fromList [WGE (Set.fromList [WorkflowRoleUser "user-id", WorkflowRoleInitiator "init-user-id"]) "node1" (Map.fromList [("sometext", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default")]),("someuser", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldUser "user-label" Nothing Nothing]),("someboolandnumber", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldBool "bool-label" Nothing (Just True), WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldNumber "number-label" "number-placeholder" Nothing (Just 0.01)])])]))] testGraph = WorkflowGraph $ Map.fromList [("node1", (WGN (WGNS "id" True (Just "someLabel")), Set.fromList [WGE (Set.fromList [WorkflowRoleUser "user-id", WorkflowRoleInitiator]) "node1" (Map.fromList [("sometext", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default") Nothing]),("someuser", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldUser "user-label" Nothing Nothing Nothing]),("someboolandnumber-opt", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldBool "bool-label" Nothing (Just True), WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldNumber "number-label" "number-placeholder" Nothing Nothing (Just 1) (Just 5) 0.01 (Just True)])])]))]
--testGraph = WorkflowGraph $ Map.fromList [("node1", (WGN (WGNS "id" True (Just "someLabel")), Set.fromList [WGE (Set.fromList [WorkflowRoleUser "user-id", WorkflowRoleInitiator "init-user-id"]) "node1" (Map.fromList [("sometext", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default")]),("someuser", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldUser "user-label" Nothing Nothing]),("somebool", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldBool "bool-label" Nothing (Just True)])])]))] --testGraph = WorkflowGraph $ Map.fromList [("node1", (WGN (WGNS "id" True (Just "someLabel")), Set.fromList [WGE (Set.fromList [WorkflowRoleUser "user-id", WorkflowRoleInitiator]) "node1" (Map.fromList [("sometext", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default")]),("someuser", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldUser "user-label" Nothing Nothing]),("somebool", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldBool "bool-label" Nothing (Just True)])])]))]
--testPayload :: WorkflowPayload Text Text
testPayload = Map.fromList [("edge-payload-label", (Seq.singleton (WEPText "hello world!"), Nothing, UTCTime (ModifiedJulianDay 58946) 57250))]