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

fix(workflow): fix node and graph FromJSON instances

Browse Source
This commit is contained in:
Sarah Vaupel 2020-04-03 22:11:15 +02:00 committed by Gregor Kleen
parent 8812f24d90
commit 263fee19f2
1 changed files with 26 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -130,7 +130,9 @@ instance (Ord userid, Ord fileid) => Ord (WorkflowGraphEdge userid fileid) where
e1@WGE{} <= e2@WGE{} = wgeActors e1 <= wgeActors e2 && wgeTarget e1 <= wgeTarget e2 && wgeForm e1 <= wgeForm e2 e1@WGE{} <= e2@WGE{} = wgeActors e1 <= wgeActors e2 && wgeTarget e1 <= wgeTarget e2 && wgeForm e1 <= wgeForm e2
data WorkflowGraph userid fileid = WorkflowGraph (Map WorkflowGraphNodeLabel (WorkflowGraphNode, Set (WorkflowGraphEdge userid fileid))) data WorkflowGraph userid fileid = WorkflowGraph
{ wgNodes :: Map WorkflowGraphNodeLabel (WorkflowGraphNode, Set (WorkflowGraphEdge userid fileid))
}
instance (Show userid, Show fileid) => Show (WorkflowGraph userid fileid) where instance (Show userid, Show fileid) => Show (WorkflowGraph userid fileid) where
show (WorkflowGraph m) = show m show (WorkflowGraph m) = show m
@ -176,9 +178,18 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
_ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> role _ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> role
instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraph userid fileid) where instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraph userid fileid) where
toJSON (WorkflowGraph m) = toJSON m toJSON WorkflowGraph{..} = JSON.object
instance (FromJSON userid, FromJSON fileid) => FromJSON (WorkflowGraph userid fileid) where [ "tag" JSON..= ("workflow" :: Text)
parseJSON = parseJSON , "nodes" JSON..= wgNodes
]
instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraph userid fileid) where
parseJSON = JSON.withObject "WorkflowGraph" $ \o -> do
fieldTag <- o JSON..: "tag"
case fieldTag of
"workflow" -> do
wgNodes <- o JSON..: "nodes"
return WorkflowGraph{..}
_ -> terror $ "WorkflowGraph parseJSON error: expected tag workflow, but got " <> fieldTag
instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraphEdge userid fileid) where instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraphEdge userid fileid) where
toJSON (WGE{..}) = JSON.object toJSON (WGE{..}) = JSON.object
@ -262,9 +273,18 @@ instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpec
_ -> 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{..}) = toJSON wgnStatus toJSON WGN{..} = JSON.object
[ "tag" JSON..= ("node" :: Text)
, "status" JSON..= wgnStatus
]
instance FromJSON WorkflowGraphNode where instance FromJSON WorkflowGraphNode where
parseJSON = parseJSON parseJSON = JSON.withObject "WorkflowGraphNode" $ \o -> do
fieldTag <- o JSON..: "tag"
case fieldTag of
"node" -> do
wgnStatus <- o JSON..: "status"
return WGN{..}
_ -> terror $ "WorkflowGraphNode parseJSON error: expected tag node, but got " <> fieldTag
deriveJSON defaultOptions deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1 { fieldLabelModifier = camelToPathPiece' 1