-- | Non-realtime synthesis. Create a sound file from the same instructions
--   you use to perform live!
-- 
--   **Note** we don't currently support redefining Synthdefs midway -- e.g.
--   you can't explicitly define a SynthDef "foo" (with 'defineSD'), then make a
--   synth from it, then explicitly define it again with a new definition, and
--   then make a new synth with the new definition


{-# LANGUAGE
     BangPatterns
   , FlexibleInstances
   , InstanceSigs
   , LambdaCase
   , TypeSynonymInstances

   , NoIncoherentInstances
   , NoMonomorphismRestriction
   , NoUndecidableInstances
   #-}

module Vivid.Actions.NRT (
     NRT -- (..) -- ^ May not be exported in the future
   , writeNRT
   , writeNRTScore
   , encodeNRTScore
   , runNRT

   , writeNRTWith
   , NRTArgs(..)
   , defaultNRTArgs
   ) where

import qualified Vivid.SC.Server.Commands as SCCmd

import Vivid.Actions.Class
import Vivid.OSC
import Vivid.OSC.Bundles (encodeOSCBundles)
import Vivid.SCServer
-- import Vivid.SCServer.State
import Vivid.SynthDef (sdToLiteral)
import Vivid.SynthDef.Types

import Control.Applicative
-- import Control.Arrow (first, second)
import Control.Exception
import Control.Monad
import Control.Monad.State (get, modify, execStateT, StateT, state)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (writeFile, hPut)
import Data.Char (toLower)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Monoid
import qualified Data.Set as Set
import System.Directory (canonicalizePath, getTemporaryDirectory) -- , removeFile)
import System.Exit
import System.FilePath (takeExtension)
import System.IO (openBinaryTempFile, hClose)
import System.Process (system)
import Prelude

data NRTState
   = NRTState {
     NRTState -> Timestamp
nrtState_now :: Timestamp
     -- We keep track of the maximum timestamp so that the generated audio file
     --   doesn't cut off before a final 'wait' finishes:
   , NRTState -> Maximum Timestamp
nrtState_maxTime :: Maximum Timestamp
   , NRTState -> Map Timestamp [Either ByteString OSC]
nrtState_messages :: Map Timestamp [Either ByteString OSC]
   , NRTState -> [BufferId]
nrtState_bufferIds :: [BufferId]
   , NRTState -> [NodeId]
nrtState_nodeIds :: [NodeId]
   , NRTState -> [SyncId]
nrtState_syncIds :: [SyncId]
   }

type NRT = StateT NRTState IO

callMessage :: Either ByteString OSC -> NRT ()
callMessage :: Either ByteString OSC -> NRT ()
callMessage Either ByteString OSC
msg = do
   Timestamp
now <- StateT NRTState IO Timestamp
forall (m :: * -> *). VividAction m => m Timestamp
getTime
   -- Writing it this way so that we can be crystal-clear that it's going on
   --   the end of the list (future: use dlist for efficiency):
   (NRTState -> NRTState) -> NRT ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((NRTState -> NRTState) -> NRT ())
