-- | /Monad/ variant of interaction with the scsynth server.
module Sound.Sc3.Server.Transport.Monad where

import Control.Monad {- base -}
import Data.List {- base -}
import Data.Maybe {- base -}

import System.Directory {- directory -}
import System.FilePath {- filepath -}

import qualified Data.ByteString.Lazy as L {- bytestring -}
import qualified Data.List.Split as Split {- split -}
import qualified Data.Tree as Tree {- containers -}
import qualified Safe {- safe -}

import Sound.Osc {- hosc -}
import qualified Sound.Osc.Time.Timeout {- hosc -}

import qualified Sound.Sc3.Common.Base.System as System
import qualified Sound.Sc3.Server.Command as Command
import qualified Sound.Sc3.Server.Command.Generic as Generic
import qualified Sound.Sc3.Server.Enum as Enum
import qualified Sound.Sc3.Server.Graphdef as Graphdef
import qualified Sound.Sc3.Server.Graphdef.Binary as Graphdef
import qualified Sound.Sc3.Server.Nrt as Nrt
import qualified Sound.Sc3.Server.Status as Status
import qualified Sound.Sc3.Server.Synthdef as Synthdef
import qualified Sound.Sc3.Ugen.Bindings.Composite as Composite
import qualified Sound.Sc3.Ugen.Ugen as Ugen

{-
import qualified Control.Monad.IO.Class as M {- transformers -}
import qualified Control.Monad.Trans.Reader as R {- transformers -}
import qualified Sound.Sc3.Server.Transport.FD as FD
-}

-- * hosc variants

-- | 'sendMessage' and 'waitReply' for a @\/done@ reply.
async :: DuplexOsc m => Message -> m Message
async :: forall (m :: * -> *). DuplexOsc m => Message -> m Message
async Message
m = Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage Message
m m () -> m Message -> m Message
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Address_Pattern -> m Message
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m Message
waitReply Address_Pattern
"/done"

-- | 'void' of 'async'.
async_ :: DuplexOsc m => Message -> m ()
async_ :: forall (m :: * -> *). DuplexOsc m => Message -> m ()
async_ = m Message -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Message -> m ()) -> (Message -> m Message) -> Message -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> m Message
forall (m :: * -> *). DuplexOsc m => Message -> m Message
async

-- | If 'isAsync' then 'async_' else 'sendMessage'.
maybe_async :: DuplexOsc m => Message -> m ()
maybe_async :: forall (m :: * -> *). DuplexOsc m => Message -> m ()
maybe_async Message
m = if Message -> Bool
Command.isAsync Message
m then Message -> m ()
forall (m :: * -> *). DuplexOsc m => Message -> m ()
async_ Message
m else Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage Message
m

-- | Variant that timestamps synchronous messages.
maybe_async_at :: DuplexOsc m => Time -> Message -> m ()
maybe_async_at :: forall (m :: * -> *). DuplexOsc m => Double -> Message -> m ()
maybe_async_at Double
t Message
m =
  if Message -> Bool
Command.isAsync Message
m
    then Message -> m ()
forall (m :: * -> *). DuplexOsc m => Message -> m ()
async_ Message
m
    else BundleOf Message -> m ()
forall (m :: * -> *). SendOsc m => BundleOf Message -> m ()
sendBundle (Double -> [Message] -> BundleOf Message
forall t. Double -> [t] -> BundleOf t
bundle Double
t [Message
m])

{- | Hostname and port number.
By default Tcp, 127.0.0.1 and 57110.
-}
type Sc3_Address = OscSocketAddress

{- | Sc3 default address.

>>> sc3_default_address
(Tcp,"127.0.0.1",57110)
-}
sc3_default_address :: Sc3_Address
sc3_default_address :: Sc3_Address
sc3_default_address = (OscProtocol
Tcp, Address_Pattern
"127.0.0.1", Node_Id
57110)

{- | Lookup ScSynth address at ScHostname and ScPort.
If either is no set default values are used.

>>> import System.Environment
>>> setEnv "ScHostname" "192.168.1.53"
>>> sc3_env_or_default_address
(Udp,"192.168.1.53",57110)
-}
sc3_env_or_default_address :: IO Sc3_Address
sc3_env_or_default_address :: IO Sc3_Address
sc3_env_or_default_address = do
  Address_Pattern
protocol <- Address_Pattern -> Address_Pattern -> IO Address_Pattern
System.lookup_env_default Address_Pattern
"ScProtocol" Address_Pattern
"Tcp"
  Address_Pattern
hostname <- Address_Pattern -> Address_Pattern -> IO Address_Pattern
System.lookup_env_default Address_Pattern
"ScHostname" Address_Pattern
"127.0.0.1"
  Address_Pattern
port <- Address_Pattern -> Address_Pattern -> IO Address_Pattern
System.lookup_env_default Address_Pattern
"ScPort" Address_Pattern
"57110"
  Sc3_Address -> IO Sc3_Address
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Address_Pattern -> OscProtocol
forall a. Read a => Address_Pattern -> a
read Address_Pattern
protocol, Address_Pattern
hostname, Address_Pattern -> Node_Id
forall a. Read a => Address_Pattern -> a
read Address_Pattern
port)

