Separate Node-related stuff from Api module

This commit is contained in:
Joscha 2020-02-08 23:26:21 +00:00
parent 72e66a55f6
commit ff2dc3e783
8 changed files with 52 additions and 56 deletions

View file

@ -14,7 +14,7 @@ import Forest.Api
import Forest.Client.NodeEditor import Forest.Client.NodeEditor
import Forest.Client.ResourceName import Forest.Client.ResourceName
import Forest.Client.Tree import Forest.Client.Tree
import Forest.Tree import Forest.Node
import Forest.Util import Forest.Util
{- Listening for server events -} {- Listening for server events -}

View file

@ -1,18 +1,9 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | This module contains all the types found in the API. -- | This module contains all the types found in the API.
module Forest.Api module Forest.Api
( ( ClientPacket(..)
-- * Common
NodeId
, Node(..)
, Path(..)
-- * Client
, ClientPacket(..)
-- * Server
, ServerPacket(..) , ServerPacket(..)
) where ) where
@ -20,37 +11,9 @@ import Control.Applicative
import Control.Monad import Control.Monad
import Data.Aeson import Data.Aeson
import Data.Aeson.Types import Data.Aeson.Types
import Data.Char
import qualified Data.Map.Strict as Map
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Generics
{- Common -} import Forest.Node
type NodeId = T.Text
data Node = Node
{ nodeText :: !T.Text
, nodeAct :: !Bool
, nodeEdit :: !Bool
, nodeDelete :: !Bool
, nodeReply :: !Bool
, nodeChildren :: !(Map.Map NodeId Node)
} deriving (Show, Generic)
nodeOptions :: Options
nodeOptions = defaultOptions{fieldLabelModifier = map toLower . drop 4}
instance ToJSON Node where
toJSON = genericToJSON nodeOptions
toEncoding = genericToEncoding nodeOptions
instance FromJSON Node where
parseJSON = genericParseJSON nodeOptions
newtype Path = Path
{ pathElements :: [NodeId]
} deriving (Show, Eq, Ord, ToJSON, FromJSON)
parsePacket :: Value -> T.Text -> (Object -> Parser a) -> Parser a parsePacket :: Value -> T.Text -> (Object -> Parser a) -> Parser a
parsePacket value packetType parser = parseJSON value >>= \o -> do parsePacket value packetType parser = parseJSON value >>= \o -> do

View file

@ -9,10 +9,9 @@ import Brick
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Forest.Api
import Forest.Client.NodeEditor import Forest.Client.NodeEditor
import Forest.Client.ResourceName import Forest.Client.ResourceName
import Forest.Tree import Forest.Node
data DrawState = DrawState data DrawState = DrawState
{ dsEditor :: Maybe NodeEditor { dsEditor :: Maybe NodeEditor

View file

@ -11,11 +11,10 @@ module Forest.Client.Tree
import Brick import Brick
import qualified Data.Set as Set import qualified Data.Set as Set
import Forest.Api
import Forest.Client.Node import Forest.Client.Node
import Forest.Client.NodeEditor import Forest.Client.NodeEditor
import Forest.Client.ResourceName import Forest.Client.ResourceName
import Forest.Tree import Forest.Node
data Tree = Tree data Tree = Tree
{ treeNode :: Node { treeNode :: Node

View file

@ -1,13 +1,18 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Forest.Tree module Forest.Node
( (
-- * Node-related functions -- * Node
emptyNode NodeId
, Node(..)
, emptyNode
, initialNode , initialNode
, applyId , applyId
, applyPath , applyPath
-- * Path-related functions -- * Path
, Path(..)
, localPath , localPath
, isLocalPath , isLocalPath
, isValidPath , isValidPath
@ -16,12 +21,36 @@ module Forest.Tree
) where ) where
import Control.Monad import Control.Monad
import Data.Aeson
import Data.Char
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Data.Maybe import Data.Maybe
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Generics
import Forest.Api {- Node -}
type NodeId = T.Text
data Node = Node
{ nodeText :: !T.Text
, nodeAct :: !Bool
, nodeEdit :: !Bool
, nodeDelete :: !Bool
, nodeReply :: !Bool
, nodeChildren :: !(Map.Map NodeId Node)
} deriving (Show, Generic)
nodeOptions :: Options
nodeOptions = defaultOptions{fieldLabelModifier = map toLower . drop 4}
instance ToJSON Node where
toJSON = genericToJSON nodeOptions
toEncoding = genericToEncoding nodeOptions
instance FromJSON Node where
parseJSON = genericParseJSON nodeOptions
emptyNode :: T.Text -> Bool -> Bool -> Bool -> Bool -> Node emptyNode :: T.Text -> Bool -> Bool -> Bool -> Bool -> Node
emptyNode text edit delete reply act = Node text edit delete reply act Map.empty emptyNode text edit delete reply act = Node text edit delete reply act Map.empty
@ -35,6 +64,12 @@ applyId nodeId node = nodeChildren node Map.!? nodeId
applyPath :: Path -> Node -> Maybe Node applyPath :: Path -> Node -> Maybe Node
applyPath (Path ids) node = foldM (flip applyId) node ids applyPath (Path ids) node = foldM (flip applyId) node ids
{- Path -}
newtype Path = Path
{ pathElements :: [NodeId]
} deriving (Show, Eq, Ord, ToJSON, FromJSON)
localPath :: Path localPath :: Path
localPath = Path [] localPath = Path []

View file

@ -10,7 +10,7 @@ import Control.Monad
import qualified Network.WebSockets as WS import qualified Network.WebSockets as WS
import Forest.Api import Forest.Api
import Forest.Tree import Forest.Node
import Forest.TreeModule import Forest.TreeModule
import Forest.Util import Forest.Util

View file

@ -5,7 +5,7 @@ module Forest.TreeModule
import qualified Data.Text as T import qualified Data.Text as T
import Forest.Api import Forest.Node
class TreeModule a where class TreeModule a where
edit :: a -> Path -> T.Text -> IO () edit :: a -> Path -> T.Text -> IO ()

View file

@ -4,7 +4,7 @@ module Forest.TreeModule.ConstModule
( constModule ( constModule
) where ) where
import Forest.Tree import Forest.Node
import Forest.TreeModule import Forest.TreeModule
data ConstModule = ConstModule data ConstModule = ConstModule