Daemon remote start

.vscode/settings.json

@@ -10,6 +10,7 @@
         "Attoparsec",
         "Hspec",
         "delim",
+        "mbls",
         "metavar",
         "subparser"
     ]

Makefile

@@ -1,3 +1,6 @@
+PID_FILE=~/.marble-os.pid
+
+
 help: ## Print documentation
 	@grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}'
 
@@ -20,4 +23,7 @@ run: ## Run de program in dev mode. Pass arguments in ARGS
 	nix-shell \
 		--run "cabal new-run marble -- $$ARGS"
 
-.PHONY: serve build test update-deps repl run
+kill-daemon: ## [Helper] Kill running daemon
+	test -s $(PID_FILE) && kill -9 `cat $(PID_FILE)` && rm $(PID_FILE)
+
+.PHONY: serve build test update-deps repl run kill-daemon

README.md

@@ -73,4 +73,4 @@ eg:
 This would, in 4 ticks, output `Say something`
 
 ### TUI for the daemon
-`brics` tui to see all connected "sync" and .mbl before running.
+`brics` tui to see all connected "sync" and .mbl before running.

sample/calculator.mbl

@@ -1 +1 @@
---5--37
+5--37

src/App.hs

@@ -19,32 +19,69 @@ import           Data.Serialize                 ( Serialize )
 import           Data.Default                   ( def )
 import qualified Pipes                         as P
 import           Pipes                          ( (<-<) )
-import qualified Control.Pipe.Serialize        as P
+import qualified Control.Pipe.Socket           as DP
 import qualified Control.Monad                 as M
 import           Control.Monad.Trans.Class      ( lift )
+import           Control.Pipe.Serialize         ( serializer
+                                                , deserializer
+                                                )
+import qualified Control.Concurrent.Chan       as Chan
 
 data Command = Hello MBL
-             | Start
+             | TriggerStart
              | List
              deriving ( Generic, Show )
 
 
 instance Serialize Command
 
-type Registry = Cursor.ListCursor MBL
+type Registry = Cursor.ListCursor (MBL, Chan.Chan MBL)
 
-data Response = Ok
+data Response = Started Int
+              | Start MBL
               | Listed [MBL]
                 deriving ( Generic, Show )
 
+{- 
+  Command      | Response
+  Hello        | await.... Start
+  TriggerStart | Started
+  List         | Listed
+ -}
+
 instance Serialize Response
 
-handleCommands :: Con.MVar Registry -> Command -> IO Response
-handleCommands registryVar command = case command of
-  Hello mbl -> Con.modifyMVar registryVar
-    $ \registry -> return $ (Cursor.listCursorAppend mbl registry, Ok)
-  Start -> error "can't start. Did not program it"
-  List  -> Listed <$> Cursor.rebuildListCursor <$> Con.readMVar registryVar
+handleCommands :: Con.MVar Registry -> DP.Handler ()
+handleCommands registryVar reader writer =
+  P.runEffect
+    $   writer
+    <-< serializer
+    <-< commandExecuter
+    <-< deserializer
+    <-< reader
+ where
+  commandExecuter = M.forever $ do
+    command <- P.await
+    case command of
+      List -> do
+        registry <- lift $ Con.readMVar registryVar
+        let mbls = fst <$> Cursor.rebuildListCursor registry
+        P.yield $ Listed mbls
+      TriggerStart -> do
+        registry <- lift $ Con.readMVar registryVar
+        let n = Cursor.listCursorLength registry
+        lift $ M.forM_ (Cursor.rebuildListCursor registry) $ \reg ->
+          Chan.writeChan (snd reg) (fst reg)
+        P.yield $ Started n
+        lift $ Con.modifyMVar_ registryVar $ \_ -> pure $ Cursor.emptyListCursor
+      Hello mbl -> do
+        newChan <- lift Chan.newChan
+        let newReg = (mbl, newChan)
+        lift $ Con.modifyMVar_ registryVar $ \reg ->
+          pure $ Cursor.listCursorAppend newReg reg
+        newMbl <- lift $ Chan.readChan newChan
+        P.yield $ Start newMbl
+
 
 main :: IO ()
 main = do
@@ -57,28 +94,36 @@ main = do
     C.Daemon (C.DaemonConfiguration config' remote) -> do
       let port    = C.port remote
       let host    = C.host remote
-      let options = def { D.daemonPort = port, D.printOnDaemonStarted = False }
-      state <- Con.newMVar Cursor.emptyListCursor
+      let options = def { D.daemonPort = port, D.printOnDaemonStarted = False } -- TODO duplicated!
       if host == def
-        then D.ensureDaemonRunning "marble-os" options (handleCommands state)
+        then do
+          state <- Con.newMVar Cursor.emptyListCursor
+          D.ensureDaemonWithHandlerRunning "marble-os"
+                                           options
+                                           (handleCommands state)
         else pure ()
       res <- D.runClient (T.unpack $ C.unHost host) port (command)
       print (res :: Maybe Response)
      where
       command :: Command
       command = case config' of
         C.List  -> List
-        C.Start -> Start
+        C.Start -> TriggerStart
     C.Sync (C.SyncConfiguration config' remote) -> do
-      let port = C.port remote
+      let port    = C.port remote
+      let host    = (T.unpack $ C.unHost $ C.host remote)
+      let options = def { D.daemonPort = port, D.printOnDaemonStarted = False } -- TODO duplicated!
+      if host == def
+        then do
+          state <- Con.newMVar Cursor.emptyListCursor
+          D.ensureDaemonWithHandlerRunning "marble-os"
+                                           options
+                                           (handleCommands state)
+        else pure ()
       contents <- BS.readFile $ T.unpack $ C.path config'
       mbl      <- either (fail) pure $ parse config' contents
-      D.runClientWithHandler (T.unpack $ C.unHost $ C.host remote) port
-        $ \reader writer -> P.runEffect $ do
-            writer <-< P.serializer <-< P.yield (Hello mbl)
-            (M.forever $ P.await >>= \(res :: Maybe Response) ->
-                lift (print (Just res))
-              )
-              <-< P.deserializer
-              <-< reader
+      res      <- D.runClient host port (Hello mbl)
+      case res of
+        Just (Start newMbl) -> interpret config' newMbl
+        _                   -> fail "TODO"
 

src/Configuration.hs

@@ -13,11 +13,12 @@ data RunConfiguration = RunConfiguration
   , tick        :: D.Duration
   , delimiter   :: Delimiter }
 
+
 data SyncConfiguration = SyncConfiguration RunConfiguration Remote
 
 data DaemonConfiguration = DaemonConfiguration DaemonSubConfiguration Remote
 
-data DaemonSubConfiguration = List | Start | Restart
+data DaemonSubConfiguration = List | Start
 
 data Remote =  Remote { port   :: Port , host :: Host }