{- | Maximum packet size, in bytes, that can be sent over Udp.
However, see also <https://tools.ietf.org/html/rfc2675>.
Tcp is now the default transport mechanism for Hsc3.
-}
sc3_udp_limit :: Num n => n
sc3_udp_limit :: forall n. Num n => n
sc3_udp_limit = n
65507

-- | Bracket @Sc3@ communication at indicated host and port.
withSc3At :: Sc3_Address -> Connection OscSocket a -> IO a
withSc3At :: forall a. Sc3_Address -> Connection OscSocket a -> IO a
withSc3At Sc3_Address
address = IO OscSocket -> Connection OscSocket a -> IO a
forall t r. Transport t => IO t -> Connection t r -> IO r
withTransport (Sc3_Address -> IO OscSocket
openOscSocket Sc3_Address
address)

{- | Bracket @Sc3@ communication, ie. 'withSc3At' 'sc3_env_or_default_address'.

> import Sound.Sc3.Server.Command

> withSc3 (sendMessage status >> waitReply "/status.reply")
-}
withSc3 :: Connection OscSocket a -> IO a
withSc3 :: forall a. Connection OscSocket a -> IO a
withSc3 Connection OscSocket a
f = do
  Sc3_Address
addr <- IO Sc3_Address
sc3_env_or_default_address
  Sc3_Address -> Connection OscSocket a -> IO a
forall a. Sc3_Address -> Connection OscSocket a -> IO a
withSc3At Sc3_Address
addr Connection OscSocket a
f

-- | 'void' of 'withSc3'.
withSc3_ :: Connection OscSocket a -> IO ()
withSc3_ :: forall a. Connection OscSocket a -> IO ()
withSc3_ = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ())
-> (Connection OscSocket a -> IO a)
-> Connection OscSocket a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection OscSocket a -> IO a
forall a. Connection OscSocket a -> IO a
withSc3

-- | 'timeout_r' of 'withSc3'
withSc3_tm :: Double -> Connection OscSocket a -> IO (Maybe a)
withSc3_tm :: forall a. Double -> Connection OscSocket a -> IO (Maybe a)
withSc3_tm Double
tm = Double -> IO a -> IO (Maybe a)
forall a. Double -> IO a -> IO (Maybe a)
Sound.Osc.Time.Timeout.timeout_r Double
tm (IO a -> IO (Maybe a))
-> (Connection OscSocket a -> IO a)
-> Connection OscSocket a
-> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection OscSocket a -> IO a
forall a. Connection OscSocket a -> IO a
withSc3

{- | Run /f/ at /k/ scsynth servers with sequential port numbers starting at 'Options.sc3_port_def'.

> withSc3AtSeq sc3_default_address 2 (sendMessage status >> waitReply "/status.reply")
-}
withSc3AtSeq :: Sc3_Address -> Int -> Connection OscSocket a -> IO [a]
withSc3AtSeq :: forall a.
Sc3_Address -> Node_Id -> Connection OscSocket a -> IO [a]
withSc3AtSeq (OscProtocol
protocol, Address_Pattern
hostname, Node_Id
port) Node_Id
k Connection OscSocket a
f = do
  let mk_socket :: Node_Id -> IO OscSocket
mk_socket Node_Id
i = Sc3_Address -> IO OscSocket
openOscSocket (OscProtocol
protocol, Address_Pattern
hostname, Node_Id
port Node_Id -> Node_Id -> Node_Id
forall a. Num a => a -> a -> a
+ Node_Id
i)
  (Node_Id -> IO a) -> [Node_Id] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Node_Id
i -> IO OscSocket -> Connection OscSocket a -> IO a
forall t r. Transport t => IO t -> Connection t r -> IO r
withTransport (Node_Id -> IO OscSocket
mk_socket Node_Id
i) Connection OscSocket a
f) [Node_Id
0 .. Node_Id
k Node_Id -> Node_Id -> Node_Id
forall a. Num a => a -> a -> a
- Node_Id
1]

-- | 'void' of 'withSc3AtSeq'.
withSc3AtSeq_ :: Sc3_Address -> Int -> Connection OscSocket a -> IO ()
withSc3AtSeq_ :: forall a. Sc3_Address -> Node_Id -> Connection OscSocket a -> IO ()
withSc3AtSeq_ Sc3_Address
loc Node_Id
k = IO [a] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [a] -> IO ())
-> (Connection OscSocket a -> IO [a])
-> Connection OscSocket a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sc3_Address -> Node_Id -> Connection OscSocket a -> IO [a]
forall a.
Sc3_Address -> Node_Id -> Connection OscSocket a -> IO [a]
withSc3AtSeq Sc3_Address
loc Node_Id
k

-- * Server control

-- | Free all nodes ('g_freeAll') at group @1@.
stop :: SendOsc m => m ()
stop :: forall (m :: * -> *). SendOsc m => m ()
stop = Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage ([Node_Id] -> Message
Command.g_freeAll [Node_Id
1])

-- * Composite

-- | Runs 'clearSched' and then frees and re-creates groups @1@ and @2@.
reset :: SendOsc m => m ()
reset :: forall (m :: * -> *). SendOsc m => m ()
reset =
  let m :: [Message]
