fix(workflow): fix types

src/Model/Types/Workflow.hs

@@ -33,11 +33,11 @@ type WorkflowGraphNodeLabel = CI Text
 
 
 data WorkflowEdgePayload userid fileid (payload :: *) where
-  WEPText   :: Text                               -> WorkflowEdgePayload userid fileid Text
+  WEPText   :: Text           -> WorkflowEdgePayload userid fileid Text
-  WEPNumber :: HasResolution prec => (Fixed prec) -> WorkflowEdgePayload userid fileid (Fixed prec)
+  WEPNumber :: SomeResolution -> WorkflowEdgePayload userid fileid SomeResolution
-  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
 
 data WorkflowEdgePayload' = WEPText' | WEPNumber' | WEPBool' | WEPFile' | WEPUser'
   deriving (Eq, Ord, Enum, Show, Read, Data, Generic, Typeable)
@@ -52,13 +52,12 @@ data WorkflowEdgePayloadField fileid userid (payload :: *) where
                                     , wepftTooltip     :: Maybe Text
                                     , wepftDefault     :: Maybe Text
                                     } -> WorkflowEdgePayloadField fileid userid Text
-  WorkflowEdgePayloadFieldNumber :: HasResolution prec => 
+  WorkflowEdgePayloadFieldNumber :: { wepfnLabel       :: Text
-                                    { wepfnLabel       :: Text
                                     , wepfnPlaceholder :: Text
                                     , wepfnTooltip     :: Maybe Text
-                                    , wepfnDefault     :: Maybe (Fixed prec)
+                                    , wepfnDefault     :: Maybe SomeResolution
                                     , wepfnPrecision   :: SomeResolution
-                                    } -> WorkflowEdgePayloadField fileid userid (Fixed prec)
+                                    } -> WorkflowEdgePayloadField fileid userid SomeResolution
   WorkflowEdgePayloadFieldBool   :: { wepfbLabel       :: Text
                                     , wepfbTooltip     :: Maybe Text
                                     , wepfbDefault     :: Maybe Bool
@@ -146,8 +145,7 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
       "initiator" -> do
         iid <- o .: "initiator"
         return $ WorkflowRoleInitiator iid
-      _ -> do
+      _ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> role
-        (error.show) $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " ++ role
 
 instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraph userid fileid) where
   toJSON (WorkflowGraph m) = toJSON m
@@ -168,81 +166,72 @@ instance (FromJSON userid, Ord userid, FromJSON fileid) => FromJSON (WorkflowGra
     return WGE{..}
 
 instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadSpecification fileid userid) where
-  toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldText{})) = toJSON f
+  toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{..}) = JSON.object
-  toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldNumber{})) = toJSON f
+    [ "tag"         JSON..= ("text" :: Text)
-  toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldBool{})) = toJSON f
+    , "label"       JSON..=  wepftLabel
-  toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldFile{})) = toJSON f
+    , "placeholder" JSON..=  wepftPlaceholder
-  toJSON (WorkflowEdgePayloadSpecification f@(WorkflowEdgePayloadFieldUser{})) = toJSON f
+    , "tooltip"     JSON..=  wepftTooltip
+    , "default"     JSON..=  wepftDefault
+    ]
+  toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..}) = JSON.object
+    [ "tag"         JSON..= ("number" :: Text)
+    , "label"       JSON..=  wepfnLabel
+    , "placeholder" JSON..=  wepfnPlaceholder
+    , "tooltip"     JSON..=  wepfnTooltip
+    , "default"     JSON..=  wepfnDefault
+    , "precision"   JSON..=  wepfnPrecision
+    ]
+  toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}) = JSON.object
+    [ "tag"         JSON..= ("bool" :: Text)
+    , "label"       JSON..=  wepfbLabel
+    , "tooltip"     JSON..=  wepfbTooltip
+    , "default"     JSON..=  wepfbDefault
+    ]
+  toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{..}) = JSON.object
+    [ "tag"         JSON..= ("file" :: Text)
+    , "label"       JSON..=  wepffLabel
+    , "tooltip"     JSON..=  wepffTooltip
+    , "default"     JSON..=  wepffDefault
+    ]
+  toJSON (WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{..}) = JSON.object
+    [ "tag"         JSON..= ("user" :: Text)
+    , "label"       JSON..=  wepfuLabel
+    , "tooltip"     JSON..=  wepfuTooltip
+    , "default"     JSON..=  wepfuDefault
+    ]
 instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpecification fileid userid) where
