diff --git a/src/Model/Types/Workflow.hs b/src/Model/Types/Workflow.hs index d36d666c1..7f87c6723 100644 --- a/src/Model/Types/Workflow.hs +++ b/src/Model/Types/Workflow.hs @@ -122,7 +122,7 @@ data WorkflowGraphEdge userid fileid = WGE } instance (Show userid, Show fileid) => Show (WorkflowGraphEdge userid fileid) where - show WGE{..} = "(wgeActors:" ++ show wgeActors ++ "; wgeTarget:" ++ show wgeTarget ++ "; wgeForm:" ++ show wgeForm ++ ")" + show WGE{..} = "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 @@ -151,21 +151,21 @@ data WorkflowInstanceScope' = WISGlobal' | WISTerm' | WISSchool' | WISCourse' instance (ToJSON userid) => ToJSON (WorkflowRole userid) where toJSON (WorkflowRoleUser uid) = JSON.object - [ "role" JSON..= ("user" :: Text) + [ "tag" JSON..= ("user" :: Text) , "user" JSON..= uid ] toJSON (WorkflowRoleAuthorized authDNF) = JSON.object - [ "role" JSON..= ("authorized" :: Text) + [ "tag" JSON..= ("authorized" :: Text) , "authorized" JSON..= authDNF ] toJSON (WorkflowRoleInitiator uid) = JSON.object - [ "role" JSON..= ("initiator" :: Text) + [ "tag" JSON..= ("initiator" :: Text) , "initiator" JSON..= uid ] instance (FromJSON userid) => FromJSON (WorkflowRole userid) where parseJSON = JSON.withObject "WorkflowRole" $ \o -> do - role <- (o JSON..: "role" :: Parser Text) - case role of + fieldTag <- (o JSON..: "tag" :: Parser Text) + case fieldTag of "user" -> do uid <- o JSON..: "user" return $ WorkflowRoleUser uid @@ -175,7 +175,7 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where "initiator" -> do iid <- o JSON..: "initiator" return $ WorkflowRoleInitiator iid - _ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> role + _ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> fieldTag instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraph userid fileid) where toJSON WorkflowGraph{..} = JSON.object @@ -292,4 +292,4 @@ deriveJSON defaultOptions testGraph :: WorkflowGraph Text Text -testGraph = WorkflowGraph $ Map.fromList [("node1", (WGN (WGNS "id" True (Just "someLabel")), Set.fromList [WGE (Set.fromList [WorkflowRoleUser "user-id", WorkflowRoleInitiator "init-user-id"]) "node1" (Map.fromList [("sometext", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default")]),("someuser", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldUser "user-label" Nothing Nothing]),("somebool", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldBool "bool-label" Nothing (Just True)])])]))] +testGraph = WorkflowGraph $ Map.fromList [("node1", (WGN (WGNS "id" True (Just "someLabel")), Set.fromList [WGE (Set.fromList [WorkflowRoleUser "user-id", WorkflowRoleInitiator "init-user-id"]) "node1" (Map.fromList [("sometext", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldText "text-label" "text-placeholder" (Just "text-tooltip") (Just "text-default")]),("someuser", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldUser "user-label" Nothing Nothing]),("someboolandnumber", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldBool "bool-label" Nothing (Just True), WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldNumber "number-label" "number-placeholder" Nothing (Just singleRes) singleRes])])]))] diff --git a/src/Utils.hs b/src/Utils.hs index ac55bfc69..bcc500c63 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -10,6 +10,7 @@ import qualified Data.Foldable as Fold import Data.Foldable as Utils (foldlM, foldrM) import Data.Monoid (First, Sum(..)) import Data.Proxy +import Data.Scientific (base10Exponent) import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI @@ -350,18 +351,26 @@ rationalToFixed2 = rationalToFixed data SomeResolution = forall prec. HasResolution prec => SomeResolution (Proxy prec) instance Eq SomeResolution where - _ == _ = True + SomeResolution (_ :: Proxy p) == SomeResolution (_ :: Proxy p') = True instance Ord SomeResolution where compare _ _ = EQ -instance FromJSON SomeResolution where - parseJSON = parseJSON instance ToJSON SomeResolution where - toJSON = toJSON + toJSON (SomeResolution (_ :: Proxy prec)) = undefined +instance FromJSON SomeResolution where + parseJSON = Aeson.withScientific "SomeResolution" $ \s -> case base10Exponent s of + 0 -> return $ SomeResolution (Proxy @E0) + 1 -> return $ SomeResolution (Proxy @E1) + 2 -> return $ SomeResolution (Proxy @E2) + 3 -> return $ SomeResolution (Proxy @E3) + e -> terror $ "SomeResolution parseJSON error: expected exponent E(0|1|2|3), but got " <> tshow e someResolutions :: [SomeResolution] someResolutions = [ SomeResolution (Proxy @E0), SomeResolution (Proxy @E1), SomeResolution (Proxy @E2), SomeResolution (Proxy @E3) ] +singleRes :: SomeResolution +singleRes = SomeResolution (Proxy @E2) + ---------- -- Bool --