-- | /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.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.NRT as NRT
import qualified Sound.SC3.Server.Options as Options
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.Type 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 :: Message -> m Message
async Message
m = Message -> m ()
forall (m :: * -> *). SendOSC m => Message -> m ()
sendMessage Message
m m () -> m Message -> m Message
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_ :: 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 :: 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 :: Time -> Message -> m ()
maybe_async_at Time
t Message
m =
    if Message -> Bool
Command.isAsync Message
m
    then Message -> m ()
forall (m :: * -> *). DuplexOSC m => Message -> m ()
async_ Message
m
    else Bundle -> m ()
forall (m :: * -> *). SendOSC m => Bundle -> m ()
sendBundle (Time -> [Message] -> Bundle
bundle Time
t [Message
m])

-- | Local host (ie. @127.0.0.1@) at port 'sc3_port_def'
sc3_default_udp :: (String,Int)
sc3_default_udp :: (Address_Pattern, Int)
sc3_default_udp = (Address_Pattern
Options.sc3_addr_def,Int
forall i. Num i => i
Options.sc3_port_def)

-- | Maximum packet size, in bytes, that can be sent over UDP.
--   However, see also <https://tools.ietf.org/html/rfc2675>
sc3_udp_limit :: Num n => n
sc3_udp_limit :: n
sc3_udp_limit = n
65507

-- | Bracket @SC3@ communication at indicated host and port.
withSC3At :: (String,Int) -> Connection UDP a -> IO a
withSC3At :: (Address_Pattern, Int) -> Connection UDP a -> IO a
withSC3At (Address_Pattern
h,Int
p) = IO UDP -> Connection UDP a -> IO a
forall t r. Transport t => IO t -> Connection t r -> IO r
withTransport (Address_Pattern -> Int -> IO UDP
openUDP Address_Pattern
h Int
p)

-- | Bracket @SC3@ communication, ie. 'withSC3At' 'sc3_default_udp'.
--
-- > import Sound.SC3.Server.Command
--
-- > withSC3 (sendMessage status >> waitReply "/status.reply")
withSC3 :: Connection UDP a -> IO a
withSC3 :: Connection UDP a -> IO a
withSC3 = (Address_Pattern, Int) -> Connection UDP a -> IO a
forall a. (Address_Pattern, Int) -> Connection UDP a -> IO a
withSC3At (Address_Pattern, Int)
sc3_default_udp

-- | 'void' of 'withSC3'.
withSC3_ :: Connection UDP a -> IO ()
withSC3_ :: Connection UDP a -> IO ()
withSC3_ = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ())
-> (Connection UDP a -> IO a) -> Connection UDP a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection UDP a -> IO a
forall a. Connection UDP a -> IO a
withSC3

-- | 'timeout_r' of 'withSC3'
withSC3_tm :: Double -> Connection UDP a -> IO (Maybe a)
withSC3_tm :: Time -> Connection UDP a -> IO (Maybe a)
withSC3_tm Time
tm = Time -> IO a -> IO (Maybe a)
forall a. Time -> IO a -> IO (Maybe a)
timeout_r Time
tm (IO a -> IO (Maybe a))
-> (Connection UDP a -> IO a) -> Connection UDP a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection UDP a -> IO a
forall a. Connection UDP a -> IO a
withSC3

-- | Run /f/ at /k/ scsynth servers with sequential port numbers starting at 'Options.sc3_port_def'.
--
-- > withSC3At_seq sc3_default_udp 2 (sendMessage status >> waitReply "/status.reply")
withSC3At_seq :: (String,Int) -> Int -> Connection UDP a -> IO [a]
withSC3At_seq :: (Address_Pattern, Int) -> Int -> Connection UDP a -> IO [a]
withSC3At_seq (Address_Pattern
h,Int
p) Int
k Connection UDP a
f = do
  let mk_udp :: Int -> IO UDP
mk_udp Int
i = Address_Pattern -> Int -> IO UDP
openUDP Address_Pattern
h (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)
  (Int -> IO a) -> [Int] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
