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

chore(workflows): replace heterogeneous list in json

Browse Source
This commit is contained in:
Sarah Vaupel 2020-04-06 11:42:27 +02:00 committed by Gregor Kleen
parent c65bc7bda8
commit c1b48e4d55
1 changed files with 23 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,9 +25,14 @@ data WorkflowGraphNodeStatus = WGNS
deriving (Eq, Ord, Show, Read, Data, Generic, Typeable) deriving (Eq, Ord, Show, Read, Data, Generic, Typeable)
data WorkflowGraphNode = WGN data WorkflowGraphNode = WGN
{ wgnStatus :: WorkflowGraphNodeStatus { wgnStatus :: WorkflowGraphNodeStatus
} }
deriving (Eq, Ord, Show, Read, Data, Generic, Typeable) deriving (Eq, Ord, Show, Read, Data, Generic, Typeable)
data WorkflowGraphNode' userid fileid = WGN'
{ wgn'Node :: WorkflowGraphNode
, wgn'Edges :: Set (WorkflowGraphEdge userid fileid)
}
deriving (Eq, Ord, Show, Generic, Typeable)
type WorkflowGraphNodeLabel = CI Text type WorkflowGraphNodeLabel = CI Text
@ -173,17 +178,18 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
return $ WorkflowRoleInitiator iid 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) => 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..= wgNodes , "nodes" JSON..= Map.map (\(wgn'Node,wgn'Edges) -> WGN'{..}) 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
fieldTag <- o JSON..: "tag" fieldTag <- o JSON..: "tag"
case fieldTag of case fieldTag of
"workflow" -> do "workflow" -> do
wgNodes <- o JSON..: "nodes" wgNodes' <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel (WorkflowGraphNode' userid fileid)))
let wgNodes = Map.map (\WGN'{..} -> (wgn'Node, 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
@ -286,6 +292,18 @@ deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1 { fieldLabelModifier = camelToPathPiece' 1
} ''WorkflowGraphNodeStatus } ''WorkflowGraphNodeStatus
instance (ToJSON userid, ToJSON fileid, Ord userid) => ToJSON (WorkflowGraphNode' userid fileid) where
toJSON WGN'{..} = JSON.object
[ "node" JSON..= wgn'Node
, "edges" JSON..= wgn'Edges
]
instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraphNode' userid fileid) where
parseJSON = JSON.withObject "WorkflowGraphNode'" $ \o -> do
wgn'Node <- o JSON..: "node"
wgn'Edges <- o JSON..: "edges"
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 singleRes) singleRes])])]))] --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 singleRes) singleRes])])]))]
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)])])]))]