Merge pull request #1105 from sss-create/dev

hosc-0.21 support
tidalcycles · Jan 18, 2025 · 069fe47 · 069fe47
2 parents bec7416 + e86b968
commit 069fe47
Show file tree

Hide file tree

Showing 7 changed files with 76 additions and 50 deletions.
diff --git a/flake.lock b/flake.lock
diff --git a/flake.nix b/flake.nix
@@ -23,6 +23,11 @@
   inputs = {
     utils.url = "github:numtide/flake-utils";
     nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
+    # Manually include `hosc` at the `v0.21.0`
+    hosc = {
+      flake = false;
+      url = "github:rd--/hosc?rev=43bb2d07ff8d65cf9e51d1f5f96d0e6ffd6fe8fa";
+    };
   };
 
   outputs = inputs: let
@@ -38,6 +43,7 @@
 
     mkPackages = pkgs: let
       project = pkgs.haskellPackages.extend (pkgs.haskell.lib.compose.packageSourceOverrides {
+        hosc = inputs.hosc; # Manually added as `hosc` 0.21 is not yet in nixpkgs.
         tidal = ./.;
         tidal-link = ./tidal-link;
         tidal-listener = ./tidal-listener;

diff --git a/stack.yaml b/stack.yaml
@@ -7,7 +7,7 @@ packages:
   - 'tidal-link'
 
 extra-deps:
-  - hosc-0.20
+  - hosc-0.21
   - haskellish-0.3.2.2
 
 
diff --git a/tidal-link/tidal-link.cabal b/tidal-link/tidal-link.cabal
@@ -33,7 +33,7 @@ library
 
   build-depends:
       base >=4.8 && <5,
-      hosc,
+      hosc >= 0.21 && <0.22,
       mtl,
       stm
 

diff --git a/tidal-listener/src/Sound/Tidal/Listener.hs b/tidal-listener/src/Sound/Tidal/Listener.hs
@@ -6,48 +6,51 @@ import qualified Sound.Tidal.Context as T
 import Sound.Tidal.Hint
 import Sound.Tidal.Listener.Config
 import Sound.Osc.Fd as O
+import Sound.Osc.Transport.Fd.Udp as UDP
 import Control.Concurrent
 import qualified Network.Socket as N
 
 
-data State = State {sIn :: MVar InterpreterMessage,
-                    sOut :: MVar InterpreterResponse,
-                    sLocal :: Udp,
-                    sRemote :: N.SockAddr,
-                    sStream :: T.Stream
-                   }
+data State = State 
+  { sIn     :: MVar InterpreterMessage
+  , sOut    :: MVar InterpreterResponse
+  , sLocal  :: Udp
+  , sRemote :: N.SockAddr
+  , sStream :: T.Stream
+  }
 
 
 -- | Start Haskell interpreter, with input and output mutable variables to
 -- communicate with it
 listenWithConfig :: Config -> IO ()
 listenWithConfig Config{..} = do
-            putStrLn $ "Starting Tidal Listener " ++ if noGHC then "without installed GHC" else "with installed GHC"
-            putStrLn $ "Listening for OSC commands on port " ++ show listenPort
-            putStrLn $ "Sending replies to port " ++ show replyPort
+  putStrLn $ "Starting Tidal Listener " ++ if noGHC then "without installed GHC" else "with installed GHC"
+  putStrLn $ "Listening for OSC commands on port " ++ show listenPort
+  putStrLn $ "Sending replies to port " ++ show replyPort
 
-            --start the stream
-            stream <- startListenerStream replyPort dirtPort
+  --start the stream
+  stream <- startListenerStream replyPort dirtPort
 
-            mIn <- newEmptyMVar
-            mOut <- newEmptyMVar
+  mIn <- newEmptyMVar
+  mOut <- newEmptyMVar
 
-            putStrLn "Starting tidal interpreter.. "
-            _ <- forkIO $ startHintJob True stream mIn mOut
+  putStrLn "Starting tidal interpreter.. "
+  _ <- forkIO $ startHintJob True stream mIn mOut
 
-            (remote_addr:_) <- N.getAddrInfo Nothing (Just "127.0.0.1") Nothing
-            local <- udpServer "127.0.0.1" listenPort
+  (remote_addr:_) <- N.getAddrInfo Nothing (Just "127.0.0.1") Nothing
+  let iOlocal = udpServer "127.0.0.1" listenPort
+  local <- iOlocal
 
-            let (N.SockAddrInet _ a) = N.addrAddress remote_addr
-                remote  = N.SockAddrInet (fromIntegral replyPort) a
-                st      = State mIn mOut local remote stream
-            loop st
-              where
-                loop st =
-                  do -- wait for, read and act on OSC message
-                     m <- recvMessage (sLocal st)
-                     st' <- act st m
-                     loop st'
+
+  let (N.SockAddrInet _ a) = N.addrAddress remote_addr
+      remote  = N.SockAddrInet (fromIntegral replyPort) a
+      st      = State mIn mOut local remote stream
+  loop st
+    where
+      loop st = do
+           m <- O.recvMessage (sLocal st)
+           st' <- act st m
+           loop st'
 
 
 act :: State -> Maybe O.Message -> IO State
@@ -59,9 +62,9 @@ act st (Just (Message "/eval" [AsciiString statement])) =
   do putMVar (sIn st) (MStat $ ascii_to_string statement)
      r <- takeMVar (sOut st)
      case r of
-       RStat (Just x) -> O.sendTo (sLocal st) (O.p_message "/eval/value" [string x]) (sRemote st)
-       RStat Nothing -> O.sendTo (sLocal st) (O.p_message "/eval/ok" []) (sRemote st)
-       RError e -> O.sendTo (sLocal st) (O.p_message "/eval/error" [string e]) (sRemote st)
+       RStat (Just x) -> UDP.sendTo (sLocal st) (O.p_message "/eval/value" [string x]) (sRemote st)
+       RStat Nothing -> UDP.sendTo (sLocal st) (O.p_message "/eval/ok" []) (sRemote st)
+       RError e -> UDP.sendTo (sLocal st) (O.p_message "/eval/error" [string e]) (sRemote st)
        _ -> return ()
      return st
 
@@ -70,30 +73,30 @@ act st (Just (Message "/type" [AsciiString expression])) =
    do putMVar (sIn st) (MType $ ascii_to_string expression)
       r <- takeMVar (sOut st)
       case r of
-        RType t -> O.sendTo (sLocal st) (O.p_message "/type/ok" [string t]) (sRemote st)
-        RError e -> O.sendTo (sLocal st) (O.p_message "/type/error" [string e]) (sRemote st)
+        RType t -> UDP.sendTo (sLocal st) (O.p_message "/type/ok" [string t]) (sRemote st)
+        RError e -> UDP.sendTo (sLocal st) (O.p_message "/type/error" [string e]) (sRemote st)
         _ -> return ()
       return st
 
 act st (Just (Message "/load" [AsciiString path])) =
    do putMVar (sIn st) (MLoad $ ascii_to_string path)
       r <- takeMVar (sOut st)
       case r of
-        RStat (Just x) -> O.sendTo (sLocal st) (O.p_message "/load/value" [string x]) (sRemote st) --cannot happen
-        RStat Nothing -> O.sendTo (sLocal st) (O.p_message "/load/ok" []) (sRemote st)
-        RError e -> O.sendTo (sLocal st) (O.p_message "/load/error" [string e]) (sRemote st)
+        RStat (Just x) -> UDP.sendTo (sLocal st) (O.p_message "/load/value" [string x]) (sRemote st) --cannot happen
+        RStat Nothing -> UDP.sendTo (sLocal st) (O.p_message "/load/ok" []) (sRemote st)
+        RError e -> UDP.sendTo (sLocal st) (O.p_message "/load/error" [string e]) (sRemote st)
         _ -> return ()
       return st
 
 -- test if the listener is responsive
 act st (Just (Message "/ping" [])) =
-  do O.sendTo (sLocal st) (O.p_message "/pong" []) (sRemote st)
+  do UDP.sendTo (sLocal st) (O.p_message "/pong" []) (sRemote st)
      return st
 
 -- get the current cps of the running stream
 act st (Just (Message "/cps" [])) =
   do cps <- streamGetCPS (sStream st)
-     O.sendTo (sLocal st) (O.p_message "/cps" [float cps]) (sRemote st)
+     UDP.sendTo (sLocal st) (O.p_message "/cps" [float cps]) (sRemote st)
      return st
 
 act st Nothing = do putStrLn "Not a message?"

diff --git a/tidal-listener/tidal-listener.cabal b/tidal-listener/tidal-listener.cabal
@@ -1,5 +1,4 @@
-cabal-version:       >=1.10
-
+cabal-version:       2.0
 name:                tidal-listener
 version:             0.1.0.0
 -- synopsis:
@@ -27,7 +26,7 @@ library
                        deepseq,
                        optparse-applicative,
                        tidal >= 1.10 && < 1.11,
-                       hosc >= 0.20 && < 0.21,
+                       hosc >= 0.21 && < 0.22,
                        hint,
                        network
   default-language:    Haskell2010

diff --git a/tidal.cabal b/tidal.cabal
@@ -61,7 +61,7 @@ library
       base >=4.8 && <5
     , containers < 0.8
     , colour < 2.4
-    , hosc >= 0.20 && < 0.21
+    , hosc >= 0.21 && < 0.22
     , text < 2.2
     , parsec >= 3.1.12 && < 3.2
     , network < 3.3
@@ -96,7 +96,7 @@ test-suite tests
   build-depends:
                 base ==4.*
               , microspec >= 0.2.0.1
-              , hosc >= 0.20 && < 0.21
+              , hosc >= 0.21 && < 0.22
               , containers
               , parsec
               , tidal
-Original file line number
+Diff line change
@@ Expand Up / @@ -33,7 +33,7 @@ library @@
       build-depends:
           base >=4.8 && <5,
-          hosc,
+          hosc >= 0.21 && <0.22,
           mtl,
           stm
@@ Expand Down @@