diff --git a/.vscode/settings.json b/.vscode/settings.json index a18eaf0..0ba14c6 100755 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -10,6 +10,7 @@ "Attoparsec", "Hspec", "delim", + "mbls", "metavar", "subparser" ] diff --git a/Makefile b/Makefile index 5d448c6..5947ec4 100755 --- a/Makefile +++ b/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 \ No newline at end of file +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 \ No newline at end of file diff --git a/README.md b/README.md index 3c52147..675441b 100755 --- a/README.md +++ b/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. \ No newline at end of file diff --git a/sample/calculator.mbl b/sample/calculator.mbl index 63a832e..fa7c74c 100644 --- a/sample/calculator.mbl +++ b/sample/calculator.mbl @@ -1 +1 @@ ---5--37 \ No newline at end of file +5--37 \ No newline at end of file diff --git a/src/App.hs b/src/App.hs index d4c4077..765a6d8 100755 --- a/src/App.hs +++ b/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,10 +94,13 @@ 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) @@ -68,17 +108,22 @@ main = do 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" diff --git a/src/Configuration.hs b/src/Configuration.hs index 915ad0d..c9038e3 100644 --- a/src/Configuration.hs +++ b/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 }