-> (NRTState -> NRTState) -> NRT ()
forall a b. (a -> b) -> a -> b
$ \NRTState
ns -> NRTState
ns {
        nrtState_messages :: Map Timestamp [Either ByteString OSC]
nrtState_messages =
           case Timestamp
-> Map Timestamp [Either ByteString OSC]
-> Maybe [Either ByteString OSC]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Timestamp
now (Map Timestamp [Either ByteString OSC]
 -> Maybe [Either ByteString OSC])
-> Map Timestamp [Either ByteString OSC]
-> Maybe [Either ByteString OSC]
forall a b. (a -> b) -> a -> b
$ NRTState -> Map Timestamp [Either ByteString OSC]
nrtState_messages NRTState
ns of
              Maybe [Either ByteString OSC]
Nothing ->   Timestamp
-> [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Timestamp
now [Either ByteString OSC
msg]           (Map Timestamp [Either ByteString OSC]
 -> Map Timestamp [Either ByteString OSC])
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
forall a b. (a -> b) -> a -> b
$ NRTState -> Map Timestamp [Either ByteString OSC]
nrtState_messages NRTState
ns
              Just [Either ByteString OSC]
msgs -> Timestamp
-> [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Timestamp
now ([Either ByteString OSC]
msgs [Either ByteString OSC]
-> [Either ByteString OSC] -> [Either ByteString OSC]
forall a. [a] -> [a] -> [a]
++ [Either ByteString OSC
msg]) (Map Timestamp [Either ByteString OSC]
 -> Map Timestamp [Either ByteString OSC])
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
forall a b. (a -> b) -> a -> b
$ NRTState -> Map Timestamp [Either ByteString OSC]
nrtState_messages NRTState
ns
      }

instance VividAction NRT where
   callOSC :: OSC -> NRT ()
   callOSC :: OSC -> NRT ()
callOSC = Either ByteString OSC -> NRT ()
callMessage (Either ByteString OSC -> NRT ())
-> (OSC -> Either ByteString OSC) -> OSC -> NRT ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OSC -> Either ByteString OSC
forall a b. b -> Either a b
Right

   callBS :: ByteString -> NRT ()
   callBS :: ByteString -> NRT ()
callBS = Either ByteString OSC -> NRT ()
callMessage (Either ByteString OSC -> NRT ())
-> (ByteString -> Either ByteString OSC) -> ByteString -> NRT ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ByteString OSC
forall a b. a -> Either a b
Left

   sync :: NRT ()
   sync :: NRT ()
sync = () -> NRT ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   waitForSync :: SyncId -> NRT ()
   waitForSync :: SyncId -> NRT ()
waitForSync SyncId
_ = () -> NRT ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

   wait :: Real n => n -> NRT ()
   wait :: n -> NRT ()
wait n
t = (NRTState -> NRTState) -> NRT ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((NRTState -> NRTState) -> NRT ())
-> (NRTState -> NRTState) -> NRT ()
forall a b. (a -> b) -> a -> b
$ \NRTState
ns ->
      let newT :: Timestamp
newT = NRTState -> Timestamp
nrtState_now NRTState
ns Timestamp -> Double -> Timestamp
`addSecs` n -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac n
t
      in NRTState
ns {
            nrtState_now :: Timestamp
nrtState_now = Timestamp
newT
          , nrtState_maxTime :: Maximum Timestamp
nrtState_maxTime = Timestamp -> Maximum Timestamp
forall a. a -> Maximum a
Maximum Timestamp
newT Maximum Timestamp -> Maximum Timestamp -> Maximum Timestamp
forall a. Ord a => a -> a -> a
`max` (NRTState -> Maximum Timestamp
nrtState_maxTime NRTState
ns)
          }

   getTime :: NRT Timestamp
   getTime :: StateT NRTState IO Timestamp
getTime = NRTState -> Timestamp
nrtState_now (NRTState -> Timestamp)
-> StateT NRTState IO NRTState -> StateT NRTState IO Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT NRTState IO NRTState
forall s (m :: * -> *). MonadState s m => m s
get

   newBufferId :: NRT BufferId
   newBufferId :: NRT BufferId
newBufferId = (NRTState -> (BufferId, NRTState)) -> NRT BufferId
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((NRTState -> (BufferId, NRTState)) -> NRT BufferId)
-> (NRTState -> (BufferId, NRTState)) -> NRT BufferId
forall a b. (a -> b) -> a -> b
$ \NRTState
ns ->
      let (BufferId
x:[BufferId]
xs) = NRTState -> [BufferId]
nrtState_bufferIds NRTState
ns
      in (BufferId
x, NRTState
ns { nrtState_bufferIds :: [BufferId]
nrtState_bufferIds = [BufferId]
xs})

   newNodeId :: NRT NodeId
   newNodeId :: NRT NodeId
newNodeId = (NRTState -> (NodeId, NRTState)) -> NRT NodeId
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((NRTState -> (NodeId, NRTState)) -> NRT NodeId)
-> (NRTState -> (NodeId, NRTState)) -> NRT NodeId
forall a b. (a -> b) -> a -> b
$ \NRTState
ns ->
      let (NodeId
x:[NodeId]
xs) = NRTState -> [NodeId]
nrtState_nodeIds NRTState
ns
      in (NodeId
x, NRTState
ns { nrtState_nodeIds :: [NodeId]
nrtState_nodeIds = [NodeId]
xs})

   newSyncId :: NRT SyncId
   newSyncId :: NRT SyncId
newSyncId =  (NRTState -> (SyncId, NRTState)) -> NRT SyncId
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((NRTState -> (SyncId, NRTState)) -> NRT SyncId)
-> (NRTState -> (SyncId, NRTState)) -> NRT SyncId
forall a b. (a -> b) -> a -> b
$ \NRTState
ns ->
      let (SyncId
x:[SyncId]
xs) = NRTState -> [SyncId]
nrtState_syncIds NRTState
ns
      in (SyncId
x, NRTState
ns { nrtState_syncIds :: [SyncId]
nrtState_syncIds = [SyncId]
xs})

   fork :: NRT () -> NRT ()
   fork :: NRT () -> NRT ()
fork NRT ()
action = do
      NRTState{nrtState_now :: NRTState -> Timestamp
nrtState_now=Timestamp
timeOfFork, nrtState_maxTime :: NRTState -> Maximum Timestamp
nrtState_maxTime = Maximum Timestamp
oldMaxTime} <- StateT NRTState IO NRTState
forall s (m :: * -> *). MonadState s m => m s
get
      NRT ()
action
      (NRTState -> NRTState) -> NRT ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((NRTState -> NRTState) -> NRT ())
-> (NRTState -> NRTState) -> NRT ()
forall a b. (a -> b) -> a -> b
$ \NRTState
ns -> NRTState
ns {
           nrtState_now :: Timestamp
nrtState_now = Timestamp
timeOfFork
           -- this 'max' probably isn't necessary:
         , nrtState_maxTime :: Maximum Timestamp
nrtState_maxTime = (NRTState -> Maximum Timestamp
nrtState_maxTime NRTState
ns) Maximum Timestamp -> Maximum Timestamp -> Maximum Timestamp
forall a. Ord a => a -> a -> a
`max` Maximum Timestamp
oldMaxTime :: Maximum Timestamp
         }

   defineSD :: SynthDef a -> NRT ()
   defineSD :: SynthDef a -> NRT ()
defineSD SynthDef a
synthDef = do
      (NRTState -> NRTState) -> NRT ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((NRTState -> NRTState) -> NRT ())
-> (NRTState -> NRTState) -> NRT ()
forall a b. (a -> b) -> a -> b
$ \NRTState
ns -> NRTState
ns {
           nrtState_messages :: Map Timestamp [Either ByteString OSC]
nrtState_messages =
              let cmd :: [Either a OSC]
cmd = [
                     OSC -> Either a OSC
forall a b. b -> Either a b
Right (OSC -> Either a OSC) -> OSC -> Either a OSC
forall a b. (a -> b) -> a -> b
$ [LiteralSynthDef] -> Maybe OSC -> OSC
SCCmd.d_recv [SynthDef a -> LiteralSynthDef
forall (a :: [Symbol]). SynthDef a -> LiteralSynthDef
sdToLiteral SynthDef a
synthDef] Maybe OSC
forall a. Maybe a
Nothing
                   ]
              in ([Either ByteString OSC]
 -> [Either ByteString OSC] -> [Either ByteString OSC])
-> Timestamp
-> [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [Either ByteString OSC]
-> [Either ByteString OSC] -> [Either ByteString OSC]
forall a. Ord a => [a] -> [a] -> [a]
mappendIfNeeded (Double -> Timestamp
Timestamp Double
0) [Either ByteString OSC]
forall a. [Either a OSC]
cmd (NRTState -> Map Timestamp [Either ByteString OSC]
nrtState_messages NRTState
ns)
         }
    where
      mappendIfNeeded :: (Ord a) {- , Monoid m)-} => [a] -> [a] -> [a]
      mappendIfNeeded :: [a] -> [a] -> [a]
mappendIfNeeded [a]
maybeSubset [a]
maybeSuperset =
         if [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
maybeSubset Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
maybeSuperset
            then [a]
maybeSuperset
            else [a]
maybeSubset [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
maybeSuperset

-- This way we can be positive that it's going to the end of the list:
_addAtTime :: Timestamp -> Either ByteString OSC -> Map Timestamp [Either ByteString OSC] -> Map Timestamp [Either ByteString OSC]
_addAtTime :: Timestamp
-> Either ByteString OSC
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
_addAtTime Timestamp
t Either ByteString OSC
msg Map Timestamp [Either ByteString OSC]
m =
   -- Separating lookup and insert is just being extra careful that the message
   --   goes on the end:
   --   (Why do you want that? - Well, one example is if you read a buffer in
   --   at time 0 and then immediately play it. You want to read it *before*
   --   you play it :) )
   Timestamp
-> [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Timestamp
t [Either ByteString OSC]
v Map Timestamp [Either ByteString OSC]
m
 where
   v :: [Either ByteString OSC]
   v :: [Either ByteString OSC]
v = case Timestamp
-> Map Timestamp [Either ByteString OSC]
-> Maybe [Either ByteString OSC]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Timestamp
t Map Timestamp [Either ByteString OSC]
m of
      Maybe [Either ByteString OSC]
Nothing -> [Either ByteString OSC
msg]
      Just [Either ByteString OSC]
l -> [Either ByteString OSC]
l [Either ByteString OSC]
-> [Either ByteString OSC] -> [Either ByteString OSC]
forall a. [a] -> [a] -> [a]
++ [Either ByteString OSC
msg] -- Could use a dlist here to snoc


runNRT :: NRT a -> IO [OSCBundle]
runNRT :: NRT a -> IO [OSCBundle]
runNRT NRT a
action = do
   NRTState
result <- NRT a -> NRTState -> IO NRTState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT NRT a
action NRTState
startingNRTState

   let Maximum Timestamp
maxTSeen = NRTState -> Maximum Timestamp
nrtState_maxTime NRTState
result
       protoBundles_woLast :: Map Timestamp [Either ByteString OSC]
       protoBundles_woLast :: Map Timestamp [Either ByteString OSC]
protoBundles_woLast = NRTState -> Map Timestamp [Either ByteString OSC]
nrtState_messages NRTState
result
       protoBundles :: Map Timestamp [Either ByteString OSC]
protoBundles = ([Either ByteString OSC]
 -> [Either ByteString OSC] -> [Either ByteString OSC])
-> Timestamp
-> [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
-> Map Timestamp [Either ByteString OSC]
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [Either ByteString OSC]
-> [Either ByteString OSC] -> [Either ByteString OSC]
forall a. Semigroup a => a -> a -> a
(<>) Timestamp
maxTSeen [] Map Timestamp [Either ByteString OSC]
protoBundles_woLast

   [OSCBundle] -> IO [OSCBundle]
forall (m :: * -> *) a. Monad m => a -> m a
return [ Timestamp -> [Either ByteString OSC] -> OSCBundle
OSCBundle Timestamp
t [Either ByteString OSC]
as | (Timestamp
t, [Either ByteString OSC]
as) <- Map Timestamp [Either ByteString OSC]
-> [(Timestamp, [Either ByteString OSC])]
forall k a. Map k a -> [(k, a)]
Map.toAscList Map Timestamp [Either ByteString OSC]
protoBundles ]

startingNRTState :: NRTState
startingNRTState :: NRTState
startingNRTState = NRTState :: Timestamp
-> Maximum Timestamp
-> Map Timestamp [Either ByteString OSC]
-> [BufferId]
-> [NodeId]
-> [SyncId]
-> NRTState
NRTState {
     nrtState_now :: Timestamp
nrtState_now = Double -> Timestamp
Timestamp Double
0
   , nrtState_maxTime :: Maximum Timestamp
nrtState_maxTime = Timestamp -> Maximum Timestamp
forall a. a -> Maximum a
Maximum (Double -> Timestamp
Timestamp Double
0)
   , nrtState_messages :: Map Timestamp [Either ByteString OSC]
nrtState_messages = Map Timestamp [Either ByteString OSC]
forall k a. Map k a
Map.empty
   , nrtState_bufferIds :: [BufferId]
nrtState_bufferIds = (Int32 -> BufferId) -> [Int32] -> [BufferId]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> BufferId
BufferId [Int32
0..]
   , nrtState_nodeIds :: [NodeId]
nrtState_nodeIds = (Int32 -> NodeId) -> [Int32] -> [NodeId]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> NodeId
NodeId [Int32
2..] -- TODO: make sure this is good
   , nrtState_syncIds :: [SyncId]
nrtState_syncIds = (Int32 -> SyncId) -> [Int32] -> [SyncId]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> SyncId
SyncId [Int32
0..]
   }

encodeNRTScore :: NRT x -> IO ByteString
encodeNRTScore :: NRT x -> IO ByteString
encodeNRTScore NRT x
action =
   [OSCBundle] -> ByteString
encodeOSCBundles ([OSCBundle] -> ByteString) -> IO [OSCBundle] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NRT x -> IO [OSCBundle]
forall a. NRT a -> IO [OSCBundle]
runNRT NRT x
action

-- | Generate a file of actions that SC can use to do NRT with.
-- 
--   __If you just want the .aiff file, you probably want 'writeNRT' instead.__
-- 
--   Usage: this will create a file at "/tmp/NRTout.aiff" with your @sound :: NRT a@:
-- 
--   > writeNRT "/tmp/foo.osc" test
--   > scsynth -N /tmp/foo.osc _ /tmp/NRTout.aiff 44100 AIFF int16
writeNRTScore :: FilePath -> NRT a -> IO ()
writeNRTScore :: FilePath -> NRT a -> IO ()
writeNRTScore FilePath
path NRT a
action =
   FilePath -> ByteString -> IO ()
BS.writeFile FilePath
path (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NRT a -> IO ByteString
forall x. NRT x -> IO ByteString
encodeNRTScore NRT a
action


-- | Generate an audio file from an NRT action -- this can write songs far faster
--   than it would take to play them.
-- 
--   This uses 'defaultNRTArgs' for its sample rate, number of channels, etc.
--   If you want to use args other than the default, use 'writeNRTWith'.
-- 
--   The file type is detected from its extension.
--   The extensions supported at the moment are .aif, .aiff, and .wav
-- 
--   (macOS users will need to make sure 'scsynth' is in their $PATH)
-- 
--   (And I apologize, but I really don't know what Windows users will need to do)
-- 
--   Currently doesn't work with single quotes in the filename
writeNRT :: FilePath -> NRT a -> IO ()
writeNRT :: FilePath -> NRT a -> IO ()
writeNRT = NRTArgs -> FilePath -> NRT a -> IO ()
forall a. NRTArgs -> FilePath -> NRT a -> IO ()
writeNRTWith NRTArgs
defaultNRTArgs

writeNRTWith ::  NRTArgs -> FilePath -> NRT a -> IO ()
writeNRTWith :: NRTArgs -> FilePath -> NRT a -> IO ()
writeNRTWith NRTArgs
nrtArgs FilePath
fPath NRT a
nrtActions = do
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
'\'' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
fPath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Didnt have time to implement filepaths with single quotes"
   ByteString
contents <- [OSCBundle] -> ByteString
encodeOSCBundles ([OSCBundle] -> ByteString) -> IO [OSCBundle] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NRT a -> IO [OSCBundle]
forall a. NRT a -> IO [OSCBundle]
runNRT NRT a
nrtActions

   --  ${SHELL}
   -- Does this work on Windows?:
   FilePath -> IO ExitCode
system FilePath
"/bin/sh -c 'which scsynth > /dev/null'" IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ExitCode
ExitSuccess -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ExitFailure Int
_ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"No 'scsynth' found! Be sure to put it in your $PATH"
   let
       !fileType :: FilePath
fileType =
          case FilePath -> Map FilePath FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeExtension FilePath
fPath) Map FilePath FilePath
extensionMap of
             Just FilePath
x -> FilePath
x
             Maybe FilePath
Nothing -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
                FilePath
"The only file extensions we currently understand are: "
                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show (Map FilePath FilePath -> [FilePath]
forall k a. Map k a -> [k]
Map.keys Map FilePath FilePath
extensionMap)
       extensionMap :: Map FilePath FilePath
extensionMap = [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
            (FilePath
".aif", FilePath
"AIFF")
          , (FilePath
".aiff", FilePath
"AIFF")
          , (FilePath
".wav", FilePath
"WAV")
          , (FilePath
".flac", FilePath
"FLAC")
          , (FilePath
".raw", FilePath
"raw")
            -- todo: these formats seem not to work.
            -- Try it on more-recent versions of SC:
          -- , (".ogg", "VORBIS")
          ]

   FilePath
tempDir <- FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO FilePath
getTemporaryDirectory
   FilePath
tempFile <- IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO FilePath)
-> IO FilePath
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (FilePath -> FilePath -> IO (FilePath, Handle)
openBinaryTempFile FilePath
tempDir FilePath
"vivid_nrt_.osc")
      (\(FilePath
_, Handle
tempFileHandle) ->
         Handle -> IO ()
hClose Handle
tempFileHandle)
      (\(FilePath
tempFile, Handle
tempFileHandle) -> do
         Handle -> ByteString -> IO ()
BS.hPut Handle
tempFileHandle (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString
contents
         FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
tempFile)

   ExitCode
ExitSuccess <- FilePath -> IO ExitCode
system (FilePath -> IO ExitCode) -> FilePath -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat [
        --  ${SHELL}
        FilePath
"/bin/sh -c "
      , FilePath
" \"" -- Note these beginning and ending quotes
      , FilePath
" scsynth"
      , FilePath
" -o ", Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ NRTArgs -> Int
_nrtArgs_numChans NRTArgs
nrtArgs
      , FilePath
" -N "
      , FilePath
tempFile
      , FilePath
" _ '", FilePath
fPath, FilePath
"' "
      , Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ NRTArgs -> Int
_nrtArgs_sampleRate NRTArgs
nrtArgs,FilePath
" ", FilePath
fileType, FilePath
" int16 "
      , FilePath
" \""
      ]

   -- TODO: I'm a little skittish about turning this on:
   -- removeFile tempFile

   () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


data NRTArgs
   = NRTArgs {
    NRTArgs -> Int
_nrtArgs_sampleRate :: Int
   ,NRTArgs -> Int
_nrtArgs_numChans :: Int
   }
 deriving (Int -> NRTArgs -> FilePath -> FilePath
[NRTArgs] -> FilePath -> FilePath
NRTArgs -> FilePath
(Int -> NRTArgs -> FilePath -> FilePath)
-> (NRTArgs -> FilePath)
-> ([NRTArgs] -> FilePath -> FilePath)
-> Show NRTArgs
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [NRTArgs] -> FilePath -> FilePath
$cshowList :: [NRTArgs] -> FilePath -> FilePath
show :: NRTArgs -> FilePath
$cshow :: NRTArgs -> FilePath
showsPrec :: Int -> NRTArgs -> FilePath -> FilePath
$cshowsPrec :: Int -> NRTArgs -> FilePath -> FilePath
Show, ReadPrec [NRTArgs]
ReadPrec NRTArgs
Int -> ReadS NRTArgs
ReadS [NRTArgs]
(Int -> ReadS NRTArgs)
-> ReadS [NRTArgs]
-> ReadPrec NRTArgs
-> ReadPrec [NRTArgs]
-> Read NRTArgs
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NRTArgs]
$creadListPrec :: ReadPrec [NRTArgs]
readPrec :: ReadPrec NRTArgs
$creadPrec :: ReadPrec NRTArgs
readList :: ReadS [NRTArgs]
$creadList :: ReadS [NRTArgs]
readsPrec :: Int -> ReadS NRTArgs
$creadsPrec :: Int -> ReadS NRTArgs
Read, NRTArgs -> NRTArgs -> Bool
(NRTArgs -> NRTArgs -> Bool)
-> (NRTArgs -> NRTArgs -> Bool) -> Eq NRTArgs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NRTArgs -> NRTArgs -> Bool
$c/= :: NRTArgs -> NRTArgs -> Bool
== :: NRTArgs -> NRTArgs -> Bool
$c== :: NRTArgs -> NRTArgs -> Bool
Eq, Eq NRTArgs
Eq NRTArgs
-> (NRTArgs -> NRTArgs -> Ordering)
-> (NRTArgs -> NRTArgs -> Bool)
-> (NRTArgs -> NRTArgs -> Bool)
-> (NRTArgs -> NRTArgs -> Bool)
-> (NRTArgs -> NRTArgs -> Bool)
-> (NRTArgs -> NRTArgs -> NRTArgs)
-> (NRTArgs -> NRTArgs -> NRTArgs)
-> Ord NRTArgs
NRTArgs -> NRTArgs -> Bool
NRTArgs -> NRTArgs -> Ordering
NRTArgs -> NRTArgs -> NRTArgs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NRTArgs -> NRTArgs -> NRTArgs
$cmin :: NRTArgs -> NRTArgs -> NRTArgs
max :: NRTArgs -> NRTArgs -> NRTArgs
$cmax :: NRTArgs -> NRTArgs -> NRTArgs
>= :: NRTArgs -> NRTArgs -> Bool
$c>= :: NRTArgs -> NRTArgs -> Bool
> :: NRTArgs -> NRTArgs -> Bool
$c> :: NRTArgs -> NRTArgs -> Bool
<= :: NRTArgs -> NRTArgs -> Bool
$c<= :: NRTArgs -> NRTArgs -> Bool
< :: NRTArgs -> NRTArgs -> Bool
$c< :: NRTArgs -> NRTArgs -> Bool
compare :: NRTArgs -> NRTArgs -> Ordering
$ccompare :: NRTArgs -> NRTArgs -> Ordering
$cp1Ord :: Eq NRTArgs
Ord)

defaultNRTArgs :: NRTArgs
defaultNRTArgs :: NRTArgs
defaultNRTArgs = NRTArgs :: Int -> Int -> NRTArgs
NRTArgs {
    _nrtArgs_sampleRate :: Int
_nrtArgs_sampleRate = Int
48000
   ,_nrtArgs_numChans :: Int
_nrtArgs_numChans = Int
2
   }

-- Given an explicit type and tag so we don't accidentally  get the wrong element out of the tuple anywhere:
newtype Maximum a = Maximum a

instance (Eq a, Ord a) => Ord (Maximum a) where
   compare :: Maximum a -> Maximum a -> Ordering
compare (Maximum a
a) (Maximum a
b) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b
   Maximum a
a <= :: Maximum a -> Maximum a -> Bool
<= Maximum a
b = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
b
   Maximum a
a < :: Maximum a -> Maximum a -> Bool
< Maximum a
b = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b
   Maximum a
a > :: Maximum a -> Maximum a -> Bool
> Maximum a
b = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
b
   Maximum a
a >= :: Maximum a -> Maximum a -> Bool
>= Maximum a
b = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
b
   max :: Maximum a -> Maximum a -> Maximum a
max (Maximum a
a) (Maximum a
b) = a -> Maximum a
forall a. a -> Maximum a
Maximum (a -> Maximum a) -> a -> Maximum a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
b
   min :: Maximum a -> Maximum a -> Maximum a
min (Maximum a
a) (Maximum a
b) = a -> Maximum a
forall a. a -> Maximum a
Maximum (a -> Maximum a) -> a -> Maximum a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
b

instance Eq a => Eq (Maximum a) where
   Maximum a
a == :: Maximum a -> Maximum a -> Bool
== Maximum a
b = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b