-  parseJSON = parseJSON -- TODO
+  parseJSON = JSON.withObject "WorkflowEdgePayloadSpecification" $ \o -> do
-
+    fieldTag <- (o JSON..: "tag" :: Parser Text)
-instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid Text) where
+    case fieldTag of
-  toJSON (WorkflowEdgePayloadFieldText{..}) = JSON.object
-    [ "label"       JSON..= wepftLabel
-    , "placeholder" JSON..= wepftPlaceholder
-    , "tooltip"     JSON..= wepftTooltip
-    , "default"     JSON..= wepftDefault
-    ]
-instance (ToJSON fileid, ToJSON userid, HasResolution prec) => ToJSON (WorkflowEdgePayloadField fileid userid (Fixed prec)) where
-  toJSON (WorkflowEdgePayloadFieldNumber{..}) = JSON.object
-    [ "label"       JSON..= wepfnLabel
-    , "placeholder" JSON..= wepfnPlaceholder
-    , "tooltip"     JSON..= wepfnTooltip
-    , "default"     JSON..= wepfnDefault
-    , "precision"   JSON..= wepfnPrecision
-    ]
-instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid Bool) where
-  toJSON (WorkflowEdgePayloadFieldBool{..}) = JSON.object
-    [ "label"       JSON..= wepfbLabel
-    , "tooltip"     JSON..= wepfbTooltip
-    , "default"     JSON..= wepfbDefault
-    ]
-instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid FileInfo) where
-  toJSON (WorkflowEdgePayloadFieldFile{..}) = JSON.object
-    [ "label"       JSON..= wepffLabel
-    , "tooltip"     JSON..= wepffTooltip
-    , "default"     JSON..= wepffDefault
-    ]
-instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowEdgePayloadField fileid userid userid) where
-  toJSON (WorkflowEdgePayloadFieldUser{..}) = JSON.object
-    [ "label"       JSON..= wepfuLabel
-    , "tooltip"     JSON..= wepfuTooltip
-    , "default"     JSON..= wepfuDefault
-    ]
-
-instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadField fileid userid payload) where
-  parseJSON = JSON.withObject "WorkflowEdgePayloadField" $ \o -> do
-    fieldType <- (o JSON..: "type" :: Parser Text)
-    case fieldType of
       "text" -> do
         wepftLabel       <-  o JSON..:  "label"
         wepftPlaceholder <-  o JSON..:  "placeholder"
         wepftTooltip     <-  o JSON..:? "tooltip"
         wepftDefault     <-  o JSON..:? "default"
-        return (WorkflowEdgePayloadFieldText{..})
+        return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldText{..}
       "number" -> do
         wepfnLabel       <-  o JSON..:  "label"
         wepfnPlaceholder <-  o JSON..:  "placeholder"
         wepfnTooltip     <-  o JSON..:? "tooltip"
-        wepfnDefault     <- (o JSON..:? "default" :: Parser (Maybe (Fixed prec)))
+        wepfnDefault     <- (o JSON..:? "default" :: Parser (Maybe SomeResolution))
         wepfnPrecision   <-  o JSON..:  "precision"
-        return (WorkflowEdgePayloadFieldNumber{..})
+        return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldNumber{..}
       "bool" -> do
         wepfbLabel       <-  o JSON..:  "label"
         wepfbTooltip     <-  o JSON..:? "tooltip"
         wepfbDefault     <- (o JSON..:? "default" :: Parser (Maybe Bool))
-        return (WorkflowEdgePayloadFieldBool{..})
+        return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldBool{..}
       "file" -> do
         wepffLabel       <-  o JSON..:  "label"
         wepffTooltip     <-  o JSON..:? "tooltip"
         wepffDefault     <- (o JSON..:? "default" :: Parser (Maybe fileid))
-        return (WorkflowEdgePayloadFieldFile{..})
+        return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldFile{..}
       "user" -> do
         wepfuLabel       <-  o JSON..:  "label"
         wepfuTooltip     <-  o JSON..:? "tooltip"
         wepfuDefault     <- (o JSON..:? "default" :: Parser (Maybe userid))
-        return (WorkflowEdgePayloadFieldUser{..})
+        return $ WorkflowEdgePayloadSpecification WorkflowEdgePayloadFieldUser{..}
-      _ -> error $ "WorkflowEdgePayloadField parseJSON error: expected field type (text|number|bool|file|user), but got " ++ fieldType
+      _ -> terror $ "WorkflowEdgePayloadSpecification parseJSON error: expected field tag (text|number|bool|file|user), but got " <> fieldTag
 
 instance ToJSON WorkflowGraphNode where
   toJSON (WGN{..}) = toJSON wgnStatus