-- Copyright 2021 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE DeriveFunctor #-}
module Synth.StreamAudioMain (main) where
import qualified Control.Concurrent.Async as Async
import qualified Data.List as List
import qualified Data.Set as Set
import qualified System.Console.GetOpt as GetOpt
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.IO as IO

import qualified Text.Read as Read

import qualified Util.Audio.PortAudio as PortAudio
import qualified Util.Lists as Lists
import qualified Util.Thread as Thread

import qualified Derive.ScoreT as ScoreT
import qualified Perform.RealTime as RealTime
import qualified Synth.StreamAudio as StreamAudio

import           Global


main :: IO ()
main :: IO ()
main = forall a. IO a -> IO a
PortAudio.initialize forall a b. (a -> b) -> a -> b
$ do
    ([Flag]
flags, (String
dir, (Set Instrument
muted, RealTime
start))) <- [String] -> IO ([Flag], (String, (Set Instrument, RealTime)))
parseArgs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
Environment.getArgs

    ([(String, Device)]
devs, String
defaultDev) <- IO ([(String, Device)], String)
StreamAudio.getDevices
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag
List forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags) forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Device)]
devs) forall a b. (a -> b) -> a -> b
$ \String
dev ->
            String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ (if String
dev forall a. Eq a => a -> a -> Bool
== String
defaultDev then String
"* " else String
"  ") forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
dev
        forall a. IO a
Exit.exitSuccess
    Maybe Device
mbDev <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO Device
getDevice forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
Lists.last [String
d | Device String
d <- [Flag]
flags]
    Flag
quit <- IO Flag
Thread.flag
    Async ()
_keyboard <- forall a. IO a -> IO (Async a)
Async.async forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
putStrLn String
"press return to quit"
        String
c <- IO String
IO.getLine
        String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
c forall a. Semigroup a => a -> a -> a
<> String
", asking streamer to stop"
        Flag -> IO ()
Thread.set Flag
quit
    Maybe Device
-> Flag -> Set Instrument -> RealTime -> String -> IO ()
StreamAudio.streamDir Maybe Device
mbDev Flag
quit Set Instrument
muted RealTime
start String
dir

getDevice :: String -> IO StreamAudio.Device
getDevice :: String -> IO Device
getDevice String
name = do
    ([(String, Device)]
devs, String
_) <- IO ([(String, Device)], String)
StreamAudio.getDevices
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"unknown device: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt String
name) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
==String
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, Device)]
devs

data Flag = List | Device String
    deriving (Flag -> Flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show)

options :: [GetOpt.OptDescr Flag]
options :: [OptDescr Flag]
options =
    [ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option [] [String
"list"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
List) String
"list output devices"
    , forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
GetOpt.Option [] [String
"device"] (forall a. (String -> a) -> String -> ArgDescr a
GetOpt.ReqArg String -> Flag
Device String
"dev")
        String
"use named device"
    ]

parseArgs :: [String]
    -> IO ([Flag], (String, (Set ScoreT.Instrument, RealTime.RealTime)))
parseArgs :: [String] -> IO ([Flag], (String, (Set Instrument, RealTime)))
parseArgs [String]
args = case forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
GetOpt.getOpt forall a. ArgOrder a
GetOpt.Permute [OptDescr Flag]
options [String]
args of
    ([Flag]
flags, [String]
args, [])
        | Flag
List forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Flag
List], (String
"", (forall a. Monoid a => a
mempty, RealTime
0)))
        | Bool
otherwise -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Flag]
flags,) forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {t :: * -> *} {b}. Foldable t => t String -> IO b
usage []) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case [String]
args of
            String
dir : [String]
args -> (String
dir,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case [String]
args of
                [] -> forall a. a -> Maybe a
Just (forall a. Monoid a => a
mempty, RealTime
0)
                [String
muted] -> forall a. a -> Maybe a
Just (String -> Set Instrument
parseMuted String
muted, RealTime
0)
                [String
muted, String
start] -> (String -> Set Instrument
parseMuted String
muted ,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> RealTime
RealTime.seconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    forall a. Read a => String -> Maybe a
Read.readMaybe String
start
                [String]
_ -> forall a. Maybe a
Nothing
            [String]
_ -> forall a. Maybe a
Nothing
    ([Flag]
_, [String]
_, [String]
errors) -> forall {t :: * -> *} {b}. Foldable t => t String -> IO b
usage [String]
errors
    where
    parseMuted :: String -> Set Instrument
parseMuted = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text -> Instrument
ScoreT.Instrument forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
txt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => NonNull a -> NonNull a -> NonNull (NonNull a)
Lists.split String
","
    usage :: t String -> IO b
usage t String
errors = do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn t String
errors
        String -> IO ()
putStrLn String
"usage: stream_audio im/cache/score/path/block/id\
            \ [ mute,mute start ]"
        String -> IO ()
putStr (forall a. String -> [OptDescr a] -> String
GetOpt.usageInfo String
"" [OptDescr Flag]
options)
        forall a. IO a
Exit.exitFailure