m =
        [ Message
Command.clearSched
        , [Node_Id] -> Message
Command.n_free [Node_Id
1, Node_Id
2]
        , [(Node_Id, AddAction, Node_Id)] -> Message
Command.g_new [(Node_Id
1, AddAction
Enum.AddToHead, Node_Id
0), (Node_Id
2, AddAction
Enum.AddToTail, Node_Id
0)]
        ]
  in BundleOf Message -> m ()
forall (m :: * -> *). SendOsc m => BundleOf Message -> m ()
sendBundle (Double -> [Message] -> BundleOf Message
forall t. Double -> [t] -> BundleOf t
bundle Double
immediately [Message]
m)

-- | (node-id,add-action,group-id,parameters)
type Play_Opt = (Command.Node_Id, Enum.AddAction, Command.Group_Id, [(String, Double)])

-- | Make 's_new' message to play 'Graphdef.Graphdef'.
play_graphdef_msg :: Play_Opt -> Graphdef.Graphdef -> Message
play_graphdef_msg :: Play_Opt -> Graphdef -> Message
play_graphdef_msg (Node_Id
nid, AddAction
act, Node_Id
gid, [(Address_Pattern, Double)]
param) Graphdef
g =
  let nm :: Address_Pattern
nm = Ascii -> Address_Pattern
ascii_to_string (Graphdef -> Ascii
Graphdef.graphdef_name Graphdef
g)
  in Address_Pattern
-> Node_Id
-> AddAction
-> Node_Id
-> [(Address_Pattern, Double)]
-> Message
Command.s_new Address_Pattern
nm Node_Id
nid AddAction
act Node_Id
gid [(Address_Pattern, Double)]
param

{- | If the graph size is less than 'sc3_udp_limit' encode and send
using 'd_recv_bytes', else write to temporary directory and read
using 'd_load'.
-}
recv_or_load_graphdef :: Transport m => Graphdef.Graphdef -> m Message
recv_or_load_graphdef :: forall (m :: * -> *). Transport m => Graphdef -> m Message
recv_or_load_graphdef Graphdef
g = do
  Address_Pattern
tmp <- IO Address_Pattern -> m Address_Pattern
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Address_Pattern
getTemporaryDirectory
  let nm :: Address_Pattern
nm = Ascii -> Address_Pattern
ascii_to_string (Graphdef -> Ascii
Graphdef.graphdef_name Graphdef
g)
      fn :: Address_Pattern
fn = Address_Pattern
tmp Address_Pattern -> Address_Pattern -> Address_Pattern
</> Address_Pattern
nm Address_Pattern -> Address_Pattern -> Address_Pattern
<.> Address_Pattern
"scsyndef"
      by :: ByteString
by = Graphdef -> ByteString
Graphdef.encode_graphdef Graphdef
g
      sz :: Int64
sz = ByteString -> Int64
L.length ByteString
by
  if Int64
sz Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
forall n. Num n => n
sc3_udp_limit
    then Message -> m Message
forall (m :: * -> *). DuplexOsc m => Message -> m Message
async (ByteString -> Message
Command.d_recv_bytes ByteString
by)
    else IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Address_Pattern -> Graphdef -> IO ()
Graphdef.graphdefWrite Address_Pattern
fn Graphdef
g) m () -> m Message -> m Message
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Message -> m Message
forall (m :: * -> *). DuplexOsc m => Message -> m Message
async (Address_Pattern -> Message
Command.d_load Address_Pattern
fn)

-- | Send 'd_recv' and 's_new' messages to scsynth.
playGraphdef :: Transport m => Play_Opt -> Graphdef.Graphdef -> m ()
playGraphdef :: forall (m :: * -> *). Transport m => Play_Opt -> Graphdef -> m ()
playGraphdef Play_Opt
opt Graphdef
g = Graphdef -> m Message
forall (m :: * -> *). Transport m => Graphdef -> m Message
recv_or_load_graphdef Graphdef
g m Message -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage (Play_Opt -> Graphdef -> Message
play_graphdef_msg Play_Opt
opt Graphdef
g)

-- | Send 'd_recv' and 's_new' messages to scsynth.
playSynthdef :: Transport m => Play_Opt -> Synthdef.Synthdef -> m ()
playSynthdef :: forall (m :: * -> *). Transport m => Play_Opt -> Synthdef -> m ()
playSynthdef Play_Opt
opt = Play_Opt -> Graphdef -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> Graphdef -> m ()
playGraphdef Play_Opt
opt (Graphdef -> m ()) -> (Synthdef -> Graphdef) -> Synthdef -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthdef -> Graphdef
Synthdef.synthdef_to_graphdef

-- | Send an /anonymous/ instrument definition using 'playSynthdef'.
playUgen :: Transport m => Play_Opt -> Ugen.Ugen -> m ()
playUgen :: forall (m :: * -> *). Transport m => Play_Opt -> Ugen -> m ()
playUgen Play_Opt
loc =
  Play_Opt -> Synthdef -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> Synthdef -> m ()
playSynthdef Play_Opt
loc
    (Synthdef -> m ()) -> (Ugen -> Synthdef) -> Ugen -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address_Pattern -> Ugen -> Synthdef
