diff --git a/client/Main.hs b/client/Main.hs index 0652333..9f8a408 100644 --- a/client/Main.hs +++ b/client/Main.hs @@ -14,7 +14,7 @@ import Forest.Api import Forest.Client.NodeEditor import Forest.Client.ResourceName import Forest.Client.Tree -import Forest.Tree +import Forest.Node import Forest.Util {- Listening for server events -} @@ -53,7 +53,7 @@ clientDraw cs = [renderTree (csEditor cs) (csTree cs)] clientHandleEvent :: ClientState -> BrickEvent ResourceName () -> EventM ResourceName (Next ClientState) clientHandleEvent cs (VtyEvent (Vty.EvKey (Vty.KChar 'q') [])) = halt cs -clientHandleEvent cs _ = continue cs +clientHandleEvent cs _ = continue cs clientApp :: App ClientState () ResourceName clientApp = App diff --git a/src/Forest/Api.hs b/src/Forest/Api.hs index 60b5219..0ddc38c 100644 --- a/src/Forest/Api.hs +++ b/src/Forest/Api.hs @@ -1,18 +1,9 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} -- | This module contains all the types found in the API. module Forest.Api - ( - -- * Common - NodeId - , Node(..) - , Path(..) - -- * Client - , ClientPacket(..) - -- * Server + ( ClientPacket(..) , ServerPacket(..) ) where @@ -20,37 +11,9 @@ import Control.Applicative import Control.Monad import Data.Aeson import Data.Aeson.Types -import Data.Char -import qualified Data.Map.Strict as Map import qualified Data.Text as T -import GHC.Generics -{- Common -} - -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) +import Forest.Node parsePacket :: Value -> T.Text -> (Object -> Parser a) -> Parser a parsePacket value packetType parser = parseJSON value >>= \o -> do diff --git a/src/Forest/Client/Node.hs b/src/Forest/Client/Node.hs index 3622395..ff0f467 100644 --- a/src/Forest/Client/Node.hs +++ b/src/Forest/Client/Node.hs @@ -9,10 +9,9 @@ import Brick import qualified Data.Map as Map import qualified Data.Set as Set -import Forest.Api import Forest.Client.NodeEditor import Forest.Client.ResourceName -import Forest.Tree +import Forest.Node data DrawState = DrawState { dsEditor :: Maybe NodeEditor diff --git a/src/Forest/Client/Tree.hs b/src/Forest/Client/Tree.hs index dd4a94c..3a922d7 100644 --- a/src/Forest/Client/Tree.hs +++ b/src/Forest/Client/Tree.hs @@ -11,11 +11,10 @@ module Forest.Client.Tree import Brick import qualified Data.Set as Set -import Forest.Api import Forest.Client.Node import Forest.Client.NodeEditor import Forest.Client.ResourceName -import Forest.Tree +import Forest.Node data Tree = Tree { treeNode :: Node diff --git a/src/Forest/Tree.hs b/src/Forest/Node.hs similarity index 55% rename from src/Forest/Tree.hs rename to src/Forest/Node.hs index 55cce30..b704be0 100644 --- a/src/Forest/Tree.hs +++ b/src/Forest/Node.hs @@ -1,13 +1,18 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} -module Forest.Tree +module Forest.Node ( - -- * Node-related functions - emptyNode + -- * Node + NodeId + , Node(..) + , emptyNode , initialNode , applyId , applyPath - -- * Path-related functions + -- * Path + , Path(..) , localPath , isLocalPath , isValidPath @@ -16,12 +21,36 @@ module Forest.Tree ) where import Control.Monad +import Data.Aeson +import Data.Char import qualified Data.Map.Strict as Map import Data.Maybe import qualified Data.Set as Set 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 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 ids) node = foldM (flip applyId) node ids +{- Path -} + +newtype Path = Path + { pathElements :: [NodeId] + } deriving (Show, Eq, Ord, ToJSON, FromJSON) + localPath :: Path localPath = Path [] diff --git a/src/Forest/Server.hs b/src/Forest/Server.hs index f904e13..2e93eb3 100644 --- a/src/Forest/Server.hs +++ b/src/Forest/Server.hs @@ -10,7 +10,7 @@ import Control.Monad import qualified Network.WebSockets as WS import Forest.Api -import Forest.Tree +import Forest.Node import Forest.TreeModule import Forest.Util diff --git a/src/Forest/TreeModule.hs b/src/Forest/TreeModule.hs index 9397d6a..1621d47 100644 --- a/src/Forest/TreeModule.hs +++ b/src/Forest/TreeModule.hs @@ -3,9 +3,9 @@ module Forest.TreeModule , ModuleConstructor ) where -import qualified Data.Text as T +import qualified Data.Text as T -import Forest.Api +import Forest.Node class TreeModule a where edit :: a -> Path -> T.Text -> IO () diff --git a/src/Forest/TreeModule/ConstModule.hs b/src/Forest/TreeModule/ConstModule.hs index 40d5c61..c9d5c5f 100644 --- a/src/Forest/TreeModule/ConstModule.hs +++ b/src/Forest/TreeModule/ConstModule.hs @@ -4,7 +4,7 @@ module Forest.TreeModule.ConstModule ( constModule ) where -import Forest.Tree +import Forest.Node import Forest.TreeModule data ConstModule = ConstModule