From c2169423e6039d4fb222ffcaf856320a342f0b17 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <vaupel.sarah@campus.lmu.de>
Date: Thu, 23 Apr 2020 17:13:39 +0200
Subject: [PATCH] refactor(workflows): rework types and instances

---
 src/Model/Types/Workflow.hs | 41 +++++++++++++++++++++----------------
 1 file changed, 23 insertions(+), 18 deletions(-)

diff --git a/src/Model/Types/Workflow.hs b/src/Model/Types/Workflow.hs
index 12fe2806f..838a1a05d 100644
--- a/src/Model/Types/Workflow.hs
+++ b/src/Model/Types/Workflow.hs
@@ -27,28 +27,28 @@ import Data.Aeson.Types (Parser)
 -- TODO remove
 --import Data.ByteString.Lazy.Internal (ByteString)
 
--- TODO: label type to newtype
-
 
 -----  WORKFLOW GRAPH  -----
 
 data WorkflowGraph fileid userid = WorkflowGraph
   { wgNodes          :: Map WorkflowGraphNodeLabel (WorkflowGraphNode fileid userid)
-  , wgPayloadViewers :: Map WorkflowPayloadLabel (NonNull (Set WorkflowRole))
+  , wgPayloadViewers :: Map WorkflowPayloadLabel (NonNull (Set (WorkflowRole userid)))
   }
   deriving (Show, Eq)
 
 
 -----  WORKFLOW GRAPH: NODES  -----
 
-type WorkflowGraphNodeLabel = CI Text
-type WorkflowGraphEdgeLabel = CI Text
+newtype WorkflowGraphNodeLabel = WorkflowGraphNodeLabel (CI Text)
+  deriving newtype (Eq, Ord, Show, Read, Typeable, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PersistField, PersistFieldSql)
+newtype WorkflowGraphEdgeLabel = WorkflowGraphEdgeLabel (CI Text)
+  deriving newtype (Eq, Ord, Show, Read, Typeable, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PersistField, PersistFieldSql)
 
 data WorkflowGraphNode fileid userid = WGN
   { wgnDisplayLabel :: Maybe Text
   , wgnInitial      :: Bool
   , wgnFinished     :: Bool
-  , wgnViewers      :: Set WorkflowRole
+  , wgnViewers      :: Set (WorkflowRole userid)
   , wgnEdges        :: Map WorkflowGraphEdgeLabel (WorkflowGraphEdge fileid userid)
   }
   deriving (Eq, Ord, Show, Generic, Typeable)
@@ -87,7 +87,8 @@ data WorkflowPayloadSpec fileid userid = forall payload. WorkflowPayloadSpec (Wo
 instance (Show fileid, Show userid) => Show (WorkflowPayloadSpec fileid userid) where
   show (WorkflowPayloadSpec payloadField) = show payloadField
 
-type WorkflowPayloadFieldLabel = CI Text
+newtype WorkflowPayloadFieldLabel = WorkflowPayloadFieldLabel (CI Text)
+  deriving newtype (Eq, Ord, Show, Read, Typeable, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PersistField, PersistFieldSql)
 
 data WorkflowPayloadField fileid userid (payload :: Type) where
   WorkflowPayloadFieldText   :: { wpftLabel       :: Text
@@ -193,7 +194,8 @@ data WorkflowInstanceScope' = WISGlobal' | WISTerm' | WISSchool' | WISCourse'
 
 -----  WORKFLOW: PAYLOAD  -----
 
-type WorkflowPayloadLabel = CI Text
+newtype WorkflowPayloadLabel = WorkflowPayloadLabel (CI Text)
+  deriving newtype (Eq, Ord, Show, Read, Typeable, ToJSON, ToJSONKey, FromJSON, FromJSONKey, PersistField, PersistFieldSql)
 
 type WorkflowPayload fileid userid = Map WorkflowPayloadLabel (Seq (WorkflowPayload' fileid userid))
 
@@ -256,18 +258,16 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
 
 instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowGraph fileid userid) where
   toJSON WorkflowGraph{..} = JSON.object
-    [ "nodes" JSON..= wgNodes
+    [ "nodes"           JSON..= wgNodes
+    , "payload-viewers" JSON..= wgPayloadViewers
     ]
 instance (FromJSON fileid, FromJSON userid
          ,     Ord fileid,      Ord userid
          ) => FromJSON (WorkflowGraph fileid userid) where
   parseJSON = JSON.withObject "WorkflowGraph" $ \o -> do
-    fieldTag <- o JSON..: "tag"
-    case fieldTag of
-      "workflow" -> do
-        wgNodes <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel WorkflowGraphNode))
-        return WorkflowGraph{..}
-      _ -> terror $ "WorkflowGraph parseJSON error: expected tag workflow, but got " <> fieldTag
+    wgNodes          <- (o JSON..: "nodes" :: Parser (Map WorkflowGraphNodeLabel (WorkflowGraphNode fileid userid)))
+    wgPayloadViewers <-  o JSON..: "payload-viewers"
+    return WorkflowGraph{..}
 
 instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowGraphEdge fileid userid) where
   toJSON (WGE{..}) = JSON.object
@@ -279,9 +279,10 @@ instance (FromJSON fileid, FromJSON userid
          ,     Ord fileid,      Ord userid
          ) => FromJSON (WorkflowGraphEdge fileid userid) where
   parseJSON = JSON.withObject "WorkflowGraphEdge" $ \o -> do
-    wgeActors <- o JSON..: "actors"
-    wgeTarget <- o JSON..: "target"
-    wgeForm   <- o JSON..: "form"
+    wgeActors    <- o JSON..: "actors"
+    wgeTarget    <- o JSON..: "target"
+    wgeAutomatic <- o JSON..: "automatic"
+    wgeForm      <- o JSON..: "form"
     return WGE{..}
 
 instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowPayloadSpec fileid userid) where
@@ -369,7 +370,9 @@ instance (FromJSON fileid, FromJSON userid
 instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowGraphNode fileid userid) where
   toJSON WGN{..} = JSON.object
     [ "display-label" JSON..= wgnDisplayLabel
+    , "initial"       JSON..= wgnInitial
     , "finished"      JSON..= wgnFinished
+    , "viewers"       JSON..= wgnViewers
     , "edges"         JSON..= wgnEdges
     ]
 instance (FromJSON fileid, FromJSON userid
@@ -377,7 +380,9 @@ instance (FromJSON fileid, FromJSON userid
          ) => FromJSON (WorkflowGraphNode fileid userid) where
   parseJSON = JSON.withObject "WorkflowGraphNode" $ \o -> do
     wgnDisplayLabel <- o JSON..: "display-label"
+    wgnInitial      <- o JSON..: "initial"
     wgnFinished     <- o JSON..: "finished"
+    wgnViewers      <- o JSON..: "viewers"
     wgnEdges        <- o JSON..: "edges"
     return WGN{..}