Synthdef.synthdef Address_Pattern
"Anonymous"
    (Ugen -> Synthdef) -> (Ugen -> Ugen) -> Ugen -> Synthdef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Double -> Ugen -> Ugen
Composite.wrapOut Maybe Double
forall a. Maybe a
Nothing

-- * Nrt

-- | Read latency from environment, defaulting to 0.1 seconds.
sc_latency :: IO Double
sc_latency :: IO Double
sc_latency = (Address_Pattern -> Double) -> IO Address_Pattern -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Address_Pattern -> Double
forall a. Read a => Address_Pattern -> a
read (Address_Pattern -> Address_Pattern -> IO Address_Pattern
System.lookup_env_default Address_Pattern
"ScLatency" Address_Pattern
"0.1")

{- | Wait ('pauseThreadUntil') until bundle is due to be sent relative
to the initial 'Time', then send each message, asynchronously if
required.
-}
run_bundle :: Transport m => Double -> Time -> BundleOf Message -> m ()
run_bundle :: forall (m :: * -> *).
Transport m =>
Double -> Double -> BundleOf Message -> m ()
run_bundle Double
latency Double
t0 BundleOf Message
b = do
  let t :: Double
t = Double
t0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BundleOf Message -> Double
forall t. BundleOf t -> Double
bundleTime BundleOf Message
b
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Double -> IO ()
forall (m :: * -> *) n. (MonadIO m, RealFrac n) => n -> m ()
pauseThreadUntil (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
latency))
  (Message -> m ()) -> [Message] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Double -> Message -> m ()
forall (m :: * -> *). DuplexOsc m => Double -> Message -> m ()
maybe_async_at Double
t) (BundleOf Message -> [Message]
forall t. BundleOf t -> [t]
bundleMessages BundleOf Message
b)

{- | Play an 'Nrt' score (as would be rendered by 'writeNrt').

> let sc = Nrt [bundle 1 [s_new0 "default" (-1) AddToHead 1]
>              ,bundle 2 [n_set1 (-1) "gate" 0]]
> in withSc3 (nrt_play sc)
-}
nrt_play :: Transport m => Nrt.Nrt -> m ()
nrt_play :: forall (m :: * -> *). Transport m => Nrt -> m ()
nrt_play Nrt
sc = do
  Double
t0 <- IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
forall (m :: * -> *). MonadIO m => m Double
time
  Double
latency <- IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
sc_latency
  (BundleOf Message -> m ()) -> [BundleOf Message] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Double -> Double -> BundleOf Message -> m ()
forall (m :: * -> *).
Transport m =>
Double -> Double -> BundleOf Message -> m ()
run_bundle Double
latency Double
t0) (Nrt -> [BundleOf Message]
Nrt.nrt_bundles Nrt
sc)

{- | Variant where asynchronous commands at time @0@ are separated out and run before
the initial time-stamp is taken.  This re-orders synchronous
commands in relation to asynchronous at time @0@.
-}
nrt_play_reorder :: Transport m => Nrt.Nrt -> m ()
nrt_play_reorder :: forall (m :: * -> *). Transport m => Nrt -> m ()
nrt_play_reorder Nrt
s = do
  let ([BundleOf Message]
i, [BundleOf Message]
r) = (Double -> Bool) -> Nrt -> ([BundleOf Message], [BundleOf Message])
Nrt.nrt_span (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0) Nrt
s
      i' :: [Message]
i' = (BundleOf Message -> [Message]) -> [BundleOf Message] -> [Message]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BundleOf Message -> [Message]
forall t. BundleOf t -> [t]
bundleMessages [BundleOf Message]
i
      ([Message]
a, [Message]
b) = [Message] -> ([Message], [Message])
Command.partition_async [Message]
i'
  (Message -> m Message) -> [Message] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Message -> m Message
forall (m :: * -> *). DuplexOsc m => Message -> m Message
async [Message]
a
  Double
t0 <- IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
forall (m :: * -> *). MonadIO m => m Double
time
  Double
latency <- IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
sc_latency
  (BundleOf Message -> m ()) -> [BundleOf Message] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Double -> Double -> BundleOf Message -> m ()
forall (m :: * -> *).
Transport m =>
Double -> Double -> BundleOf Message -> m ()
run_bundle Double
latency Double
t0) (Double -> [Message] -> BundleOf Message
forall t. Double -> [t] -> BundleOf t
Bundle Double
0 [Message]
b BundleOf Message -> [BundleOf Message] -> [BundleOf Message]
forall a. a -> [a] -> [a]
: [BundleOf Message]
r)

-- | 'withSc3' of 'nrt_play'.
nrt_audition :: Nrt.Nrt -> IO ()
nrt_audition :: Nrt -> IO ()
nrt_audition = Connection OscSocket () -> IO ()
forall a. Connection OscSocket a -> IO a
withSc3 (Connection OscSocket () -> IO ())
-> (Nrt -> Connection OscSocket ()) -> Nrt -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nrt -> Connection OscSocket ()
forall (m :: * -> *). Transport m => Nrt -> m ()
nrt_play

-- * Audible

