diff --git a/src/Model/Types/Workflow.hs b/src/Model/Types/Workflow.hs index bbf99c7a4..206733943 100644 --- a/src/Model/Types/Workflow.hs +++ b/src/Model/Types/Workflow.hs @@ -16,71 +16,68 @@ import Data.Aeson.Types (Parser) import Data.ByteString.Lazy.Internal (ByteString) -data WorkflowRole userid = WorkflowRoleUser userid + +----- WORKFLOW GRAPH ----- + +data WorkflowGraph fileid userid = WorkflowGraph + { wgNodes :: Map WorkflowGraphNodeLabel (WorkflowGraphNode fileid userid) + } + deriving (Show, Eq) + + +----- WORKFLOW GRAPH: NODES ----- + +type WorkflowGraphNodeLabel = CI Text + +data WorkflowGraphNode fileid userid = WGN + { wgnDisplayLabel :: Maybe Text + , wgnFinished :: Bool + , wgnEdges :: Set (WorkflowGraphEdge fileid userid) + } + deriving (Eq, Ord, Show, Generic, Typeable) + + +----- WORKFLOW GRAPH: EDGES ----- + +data WorkflowGraphEdge fileid userid = WGE + { wgeTarget :: WorkflowGraphNodeLabel + , wgeActors :: Set (WorkflowRole userid) + , wgeForm :: Map WorkflowPayloadLabel (NonNull (Set (WorkflowPayloadSpec fileid userid))) + } + deriving Show + +instance (Eq fileid, Eq userid) => Eq (WorkflowGraphEdge fileid userid) where + e1@WGE{} == e2@WGE{} = wgeTarget e1 == wgeTarget e2 && wgeActors e1 == wgeActors e2 && wgeForm e1 == wgeForm e2 + +instance (Ord fileid, Ord userid) => Ord (WorkflowGraphEdge fileid userid) where + compare = mconcat [comparing wgeTarget, comparing wgeActors, comparing wgeForm] + + +----- WORKFLOW GRAPH: ROLES / ACTORS ----- + +data WorkflowRole userid = WorkflowRoleUser userid | WorkflowRoleAuthorized AuthDNF | WorkflowRoleInitiator deriving (Eq, Ord, Show, Read, Generic, Typeable) -data WorkflowGraphNodeStatus = WGNS - { wgnsIdent :: CI Text - , wgnsFinished :: Bool - , wgnsLabel :: Maybe Text - } - deriving (Eq, Ord, Show, Read, Data, Generic, Typeable) +----- WORKFLOW GRAPH: PAYLOAD SPECIFICATION ----- -data WorkflowGraphNode = WGN - { wgnStatus :: WorkflowGraphNodeStatus - } - deriving (Eq, Ord, Show, Read, Data, Generic, Typeable) -data WorkflowGraphNode' userid fileid = WGN' - { wgn'Status :: WorkflowGraphNodeStatus - , wgn'Edges :: Set (WorkflowGraphEdge userid fileid) - } - deriving (Eq, Ord, Show, Generic, Typeable) +data WorkflowPayloadSpec fileid userid = forall payload. WorkflowPayloadSpec (WorkflowPayloadField fileid userid payload) -type WorkflowGraphNodeLabel = CI Text - - -data WorkflowFieldPayload userid fileid (payload :: *) where - WFPText :: { wfptLabel :: Text - , wfptText :: Text - } -> WorkflowFieldPayload userid fileid Text - WFPNumber :: { wfpnLabel :: Text - , wfpnNumber :: Scientific - } -> WorkflowFieldPayload userid fileid Scientific - WFPBool :: { wfpbLabel :: Text - , wfpbBool :: Bool - } -> WorkflowFieldPayload userid fileid Bool - WFPFile :: { wfpfLabel :: Text - , wfpfFile :: fileid - } -> WorkflowFieldPayload userid fileid fileid - WFPUser :: { wfpuLabel :: Text - , wfpuUser :: userid - } -> WorkflowFieldPayload userid fileid userid - -instance (Show userid, Show fileid) => Show (WorkflowFieldPayload userid fileid payload) where - show WFPText{..} = "WFPText{label = " <> show wfptLabel <> ", text = " <> show wfptText <> "}" - show WFPNumber{..} = "WFPNumber{label = " <> show wfpnLabel <> ", number = " <> show wfpnNumber <> "}" - show WFPBool{..} = "WFPBool{label = " <> show wfpbLabel <> ", bool = " <> show wfpbBool <> "}" - show WFPFile{..} = "WFPFile{label = " <> show wfpfLabel <> ", file = " <> show wfpfFile <> "}" - show WFPUser{..} = "WFPUser{label = " <> show wfpuLabel <> ", user = " <> show wfpuUser <> "}" - -data WorkflowFieldPayload' = WFPText' | WFPNumber' | WFPBool' | WFPFile' | WFPUser' - deriving (Eq, Ord, Enum, Show, Read, Data, Generic, Typeable) - - -type WorkflowPayloadLabel = CI Text +instance (Show fileid, Show userid) => Show (WorkflowPayloadSpec fileid userid) where + show (WorkflowPayloadSpec payloadField) = show payloadField +type WorkflowPayloadFieldLabel = Text data WorkflowPayloadField fileid userid (payload :: *) where - WorkflowPayloadFieldText :: { wpftLabel :: Text + WorkflowPayloadFieldText :: { wpftLabel :: WorkflowPayloadFieldLabel , wpftPlaceholder :: Text , wpftTooltip :: Maybe Text , wpftDefault :: Maybe Text , wpftOptional :: Maybe Bool } -> WorkflowPayloadField fileid userid Text - WorkflowPayloadFieldNumber :: { wpfnLabel :: Text + WorkflowPayloadFieldNumber :: { wpfnLabel :: WorkflowPayloadFieldLabel , wpfnPlaceholder :: Text , wpfnTooltip :: Maybe Text , wpfnDefault :: Maybe Scientific @@ -89,16 +86,16 @@ data WorkflowPayloadField fileid userid (payload :: *) where , wpfnStep :: Scientific , wpfnOptional :: Maybe Bool } -> WorkflowPayloadField fileid userid Scientific - WorkflowPayloadFieldBool :: { wpfbLabel :: Text + WorkflowPayloadFieldBool :: { wpfbLabel :: WorkflowPayloadFieldLabel , wpfbTooltip :: Maybe Text , wpfbDefault :: Maybe Bool } -> WorkflowPayloadField fileid userid Bool - WorkflowPayloadFieldFile :: { wpffLabel :: Text + WorkflowPayloadFieldFile :: { wpffLabel :: WorkflowPayloadFieldLabel , wpffTooltip :: Maybe Text , wpffDefault :: Maybe fileid , wpffOptional :: Maybe Bool } -> WorkflowPayloadField fileid userid FileInfo - WorkflowPayloadFieldUser :: { wpfuLabel :: Text + WorkflowPayloadFieldUser :: { wpfuLabel :: WorkflowPayloadFieldLabel , wpfuTooltip :: Maybe Text , wpfuDefault :: Maybe userid , wpfuOptional :: Maybe Bool @@ -135,13 +132,6 @@ instance (Show fileid, Show userid) => Show (WorkflowPayloadField fileid userid <> ", optional = " <> show wpfuOptional <> "}" - - -data WorkflowPayloadSpec fileid userid = forall payload. WorkflowPayloadSpec (WorkflowPayloadField fileid userid payload) - -instance (Show fileid, Show userid) => Show (WorkflowPayloadSpec fileid userid) where - show (WorkflowPayloadSpec payloadField) = show payloadField - instance (Eq fileid, Eq userid) => Eq (WorkflowPayloadSpec fileid userid) where (WorkflowPayloadSpec f1@WorkflowPayloadFieldText{}) == (WorkflowPayloadSpec f2@WorkflowPayloadFieldText{}) = wpftLabel f1 == wpftLabel f2 && wpftPlaceholder f1 == wpftPlaceholder f2 && wpftTooltip f1 == wpftTooltip f2 && wpftDefault f1 == wpftDefault f2 && wpftOptional f1 == wpftOptional f2 (WorkflowPayloadSpec f1@WorkflowPayloadFieldNumber{}) == (WorkflowPayloadSpec f2@WorkflowPayloadFieldNumber{}) = wpfnLabel f1 == wpfnLabel f2 && wpfnPlaceholder f1 == wpfnPlaceholder f2 && wpfnTooltip f1 == wpfnTooltip f2 && wpfnDefault f1 == wpfnDefault f2 && wpfnOptional f1 == wpfnOptional f2 @@ -169,42 +159,57 @@ instance (Ord fileid, Ord userid) => Ord (WorkflowPayloadSpec fileid userid) whe compare (WorkflowPayloadSpec WorkflowPayloadFieldUser{}) _ = LT -data WorkflowPayload userid fileid = forall payload. WorkflowPayload - { wpPayload :: Map WorkflowPayloadLabel (Map Text (WorkflowFieldPayload userid fileid payload)) - , wpActor :: Maybe userid - , wpActionTime :: UTCTime - } +----- WORKFLOW INSTANCE ----- - -data WorkflowGraphEdge userid fileid = WGE - { wgeActors :: Set (WorkflowRole userid) - , wgeTarget :: WorkflowGraphNodeLabel - , wgeForm :: Map WorkflowPayloadLabel (NonNull (Set (WorkflowPayloadSpec fileid userid))) - } - deriving Show - -instance (Eq userid, Eq fileid) => Eq (WorkflowGraphEdge userid fileid) where - e1@WGE{} == e2@WGE{} = wgeActors e1 == wgeActors e2 && wgeTarget e1 == wgeTarget e2 && wgeForm e1 == wgeForm e2 -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 - - -data WorkflowGraph userid fileid = WorkflowGraph - { wgNodes :: Map WorkflowGraphNodeLabel (WorkflowGraphNode, Set (WorkflowGraphEdge userid fileid)) - } - deriving Show - -instance (Eq userid, Eq fileid) => Eq (WorkflowGraph userid fileid) where - WorkflowGraph m1 == WorkflowGraph m2 = m1 == m2 - - -data WorkflowInstanceScope term school course = WISGlobal | WISTerm term | WISSchool school | WISCourse course +data WorkflowInstanceScope term school course = WISGlobal + | WISTerm term + | WISSchool school + | WISCourse course deriving (Eq, Ord, Show, Read, Data, Generic, Typeable) data WorkflowInstanceScope' = WISGlobal' | WISTerm' | WISSchool' | WISCourse' deriving (Eq, Ord, Enum, Read, Show, Data, Generic, Typeable) +----- WORKFLOW: PAYLOAD ----- + +type WorkflowPayloadLabel = CI Text + +data WorkflowPayload fileid userid = forall payload. WorkflowPayload + { wpPayload :: Map WorkflowPayloadLabel (Map WorkflowPayloadFieldLabel (WorkflowFieldPayload fileid userid payload)) + , wpActor :: Maybe userid + , wpActionTime :: UTCTime + } + +data WorkflowFieldPayload fileid userid (payload :: *) where + WFPText :: { wfptLabel :: Text + , wfptText :: Text + } -> WorkflowFieldPayload fileid userid Text + WFPNumber :: { wfpnLabel :: Text + , wfpnNumber :: Scientific + } -> WorkflowFieldPayload fileid userid Scientific + WFPBool :: { wfpbLabel :: Text + , wfpbBool :: Bool + } -> WorkflowFieldPayload fileid userid Bool + WFPFile :: { wfpfLabel :: Text + , wfpfFile :: fileid + } -> WorkflowFieldPayload fileid userid fileid + WFPUser :: { wfpuLabel :: Text + , wfpuUser :: userid + } -> WorkflowFieldPayload fileid userid userid + +instance (Show fileid, Show userid) => Show (WorkflowFieldPayload fileid userid payload) where + show WFPText{..} = "WFPText{label = " <> show wfptLabel <> ", text = " <> show wfptText <> "}" + show WFPNumber{..} = "WFPNumber{label = " <> show wfpnLabel <> ", number = " <> show wfpnNumber <> "}" + show WFPBool{..} = "WFPBool{label = " <> show wfpbLabel <> ", bool = " <> show wfpbBool <> "}" + show WFPFile{..} = "WFPFile{label = " <> show wfpfLabel <> ", file = " <> show wfpfFile <> "}" + show WFPUser{..} = "WFPUser{label = " <> show wfpuLabel <> ", user = " <> show wfpuUser <> "}" + +data WorkflowFieldPayload' = WFPText' | WFPNumber' | WFPBool' | WFPFile' | WFPUser' + deriving (Eq, Ord, Enum, Show, Read, Data, Generic, Typeable) + + +----- ToJSON / FromJSON instances ----- instance (ToJSON userid) => ToJSON (WorkflowRole userid) where toJSON (WorkflowRoleUser uid) = JSON.object @@ -231,18 +236,17 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where "initiator" -> return WorkflowRoleInitiator _ -> 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 fileid, ToJSON userid, Ord userid) => ToJSON (WorkflowGraph fileid userid) where toJSON WorkflowGraph{..} = JSON.object [ "tag" JSON..= ("workflow" :: Text) - , "nodes" JSON..= Map.map (\(WGN{..},wgn'Edges) -> WGN'{wgn'Status=wgnStatus,wgn'Edges=wgn'Edges}) wgNodes + , "nodes" JSON..= wgNodes ] -instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraph userid fileid) where +instance (FromJSON fileid, FromJSON userid, Ord fileid, Ord userid) => FromJSON (WorkflowGraph fileid userid) where parseJSON = JSON.withObject "WorkflowGraph" $ \o -> do fieldTag <- o JSON..: "tag" case fieldTag of "workflow" -> do - wgNodes' <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel (WorkflowGraphNode' userid fileid))) - let wgNodes = Map.map (\WGN'{..} -> (WGN{wgnStatus=wgn'Status}, wgn'Edges)) wgNodes' + wgNodes <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel (WorkflowGraphNode fileid userid))) return WorkflowGraph{..} _ -> terror $ "WorkflowGraph parseJSON error: expected tag workflow, but got " <> fieldTag @@ -252,7 +256,7 @@ instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraphEdge userid file , "target" JSON..= wgeTarget , "form" JSON..= wgeForm ] -instance (Ord userid, Ord fileid, FromJSON userid, FromJSON fileid) => FromJSON (WorkflowGraphEdge userid fileid) where +instance (FromJSON fileid, FromJSON userid, Ord fileid, Ord userid) => FromJSON (WorkflowGraphEdge fileid userid) where parseJSON = JSON.withObject "WorkflowGraphEdge" $ \o -> do wgeActors <- o JSON..: "actors" wgeTarget <- o JSON..: "target" @@ -339,42 +343,27 @@ instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowPayloadSpec fil return $ WorkflowPayloadSpec WorkflowPayloadFieldUser{..} _ -> terror $ "WorkflowPayloadSpec parseJSON error: expected field tag (text|number|bool|file|user), but got " <> fieldTag ---instance ToJSON WorkflowGraphNode where --- toJSON WGN{..} = JSON.object --- [ "tag" JSON..= ("node" :: Text) --- , "status" JSON..= wgnStatus --- ] ---instance FromJSON WorkflowGraphNode where --- 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 - { fieldLabelModifier = camelToPathPiece' 1 - } ''WorkflowGraphNodeStatus - -instance (ToJSON userid, ToJSON fileid, Ord userid) => ToJSON (WorkflowGraphNode' userid fileid) where - toJSON WGN'{..} = JSON.object - [ "status" JSON..= wgn'Status - , "edges" JSON..= wgn'Edges +instance (ToJSON fileid, ToJSON userid, Ord userid) => ToJSON (WorkflowGraphNode fileid userid) where + toJSON WGN{..} = JSON.object + [ "display-label" JSON..= wgnDisplayLabel + , "finished" JSON..= wgnFinished + , "edges" JSON..= wgnEdges ] -instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraphNode' userid fileid) where - parseJSON = JSON.withObject "WorkflowGraphNode'" $ \o -> do - wgn'Status <- o JSON..: "status" - wgn'Edges <- o JSON..: "edges" - return WGN'{..} +instance (FromJSON fileid, FromJSON userid, Ord fileid, Ord userid) => FromJSON (WorkflowGraphNode fileid userid) where + parseJSON = JSON.withObject "WorkflowGraphNode" $ \o -> do + wgnDisplayLabel <- o JSON..: "display-label" + wgnFinished <- o JSON..: "finished" + wgnEdges <- o JSON..: "edges" + return WGN{..} +----- TEST DEFS (TODO remove) ----- + testGraph :: WorkflowGraph Text Text -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 [WorkflowPayloadSpec $ WorkflowPayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default") Nothing]),("someuser", impureNonNull $ Set.fromList [WorkflowPayloadSpec $ WorkflowPayloadFieldUser "user-label" Nothing Nothing Nothing]),("someboolandnumber-opt", impureNonNull $ Set.fromList [WorkflowPayloadSpec $ WorkflowPayloadFieldBool "bool-label" Nothing (Just True), WorkflowPayloadSpec $ WorkflowPayloadFieldNumber "number-label" "number-placeholder" Nothing Nothing (Just 1) (Just 5) 0.01 (Just True)])])]))] +testGraph = WorkflowGraph $ Map.fromList [("node1", WGN (Just "someLabel") True (Set.fromList [WGE "node1" (Set.fromList [WorkflowRoleUser "user-id", WorkflowRoleInitiator]) (Map.fromList [("sometext", impureNonNull $ Set.fromList [WorkflowPayloadSpec $ WorkflowPayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default") Nothing]),("someuser", impureNonNull $ Set.fromList [WorkflowPayloadSpec $ WorkflowPayloadFieldUser "user-label" Nothing Nothing Nothing]),("someboolandnumber-opt", impureNonNull $ Set.fromList [WorkflowPayloadSpec $ WorkflowPayloadFieldBool "bool-label" Nothing (Just True), WorkflowPayloadSpec $ WorkflowPayloadFieldNumber "number-label" "number-placeholder" Nothing Nothing (Just 1) (Just 5) 0.01 (Just True)])])]))] testGraphStr :: Data.ByteString.Lazy.Internal.ByteString testGraphStr = "{\"tag\":\"workflow\",\"nodes\":{\"node1\":{\"status\":{\"ident\":\"status-ident\",\"finished\":true,\"label\":\"status-label\"},\"edges\":[{\"actors\":[{\"tag\":\"initiator\"}],\"form\":{\"some-number\":[{\"tag\":\"number\",\"step\":0.01,\"label\":\"number-label\",\"placeholder\":\"number-placeholder\"}]},\"target\":\"node1\"}]}}}" ---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 [WorkflowPayloadSpec $ WorkflowPayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default")]),("someuser", impureNonNull $ Set.fromList [WorkflowPayloadSpec $ WorkflowPayloadFieldUser "user-label" Nothing Nothing]),("somebool", impureNonNull $ Set.fromList [WorkflowPayloadSpec $ WorkflowPayloadFieldBool "bool-label" Nothing (Just True)])])]))] --testPayload :: WorkflowPayload Text Text testPayload = Map.fromList [("sometext" :: WorkflowPayloadLabel, (Seq.singleton (WFPText "text-label" "hello world!"), Just "actor-user-id" :: Maybe Text, UTCTime (ModifiedJulianDay 58946) 57250))]