vivid 0.4.2.1 → 0.4.2.2

raw patch · 2 files changed

+40/−33 lines, 2 files

Files

• Vivid/SCServer/Connection.hs +39/−32
• vivid.cabal +1/−1

@@ -1,10 +1,12 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE+     BangPatterns+   , LambdaCase+   , OverloadedStrings -{-# LANGUAGE NoIncoherentInstances #-}-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE NoUndecidableInstances #-}+   , NoIncoherentInstances+   , NoMonomorphismRestriction+   , NoUndecidableInstances+   #-}  module Vivid.SCServer.Connection (      createSCServerConnection@@ -61,8 +63,9 @@ createSCServerConnection connConfig = do    let !_ = scServerState    shouldMakeSock scServerState >>= \case-      True -> do-         Right <$> makeSock scServerState connConfig+      True -> makeSock scServerState connConfig >>= \case+         Just s -> pure $ Right s+         Nothing -> pure $ Left "Unable to create socket"       False ->          pure $ Left "Too late -- connection already established. Disconnect first." @@ -100,7 +103,7 @@       (Just sock, Just listener) -> do          killThread listener          withSocketsDo $ close sock-      (Nothing, Nothing) -> return ()+      (Nothing, Nothing) -> pure ()       _ -> error "well that's weird"  @@ -157,7 +160,7 @@          print 1          listen s 1          -- _ <- accept s-         return ()+         pure ()    else connect s (addrAddress serverAddr) -}    setClientId (_scConnectConfig_clientId scConnectConfig)@@ -174,7 +177,7 @@       , Right $ SCCmd.sync (SyncId firstSyncID)       ]    waitForSync_io (SyncId firstSyncID)-   return (s, listener)+   pure (s, listener)  waitForSync_io :: SyncId -> IO () waitForSync_io syncId = do@@ -187,7 +190,7 @@ waitForSync_io_noGC :: SyncId -> IO () waitForSync_io_noGC syncId = do    _ <- readMVar =<< getMailboxForSyncId syncId-   return ()+   pure ()  -- TODO: what's "mailbox" here? Is it like an Erlang mailbox, to receive and -- dispatch all messages?@@ -199,7 +202,7 @@          Right (OSC "/synced" [OSC_I theSyncId]) -> do             syncBox <- getMailboxForSyncId (SyncId theSyncId)             tryPutMVar syncBox () >>= \case-               True -> return ()+               True -> pure ()                False ->                   putStrLn $                      "That's weird!: we got the same syncId twice: "@@ -215,17 +218,17 @@ defaultMessageFunction = \case    -- Some examples you might want to handle individually:    {--   OSC "/fail" [OSC_S "/blah", OSC_S "Command not found"] -> return ()-   OSC "/fail" [OSC_S "/s_new", OSC_S "wrong argument type"] -> return ()+   OSC "/fail" [OSC_S "/blah", OSC_S "Command not found"] -> pure ()+   OSC "/fail" [OSC_S "/s_new", OSC_S "wrong argument type"] -> pure ()    OSC "/fail" [OSC_S "/b_allocRead", OSC_S "File 'blah.ogg' could not be opened: Error : flac decoder lost sync.\n",OSC_I 2]    -}-   OSC "/done" [OSC_S _] -> return ()-   OSC "/done" [OSC_S _, OSC_I _] -> return ()+   OSC "/done" [OSC_S _] -> pure ()+   OSC "/done" [OSC_S _, OSC_I _] -> pure ()    x -> putStrLn $ "Msg from server: " <> show x  -- | If you don't want to hear what the server has to say ignoreMessagesFunction :: OSC -> IO ()-ignoreMessagesFunction _ = return ()+ignoreMessagesFunction _ = pure ()  -- This is a nice example of when STM can be really helpful - -- It's impossible! (right?) to have 2 threads create mailboxes and have em overwrite each@@ -236,11 +239,11 @@    atomically $ do       allMailboxes <- readTVar (_scServerState_syncIdMailboxes scServerState)       case Map.lookup syncId allMailboxes of-         Just syncBox -> return syncBox+         Just syncBox -> pure syncBox          Nothing -> do             writeTVar (_scServerState_syncIdMailboxes scServerState)               (Map.insert syncId mvarThatIMightWannaUse allMailboxes)-            return mvarThatIMightWannaUse+            pure mvarThatIMightWannaUse  getSCServerSocket :: IO Socket getSCServerSocket = getSCServerSocket' scServerState@@ -250,8 +253,9 @@    let !_ = scServerState'    shouldMakeSock scServerState' >>= \case       True -> do-         makeSock scServerState' defaultConnectConfig-      -- Just s -> return s+         makeSock scServerState' defaultConnectConfig >>= \case+            Just x -> pure x+            Nothing -> error "Unexpected failure creating socket"       False -> atomically . readTMVar $ _scServerState_socket scServerState'  shouldMakeSock :: SCServerState -> IO Bool@@ -259,17 +263,20 @@    let theVar = _scServerState_socketConnectStarted serverState    alreadyBeingMade <- readTVar theVar    case alreadyBeingMade of-      True -> return False+      True -> pure False       False -> do          writeTVar theVar True-         return True+         pure True -makeSock :: SCServerState -> SCConnectConfig -> IO Socket+makeSock :: SCServerState -> SCConnectConfig -> IO (Maybe Socket) makeSock serverState connConfig = do-         (sock, listener) <- connectToSCServer connConfig-         atomically $ do-            -- writeTVar (_scServerState_socket serverState) $ Just sock-            -- writeTVar (_scServerState_listener serverState) $ Just listener-            True <- tryPutTMVar (_scServerState_socket serverState) sock-            True <- tryPutTMVar (_scServerState_listener serverState) listener-            return sock+   (sock, listener) <- connectToSCServer connConfig+   atomically $ (do+      -- writeTVar (_scServerState_socket serverState) $ Just sock+      -- writeTVar (_scServerState_listener serverState) $ Just listener+      a <- tryPutTMVar (_scServerState_socket serverState) sock+      b <- tryPutTMVar (_scServerState_listener serverState) listener+      check $ a && b+      pure $ Just sock)+         `orElse` (pure Nothing)+

@@ -1,7 +1,7 @@ -- TODO: get the readme change from the github merge  name:                vivid-version:             0.4.2.1+version:             0.4.2.2 synopsis:            Sound synthesis with SuperCollider description:            Music and sound synthesis with SuperCollider.