fix(workflow): fix types
This commit is contained in:
Sarah Vaupel
Gregor Kleen
parent
d1b9d502e8
commit
ce1acec444
@ -33,11 +33,11 @@ type WorkflowGraphNodeLabel = CI Text
|
||||
|
||||
|
||||
data WorkflowEdgePayload userid fileid (payload :: *) where
|
||||
WEPText :: Text -> WorkflowEdgePayload userid fileid Text
|
||||
WEPNumber :: HasResolution prec => (Fixed prec) -> WorkflowEdgePayload userid fileid (Fixed prec)
|
||||
WEPBool :: Bool -> WorkflowEdgePayload userid fileid Bool
|
||||
WEPFile :: fileid -> WorkflowEdgePayload userid fileid fileid
|
||||
WEPUser :: userid -> WorkflowEdgePayload userid fileid userid
|
||||
WEPText :: Text -> WorkflowEdgePayload userid fileid Text
|
||||
WEPNumber :: SomeResolution -> WorkflowEdgePayload userid fileid SomeResolution
|
||||
WEPBool :: Bool -> WorkflowEdgePayload userid fileid Bool
|
||||
WEPFile :: fileid -> WorkflowEdgePayload userid fileid fileid
|
||||
WEPUser :: userid -> WorkflowEdgePayload userid fileid userid
|
||||
|
||||
data WorkflowEdgePayload' = WEPText' | WEPNumber' | WEPBool' | WEPFile' | WEPUser'
|
||||
deriving (Eq, Ord, Enum, Show, Read, Data, Generic, Typeable)
|
||||
@ -52,13 +52,12 @@ data WorkflowEdgePayloadField fileid userid (payload :: *) where
|
||||
, wepftTooltip :: Maybe Text
|
||||
, wepftDefault :: Maybe Text
|
||||
} -> WorkflowEdgePayloadField fileid userid Text
|
||||
WorkflowEdgePayloadFieldNumber :: HasResolution prec =>
|
||||
{ wepfnLabel :: Text
|
||||
WorkflowEdgePayloadFieldNumber :: { wepfnLabel :: Text
|
||||
, wepfnPlaceholder :: Text
|
||||
, wepfnTooltip :: Maybe Text
|
||||
, wepfnDefault :: Maybe (Fixed prec)
|
||||
, wepfnDefault :: Maybe SomeResolution
|
||||
, wepfnPrecision :: SomeResolution
|
||||
} -> WorkflowEdgePayloadField fileid userid (Fixed prec)
|
||||
} -> WorkflowEdgePayloadField fileid userid SomeResolution
|
||||
WorkflowEdgePayloadFieldBool :: { wepfbLabel :: Text
|
||||
, wepfbTooltip :: Maybe Text
|
||||
, wepfbDefault :: Maybe Bool
|
||||
@ -146,8 +145,7 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
|
||||
"initiator" -> do
|
||||
iid <- o .: "initiator"
|
||||
return $ WorkflowRoleInitiator iid
|
||||
_ -> do
|
||||
(error.show) $ "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
|
||||
toJSON (WorkflowGraph m) = toJSON m
|
||||
@ -168,81 +166,72 @@ instance (FromJSON userid, Ord userid, FromJSON fileid) => FromJSON (WorkflowGra
|
||||
return WGE{..}
|
||||
|
||||
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadSpecification fileid userid) where
|
||||
toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldText{})) = toJSON f
|
||||
toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldNumber{})) = toJSON f
|
||||
toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldBool{})) = toJSON f
|
||||
toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldFile{})) = toJSON f
|
||||
toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldUser{})) = toJSON f
|
||||
toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{..}) = JSON.object
|
||||
[ "tag" JSON..= ("text" :: Text)
|
||||
, "label" JSON..= wepftLabel
|
||||
, "placeholder" JSON..= wepftPlaceholder
|
||||
, "tooltip" JSON..= wepftTooltip
|
||||
, "default" JSON..= wepftDefault
|
||||
]
|
||||
toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..}) = JSON.object
|
||||
[ "tag" JSON..= ("number" :: Text)
|
||||
, "label" JSON..= wepfnLabel
|
||||
, "placeholder" JSON..= wepfnPlaceholder
|
||||
, "tooltip" JSON..= wepfnTooltip
|
||||
, "default" JSON..= wepfnDefault
|
||||
, "precision" JSON..= wepfnPrecision
|
||||
]
|
||||
toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}) = JSON.object
|
||||
[ "tag" JSON..= ("bool" :: Text)
|
||||
, "label" JSON..= wepfbLabel
|
||||
, "tooltip" JSON..= wepfbTooltip
|
||||
, "default" JSON..= wepfbDefault
|
||||
]
|
||||
toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{..}) = JSON.object
|
||||
[ "tag" JSON..= ("file" :: Text)
|
||||
, "label" JSON..= wepffLabel
|
||||
, "tooltip" JSON..= wepffTooltip
|
||||
, "default" JSON..= wepffDefault
|
||||
]
|
||||
toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{..}) = JSON.object
|
||||
[ "tag" JSON..= ("user" :: Text)
|
||||
, "label" JSON..= wepfuLabel
|
||||
, "tooltip" JSON..= wepfuTooltip
|
||||
, "default" JSON..= wepfuDefault
|
||||
]
|
||||
instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpecification fileid userid) where
|
||||
parseJSON = parseJSON -- TODO
|
||||
|
||||
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid Text) where
|
||||
toJSON (WorkflowEdgePayloadFieldText{..}) = JSON.object
|
||||
[ "label" JSON..= wepftLabel
|
||||
, "placeholder" JSON..= wepftPlaceholder
|
||||
, "tooltip" JSON..= wepftTooltip
|
||||
, "default" JSON..= wepftDefault
|
||||
]
|
||||
instance (ToJSON fileid, ToJSON userid, HasResolution prec) => ToJSON (WorkflowEdgePayloadField fileid userid (Fixed prec)) where
|
||||
toJSON (WorkflowEdgePayloadFieldNumber{..}) = JSON.object
|
||||
[ "label" JSON..= wepfnLabel
|
||||
, "placeholder" JSON..= wepfnPlaceholder
|
||||
, "tooltip" JSON..= wepfnTooltip
|
||||
, "default" JSON..= wepfnDefault
|
||||
, "precision" JSON..= wepfnPrecision
|
||||
]
|
||||
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid Bool) where
|
||||
toJSON (WorkflowEdgePayloadFieldBool{..}) = JSON.object
|
||||
[ "label" JSON..= wepfbLabel
|
||||
, "tooltip" JSON..= wepfbTooltip
|
||||
, "default" JSON..= wepfbDefault
|
||||
]
|
||||
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid FileInfo) where
|
||||
toJSON (WorkflowEdgePayloadFieldFile{..}) = JSON.object
|
||||
[ "label" JSON..= wepffLabel
|
||||
, "tooltip" JSON..= wepffTooltip
|
||||
, "default" JSON..= wepffDefault
|
||||
]
|
||||
instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid userid) where
|
||||
toJSON (WorkflowEdgePayloadFieldUser{..}) = JSON.object
|
||||
[ "label" JSON..= wepfuLabel
|
||||
, "tooltip" JSON..= wepfuTooltip
|
||||
, "default" JSON..= wepfuDefault
|
||||
]
|
||||
|
||||
instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadField fileid userid payload) where
|
||||
parseJSON = JSON.withObject "WorkflowEdgePayloadField" $ \o -> do
|
||||
fieldType <- (o JSON..: "type" :: Parser Text)
|
||||
case fieldType of
|
||||
parseJSON = JSON.withObject "WorkflowEdgePayloadSpecification" $ \o -> do
|
||||
fieldTag <- (o JSON..: "tag" :: Parser Text)
|
||||
case fieldTag of
|
||||
"text" -> do
|
||||
wepftLabel <- o JSON..: "label"
|
||||
wepftPlaceholder <- o JSON..: "placeholder"
|
||||
wepftTooltip <- o JSON..:? "tooltip"
|
||||
wepftDefault <- o JSON..:? "default"
|
||||
return (WorkflowEdgePayloadFieldText{..})
|
||||
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{..}
|
||||
"number" -> do
|
||||
wepfnLabel <- o JSON..: "label"
|
||||
wepfnPlaceholder <- o JSON..: "placeholder"
|
||||
wepfnTooltip <- o JSON..:? "tooltip"
|
||||
wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe (Fixed prec)))
|
||||
wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe SomeResolution))
|
||||
wepfnPrecision <- o JSON..: "precision"
|
||||
return (WorkflowEdgePayloadFieldNumber{..})
|
||||
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..}
|
||||
"bool" -> do
|
||||
wepfbLabel <- o JSON..: "label"
|
||||
wepfbTooltip <- o JSON..:? "tooltip"
|
||||
wepfbDefault <- (o JSON..:? "default" :: Parser (Maybe Bool))
|
||||
return (WorkflowEdgePayloadFieldBool{..})
|
||||
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}
|
||||
"file" -> do
|
||||
wepffLabel <- o JSON..: "label"
|
||||
wepffTooltip <- o JSON..:? "tooltip"
|
||||
wepffDefault <- (o JSON..:? "default" :: Parser (Maybe fileid))
|
||||
return (WorkflowEdgePayloadFieldFile{..})
|
||||
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{..}
|
||||
"user" -> do
|
||||
wepfuLabel <- o JSON..: "label"
|
||||
wepfuTooltip <- o JSON..:? "tooltip"
|
||||
wepfuDefault <- (o JSON..:? "default" :: Parser (Maybe userid))
|
||||
return (WorkflowEdgePayloadFieldUser{..})
|
||||
_ -> error $ "WorkflowEdgePayloadField parseJSON error: expected field type (text|number|bool|file|user), but got " ++ fieldType
|
||||
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{..}
|
||||
_ -> terror $ "WorkflowEdgePayloadSpecification parseJSON error: expected field tag (text|number|bool|file|user), but got " <> fieldTag
|
||||
|
||||
instance ToJSON WorkflowGraphNode where
|
||||
toJSON (WGN{..}) = toJSON wgnStatus
|
||||
|
||||
Loading…
Reference in New Issue
Block a user