i -> IO UDP -> Connection UDP a -> IO a
forall t r. Transport t => IO t -> Connection t r -> IO r
withTransport (Int -> IO UDP
mk_udp Int
i) Connection UDP a
f) [Int
0 .. Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

-- | 'void' of 'withSC3_seq'.
withSC3At_seq_ :: (String,Int) -> Int -> Connection UDP a -> IO ()
withSC3At_seq_ :: (Address_Pattern, Int) -> Int -> Connection UDP a -> IO ()
withSC3At_seq_ (Address_Pattern, Int)
loc Int
k = IO [a] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [a] -> IO ())
-> (Connection UDP a -> IO [a]) -> Connection UDP a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address_Pattern, Int) -> Int -> Connection UDP a -> IO [a]
forall a.
(Address_Pattern, Int) -> Int -> Connection UDP a -> IO [a]
withSC3At_seq (Address_Pattern, Int)
loc Int
k

-- * Server control

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

-- * Composite

-- | Runs 'clearSched' and then frees and re-creates groups @1@ and @2@.
reset :: SendOSC m => m ()
reset :: m ()
reset =
    let m :: [Message]
m = [Message
Command.clearSched
            ,[Int] -> Message
Command.n_free [Int
1,Int
2]
            ,[(Int, AddAction, Int)] -> Message
Command.g_new [(Int
1,AddAction
Enum.AddToHead,Int
0),(Int
2,AddAction
Enum.AddToTail,Int
0)]]
    in Bundle -> m ()
