{-# Language OverloadedStrings #-} module Export where ----------------Imports---------------- import Data.Aeson import Data.Map hiding (fromList) import Data.Vector hiding ((!), (++)) import Workflow (NodeData(..), EdgeData(..), GraphData(..), Entry(..), Message(..), Label(..), Viewers (..)) import Data.Text (Text, pack) -- import Data.YAML (Node (..)) import Data.YAML.Event (tagToText, Pos) import Data.Maybe (fromMaybe) import YamlParser (YAMLNode (..), AnchorData (..)) import Data.Aeson.Types (toJSONKeyText) --------------------------------------- ---------------Instances--------------- instance ToJSON Entry where toJSON (Single s) = toJSON s toJSON (Msg m) = toJSON m toJSON (Dict d) = toJSON d toJSON (List l) = toJSON l toJSON (Val v) = toJSON v instance ToJSON YAMLNode where toJSON (Scalar b c a p) = object [ "content" .= show b, "comment" .= c, "anchor" .= a, "position" .= p ] instance ToJSONKey YAMLNode where toJSONKey = toJSONKeyText display where display :: YAMLNode -> Text display (Scalar bytes _ _ _) = pack $ show bytes instance ToJSON AnchorData where toJSON (AnchorDef a) = object ["type" .= String "anchor", "name" .= a] toJSON (AnchorAlias a) = object ["type" .= String "alias", "name" .= a] toJSON NoAnchor = Null instance ToJSON Pos instance ToJSON Message where toJSON (Message content status viewers comment anchor) = object [ "content" .= content, "status" .= status, "viewers" .= viewers, "comment" .= comment, "anchor" .= anchor] instance ToJSON Viewers where toJSON (Viewers mappings comment anchor) = object [ "viewers" .= mappings, "comment" .= comment, "anchor" .= anchor ] instance ToJSON Label where toJSON (Label fallback fallbackLang translations comment anchor) = object [ "fallback" .= fallback, "fallback-lang" .= fallbackLang, "translations" .= translations, "comment" .= comment, "anchor" .= anchor] instance ToJSON NodeData where toJSON (NData d) = Array (fromList $ foldrWithKey newObject [] d) where newObject :: Text -> Map Text Entry -> [Value] -> [Value] newObject ident values result = object [ "id" .= ident, "name" .= values ! "name", "val" .= show 5, -- Todo adjust to number of edges "stateData" .= object [ "viewers" .= values ! "viewers", "final" .= values ! "final", "messages" .= values ! "messages", "payload" .= values ! "payload"]] : result -- toEncoding = genericToEncoding defaultOptions instance ToJSON EdgeData where toJSON (EData d) = Array (fromList $ foldrWithKey newObject [] d) where newObject :: Text -> Map Text Entry -> [Value] -> [Value] newObject ident values result = object [ "id" .= ident, "name" .= values ! "name", "source" .= values ! "source", "target" .= values ! "target", "actionData" .= object [ "mode" .= values ! "mode", "actors" .= values ! "actors", "viewers" .= values ! "viewers", "actor Viewers" .= values ! "view-actor", "messages" .= values ! "messages", "form" .= values ! "form"]] : result instance ToJSON GraphData where toJSON (GData (nd, ed)) = object ["states" .= toJSON nd, "actions" .= toJSON ed] ---------------------------------------