-- | Class for values that can be encoded and send to @scsynth@ for audition.
class Audible e where
  playAt :: Transport m => Play_Opt -> e -> m ()

  -- | Variant where /id/ is @-1@.
  play :: Transport m => e -> m ()
  play = Play_Opt -> e -> m ()
forall e (m :: * -> *).
(Audible e, Transport m) =>
Play_Opt -> e -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> e -> m ()
playAt (-Node_Id
1, AddAction
Enum.AddToHead, Node_Id
1, [])

instance Audible Graphdef.Graphdef where
  playAt :: forall (m :: * -> *). Transport m => Play_Opt -> Graphdef -> m ()
playAt = Play_Opt -> Graphdef -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> Graphdef -> m ()
playGraphdef

instance Audible Synthdef.Synthdef where
  playAt :: forall (m :: * -> *). Transport m => Play_Opt -> Synthdef -> m ()
playAt = Play_Opt -> Synthdef -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> Synthdef -> m ()
playSynthdef

instance Audible Ugen.Ugen where
  playAt :: forall (m :: * -> *). Transport m => Play_Opt -> Ugen -> m ()
playAt = Play_Opt -> Ugen -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> Ugen -> m ()
playUgen

-- | 'withSc3At' of 'playAt'.
auditionAt :: Audible e => Sc3_Address -> Play_Opt -> e -> IO ()
auditionAt :: forall e. Audible e => Sc3_Address -> Play_Opt -> e -> IO ()
auditionAt Sc3_Address
loc Play_Opt
opt = Sc3_Address -> Connection OscSocket () -> IO ()
forall a. Sc3_Address -> Connection OscSocket a -> IO a
withSc3At Sc3_Address
loc (Connection OscSocket () -> IO ())
-> (e -> Connection OscSocket ()) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Play_Opt -> e -> Connection OscSocket ()
forall e (m :: * -> *).
(Audible e, Transport m) =>
Play_Opt -> e -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> e -> m ()
playAt Play_Opt
opt

-- | 'withSc3AtSeq' of 'playAt'.
auditionAtSeq :: Audible e => Sc3_Address -> Play_Opt -> Int -> e -> IO ()
auditionAtSeq :: forall e.
Audible e =>
Sc3_Address -> Play_Opt -> Node_Id -> e -> IO ()
auditionAtSeq Sc3_Address
loc Play_Opt
opt Node_Id
k = Sc3_Address -> Node_Id -> Connection OscSocket () -> IO ()
forall a. Sc3_Address -> Node_Id -> Connection OscSocket a -> IO ()
withSc3AtSeq_ Sc3_Address
loc Node_Id
k (Connection OscSocket () -> IO ())
-> (e -> Connection OscSocket ()) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Play_Opt -> e -> Connection OscSocket ()
forall e (m :: * -> *).
(Audible e, Transport m) =>
Play_Opt -> e -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> e -> m ()
playAt Play_Opt
opt

-- | Default 'Play_Opt', ie. (-1,addToHead,1,[])
def_play_opt :: Play_Opt
def_play_opt :: Play_Opt
def_play_opt = (-Node_Id
1, AddAction
Enum.AddToHead, Node_Id
1, [])

-- | 'auditionAt' 'sc3_env_or_default_address'
auditionOpt :: Audible e => Play_Opt -> e -> IO ()
auditionOpt :: forall e. Audible e => Play_Opt -> e -> IO ()
auditionOpt Play_Opt
o e
e = do
  Sc3_Address
addr <- IO Sc3_Address
sc3_env_or_default_address
  Sc3_Address -> Play_Opt -> e -> IO ()
forall e. Audible e => Sc3_Address -> Play_Opt -> e -> IO ()
auditionAt Sc3_Address
addr Play_Opt
o e
e

-- | 'auditionOpt' 'def_play_opt'
audition :: Audible e => e -> IO ()
audition :: forall e. Audible e => e -> IO ()
audition = Play_Opt -> e -> IO ()
forall e. Audible e => Play_Opt -> e -> IO ()
auditionOpt Play_Opt
def_play_opt

-- | 'auditionAtSeq' 'def_play_opt'
auditionSeq :: Audible e => Int -> e -> IO ()
auditionSeq :: forall e. Audible e => Node_Id -> e -> IO ()
auditionSeq Node_Id
k e
x = do
  Sc3_Address
addr <- IO Sc3_Address
sc3_env_or_default_address
  Sc3_Address -> Play_Opt -> Node_Id -> e -> IO ()
forall e.
Audible e =>
Sc3_Address -> Play_Opt -> Node_Id -> e -> IO ()
auditionAtSeq Sc3_Address
addr Play_Opt
def_play_opt Node_Id
k e
x

-- * Notifications

-- | Turn on notifications, run /f/, turn off notifications, return result.
withNotifications :: DuplexOsc m => m a -> m a
withNotifications :: forall (m :: * -> *) a. DuplexOsc m => m a -> m a
withNotifications m a
f = do
  Message -> m ()
forall (m :: * -> *). DuplexOsc m => Message -> m ()
async_ (Bool -> Message
Command.notify Bool
True)
  a
r <- m a
f
  Message -> m ()