forall (m :: * -> *). SendOSC m => Bundle -> m ()
sendBundle (Time -> [Message] -> Bundle
bundle Time
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 (Int
nid,AddAction
act,Int
gid,[(Address_Pattern, Time)]
param) Graphdef
g =
    let nm :: Address_Pattern
nm = ASCII -> Address_Pattern
ascii_to_string (Graphdef -> ASCII
Graphdef.graphdef_name Graphdef
g)
    in Address_Pattern
-> Int -> AddAction -> Int -> [(Address_Pattern, Time)] -> Message
Command.s_new Address_Pattern
nm Int
nid AddAction
act Int
gid [(Address_Pattern, Time)]
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 :: Graphdef -> m Message
recv_or_load_graphdef Graphdef
g = do
  Address_Pattern
tmp <- IO Address_Pattern -> m Address_Pattern
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 i. Num i => i
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 (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 (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 :: 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 (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 :: 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 :: 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 Time -> UGen -> UGen
Composite.wrapOut Maybe Time
forall a. Maybe a
Nothing

-- * NRT

-- | 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 => Time -> Bundle -> m ()
run_bundle :: Time -> Bundle -> m ()
run_bundle Time
t0 Bundle
b = do
  let t :: Time
t = Time
t0 Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Bundle -> Time
bundleTime Bundle
b
      latency :: Time
latency = Time
0.1
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Time -> IO ()
forall (m :: * -> *). MonadIO m => Time -> m ()
pauseThreadUntil (Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
latency))
  (Message -> m ()) -> [Message] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Time -> Message -> m ()
forall (m :: * -> *). DuplexOSC m => Time -> Message -> m ()
maybe_async_at Time
t) (Bundle -> [Message]
bundleMessages Bundle
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 :: NRT -> m ()
nrt_play NRT
sc = do
  Time
t0 <- IO Time -> m Time
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Time
forall (m :: * -> *). MonadIO m => m Time
time
  (Bundle -> m ()) -> [Bundle] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Time -> Bundle -> m ()
forall (m :: * -> *). Transport m => Time -> Bundle -> m ()
run_bundle Time
t0) (NRT -> [Bundle]
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 :: NRT -> m ()
nrt_play_reorder NRT
s = do
  let ([Bundle]
i,[Bundle]
r) = (Time -> Bool) -> NRT -> ([Bundle], [Bundle])
NRT.nrt_span (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
0) NRT
s
      i' :: [Message]
i' = (Bundle -> [Message]) -> [Bundle] -> [Message]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Bundle -> [Message]
bundleMessages [Bundle]
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
  Time
t <- IO Time -> m Time
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Time
forall (m :: * -> *). MonadIO m => m Time
time
  (Bundle -> m ()) -> [Bundle] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Time -> Bundle -> m ()
forall (m :: * -> *). Transport m => Time -> Bundle -> m ()
run_bundle Time
t) (Time -> [Message] -> Bundle
Bundle Time
0 [Message]
b Bundle -> [Bundle] -> [Bundle]
forall a. a -> [a] -> [a]
: [Bundle]
r)

-- | 'withSC3' of 'nrt_play'.
nrt_audition :: NRT.NRT -> IO ()
nrt_audition :: NRT -> IO ()
nrt_audition = Connection UDP () -> IO ()
forall a. Connection UDP a -> IO a
withSC3 (Connection UDP () -> IO ())
-> (NRT -> Connection UDP ()) -> NRT -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NRT -> Connection UDP ()
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
    play_at :: 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 ()
play_at (-Int
1,AddAction
Enum.AddToHead,Int
1,[])

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

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

instance Audible UGen.UGen where
    play_at :: Play_Opt -> UGen -> m ()
play_at = Play_Opt -> UGen -> m ()
forall (m :: * -> *). Transport m => Play_Opt -> UGen -> m ()
playUGen

-- | 'withSC3At' of 'play_at'.
audition_at :: Audible e => (String,Int) -> Play_Opt -> e -> IO ()
audition_at :: (Address_Pattern, Int) -> Play_Opt -> e -> IO ()
audition_at (Address_Pattern, Int)
loc Play_Opt
opt = (Address_Pattern, Int) -> Connection UDP () -> IO ()
forall a. (Address_Pattern, Int) -> Connection UDP a -> IO a
withSC3At (Address_Pattern, Int)
loc (Connection UDP () -> IO ())
-> (e -> Connection UDP ()) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Play_Opt -> e -> Connection UDP ()
forall e (m :: * -> *).
(Audible e, Transport m) =>
Play_Opt -> e -> m ()
play_at Play_Opt
opt

-- | 'withSC3_seq' of 'play_at'.
audition_at_seq :: Audible e => (String,Int) -> Play_Opt -> Int -> e -> IO ()
audition_at_seq :: (Address_Pattern, Int) -> Play_Opt -> Int -> e -> IO ()
audition_at_seq (Address_Pattern, Int)
loc Play_Opt
opt Int
k = (Address_Pattern, Int) -> Int -> Connection UDP () -> IO ()
forall a.
(Address_Pattern, Int) -> Int -> Connection UDP a -> IO ()
withSC3At_seq_ (Address_Pattern, Int)
loc Int
k (Connection UDP () -> IO ())
-> (e -> Connection UDP ()) -> e -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Play_Opt -> e -> Connection UDP ()
forall e (m :: * -> *).
(Audible e, Transport m) =>
Play_Opt -> e -> m ()
play_at Play_Opt
opt

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

-- | 'audition_at' 'def_play_opt'
audition :: Audible e => e -> IO ()
audition :: e -> IO ()
audition = (Address_Pattern, Int) -> Play_Opt -> e -> IO ()
forall e.
Audible e =>
(Address_Pattern, Int) -> Play_Opt -> e -> IO ()
audition_at (Address_Pattern, Int)
sc3_default_udp Play_Opt
def_play_opt

-- | 'audition_at_seq' 'def_play_opt'
audition_seq :: Audible e => Int -> e -> IO ()
audition_seq :: Int -> e -> IO ()
audition_seq = (Address_Pattern, Int) -> Play_Opt -> Int -> e -> IO ()
forall e.
Audible e =>
(Address_Pattern, Int) -> Play_Opt -> Int -> e -> IO ()
audition_at_seq (Address_Pattern, Int)
sc3_default_udp Play_Opt
def_play_opt

-- * Notifications

-- | Turn on notifications, run /f/, turn off notifications, return result.
withNotifications :: DuplexOSC m => m a -> m a
withNotifications :: 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 (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 :: Int -> (Int, Int) -> m [Time]
b_getn1_data Int
b (Int, Int)
s = do
  let f :: Message -> [Time]
f Message
m = let (Int
_,Int
_,Int
_,[Time]
r) = Message -> (Int, Int, Int, [Time])
Command.unpack_b_setn_err Message
m in [Time]
r
  Message -> m ()
forall (m :: * -> *). SendOSC m => Message -> m ()
sendMessage (Int -> (Int, Int) -> Message
Command.b_getn1 Int
b (Int, Int)
s)
  (Message -> [Time]) -> m Message -> m [Time]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Message -> [Time]
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 :: Int -> Int -> (Int, Int) -> m [Time]
b_getn1_data_segment Int
n Int
b (Int
i,Int
j) = do
  let ix :: [(Int, Int)]
ix = Int -> Int -> Int -> [(Int, Int)]
Command.b_indices Int
n Int
j Int
i
  [[Time]]
d <- ((Int, Int) -> m [Time]) -> [(Int, Int)] -> m [[Time]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int -> (Int, Int) -> m [Time]
forall (m :: * -> *). DuplexOSC m => Int -> (Int, Int) -> m [Time]
b_getn1_data Int
b) [(Int, Int)]
ix
  [Time] -> m [Time]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Time]] -> [Time]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Time]]
