Garmelon/forest
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[server] Rename "graft" to "draw"

Browse source
This commit is contained in:
Joscha 2020-03-15 22:29:45 +00:00
parent 83406dff10
commit aa074d181b
2 changed files with 7 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

9
forest-cabin/app/Main.hs
View file

@ -35,8 +35,8 @@ data AppState = AppState
, asSharedNode :: Node , asSharedNode :: Node
} }
graft :: AppState -> Node draw :: AppState -> Node
graft = asSharedNode draw = asSharedNode
updateSharedNode :: AppState -> (Node -> Node) -> IO AppState updateSharedNode :: AppState -> (Node -> Node) -> IO AppState
updateSharedNode s f = do updateSharedNode s f = do
@ -61,8 +61,7 @@ handleEvent s (Delete path) = do
handleEvent s (Reply path text) = do handleEvent s (Reply path text) = do
s' <- updateSharedNode s $ appendAt (txtNode "edr" text) path s' <- updateSharedNode s $ appendAt (txtNode "edr" text) path
pure $ continue s' pure $ continue s'
handleEvent s _ = do handleEvent s _ = pure $ continue s
pure $ continue s
constructor constructor
:: TChan AppEvent :: TChan AppEvent
@ -81,7 +80,7 @@ main = do
sharedNodeVar <- newMVar $ txtNode "r" "Sandbox" sharedNodeVar <- newMVar $ txtNode "r" "Sandbox"
broadcastChan <- atomically newBroadcastTChan broadcastChan <- atomically newBroadcastTChan
let app = TreeApp let app = TreeApp
{ appGraft = graft { appDraw = draw
, appHandleEvent = handleEvent , appHandleEvent = handleEvent
, appConstructor = constructor broadcastChan sharedNodeVar , appConstructor = constructor broadcastChan sharedNodeVar
} }

6
forest-server/src/Forest/Server/TreeApp.hs
View file

@ -39,7 +39,7 @@ data Event e
| Custom e | Custom e
data TreeApp s e = TreeApp data TreeApp s e = TreeApp
{ appGraft :: s -> Node { appDraw :: s -> Node
, appHandleEvent :: s -> Event e -> IO (Next s) , appHandleEvent :: s -> Event e -> IO (Next s)
, appConstructor :: forall a. (s -> Maybe (TChan e) -> IO a) -> IO a , appConstructor :: forall a. (s -> Maybe (TChan e) -> IO a) -> IO a
} }
@ -93,7 +93,7 @@ runUntilHalt conn app rs = do
case next of case next of
Halt -> pure () Halt -> pure ()
Continue state' -> do Continue state' -> do
let node' = appGraft app state' let node' = appDraw app state'
sendNodeUpdate conn (rsNode rs) node' sendNodeUpdate conn (rsNode rs) node'
runUntilHalt conn app rs{rsState = state', rsNode = node'} runUntilHalt conn app rs{rsState = state', rsNode = node'}
@ -106,7 +106,7 @@ runTreeApp pingDelay app pendingConn = do
firstPacket <- receivePacket conn firstPacket <- receivePacket conn
case firstPacket of case firstPacket of
ClientHello _ -> do ClientHello _ -> do
let initialNode = appGraft app initialState let initialNode = appDraw app initialState
rs = RunState chan customChan initialState initialNode rs = RunState chan customChan initialState initialNode
sendPacket conn $ ServerHello [] initialNode sendPacket conn $ ServerHello [] initialNode
withThread (receiveThread conn chan) $ runUntilHalt conn app rs withThread (receiveThread conn chan) $ runUntilHalt conn app rs