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

feat(workflows): new field CaptureDateTime

Browse Source
This commit is contained in:
Gregor Kleen 2021-06-09 13:12:01 +02:00
parent df073ef794
commit 5944a174bc
6 changed files with 167 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/categories/workflows/de-de-formal.msg
View File

@ -75,6 +75,10 @@ WorkflowEdgeFormFieldUserNotFound: E-Mail Adresse konnte keinem/keiner Benutzer:
WorkflowEdgeFormFieldMultipleNoneAdded: (Noch) keine Einträge
WorkflowEdgeFormFieldCaptureUserLabel: Aktuelle:r Benutzer:in
WorkflowEdgeFormFieldCaptureDateLabel: Aktuelles Datum
WorkflowEdgeFormFieldCaptureTimeLabel: Aktuelle Uhrzeit
WorkflowEdgeFormFieldCaptureDateTimeLabel: Aktuelles Datum/Zeit
WorkflowWorkflowWorkflowHistoryHeading: Verlauf
WorkflowWorkflowWorkflowEdgeFormHeading: Aktion im Workflow auslösen
WorkflowWorkflowWorkflowEdgeSuccess: Aktion erfolgreich ausgelöst

6
messages/uniworx/categories/workflows/en-eu.msg
View File

@ -34,6 +34,10 @@ WorkflowEdgeFormFieldUserNotFound: Email could not be resolved to an user
WorkflowEdgeFormFieldMultipleNoneAdded: No entries (yet)
WorkflowEdgeFormFieldCaptureUserLabel: Current user
WorkflowEdgeFormFieldCaptureDateLabel: Current date
WorkflowEdgeFormFieldCaptureTimeLabel: Current time
WorkflowEdgeFormFieldCaptureDateTimeLabel: Current date/time
WorkflowWorkflowWorkflowHistoryHeading: History
WorkflowWorkflowWorkflowEdgeFormHeading: Trigger action within workflow
WorkflowWorkflowWorkflowEdgeSuccess: Successfully triggered action
@ -137,4 +141,4 @@ YAMLFieldDecodeFailure yamlFailure: Could not parse YAML: #{yamlFailure}
WGFTextInput: Text field
WGFFileUpload: File field
WorkflowWorkflowListPersons: Involved users
WorkflowWorkflowListPersons: Involved users

44
src/Handler/Utils/Workflow/EdgeForm.hs
View File