forall (m :: * -> *). DuplexOsc m => Message -> m ()
async_ (Bool -> Message
Command.notify Bool
False)
  a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- * Buffer & control & node variants.

{- | Variant of 'b_getn1' that waits for return message and unpacks it.

> withSc3_tm 1.0 (b_getn1_data 0 (0,5))
-}
b_getn1_data :: DuplexOsc m => Int -> (Int, Int) -> m [Double]
b_getn1_data :: forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> (Node_Id, Node_Id) -> m [Double]
b_getn1_data Node_Id
b (Node_Id, Node_Id)
s = do
  let f :: Message -> [Double]
f Message
m = let (Node_Id
_, Node_Id
_, Node_Id
_, [Double]
r) = Message -> (Node_Id, Node_Id, Node_Id, [Double])
Command.unpack_b_setn_err Message
m in [Double]
r
  Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage (Node_Id -> (Node_Id, Node_Id) -> Message
Command.b_getn1 Node_Id
b (Node_Id, Node_Id)
s)
  (Message -> [Double]) -> m Message -> m [Double]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> [Double]
f (Address_Pattern -> m Message
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m Message
waitReply Address_Pattern
"/b_setn")

{- | Variant of 'b_getn1_data' that segments individual 'b_getn'
messages to /n/ elements.

> withSc3_tm 1.0 (b_getn1_data_segment 1 0 (0,5))
-}
b_getn1_data_segment ::
  DuplexOsc m =>
  Int ->
  Int ->
  (Int, Int) ->
  m [Double]
b_getn1_data_segment :: forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> Node_Id -> (Node_Id, Node_Id) -> m [Double]
b_getn1_data_segment Node_Id
n Node_Id
b (Node_Id
i, Node_Id
j) = do
  let ix :: [(Node_Id, Node_Id)]
ix = Node_Id -> Node_Id -> Node_Id -> [(Node_Id, Node_Id)]
Command.b_indices Node_Id
n Node_Id
j Node_Id
i
  [[Double]]
d <- ((Node_Id, Node_Id) -> m [Double])
-> [(Node_Id, Node_Id)] -> m [[Double]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Node_Id -> (Node_Id, Node_Id) -> m [Double]
forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> (Node_Id, Node_Id) -> m [Double]
b_getn1_data Node_Id
b) [(Node_Id, Node_Id)]
ix
  [Double] -> m [Double]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double]]
d)

-- | Variant of 'b_getn1_data_segment' that gets the entire buffer.
b_fetch :: DuplexOsc m => Int -> Int -> m [[Double]]
b_fetch :: forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> Node_Id -> m [[Double]]
b_fetch Node_Id
n Node_Id
b = do
  let f :: Message -> f [[Double]]
f Message
m =
        let (Node_Id
_, Node_Id
nf, Node_Id
nc, Double
_) = Message -> (Node_Id, Node_Id, Node_Id, Double)
Command.unpack_b_info_err Message
m
            ix :: (Node_Id, Node_Id)
ix = (Node_Id
0, Node_Id
nf Node_Id -> Node_Id -> Node_Id
forall a. Num a => a -> a -> a
* Node_Id
nc)
            deinterleave :: [a] -> [[a]]
deinterleave = [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
transpose ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node_Id -> [a] -> [[a]]
forall e. Node_Id -> [e] -> [[e]]
Split.chunksOf Node_Id
nc
        in ([Double] -> [[Double]]) -> f [Double] -> f [[Double]]
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> [[Double]]
forall {a}. [a] -> [[a]]
deinterleave (Node_Id -> Node_Id -> (Node_Id, Node_Id) -> f [Double]
forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> Node_Id -> (Node_Id, Node_Id) -> m [Double]
b_getn1_data_segment Node_Id
n Node_Id
b (Node_Id, Node_Id)
ix)
  Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage (Node_Id -> Message
Command.b_query1 Node_Id
b)
  Address_Pattern -> m Message
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m Message
waitReply Address_Pattern
"/b_info" m Message -> (Message -> m [[Double]]) -> m [[Double]]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message -> m [[Double]]
forall {f :: * -> *}. DuplexOsc f => Message -> f [[Double]]
f

{- | First channel of 'b_fetch', errors if there is no data.

> withSc3 (b_fetch1 512 123456789)
-}
b_fetch1 :: DuplexOsc m => Int -> Int -> m [Double]
b_fetch1 :: forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> Node_Id -> m [Double]
b_fetch1 Node_Id
n Node_Id
b = ([[Double]] -> [Double]) -> m [[Double]] -> m [Double]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Address_Pattern -> [[Double]] -> [Double]
forall a. Partial => Address_Pattern -> [a] -> a
Safe.headNote Address_Pattern
"b_fetch1: no data") (Node_Id -> Node_Id -> m [[Double]]
forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> Node_Id -> m [[Double]]
b_fetch Node_Id
n Node_Id
b)

-- | Combination of 'b_query1_unpack' and 'b_fetch'.
b_fetch_hdr :: Transport m => Int -> Int -> m ((Int, Int, Int, Double), [[Double]])
b_fetch_hdr :: forall (m :: * -> *).
Transport m =>
Node_Id
-> Node_Id -> m ((Node_Id, Node_Id, Node_Id, Double), [[Double]])
b_fetch_hdr Node_Id
k Node_Id
b = do
  (Node_Id, Node_Id, Node_Id, Double)