d)

-- | Variant of 'b_getn1_data_segment' that gets the entire buffer.
b_fetch :: DuplexOSC m => Int -> Int -> m [[Double]]
b_fetch :: Int -> Int -> m [[Time]]
b_fetch Int
n Int
b = do
  let f :: Message -> f [[Time]]
f Message
m = let (Int
_,Int
nf,Int
nc,Time
_) = Message -> (Int, Int, Int, Time)
Command.unpack_b_info_err Message
m
                ix :: (Int, Int)
ix = (Int
0,Int
nf Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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
. Int -> [a] -> [[a]]
forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
nc
            in ([Time] -> [[Time]]) -> f [Time] -> f [[Time]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Time] -> [[Time]]
forall a. [a] -> [[a]]
deinterleave (Int -> Int -> (Int, Int) -> f [Time]
forall (m :: * -> *).
DuplexOSC m =>
Int -> Int -> (Int, Int) -> m [Time]
b_getn1_data_segment Int
n Int
b (Int, Int)
ix)
  Message -> m ()
forall (m :: * -> *). SendOSC m => Message -> m ()
sendMessage (Int -> Message
Command.b_query1 Int
b)
  Address_Pattern -> m Message
forall (m :: * -> *). RecvOSC m => Address_Pattern -> m Message
waitReply Address_Pattern
"/b_info" m Message -> (Message -> m [[Time]]) -> m [[Time]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message -> m [[Time]]
forall (f :: * -> *). DuplexOSC f => Message -> f [[Time]]
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 :: Int -> Int -> m [Time]
b_fetch1 Int
n Int
b = ([[Time]] -> [Time]) -> m [[Time]] -> m [Time]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Address_Pattern -> [[Time]] -> [Time]
forall a. Partial => Address_Pattern -> [a] -> a
Safe.headNote Address_Pattern
"b_fetch1: no data") (Int -> Int -> m [[Time]]
forall (m :: * -> *). DuplexOSC m => Int -> Int -> m [[Time]]
b_fetch Int
n Int
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 :: Int -> Int -> m ((Int, Int, Int, Time), [[Time]])
b_fetch_hdr Int
k Int
b = do
  (Int, Int, Int, Time)
q <- Int -> m (Int, Int, Int, Time)
forall (m :: * -> *). DuplexOSC m => Int -> m (Int, Int, Int, Time)
b_query1_unpack Int
b
  [[Time]]
d <- Int -> Int -> m [[Time]]
forall (m :: * -> *). DuplexOSC m => Int -> Int -> m [[Time]]
b_fetch Int
k Int
b
  ((Int, Int, Int, Time), [[Time]])
-> m ((Int, Int, Int, Time), [[Time]])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int, Int, Time)
q,[[Time]]
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 :: Int -> m (n, n, n, r)
b_query1_unpack_generic Int
n = do
  Message -> m ()
forall (m :: * -> *). SendOSC m => Message -> m ()
sendMessage (Int -> Message
Command.b_query1 Int
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 (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 :: Int -> m (Int, Int, Int, Time)
b_query1_unpack = Int -> m (Int, Int, Int, Time)
forall (m :: * -> *) n r.
(DuplexOSC m, Num n, Fractional r) =>
Int -> 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 :: (Int, Int) -> m [t]
c_getn1_data (Int, Int)
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 ((Int, Int) -> Message
Command.c_getn1 (Int, Int)
s)
  ([Datum] -> [t]) -> m [Datum] -> m [t]
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 :: (Message -> t) -> Int -> m t
n_query1_unpack_f Message -> t
f Int
n = do
  Message -> m ()
forall (m :: * -> *). SendOSC m => Message -> m ()
sendMessage ([Int] -> Message
Command.n_query [Int
n])
  Message
r <- Address_Pattern -> m Message
forall (m :: * -> *). RecvOSC m => Address_Pattern -> m Message
waitReply Address_Pattern
"/n_info"
  t -> m t
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 :: Int -> m (Maybe (Int, Int, Int, Int, Int, Maybe (Int, Int)))
n_query1_unpack = (Message -> Maybe (Int, Int, Int, Int, Int, Maybe (Int, Int)))
-> Int -> m (Maybe (Int, Int, Int, Int, Int, Maybe (Int, Int)))
forall (m :: * -> *) t. DuplexOSC m => (Message -> t) -> Int -> m t
n_query1_unpack_f Message -> Maybe (Int, Int, Int, Int, Int, Maybe (Int, Int))
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 :: Int -> m [Int]
n_query1_unpack_plain = (Message -> [Int]) -> Int -> m [Int]
forall (m :: * -> *) t. DuplexOSC m => (Message -> t) -> Int -> m t
n_query1_unpack_f Message -> [Int]
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 :: Int -> m Query_Node
g_queryTree1_unpack Int
n = do
  Message -> m ()
forall (m :: * -> *). SendOSC m => Message -> m ()
sendMessage ([(Int, Bool)] -> Message
Command.g_queryTree [(Int
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 (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 :: m [Address_Pattern]
serverStatus = ([Datum] -> [Address_Pattern]) -> m [Datum] -> m [Address_Pattern]
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 :: m Address_Pattern
server_status_concise = ([Datum] -> Address_Pattern) -> m [Datum] -> m Address_Pattern
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 :: m Time
serverSampleRateNominal = ([Datum] -> Time) -> m [Datum] -> m Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Datum] -> Time
forall n. Floating n => Int -> [Datum] -> n
Status.extractStatusField Int
7) m [Datum]
forall (m :: * -> *). DuplexOSC m => m [Datum]
serverStatusData

-- | Read actual sample rate of server.
--
-- > withSC3 serverSampleRateActual
serverSampleRateActual :: DuplexOSC m => m Double
serverSampleRateActual :: m Time
serverSampleRateActual = ([Datum] -> Time) -> m [Datum] -> m Time
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Datum] -> Time
forall n. Floating n => Int -> [Datum] -> n
Status.extractStatusField Int
8) m [Datum]
forall (m :: * -> *). DuplexOSC m => m [Datum]
serverStatusData

-- | Retrieve status data from server.
serverStatusData :: DuplexOSC m => m [Datum]
serverStatusData :: 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 :: m [Address_Pattern]
serverTree = do
  Query_Node
qt <- Int -> m Query_Node
forall (m :: * -> *). DuplexOSC m => Int -> m Query_Node
g_queryTree1_unpack Int
0
  let tr :: Tree Query_Node
tr = Query_Node -> Tree Query_Node
Status.queryTree_rt Query_Node
qt
  [Address_Pattern] -> m [Address_Pattern]
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Query_Node -> Address_Pattern
Status.query_node_pp Tree Query_Node
tr)]