@ -12,6 +12,7 @@ import Handler.Utils.Form
import Handler.Utils.Workflow.CanonicalRoute
import Handler.Utils.Widgets
import Handler.Utils.Workflow.Restriction
import Handler.Utils.DateTime
import qualified ListT
@ -312,6 +313,17 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
wSetTooltip' :: _ => Maybe Html -> t' (t (MForm (WriterT [FieldView UniWorX] Handler))) a -> t' (t (MForm (WriterT [FieldView UniWorX] Handler))) a
wSetTooltip' tip = hoist (hoist (wSetTooltip tip))
delTyp :: forall m.
( MonadState [WorkflowFieldPayloadW FileReference UserId] m
, IsWorkflowFieldPayload FileReference FileReference UserId UserId payload payload
) => m ()
delTyp = State.modify $ \xs' ->
let go [] = []
go (x:xs) | is (_WorkflowFieldPayloadW @payload) x = xs
| otherwise = x : go xs
in go xs'
MsgRenderer mr <- getMsgRenderer
LanguageSelectI18n{..} <- getLanguageSelectI18n
mNudge <- ask
@ -411,6 +423,38 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
}
(True, FormSuccess . Just . (:| []) $ _WorkflowFieldPayloadW . _WorkflowFieldPayload # uid) <$ tell (All True)
Nothing -> (False, FormMissing) <$ tell (All False)
WorkflowPayloadFieldCaptureDateTime{..} -> do
let
cLabel = case wpfcdtPrecision of
WFCaptureDate -> MsgWorkflowEdgeFormFieldCaptureDateLabel
WFCaptureTime -> MsgWorkflowEdgeFormFieldCaptureTimeLabel
WFCaptureDateTime -> MsgWorkflowEdgeFormFieldCaptureDateTimeLabel
fvId <- newIdent
lift . lift . lift . tell $ pure FieldView
{ fvLabel = Blaze.toMarkup $ slI18n wpfcdtLabel
, fvTooltip = slI18n <$> wpfcdtTooltip
, fvId
, fvInput = [whamlet|
$newline never
<span ##{fvId} .explanation>
_{cLabel}
|]
, fvErrors = Nothing
, fvRequired = False
}
t <- liftIO getCurrentTime
case wpfcdtPrecision of
WFCaptureDate -> do
delTyp
(True, FormSuccess . Just . (:| []) . review (_WorkflowFieldPayloadW . _WorkflowFieldPayload) . localDay $ utcToLocalTime t) <$ tell (All True)
WFCaptureTime -> do
delTyp
(True, FormSuccess . Just . (:| []) . review (_WorkflowFieldPayloadW . _WorkflowFieldPayload) . localTimeOfDay $ utcToLocalTime t) <$ tell (All True)
WFCaptureDateTime -> do
delTyp
(True, FormSuccess . Just $ (_WorkflowFieldPayloadW . _WorkflowFieldPayload # t) :| []) <$ tell (All True)
WorkflowPayloadFieldReference{..} -> throwE wpfrTarget
WorkflowPayloadFieldMultiple{..} -> do
fRefs <- nonEmpty <$> State.state (maybe (, []) (splitAt . fromIntegral) $ (+ wpfmMin) <$> wpfmRange)

2
src/Handler/Workflow/Workflow/List.hs
View File

@ -476,6 +476,8 @@ workflowWorkflowList (title, heading) WWListColumns{..} sqlPred = do
WorkflowFieldPayloadW (WFPNumber n ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPNumber n)
WorkflowFieldPayloadW (WFPBool b ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPBool b)
WorkflowFieldPayloadW (WFPDay d ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDay d)
WorkflowFieldPayloadW (WFPTime t ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPTime t)
WorkflowFieldPayloadW (WFPDateTime t) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDateTime t)
WorkflowFieldPayloadW (WFPFile _ ) -> tell (mempty, Any True)
WorkflowFieldPayloadW (WFPUser uid) -> tell . (, mempty) . pure . review (_WorkflowFieldPayloadW . _WorkflowFieldPayload) . toJsonUser =<< lift (lift . lift $ getEntity uid)

14
src/Handler/Workflow/Workflow/Workflow.hs
View File

@ -183,6 +183,8 @@ workflowR rScope cID = do
WorkflowFieldPayloadW (WFPNumber n ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPNumber n)
WorkflowFieldPayloadW (WFPBool b ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPBool b)
WorkflowFieldPayloadW (WFPDay d ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDay d)
WorkflowFieldPayloadW (WFPTime t ) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPTime t)
WorkflowFieldPayloadW (WFPDateTime t) -> tell . (, mempty) . pure $ WorkflowFieldPayloadW (WFPDateTime t)
WorkflowFieldPayloadW (WFPFile _ ) -> tell (mempty, Any True)
WorkflowFieldPayloadW (WFPUser uid) -> tell . (, mempty) . pure . review (_WorkflowFieldPayloadW . _WorkflowFieldPayload) =<< lift (lift . lift $ getEntity uid)
@ -243,13 +245,15 @@ workflowR rScope cID = do
<p .workflow-payload--text>
#{t}
|]
WorkflowFieldPayloadW (WFPNumber n ) -> toWidget . toMarkup $ formatScientific Scientific.Fixed Nothing n
WorkflowFieldPayloadW (WFPBool b ) -> i18n $ WorkflowPayloadBool b
WorkflowFieldPayloadW (WFPDay d ) -> formatTimeW SelFormatDate d
WorkflowFieldPayloadW (WFPUser mUserEnt) -> case mUserEnt of
WorkflowFieldPayloadW (WFPNumber n ) -> toWidget . toMarkup $ formatScientific Scientific.Fixed Nothing n
WorkflowFieldPayloadW (WFPBool b ) -> i18n $ WorkflowPayloadBool b
WorkflowFieldPayloadW (WFPDay d ) -> formatTimeW SelFormatDate d
WorkflowFieldPayloadW (WFPTime t ) -> formatTimeW SelFormatTime t
WorkflowFieldPayloadW (WFPDateTime t ) -> formatTimeW SelFormatDateTime t
WorkflowFieldPayloadW (WFPUser mUserEnt) -> case mUserEnt of
Nothing -> i18n MsgWorkflowPayloadUserGone
Just (Entity _ User{..}) -> nameWidget userDisplayName userSurname
WorkflowFieldPayloadW (WFPFile v ) -> absurd v
WorkflowFieldPayloadW (WFPFile v ) -> absurd v
$(widgetFile "workflows/workflow")
getWorkflowFilesR :: RouteWorkflowScope

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