q <- Node_Id -> m (Node_Id, Node_Id, Node_Id, Double)
forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> m (Node_Id, Node_Id, Node_Id, Double)
b_query1_unpack Node_Id
b
  [[Double]]
d <- Node_Id -> Node_Id -> m [[Double]]
forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> Node_Id -> m [[Double]]
b_fetch Node_Id
k Node_Id
b
  ((Node_Id, Node_Id, Node_Id, Double), [[Double]])
-> m ((Node_Id, Node_Id, Node_Id, Double), [[Double]])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Node_Id, Node_Id, Node_Id, Double)
q, [[Double]]
d)

-- | 'b_info_unpack_err' of 'b_query1'.
b_query1_unpack_generic :: (DuplexOsc m, Num n, Fractional r) => Int -> m (n, n, n, r)
b_query1_unpack_generic :: forall (m :: * -> *) n r.
(DuplexOsc m, Num n, Fractional r) =>
Node_Id -> m (n, n, n, r)
b_query1_unpack_generic Node_Id
n = do
  Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage (Node_Id -> Message
Command.b_query1 Node_Id
n)
  Message
q <- Address_Pattern -> m Message
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m Message
waitReply Address_Pattern
"/b_info"
  (n, n, n, r) -> m (n, n, n, r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> (n, n, n, r)
forall i f. (Num i, Fractional f) => Message -> (i, i, i, f)
Generic.unpack_b_info_err Message
q)

{- | Type specialised 'b_query1_unpack_generic'.

> withSc3 (b_query1_unpack 0)
-}
b_query1_unpack :: DuplexOsc m => Command.Buffer_Id -> m (Int, Int, Int, Double)
b_query1_unpack :: forall (m :: * -> *).
DuplexOsc m =>
Node_Id -> m (Node_Id, Node_Id, Node_Id, Double)
b_query1_unpack = Node_Id -> m (Node_Id, Node_Id, Node_Id, Double)
forall (m :: * -> *) n r.
(DuplexOsc m, Num n, Fractional r) =>
Node_Id -> m (n, n, n, r)
b_query1_unpack_generic

-- | Variant of 'c_getn1' that waits for the reply and unpacks the data.
c_getn1_data :: (DuplexOsc m, Floating t) => (Int, Int) -> m [t]
c_getn1_data :: forall (m :: * -> *) t.
(DuplexOsc m, Floating t) =>
(Node_Id, Node_Id) -> m [t]
c_getn1_data (Node_Id, Node_Id)
s = do
  let f :: [Datum] -> [b]
f [Datum]
d = case [Datum]
d of
        Int32 Int32
_ : Int32 Int32
_ : [Datum]
x -> (Datum -> Maybe b) -> [Datum] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Datum -> Maybe b
forall n. Floating n => Datum -> Maybe n
datum_floating [Datum]
x
        [Datum]
_ -> Address_Pattern -> [b]
forall a. Partial => Address_Pattern -> a
error Address_Pattern
"c_getn1_data"
  Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage ((Node_Id, Node_Id) -> Message
Command.c_getn1 (Node_Id, Node_Id)
s)
  ([Datum] -> [t]) -> m [Datum] -> m [t]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Datum] -> [t]
forall {b}. Floating b => [Datum] -> [b]
f (Address_Pattern -> m [Datum]
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m [Datum]
waitDatum Address_Pattern
"/c_setn")

-- | Apply /f/ to result of 'n_query'.
n_query1_unpack_f :: DuplexOsc m => (Message -> t) -> Command.Node_Id -> m t
n_query1_unpack_f :: forall (m :: * -> *) t.
DuplexOsc m =>
(Message -> t) -> Node_Id -> m t
n_query1_unpack_f Message -> t
f Node_Id
n = do
  Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage ([Node_Id] -> Message
Command.n_query [Node_Id
n])
  Message
r <- Address_Pattern -> m Message
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m Message
waitReply Address_Pattern
"/n_info"
  t -> m t
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> t
f Message
r)

-- | Variant of 'n_query' that waits for and unpacks the reply.
n_query1_unpack :: DuplexOsc m => Command.Node_Id -> m (Maybe (Int, Int, Int, Int, Int, Maybe (Int, Int)))
n_query1_unpack :: forall (m :: * -> *).
DuplexOsc m =>
Node_Id
-> m (Maybe
        (Node_Id, Node_Id, Node_Id, Node_Id, Node_Id,
         Maybe (Node_Id, Node_Id)))
n_query1_unpack = (Message
 -> Maybe
      (Node_Id, Node_Id, Node_Id, Node_Id, Node_Id,
       Maybe (Node_Id, Node_Id)))
-> Node_Id
-> m (Maybe
        (Node_Id, Node_Id, Node_Id, Node_Id, Node_Id,
         Maybe (Node_Id, Node_Id)))
forall (m :: * -> *) t.
DuplexOsc m =>
(Message -> t) -> Node_Id -> m t
n_query1_unpack_f Message
-> Maybe
     (Node_Id, Node_Id, Node_Id, Node_Id, Node_Id,
      Maybe (Node_Id, Node_Id))
