From 857ab74525228bee39bd967ce61365db0e3240cc Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Mon, 6 Apr 2020 12:02:31 +0200 Subject: [PATCH] chore(workflows): switch from SomeResolution to Scientific (wip) --- src/Model/Types/Workflow.hs | 20 ++++++++--------- src/Utils.hs | 44 ++++++++++++++++++------------------- 2 files changed, 31 insertions(+), 33 deletions(-) diff --git a/src/Model/Types/Workflow.hs b/src/Model/Types/Workflow.hs index da71d6d2b..384969aec 100644 --- a/src/Model/Types/Workflow.hs +++ b/src/Model/Types/Workflow.hs @@ -6,6 +6,7 @@ import Model.Types.Security (AuthDNF) import qualified Data.Set as Set (toList, fromList) import qualified Data.Map as Map +import Data.Scientific import qualified Data.Aeson as JSON import Data.Aeson.Types (Parser) @@ -39,7 +40,7 @@ type WorkflowGraphNodeLabel = CI Text data WorkflowEdgePayload userid fileid (payload :: *) where WEPText :: Text -> WorkflowEdgePayload userid fileid Text - WEPNumber :: SomeResolution -> WorkflowEdgePayload userid fileid SomeResolution + WEPNumber :: Scientific -> WorkflowEdgePayload userid fileid Scientific WEPBool :: Bool -> WorkflowEdgePayload userid fileid Bool WEPFile :: fileid -> WorkflowEdgePayload userid fileid fileid WEPUser :: userid -> WorkflowEdgePayload userid fileid userid @@ -60,9 +61,8 @@ data WorkflowEdgePayloadField fileid userid (payload :: *) where WorkflowEdgePayloadFieldNumber :: { wepfnLabel :: Text , wepfnPlaceholder :: Text , wepfnTooltip :: Maybe Text - , wepfnDefault :: Maybe SomeResolution - , wepfnPrecision :: SomeResolution - } -> WorkflowEdgePayloadField fileid userid SomeResolution + , wepfnDefault :: Maybe Scientific + } -> WorkflowEdgePayloadField fileid userid Scientific WorkflowEdgePayloadFieldBool :: { wepfbLabel :: Text , wepfbTooltip :: Maybe Text , wepfbDefault :: Maybe Bool @@ -92,7 +92,7 @@ instance (Show fileid, Show userid) => Show (WorkflowEdgePayloadSpecification fi 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@WorkflowEdgePayloadFieldNumber{}) == (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = wepfnLabel f1 == wepfnLabel f2 && wepfnPlaceholder f1 == wepfnPlaceholder f2 && wepfnTooltip f1 == wepfnTooltip f2 && wepfnDefault f1 == wepfnDefault 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 @@ -100,7 +100,7 @@ instance (Eq fileid, Eq userid) => Eq (WorkflowEdgePayloadSpecification fileid u 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@WorkflowEdgePayloadFieldNumber{}) <= (WorkflowEdgePayloadSpecification f2@WorkflowEdgePayloadFieldNumber{}) = wepfnLabel f1 <= wepfnLabel f2 && wepfnPlaceholder f1 <= wepfnPlaceholder f2 && wepfnTooltip f1 <= wepfnTooltip f2 && wepfnDefault f1 <= wepfnDefault 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 @@ -220,7 +220,6 @@ instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadSpecificat , "placeholder" JSON..= wepfnPlaceholder , "tooltip" JSON..= wepfnTooltip , "default" JSON..= wepfnDefault - , "precision" JSON..= wepfnPrecision ] toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}) = JSON.object [ "tag" JSON..= ("bool" :: Text) @@ -254,8 +253,7 @@ instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpec wepfnLabel <- o JSON..: "label" wepfnPlaceholder <- o JSON..: "placeholder" wepfnTooltip <- o JSON..:? "tooltip" - wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe SomeResolution)) - wepfnPrecision <- o JSON..: "precision" + wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe Scientific)) return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..} "bool" -> do wepfbLabel <- o JSON..: "label" @@ -305,5 +303,5 @@ instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON 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]),("someboolandnumber", impureNonNull $ Set.fromList [WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldBool "bool-label" Nothing (Just True), WorkflowEdgePayloadSpecification $ WorkflowEdgePayloadFieldNumber "number-label" "number-placeholder" Nothing (Just singleRes) singleRes])])]))] -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 0.01)])])]))] +--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)])])]))] diff --git a/src/Utils.hs b/src/Utils.hs index bcc500c63..7c4641f02 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -348,28 +348,28 @@ rationalToFixed3 = rationalToFixed rationalToFixed2 :: Rational -> Fixed E2 rationalToFixed2 = rationalToFixed -data SomeResolution = forall prec. HasResolution prec => SomeResolution (Proxy prec) - -instance Eq SomeResolution where - SomeResolution (_ :: Proxy p) == SomeResolution (_ :: Proxy p') = True -instance Ord SomeResolution where - compare _ _ = EQ - -instance ToJSON SomeResolution where - 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) +--data SomeResolution = forall prec. HasResolution prec => SomeResolution (Proxy prec) +-- +--instance Eq SomeResolution where +-- SomeResolution (_ :: Proxy p) == SomeResolution (_ :: Proxy p') = True +--instance Ord SomeResolution where +-- compare _ _ = EQ +-- +--instance ToJSON SomeResolution where +-- 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) ----------