feat(workflows): add missing instances; correct Int64 workaround
This commit is contained in:
Sarah Vaupel
Gregor Kleen
parent
6689df5929
commit
8b32edee64
@ -1,15 +1,15 @@
|
||||
WorkflowDefinition
|
||||
graph (WorkflowGraph UserId FileId)
|
||||
graph (WorkflowGraph Int64 Int64)
|
||||
scope WorkflowInstanceScope'
|
||||
|
||||
WorkflowInstance
|
||||
definition WorkflowDefinition
|
||||
graph (WorkflowGraph UserId FileId)
|
||||
scope (WorkflowInstaceScope TermId SchoolId CourseId)
|
||||
graph (WorkflowGraph Int64 Int64) -- FileId, UserId
|
||||
scope (WorkflowInstanceScope Int64 Int64 Int64) -- TermId, SchoolId, CourseId
|
||||
|
||||
Workflow
|
||||
WorkflowWorkflow
|
||||
instance WorkflowInstance
|
||||
graph (WorkflowGraph UserId FileId)
|
||||
graph (WorkflowGraph Int64 Int64) -- FileId, UserId
|
||||
initiator UserId Maybe
|
||||
payload (WorkflowPayload UserId FileId)
|
||||
payload (WorkflowPayload Int64 Int64) -- FileId, UserId
|
||||
currentNode WorkflowGraphNodeLabel Maybe
|
||||
|
||||
@ -2,6 +2,7 @@ module Model.Types.Workflow
|
||||
( WorkflowGraph(..)
|
||||
, WorkflowGraphNodeLabel
|
||||
, WorkflowInstanceScope(..)
|
||||
, WorkflowInstanceScope'(..)
|
||||
, WorkflowPayload
|
||||
, WorkflowPayload'(..)
|
||||
) where
|
||||
@ -10,17 +11,20 @@ import Import.NoModel
|
||||
|
||||
import Model.Types.Security (AuthDNF)
|
||||
|
||||
import Database.Persist.Sql (PersistFieldSql(..))
|
||||
|
||||
import qualified Data.Set as Set (toList)
|
||||
import qualified Data.Set as Set (toList, fromList)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Sequence as Seq
|
||||
--import qualified Data.Set as Set (toList, fromList)
|
||||
--import qualified Data.Map as Map
|
||||
--import qualified Data.Sequence as Seq
|
||||
import Data.Scientific
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
import Data.Aeson.Types (Parser)
|
||||
|
||||
-- TODO remove
|
||||
import Data.ByteString.Lazy.Internal (ByteString)
|
||||
--import Data.ByteString.Lazy.Internal (ByteString)
|
||||
|
||||
|
||||
|
||||
@ -184,12 +188,14 @@ type WorkflowPayloadLabel = CI Text
|
||||
|
||||
type WorkflowPayload fileid userid = Map WorkflowPayloadLabel (Seq (WorkflowPayload' fileid userid))
|
||||
|
||||
data WorkflowPayload' fileid userid = forall payload. WorkflowPayload'
|
||||
{ wpPayload :: Map WorkflowPayloadFieldLabel (WorkflowFieldPayload fileid userid payload)
|
||||
data WorkflowPayload' fileid userid = WorkflowPayload'
|
||||
{ wpPayload :: Map WorkflowPayloadFieldLabel (WorkflowFieldPayloadW fileid userid)
|
||||
, wpActor :: Maybe userid
|
||||
, wpActionTime :: UTCTime
|
||||
}
|
||||
|
||||
data WorkflowFieldPayloadW fileid userid = forall payload. WorkflowFieldPayloadW (WorkflowFieldPayload fileid userid payload)
|
||||
|
||||
data WorkflowFieldPayload fileid userid (payload :: *) where
|
||||
WFPText :: Text -> WorkflowFieldPayload fileid userid Text
|
||||
WFPNumber :: Scientific -> WorkflowFieldPayload fileid userid Scientific
|
||||
@ -237,17 +243,12 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
|
||||
|
||||
instance (ToJSON fileid, ToJSON userid, Ord userid) => ToJSON (WorkflowGraph fileid userid) where
|
||||
toJSON WorkflowGraph{..} = JSON.object
|
||||
[ "tag" JSON..= ("workflow" :: Text)
|
||||
, "nodes" JSON..= wgNodes
|
||||
[ "nodes" JSON..= wgNodes
|
||||
]
|
||||
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 fileid userid)))
|
||||
return WorkflowGraph{..}
|
||||
_ -> terror $ "WorkflowGraph parseJSON error: expected tag workflow, but got " <> fieldTag
|
||||
wgNodes <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel (WorkflowGraphNode fileid userid)))
|
||||
return WorkflowGraph{..}
|
||||
|
||||
instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraphEdge userid fileid) where
|
||||
toJSON (WGE{..}) = JSON.object
|
||||
@ -356,13 +357,146 @@ instance (FromJSON fileid, FromJSON userid, Ord fileid, Ord userid) => FromJSON
|
||||
return WGN{..}
|
||||
|
||||
|
||||
instance (ToJSON termid, ToJSON schoolid, ToJSON courseid) => ToJSON (WorkflowInstanceScope termid schoolid courseid) where
|
||||
toJSON WISGlobal = JSON.object
|
||||
[ "tag" JSON..= ("global" :: Text)
|
||||
]
|
||||
toJSON (WISTerm t) = JSON.object
|
||||
[ "tag" JSON..= ("term" :: Text)
|
||||
, "term" JSON..= t
|
||||
]
|
||||
toJSON (WISSchool s) = JSON.object
|
||||
[ "tag" JSON..= ("school" :: Text)
|
||||
, "school" JSON..= s
|
||||
]
|
||||
toJSON (WISCourse c) = JSON.object
|
||||
[ "tag" JSON..= ("course" :: Text)
|
||||
, "course" JSON..= c
|
||||
]
|
||||
instance (FromJSON termid, FromJSON schoolid, FromJSON courseid) => FromJSON (WorkflowInstanceScope termid schoolid courseid) where
|
||||
parseJSON = JSON.withObject "WorkflowInstanceScope" $ \o -> do
|
||||
fieldTag <- (o JSON..: "tag" :: Parser Text)
|
||||
case fieldTag of
|
||||
"global" -> return WISGlobal
|
||||
"term" -> do
|
||||
t <- o JSON..: "term"
|
||||
return $ WISTerm t
|
||||
"school" -> do
|
||||
s <- o JSON..: "school"
|
||||
return $ WISSchool s
|
||||
"course" -> do
|
||||
c <- o JSON..: "course"
|
||||
return $ WISCourse c
|
||||
_ -> terror $ "WorkflowInstanceScope parseJSON error: expected field tag (global|term|school|course), but got " <> fieldTag
|
||||
|
||||
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = camelToPathPiece' 1 . fromJust . stripSuffix "'"
|
||||
} ''WorkflowInstanceScope'
|
||||
derivePersistFieldJSON ''WorkflowInstanceScope'
|
||||
|
||||
|
||||
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowPayload' fileid userid) where
|
||||
toJSON WorkflowPayload'{..} = JSON.object
|
||||
[ "payload" JSON..= wpPayload
|
||||
, "actor" JSON..= wpActor
|
||||
, "action-time" JSON..= wpActionTime
|
||||
]
|
||||
instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowPayload' fileid userid) where
|
||||
parseJSON = JSON.withObject "WorkflowPayload'" $ \o -> do
|
||||
wpPayload <- o JSON..: "payload"
|
||||
wpActor <- o JSON..:? "actor"
|
||||
wpActionTime <- o JSON..: "action-time"
|
||||
return WorkflowPayload'{..}
|
||||
|
||||
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowFieldPayloadW fileid userid) where
|
||||
toJSON (WorkflowFieldPayloadW (WFPText t)) = JSON.object
|
||||
[ "tag" JSON..= ("text" :: Text)
|
||||
, "text" JSON..= t
|
||||
]
|
||||
toJSON (WorkflowFieldPayloadW (WFPNumber n)) = JSON.object
|
||||
[ "tag" JSON..= ("number" :: Text)
|
||||
, "number" JSON..= n
|
||||
]
|
||||
toJSON (WorkflowFieldPayloadW (WFPBool b)) = JSON.object
|
||||
[ "tag" JSON..= ("bool" :: Text)
|
||||
, "bool" JSON..= b
|
||||
]
|
||||
toJSON (WorkflowFieldPayloadW (WFPFile fid)) = JSON.object
|
||||
[ "tag" JSON..= ("file" :: Text)
|
||||
, "file" JSON..= fid
|
||||
]
|
||||
toJSON (WorkflowFieldPayloadW (WFPUser uid)) = JSON.object
|
||||
[ "tag" JSON..= ("user" :: Text)
|
||||
, "user" JSON..= uid
|
||||
]
|
||||
instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowFieldPayloadW fileid userid) where
|
||||
parseJSON = JSON.withObject "WorkflowFieldPayloadW" $ \o -> do
|
||||
fieldTag <- (o JSON..: "tag" :: Parser Text)
|
||||
case fieldTag of
|
||||
"text" -> do
|
||||
t <- o JSON..: "text"
|
||||
return $ WorkflowFieldPayloadW $ WFPText t
|
||||
"number" -> do
|
||||
n <- o JSON..: "number"
|
||||
return $ WorkflowFieldPayloadW $ WFPNumber n
|
||||
"bool" -> do
|
||||
b <- o JSON..: "bool"
|
||||
return $ WorkflowFieldPayloadW $ WFPBool b
|
||||
"file" -> do
|
||||
fid <- o JSON..: "file"
|
||||
return $ WorkflowFieldPayloadW $ WFPFile fid
|
||||
"user" -> do
|
||||
uid <- o JSON..: "user"
|
||||
return $ WorkflowFieldPayloadW $ WFPUser uid
|
||||
_ -> terror $ "WorkflowFieldPayloadW parseJSON error: expected field tag (text|number|bool|file|user), but got " <> fieldTag
|
||||
|
||||
|
||||
|
||||
----- PersistField / PersistFieldSql instances -----
|
||||
|
||||
instance ( ToJSON fileid, ToJSON userid
|
||||
, FromJSON fileid, FromJSON userid
|
||||
, Ord fileid, Ord userid
|
||||
) => PersistField (WorkflowGraph fileid userid) where
|
||||
toPersistValue = toPersistValueJSON
|
||||
fromPersistValue = fromPersistValueJSON
|
||||
instance ( ToJSON fileid, ToJSON userid
|
||||
, FromJSON fileid, FromJSON userid
|
||||
, Ord fileid, Ord userid
|
||||
) => PersistFieldSql (WorkflowGraph fileid userid) where
|
||||
sqlType _ = SqlString
|
||||
|
||||
|
||||
instance ( ToJSON termid, ToJSON schoolid, ToJSON courseid
|
||||
, FromJSON termid, FromJSON schoolid, FromJSON courseid
|
||||
) => PersistField (WorkflowInstanceScope termid schoolid courseid) where
|
||||
toPersistValue = toPersistValueJSON
|
||||
fromPersistValue = fromPersistValueJSON
|
||||
instance ( ToJSON termid, ToJSON schoolid, ToJSON courseid
|
||||
, FromJSON termid, FromJSON schoolid, FromJSON courseid
|
||||
) => PersistFieldSql (WorkflowInstanceScope termid schoolid courseid) where
|
||||
sqlType _ = SqlString
|
||||
|
||||
|
||||
instance ( ToJSON fileid, ToJSON userid
|
||||
, FromJSON fileid, FromJSON userid
|
||||
) => PersistField (WorkflowPayload fileid userid) where
|
||||
toPersistValue = toPersistValueJSON
|
||||
fromPersistValue = fromPersistValueJSON
|
||||
instance ( ToJSON fileid, ToJSON userid
|
||||
, FromJSON fileid, FromJSON userid
|
||||
) => PersistFieldSql (WorkflowPayload fileid userid) where
|
||||
sqlType _ = SqlString
|
||||
|
||||
|
||||
----- TEST DEFS (TODO remove) -----
|
||||
|
||||
testGraph :: WorkflowGraph Text Text
|
||||
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)])])]))]
|
||||
--testGraph :: WorkflowGraph Text Text
|
||||
--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\":{\"display-label\":\"node-label\",\"finished\":true,\"edges\":[{\"actors\":[{\"tag\":\"initiator\"},{\"tag\":\"user\",\"user\":\"user-id\"},{\"tag\":\"authorized\",\"authorized\":{\"dnf\":{\"dnfTerms\":[[{\"plVar\":\"lecturer\",\"val\":\"variable\"},{\"plVar\":\"participant\",\"val\":\"negated\"}]]}}}],\"form\":{\"some-number\":[{\"tag\":\"number\",\"step\":0.01,\"label\":\"number-label\",\"placeholder\":\"number-placeholder\"}]},\"target\":\"node1\"}]}}}"
|
||||
--testGraphStr :: Data.ByteString.Lazy.Internal.ByteString
|
||||
--testGraphStr = "{\"nodes\":{\"node1\":{\"display-label\":\"node-label\",\"finished\":true,\"edges\":[{\"actors\":[{\"tag\":\"initiator\"},{\"tag\":\"user\",\"user\":\"user-id\"},{\"tag\":\"authorized\",\"authorized\":{\"dnf\":{\"dnfTerms\":[[{\"plVar\":\"lecturer\",\"val\":\"variable\"},{\"plVar\":\"participant\",\"val\":\"negated\"}]]}}}],\"form\":{\"some-number\":[{\"tag\":\"number\",\"step\":0.01,\"label\":\"number-label\",\"placeholder\":\"number-placeholder\"}]},\"target\":\"node1\"}]}}}"
|
||||
|
||||
testPayload :: WorkflowPayload Text Text
|
||||
testPayload = Map.fromList [("sometext" :: WorkflowPayloadLabel, (Seq.singleton (WorkflowPayload' (Map.fromList [("text-label", WFPText "hello world!")]) (Just "actor-user-id" :: Maybe Text) (UTCTime (ModifiedJulianDay 58946) 57250))))]
|
||||
--testPayload :: WorkflowPayload Text Text
|
||||
--testPayload = Map.fromList [("sometext" :: WorkflowPayloadLabel, (Seq.singleton (WorkflowPayload' (Map.fromList [("text-label", WFPText "hello world!")]) (Just "actor-user-id" :: Maybe Text) (UTCTime (ModifiedJulianDay 58946) 57250))))]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user