Command.unpack_n_info

-- | Variant of 'n_query1_unpack' that returns plain (un-lifted) result.
n_query1_unpack_plain :: DuplexOsc m => Command.Node_Id -> m [Int]
n_query1_unpack_plain :: forall (m :: * -> *). DuplexOsc m => Node_Id -> m [Node_Id]
n_query1_unpack_plain = (Message -> [Node_Id]) -> Node_Id -> m [Node_Id]
forall (m :: * -> *) t.
DuplexOsc m =>
(Message -> t) -> Node_Id -> m t
n_query1_unpack_f Message -> [Node_Id]
Command.unpack_n_info_plain

-- | Variant of 'g_queryTree' that waits for and unpacks the reply.
g_queryTree1_unpack :: DuplexOsc m => Command.Group_Id -> m Status.Query_Node
g_queryTree1_unpack :: forall (m :: * -> *). DuplexOsc m => Node_Id -> m Query_Node
g_queryTree1_unpack Node_Id
n = do
  Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage ([(Node_Id, Bool)] -> Message
Command.g_queryTree [(Node_Id
n, Bool
True)])
  Message
r <- Address_Pattern -> m Message
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m Message
waitReply Address_Pattern
"/g_queryTree.reply"
  Query_Node -> m Query_Node
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Datum] -> Query_Node
Status.queryTree (Message -> [Datum]
messageDatum Message
r))

-- * Status

{- | Collect server status information.

> withSc3 serverStatus >>= mapM putStrLn
-}
serverStatus :: DuplexOsc m => m [String]
serverStatus :: forall (m :: * -> *). DuplexOsc m => m [Address_Pattern]
serverStatus = ([Datum] -> [Address_Pattern]) -> m [Datum] -> m [Address_Pattern]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Datum] -> [Address_Pattern]
Status.statusFormat m [Datum]
forall (m :: * -> *). DuplexOsc m => m [Datum]
serverStatusData

{- | Collect server status information.

> withSc3 server_status_concise >>= putStrLn
-}
server_status_concise :: DuplexOsc m => m String
server_status_concise :: forall (m :: * -> *). DuplexOsc m => m Address_Pattern
server_status_concise = ([Datum] -> Address_Pattern) -> m [Datum] -> m Address_Pattern
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Datum] -> Address_Pattern
Status.status_format_concise m [Datum]
forall (m :: * -> *). DuplexOsc m => m [Datum]
serverStatusData

{- | Read nominal sample rate of server.

> withSc3 serverSampleRateNominal
-}
serverSampleRateNominal :: DuplexOsc m => m Double
serverSampleRateNominal :: forall (m :: * -> *). DuplexOsc m => m Double
serverSampleRateNominal = ([Datum] -> Double) -> m [Datum] -> m Double
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node_Id -> [Datum] -> Double
forall n. Floating n => Node_Id -> [Datum] -> n
Status.extractStatusField Node_Id
7) m [Datum]
forall (m :: * -> *). DuplexOsc m => m [Datum]
serverStatusData

{- | Read actual sample rate of server.

> withSc3 serverSampleRateActual
-}
serverSampleRateActual :: DuplexOsc m => m Double
serverSampleRateActual :: forall (m :: * -> *). DuplexOsc m => m Double
serverSampleRateActual = ([Datum] -> Double) -> m [Datum] -> m Double
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Node_Id -> [Datum] -> Double
forall n. Floating n => Node_Id -> [Datum] -> n
Status.extractStatusField Node_Id
8) m [Datum]
forall (m :: * -> *). DuplexOsc m => m [Datum]
serverStatusData

-- | Retrieve status data from server.
serverStatusData :: DuplexOsc m => m [Datum]
serverStatusData :: forall (m :: * -> *). DuplexOsc m => m [Datum]
serverStatusData = do
  Message -> m ()
forall (m :: * -> *). SendOsc m => Message -> m ()
sendMessage Message
Command.status
  Address_Pattern -> m [Datum]
forall (m :: * -> *). RecvOsc m => Address_Pattern -> m [Datum]
waitDatum Address_Pattern
"/status.reply"

-- * Tree

{- | Collect server node tree information.

> withSc3 serverTree >>= mapM_ putStrLn
-}
serverTree :: DuplexOsc m => m [String]
serverTree :: forall (m :: * -> *). DuplexOsc m => m [Address_Pattern]
serverTree = do
  Query_Node
qt <- Node_Id -> m Query_Node
forall (m :: * -> *). DuplexOsc m => Node_Id -> m Query_Node
g_queryTree1_unpack Node_Id
0
  let tr :: Tree Query_Node
tr = Query_Node -> Tree Query_Node
Status.queryTree_rt Query_Node
qt
  [Address_Pattern] -> m [Address_Pattern]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Address_Pattern
"***** SuperCollider Server Tree *****", Tree Address_Pattern -> Address_Pattern
Tree.drawTree ((Query_Node -> Address_Pattern)
-> Tree Query_Node -> Tree Address_Pattern
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Query_Node -> Address_Pattern
Status.query_node_pp Tree Query_Node
tr)]