@ -16,6 +16,7 @@ module Model.Types.Workflow
, WorkflowPayloadView(..)
, WorkflowPayloadSpec(..), _WorkflowPayloadSpec
, WorkflowPayloadFieldReference
, WorkflowPayloadTimeCapturePrecision(..)
, WorkflowPayloadField(..)
, WorkflowScope(..)
, WorkflowScope'(..), classifyWorkflowScope
@ -244,6 +245,13 @@ instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (Wo
data WorkflowPayloadFieldReference
deriving (Typeable)
data WorkflowPayloadTimeCapturePrecision
= WFCaptureDate | WFCaptureTime | WFCaptureDateTime
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
deriving anyclass (Universe, Finite, NFData)
instance Default WorkflowPayloadTimeCapturePrecision where
def = WFCaptureDateTime
-- Don't forget to update the NFData instance for every change!
data WorkflowPayloadField fileid userid (payload :: Type) where
WorkflowPayloadFieldText :: { wpftLabel :: I18nText
@ -283,6 +291,10 @@ data WorkflowPayloadField fileid userid (payload :: Type) where
, wpfuOptional :: Bool
} -> WorkflowPayloadField fileid userid userid
WorkflowPayloadFieldCaptureUser :: WorkflowPayloadField fileid userid userid
WorkflowPayloadFieldCaptureDateTime :: { wpfcdtPrecision :: WorkflowPayloadTimeCapturePrecision
, wpfcdtLabel :: I18nText
, wpfcdtTooltip :: Maybe I18nHtml
} -> WorkflowPayloadField fileid userid userid
WorkflowPayloadFieldReference :: { wpfrTarget :: WorkflowPayloadLabel
} -> WorkflowPayloadField fileid userid WorkflowPayloadFieldReference
WorkflowPayloadFieldMultiple :: { wpfmLabel :: I18nText
@ -337,6 +349,14 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileFie
(WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldFile{}) -> GT
(WorkflowPayloadFieldCaptureUser{}, WorkflowPayloadFieldUser{}) -> GT
(WorkflowPayloadFieldCaptureUser{}, _) -> LT
(WorkflowPayloadFieldCaptureDateTime{}, WorkflowPayloadFieldText{}) -> GT
(WorkflowPayloadFieldCaptureDateTime{}, WorkflowPayloadFieldNumber{}) -> GT
(WorkflowPayloadFieldCaptureDateTime{}, WorkflowPayloadFieldBool{}) -> GT
(WorkflowPayloadFieldCaptureDateTime{}, WorkflowPayloadFieldDay{}) -> GT
(WorkflowPayloadFieldCaptureDateTime{}, WorkflowPayloadFieldFile{}) -> GT
(WorkflowPayloadFieldCaptureDateTime{}, WorkflowPayloadFieldUser{}) -> GT
(WorkflowPayloadFieldCaptureDateTime{}, WorkflowPayloadFieldCaptureUser{}) -> GT
(WorkflowPayloadFieldCaptureDateTime{}, _) -> LT
(WorkflowPayloadFieldReference{}, WorkflowPayloadFieldText{}) -> GT
(WorkflowPayloadFieldReference{}, WorkflowPayloadFieldNumber{}) -> GT
(WorkflowPayloadFieldReference{}, WorkflowPayloadFieldBool{}) -> GT
@ -344,6 +364,7 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileFie
(WorkflowPayloadFieldReference{}, WorkflowPayloadFieldFile{}) -> GT
(WorkflowPayloadFieldReference{}, WorkflowPayloadFieldUser{}) -> GT
(WorkflowPayloadFieldReference{}, WorkflowPayloadFieldCaptureUser{}) -> GT
(WorkflowPayloadFieldReference{}, WorkflowPayloadFieldCaptureDateTime{}) -> GT
(WorkflowPayloadFieldReference{}, _) -> LT
(WorkflowPayloadFieldMultiple{}, _) -> GT
@ -356,6 +377,7 @@ instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (Wo
WorkflowPayloadFieldFile{..} -> wpffLabel `deepseq` wpffTooltip `deepseq` wpffConfig `deepseq` wpffOptional `deepseq` ()
WorkflowPayloadFieldUser{..} -> wpfuLabel `deepseq` wpfuTooltip `deepseq` wpfuDefault `deepseq` wpfuOptional `deepseq` ()
WorkflowPayloadFieldCaptureUser -> ()
WorkflowPayloadFieldCaptureDateTime{..} -> wpfcdtPrecision `deepseq` wpfcdtLabel `deepseq` wpfcdtTooltip `deepseq` ()
WorkflowPayloadFieldReference{..} -> wpfrTarget `deepseq` ()
WorkflowPayloadFieldMultiple{..} -> wpfmLabel `deepseq` wpfmTooltip `deepseq` wpfmDefault `deepseq` wpfmSub `deepseq` wpfmMin `deepseq` wpfmRange `deepseq` ()
@ -364,7 +386,7 @@ _WorkflowPayloadSpec :: forall payload fileid userid.
=> Prism' (WorkflowPayloadSpec fileid userid) (WorkflowPayloadField fileid userid payload)
_WorkflowPayloadSpec = prism' WorkflowPayloadSpec $ \(WorkflowPayloadSpec pF) -> cast pF
data WorkflowPayloadField' = WPFText' | WPFNumber' | WPFBool' | WPFDay' | WPFFile' | WPFUser' | WPFCaptureUser' | WPFReference' | WPFMultiple'
data WorkflowPayloadField' = WPFText' | WPFNumber' | WPFBool' | WPFDay' | WPFFile' | WPFUser' | WPFCaptureUser' | WPFCaptureDateTime' | WPFReference' | WPFMultiple'
deriving (Eq, Ord, Enum, Bounded, Show, Read, Data, Generic, Typeable)
deriving anyclass (Universe, Finite, NFData)
@ -478,10 +500,23 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid) => Ord (Work
(WFPDay{}, WFPNumber{}) -> GT
(WFPDay{}, WFPBool{}) -> GT
(WFPDay{}, _) -> LT
(WFPTime{}, WFPText{}) -> GT
(WFPTime{}, WFPNumber{}) -> GT
(WFPTime{}, WFPBool{}) -> GT
(WFPTime{}, WFPDay{}) -> GT
(WFPTime{}, _) -> LT
(WFPDateTime{}, WFPText{}) -> GT
(WFPDateTime{}, WFPNumber{}) -> GT
(WFPDateTime{}, WFPBool{}) -> GT
(WFPDateTime{}, WFPDay{}) -> GT
(WFPDateTime{}, WFPTime{}) -> GT
(WFPDateTime{}, _) -> LT
(WFPFile{}, WFPText{}) -> GT
(WFPFile{}, WFPNumber{}) -> GT
(WFPFile{}, WFPBool{}) -> GT
(WFPFile{}, WFPDay{}) -> GT
(WFPFile{}, WFPTime{}) -> GT
(WFPFile{}, WFPDateTime{}) -> GT
(WFPFile{}, _) -> LT
(WFPUser{}, _) -> GT
@ -506,11 +541,26 @@ workflowPayloadSort ordFiles ordUsers (WorkflowFieldPayloadW a) (WorkflowFieldPa
(WFPDay{}, WFPNumber{} ) -> GT
(WFPDay{}, WFPBool{} ) -> GT
(WFPDay{}, _ ) -> LT
(WFPTime a', WFPTime b' ) -> compare a' b'
(WFPTime{}, WFPText{} ) -> GT
(WFPTime{}, WFPNumber{} ) -> GT
(WFPTime{}, WFPBool{} ) -> GT
(WFPTime{}, WFPDay{} ) -> GT
(WFPTime{}, _ ) -> LT
(WFPDateTime a', WFPDateTime b') -> compare a' b'
(WFPDateTime{}, WFPText{} ) -> GT
(WFPDateTime{}, WFPNumber{} ) -> GT
(WFPDateTime{}, WFPBool{} ) -> GT
(WFPDateTime{}, WFPDay{} ) -> GT
(WFPDateTime{}, WFPTime{} ) -> GT
(WFPDateTime{}, _ ) -> LT
(WFPFile a', WFPFile b' ) -> ordFiles a' b'
(WFPFile{}, WFPText{} ) -> GT
(WFPFile{}, WFPNumber{} ) -> GT
(WFPFile{}, WFPBool{} ) -> GT
(WFPFile{}, WFPDay{} ) -> GT
(WFPFile{}, WFPTime{} ) -> GT
(WFPFile{}, WFPDateTime{}) -> GT
(WFPFile{}, _ ) -> LT
(WFPUser a', WFPUser b' ) -> ordUsers a' b'
(WFPUser{}, _ ) -> GT
@ -524,6 +574,8 @@ data WorkflowFieldPayload fileid userid (payload :: Type) where
WFPNumber :: Scientific -> WorkflowFieldPayload fileid userid Scientific
WFPBool :: Bool -> WorkflowFieldPayload fileid userid Bool
WFPDay :: Day -> WorkflowFieldPayload fileid userid Day
WFPTime :: TimeOfDay -> WorkflowFieldPayload fileid userid TimeOfDay
WFPDateTime :: UTCTime -> WorkflowFieldPayload fileid userid UTCTime
WFPFile :: fileid -> WorkflowFieldPayload fileid userid fileid
WFPUser :: userid -> WorkflowFieldPayload fileid userid userid
deriving (Typeable)
@ -534,19 +586,21 @@ deriving instance (Typeable fileid, Typeable userid, Ord fileid, Ord userid) =>
instance (NFData fileid, NFData userid) => NFData (WorkflowFieldPayload fileid userid payload) where
rnf = \case
WFPText t -> rnf t
WFPNumber n -> rnf n
WFPBool b -> rnf b
WFPDay d -> rnf d
WFPFile f -> rnf f
WFPUser u -> rnf u
WFPText t -> rnf t
WFPNumber n -> rnf n
WFPBool b -> rnf b
WFPDay d -> rnf d
WFPTime t -> rnf t
WFPDateTime t -> rnf t
WFPFile f -> rnf f
WFPUser u -> rnf u
_WorkflowFieldPayloadW :: forall payload fileid userid.
( IsWorkflowFieldPayload' fileid userid payload, Typeable fileid, Typeable userid )
=> Prism' (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayload fileid userid payload)
_WorkflowFieldPayloadW = prism' WorkflowFieldPayloadW $ \(WorkflowFieldPayloadW fp) -> cast fp
data WorkflowFieldPayload' = WFPText' | WFPNumber' | WFPBool' | WFPDay' | WFPFile' | WFPUser'
data WorkflowFieldPayload' = WFPText' | WFPNumber' | WFPBool' | WFPDay' | WFPTime' | WFPDateTime' | WFPFile' | WFPUser'
deriving (Eq, Ord, Enum, Bounded, Show, Read, Data, Generic, Typeable)
deriving anyclass (Universe, Finite, NFData, Binary)
@ -563,6 +617,10 @@ instance IsWorkflowFieldPayload fileid fileid userid userid Bool Bool where
_WorkflowFieldPayload = prism' WFPBool $ \case { WFPBool x -> Just x; _other -> Nothing }
instance IsWorkflowFieldPayload fileid fileid userid userid Day Day where
_WorkflowFieldPayload = prism' WFPDay $ \case { WFPDay x -> Just x; _other -> Nothing }
instance IsWorkflowFieldPayload fileid fileid userid userid TimeOfDay TimeOfDay where
_WorkflowFieldPayload = prism' WFPTime $ \case { WFPTime x -> Just x; _other -> Nothing }
instance IsWorkflowFieldPayload fileid fileid userid userid UTCTime UTCTime where
_WorkflowFieldPayload = prism' WFPDateTime $ \case { WFPDateTime x -> Just x; _other -> Nothing }
instance Typeable fileid => IsWorkflowFieldPayload fileid fileid' userid userid fileid fileid' where
_WorkflowFieldPayload = prism WFPFile $ \case { WFPFile x -> Right x; other -> Left $ unsafeCoerce other }
instance Typeable userid => IsWorkflowFieldPayload fileid fileid userid userid' userid userid' where
@ -677,6 +735,7 @@ instance (Typeable userid, Typeable fileid, Typeable fileid', Ord fileid', useri
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldDay{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldDay{..}
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldUser{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldUser{..}
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldCaptureDateTime{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureDateTime{..}
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldReference{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldReference{..}
instance (Typeable userid, Typeable userid', Typeable fileid, fileid ~ fileid') => HasTypesCustom WorkflowChildren (WorkflowPayloadSpec fileid userid) (WorkflowPayloadSpec fileid' userid') userid userid' where
@ -690,6 +749,7 @@ instance (Typeable userid, Typeable userid', Typeable fileid, fileid ~ fileid')
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldDay{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldDay{..}
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldFile{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldFile{..}
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldCaptureDateTime{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureDateTime{..}
typesCustom _ (WorkflowPayloadSpec WorkflowPayloadFieldReference{..}) = pure $ WorkflowPayloadSpec WorkflowPayloadFieldReference{..}
instance (Typeable payload, Typeable fileid, Typeable userid, IsWorkflowFieldPayload' fileid userid payload, IsWorkflowFieldPayload' fileid' userid' payload', fileid ~ fileid', userid ~ userid') => HasTypesCustom WorkflowChildren (WorkflowFieldPayloadW fileid userid) (WorkflowFieldPayloadW fileid' userid') payload payload' where
@ -739,6 +799,8 @@ nullaryPathPiece ''WorkflowPayloadField' $ camelToPathPiece' 1 . fromJust . stri
derivePathPiece ''WorkflowScope (camelToPathPiece' 1) "--"
nullaryPathPiece ''WorkflowPayloadTimeCapturePrecision $ camelToPathPiece' 2
----- ToJSON / FromJSON instances -----
omitNothing :: [JSON.Pair] -> [JSON.Pair]
@ -762,6 +824,8 @@ deriveJSON defaultOptions
, constructorTagModifier = camelToPathPiece' 3
} ''WorkflowGraphRestriction
pathPieceJSON ''WorkflowPayloadTimeCapturePrecision
instance (FromJSON userid, Ord userid) => FromJSON (WorkflowNodeMessage userid) where
parseJSON = genericParseJSON workflowNodeMessageAesonOptions
instance (FromJSON userid, Ord userid) => FromJSON (WorkflowEdgeMessage userid) where
@ -902,6 +966,12 @@ instance (ToJSON fileid, ToJSON userid, ToJSON (FileField fileid)) => ToJSON (Wo
toJSON WorkflowPayloadFieldCaptureUser{} = JSON.object
[ "tag" JSON..= WPFCaptureUser'
]
toJSON WorkflowPayloadFieldCaptureDateTime{..} = JSON.object
[ "tag" JSON..= WPFCaptureDateTime'
, "label" JSON..= wpfcdtLabel
, "tooltip" JSON..= wpfcdtTooltip
, "precision" JSON..= wpfcdtPrecision
]
toJSON WorkflowPayloadFieldReference{..} = JSON.object
[ "tag" JSON..= WPFReference'
, "target" JSON..= wpfrTarget
@ -967,6 +1037,11 @@ instance ( FromJSON fileid, FromJSON userid
wpfuOptional <- o JSON..: "optional"
return $ WorkflowPayloadSpec WorkflowPayloadFieldUser{..}
WPFCaptureUser' -> pure $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureUser
WPFCaptureDateTime' -> do
wpfcdtPrecision <- o JSON..:? "precision" JSON..!= def
wpfcdtLabel <- o JSON..: "label"
wpfcdtTooltip <- o JSON..:? "tooltip"
return $ WorkflowPayloadSpec WorkflowPayloadFieldCaptureDateTime{..}
WPFReference' -> do
wpfrTarget <- o JSON..: "target"
return $ WorkflowPayloadSpec WorkflowPayloadFieldReference{..}
@ -1040,6 +1115,14 @@ instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowFieldPayloadW fileid
[ "tag" JSON..= WFPDay'
, toPathPiece WFPDay' JSON..= d
]
toJSON (WorkflowFieldPayloadW (WFPTime d)) = JSON.object
[ "tag" JSON..= WFPTime'
, toPathPiece WFPTime' JSON..= d
]
toJSON (WorkflowFieldPayloadW (WFPDateTime t)) = JSON.object
[ "tag" JSON..= WFPDateTime'
, toPathPiece WFPDateTime' JSON..= t
]
toJSON (WorkflowFieldPayloadW (WFPFile fid)) = JSON.object
[ "tag" JSON..= WFPFile'
, toPathPiece WFPFile' JSON..= fid
@ -1062,8 +1145,14 @@ instance (Ord fileid, FromJSON fileid, FromJSON userid, Typeable fileid, Typeabl
b <- o JSON..: toPathPiece WFPBool'
return $ WorkflowFieldPayloadW $ WFPBool b
WFPDay' -> do
b <- o JSON..: toPathPiece WFPDay'
return $ WorkflowFieldPayloadW $ WFPDay b
d <- o JSON..: toPathPiece WFPDay'
return $ WorkflowFieldPayloadW $ WFPDay d
WFPTime' -> do
t <- o JSON..: toPathPiece WFPTime'
return $ WorkflowFieldPayloadW $ WFPTime t
WFPDateTime' -> do
t <- o JSON..: toPathPiece WFPDateTime'
return $ WorkflowFieldPayloadW $ WFPDateTime t
WFPFile' -> do
fid <- o JSON..: toPathPiece WFPFile'
return $ WorkflowFieldPayloadW $ WFPFile fid
@ -1137,6 +1226,8 @@ instance (Binary fileid, Binary userid, Typeable fileid, Typeable userid) => Bin
WFPNumber' -> WorkflowFieldPayloadW . WFPNumber <$> Binary.get
WFPBool' -> WorkflowFieldPayloadW . WFPBool <$> Binary.get
WFPDay' -> WorkflowFieldPayloadW . WFPDay <$> Binary.get
WFPTime' -> WorkflowFieldPayloadW . WFPTime <$> Binary.get
WFPDateTime' -> WorkflowFieldPayloadW . WFPDateTime <$> Binary.get
WFPFile' -> WorkflowFieldPayloadW . WFPFile <$> Binary.get
WFPUser' -> WorkflowFieldPayloadW . WFPUser <$> Binary.get
put = \case
@ -1144,6 +1235,8 @@ instance (Binary fileid, Binary userid, Typeable fileid, Typeable userid) => Bin
WorkflowFieldPayloadW (WFPNumber n ) -> Binary.put WFPNumber' >> Binary.put n
WorkflowFieldPayloadW (WFPBool b ) -> Binary.put WFPBool' >> Binary.put b
WorkflowFieldPayloadW (WFPDay d ) -> Binary.put WFPDay' >> Binary.put d
WorkflowFieldPayloadW (WFPTime t ) -> Binary.put WFPTime' >> Binary.put t
WorkflowFieldPayloadW (WFPDateTime t) -> Binary.put WFPDateTime' >> Binary.put t
WorkflowFieldPayloadW (WFPFile fid) -> Binary.put WFPFile' >> Binary.put fid
WorkflowFieldPayloadW (WFPUser uid) -> Binary.put WFPUser' >> Binary.put uid