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

chore(workflows): switch from SomeResolution to Scientific (wip)

Browse Source
This commit is contained in:
Sarah Vaupel 2020-04-06 12:02:31 +02:00 committed by Gregor Kleen
parent c1b48e4d55
commit 857ab74525
2 changed files with 31 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,6 +6,7 @@ import Model.Types.Security (AuthDNF)
import qualified Data.Set as Set (toList, fromList) import qualified Data.Set as Set (toList, fromList)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Scientific
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import Data.Aeson.Types (Parser) import Data.Aeson.Types (Parser)
@ -39,7 +40,7 @@ type WorkflowGraphNodeLabel = CI Text
data WorkflowEdgePayload userid fileid (payload :: *) where data WorkflowEdgePayload userid fileid (payload :: *) where
WEPText :: Text -> WorkflowEdgePayload userid fileid Text WEPText :: Text -> WorkflowEdgePayload userid fileid Text
WEPNumber :: SomeResolution -> WorkflowEdgePayload userid fileid SomeResolution WEPNumber :: Scientific -> WorkflowEdgePayload userid fileid Scientific
WEPBool :: Bool -> WorkflowEdgePayload userid fileid Bool WEPBool :: Bool -> WorkflowEdgePayload userid fileid Bool
WEPFile :: fileid -> WorkflowEdgePayload userid fileid fileid WEPFile :: fileid -> WorkflowEdgePayload userid fileid fileid
WEPUser :: userid -> WorkflowEdgePayload userid fileid userid WEPUser :: userid -> WorkflowEdgePayload userid fileid userid
@ -60,9 +61,8 @@ data WorkflowEdgePayloadField fileid userid (payload :: *) where
WorkflowEdgePayloadFieldNumber :: { wepfnLabel :: Text WorkflowEdgePayloadFieldNumber :: { wepfnLabel :: Text
, wepfnPlaceholder :: Text , wepfnPlaceholder :: Text
, wepfnTooltip :: Maybe Text , wepfnTooltip :: Maybe Text
, wepfnDefault :: Maybe SomeResolution , wepfnDefault :: Maybe Scientific
, wepfnPrecision :: SomeResolution } -> WorkflowEdgePayloadField fileid userid Scientific
} -> WorkflowEdgePayloadField fileid userid SomeResolution
WorkflowEdgePayloadFieldBool :: { wepfbLabel :: Text WorkflowEdgePayloadFieldBool :: { wepfbLabel :: Text
, wepfbTooltip :: Maybe Text , wepfbTooltip :: Maybe Text
, wepfbDefault :: Maybe Bool , 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 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@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@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@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 (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 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@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@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@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 (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 , "placeholder" JSON..= wepfnPlaceholder
, "tooltip" JSON..= wepfnTooltip , "tooltip" JSON..= wepfnTooltip
, "default" JSON..= wepfnDefault , "default" JSON..= wepfnDefault
, "precision" JSON..= wepfnPrecision
] ]
toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}) = JSON.object toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}) = JSON.object
[ "tag" JSON..= ("bool" :: Text) [ "tag" JSON..= ("bool" :: Text)
@ -254,8 +253,7 @@ instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpec
wepfnLabel <- o JSON..: "label" wepfnLabel <- o JSON..: "label"
wepfnPlaceholder <- o JSON..: "placeholder" wepfnPlaceholder <- o JSON..: "placeholder"
wepfnTooltip <- o JSON..:? "tooltip" wepfnTooltip <- o JSON..:? "tooltip"
wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe SomeResolution)) wepfnDefault <- (o JSON..:? "default" :: Parser (Maybe Scientific))
wepfnPrecision <- o JSON..: "precision"
return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..} return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..}
"bool" -> do "bool" -> do
wepfbLabel <- o JSON..: "label" wepfbLabel <- o JSON..: "label"
@ -305,5 +303,5 @@ instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON
testGraph :: WorkflowGraph Text Text 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]),("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)])])]))] --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
View File

@ -348,28 +348,28 @@ rationalToFixed3 = rationalToFixed
rationalToFixed2 :: Rational -> Fixed E2 rationalToFixed2 :: Rational -> Fixed E2
rationalToFixed2 = rationalToFixed rationalToFixed2 = rationalToFixed
data SomeResolution = forall prec. HasResolution prec => SomeResolution (Proxy prec) --data SomeResolution = forall prec. HasResolution prec => SomeResolution (Proxy prec)
--
instance Eq SomeResolution where --instance Eq SomeResolution where
SomeResolution (_ :: Proxy p) == SomeResolution (_ :: Proxy p') = True -- SomeResolution (_ :: Proxy p) == SomeResolution (_ :: Proxy p') = True
instance Ord SomeResolution where --instance Ord SomeResolution where
compare _ _ = EQ -- compare _ _ = EQ
--
instance ToJSON SomeResolution where --instance ToJSON SomeResolution where
toJSON (SomeResolution (_ :: Proxy prec)) = undefined -- toJSON (SomeResolution (_ :: Proxy prec)) = undefined
instance FromJSON SomeResolution where --instance FromJSON SomeResolution where
parseJSON = Aeson.withScientific "SomeResolution" $ \s -> case base10Exponent s of -- parseJSON = Aeson.withScientific "SomeResolution" $ \s -> case base10Exponent s of
0 -> return $ SomeResolution (Proxy @E0) -- 0 -> return $ SomeResolution (Proxy @E0)
1 -> return $ SomeResolution (Proxy @E1) -- 1 -> return $ SomeResolution (Proxy @E1)
2 -> return $ SomeResolution (Proxy @E2) -- 2 -> return $ SomeResolution (Proxy @E2)
3 -> return $ SomeResolution (Proxy @E3) -- 3 -> return $ SomeResolution (Proxy @E3)
e -> terror $ "SomeResolution parseJSON error: expected exponent E(0|1|2|3), but got " <> tshow e -- e -> terror $ "SomeResolution parseJSON error: expected exponent E(0|1|2|3), but got " <> tshow e
--
someResolutions :: [SomeResolution] --someResolutions :: [SomeResolution]
someResolutions = [ SomeResolution (Proxy @E0), SomeResolution (Proxy @E1), SomeResolution (Proxy @E2), SomeResolution (Proxy @E3) ] --someResolutions = [ SomeResolution (Proxy @E0), SomeResolution (Proxy @E1), SomeResolution (Proxy @E2), SomeResolution (Proxy @E3) ]
--
singleRes :: SomeResolution --singleRes :: SomeResolution
singleRes = SomeResolution (Proxy @E2) --singleRes = SomeResolution (Proxy @E2)
---------- ----------