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

fix(workflow): fix false instance with atrocious instances

Browse Source
This commit is contained in:
Sarah Vaupel 2020-04-03 21:51:05 +02:00 committed by Gregor Kleen
parent ce1acec444
commit 8812f24d90
1 changed files with 56 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -71,26 +71,46 @@ data WorkflowEdgePayloadField fileid userid (payload :: *) where
, wepfuDefault :: Maybe userid
} -> WorkflowEdgePayloadField fileid userid userid
instance forall fileid userid payload. (Eq fileid, Eq userid) => Eq (WorkflowEdgePayloadField fileid userid payload) where
(WorkflowEdgePayloadFieldText l1 p1 tt1 d1) == (WorkflowEdgePayloadFieldText l2 p2 tt2 d2) = l1 == l2 && p1 == p2 && tt1 == tt2 && d1 == d2
(WorkflowEdgePayloadFieldNumber l1 p1 tt1 d1 prec1) == (WorkflowEdgePayloadFieldNumber l2 p2 tt2 d2 prec2) = l1 == l2 && p1 == p2 && tt1 == tt2 && d1 == d2 && prec1 == prec2
(WorkflowEdgePayloadFieldBool l1 tt1 d1) == (WorkflowEdgePayloadFieldBool l2 tt2 d2) = l1 == l2 && tt1 == tt2 && d1 == d2
(WorkflowEdgePayloadFieldFile l1 tt1 d1) == (WorkflowEdgePayloadFieldFile l2 tt2 d2) = l1 == l2 && tt1 == tt2 && d1 == d2
(WorkflowEdgePayloadFieldUser l1 tt1 d1) == (WorkflowEdgePayloadFieldUser l2 tt2 d2) = l1 == l2 && tt1 == tt2 && d1 == d2
_ == _ = False
instance (Show fileid, Show userid) => Show (WorkflowEdgePayloadField fileid userid payload) where
show (WorkflowEdgePayloadFieldText{..} ) = show wepftLabel
show (WorkflowEdgePayloadFieldNumber{..}) = show wepfnLabel
show (WorkflowEdgePayloadFieldBool{..} ) = show wepfbLabel
show (WorkflowEdgePayloadFieldFile{..} ) = show wepffLabel
show (WorkflowEdgePayloadFieldUser{..} ) = show wepfuLabel
-- TODO remove this instance on removal of the test definition
instance forall fileid userid payload. (Ord fileid, Ord userid) => Ord (WorkflowEdgePayloadField fileid userid payload) where
compare _ _ = EQ
data WorkflowEdgePayloadSpecification fileid userid = forall payload. WorkflowEdgePayloadSpecification (WorkflowEdgePayloadField fileid userid payload)
-- TODO remove (see above)
instance Eq (WorkflowEdgePayloadSpecification fileid userid) where
(WorkflowEdgePayloadSpecification _) == (WorkflowEdgePayloadSpecification _) = True
instance Ord (WorkflowEdgePayloadSpecification fileid userid) where
compare _ _ = EQ
instance (Show fileid, Show userid) => Show (WorkflowEdgePayloadSpecification fileid userid) where
show (WorkflowEdgePayloadSpecification payloadField) = show payloadField
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@WorkflowEdgePayloadFieldNumber{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = wepfnLabel f1 == wepfnLabel f2 && wepfnPlaceholder f1 == wepfnPlaceholder f2 && wepfnTooltip f1 == wepfnTooltip f2 && wepfnDefault f1 == wepfnDefault f2 && wepfnPrecision f1 == wepfnPrecision 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@WorkflowEdgePayloadFieldUser{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldUser{}) = wepfuLabel f1 == wepfuLabel f2 && wepfuTooltip f1 == wepfuTooltip f2 && wepfuDefault f1 == wepfuDefault f2
_ == _ = False
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
(WorkflowEdgePayloadSpecification f1@WorkflowEdgePayloadFieldNumber{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = wepfnLabel f1 <= wepfnLabel f2 && wepfnPlaceholder f1 <= wepfnPlaceholder f2 && wepfnTooltip f1 <= wepfnTooltip f2 && wepfnDefault f1 <= wepfnDefault f2 && wepfnPrecision f1 <= wepfnPrecision 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@WorkflowEdgePayloadFieldUser{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldUser{}) = wepfuLabel f1 <= wepfuLabel f2 && wepfuTooltip f1 <= wepfuTooltip f2 && wepfuDefault f1 <= wepfuDefault f2
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{} ) <= _ = False
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = True
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) <= _ = False
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = True
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) = True
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) <= _ = False
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{}) = True
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{}) = True
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{}) = True
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{}) <= _ = False
(WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{}) <= _ = False
data WorkflowPayload userid fileid = forall payload. Map WorkflowEdgePayloadLabel (WorkflowEdgePayload userid fileid payload)
@ -101,15 +121,23 @@ data WorkflowGraphEdge userid fileid = WGE
, wgeForm :: Map WorkflowEdgePayloadLabel (NonNull (Set (WorkflowEdgePayloadSpecification fileid userid)))
}
-- TODO remove (see above)
instance Eq (WorkflowGraphEdge userid fileid) where
_ == _ = True
instance Ord (WorkflowGraphEdge userid fileid) where
compare _ _ = EQ
instance (Show userid, Show fileid) => Show (WorkflowGraphEdge userid fileid) where
show WGE{..} = "(wgeActors:" ++ show wgeActors ++ "; wgeTarget:" ++ show wgeTarget ++ "; wgeForm:" ++ show wgeForm ++ ")"
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 (Map WorkflowGraphNodeLabel (WorkflowGraphNode, Set (WorkflowGraphEdge userid fileid)))
instance (Show userid, Show fileid) => Show (WorkflowGraph userid fileid) where
show (WorkflowGraph m) = show m
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
deriving (Eq, Ord, Show, Read, Data, Generic, Typeable)
@ -134,16 +162,16 @@ instance (ToJSON userid) => ToJSON (WorkflowRole userid) where
]
instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
parseJSON = JSON.withObject "WorkflowRole" $ \o -> do
role <- (o .: "role" :: Parser Text)
role <- (o JSON..: "role" :: Parser Text)
case role of
"user" -> do
uid <- o .: "user"
uid <- o JSON..: "user"
return $ WorkflowRoleUser uid
"authorized" -> do
adnf <- o .: "authorized"
adnf <- o JSON..: "authorized"
return $ WorkflowRoleAuthorized adnf
"initiator" -> do
iid <- o .: "initiator"
iid <- o JSON..: "initiator"
return $ WorkflowRoleInitiator iid
_ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> role
@ -158,11 +186,11 @@ instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraphEdge userid file
, "target" JSON..= wgeTarget
, "form" JSON..= wgeForm
]
instance (FromJSON userid, Ord userid, FromJSON fileid) => FromJSON (WorkflowGraphEdge userid fileid) where
instance (Ord userid, Ord fileid, FromJSON userid, FromJSON fileid) => FromJSON (WorkflowGraphEdge userid fileid) where
parseJSON = JSON.withObject "WorkflowGraphEdge" $ \o -> do
wgeActors <- o .: "actors"
wgeTarget <- o .: "target"
wgeForm <- o .: "form"
wgeActors <- o JSON..: "actors"
wgeTarget <- o JSON..: "target"
wgeForm <- o JSON..: "form"
return WGE{..}
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadSpecification fileid userid) where