chore(workflows): switch from SomeResolution to Scientific (wip)
This commit is contained in:
Sarah Vaupel
Gregor Kleen
parent
c1b48e4d55
commit
857ab74525
@ -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)])])]))]
|
||||
|
||||
44
src/Utils.hs
44
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)
|
||||
|
||||
|
||||
----------
|
||||
|
||||
Loading…
Reference in New Issue
Block a user