module Csound.Typed.Render(
    renderOut, renderOutBy,
    renderEff, renderEffBy,
    renderOut_, renderOutBy_,
    -- * Options
    module Csound.Typed.GlobalState.Options,
    module Csound.Dynamic.Types.Flags,
    saveUserOptions, getUserOptions
) where

import qualified Data.Map as M
import Data.Default
import Data.Maybe
import Data.Tuple
import Data.Ord
import Data.List(sortBy, groupBy)
import qualified Data.IntMap as IM
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class

import System.Directory
import System.FilePath
import Text.Read (readMaybe)

import Text.PrettyPrint.Leijen(displayS, renderPretty)

import Csound.Dynamic hiding (csdFlags)
import Csound.Typed.Types
import Csound.Typed.GlobalState
import Csound.Typed.GlobalState.Elements(NamedInstrs(..))
import Csound.Typed.GlobalState.Options
import Csound.Typed.Control.Instr
import Csound.Typed.Control(getIns)
import Csound.Dynamic.Types.Flags

import Csound.Typed.Gui.Gui(guiStmt, panelIsKeybdSensitive)
import Csound.Typed.Gui.Cabbage.CabbageLang(ppCabbage)


toCsd :: Tuple a => Maybe Int -> Options -> SE a -> GE Csd
toCsd :: Maybe Int -> Options -> SE a -> GE Csd
toCsd Maybe Int
mnchnls_i Options
options SE a
sigs = do
    Arity -> InsExp -> GE ()
saveMasterInstr (SE a -> Arity
forall a. Tuple a => SE a -> Arity
constArity SE a
sigs) (SE a -> InsExp
forall a. Tuple a => SE a -> InsExp
masterExp SE a
sigs)
    GE ()
saveMidiMap  -- save midi innstruments
    GE ()
handleMissingKeyPannel
    Maybe Int -> Int -> Options -> GE Csd
renderHistory Maybe Int
mnchnls_i (SE a -> Int
forall a. Tuple a => SE a -> Int
outArity SE a
sigs) Options
options

handleMissingKeyPannel :: GE ()
handleMissingKeyPannel :: GE ()
handleMissingKeyPannel = do
    Guis
st <- (History -> Guis) -> GE History -> GE Guis
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap History -> Guis
guis (GE History -> GE Guis) -> GE History -> GE Guis
forall a b. (a -> b) -> a -> b
$ GE History
getHistory
    if (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ IntMap Var -> Bool
forall a. IntMap a -> Bool
IM.null (IntMap Var -> Bool) -> IntMap Var -> Bool
forall a b. (a -> b) -> a -> b
$ Guis -> IntMap Var
guiKeyEvents Guis
st) Bool -> Bool -> Bool
&& ([Panel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Panel] -> Bool) -> [Panel] -> Bool
forall a b. (a -> b) -> a -> b
$ (Panel -> Bool) -> [Panel] -> [Panel]
forall a. (a -> Bool) -> [a] -> [a]
filter Panel -> Bool
panelIsKeybdSensitive ([Panel] -> [Panel]) -> [Panel] -> [Panel]
forall a b. (a -> b) -> a -> b
$ Guis -> [Panel]
guiStateRoots Guis
st)
        then do
            GE ()
saveDefKeybdPanel
        else do
            () -> GE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

renderOut_ :: SE () -> IO String
renderOut_ :: SE () -> IO String
renderOut_ = Options -> SE () -> IO String
renderOutBy_ Options
forall a. Default a => a
def

renderOutBy_ :: Options -> SE () -> IO String
renderOutBy_ :: Options -> SE () -> IO String
renderOutBy_ Options
options SE ()
sigs = do
    Options
finalOptions <- (Maybe Options -> Options) -> IO (Maybe Options) -> IO Options
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Options -> (Options -> Options) -> Maybe Options -> Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
options (Options
options Options -> Options -> Options
forall a. Monoid a => a -> a -> a
`mappend` )) IO (Maybe Options)
getUserOptions
    Options -> GE String -> IO String
forall a. Options -> GE a -> IO a
evalGE Options
finalOptions (GE String -> IO String) -> GE String -> IO String
forall a b. (a -> b) -> a -> b
$ (Csd -> String) -> GE Csd -> GE String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Csd -> String
renderCsd (GE Csd -> GE String) -> GE Csd -> GE String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Options -> SE Unit -> GE Csd
forall a. Tuple a => Maybe Int -> Options -> SE a -> GE Csd
toCsd Maybe Int
forall a. Maybe a
Nothing Options
finalOptions ((() -> Unit) -> SE () -> SE Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit -> () -> Unit
forall a b. a -> b -> a
const Unit
unit) SE ()
sigs)

renderOut :: Sigs a => SE a -> IO String
renderOut :: SE a -> IO String
renderOut = Options -> SE a -> IO String
forall a. Sigs a => Options -> SE a -> IO String
renderOutBy Options
forall a. Default a => a
def

renderOutBy :: Sigs a => Options -> SE a -> IO String
renderOutBy :: Options -> SE a -> IO String
renderOutBy Options
options SE a
sigs = do
    Options
finalOptions <- (Maybe Options -> Options) -> IO (Maybe Options) -> IO Options
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Options -> (Options -> Options) -> Maybe Options -> Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
options (Options
options Options -> Options -> Options
forall a. Monoid a => a -> a -> a
`mappend` )) IO (Maybe Options)
getUserOptions
    Options -> GE String -> IO String
forall a. Options -> GE a -> IO a
evalGE Options
finalOptions (GE String -> IO String) -> GE String -> IO String
forall a b. (a -> b) -> a -> b
$ (Csd -> String) -> GE Csd -> GE String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Csd -> String
renderCsd (GE Csd -> GE String) -> GE Csd -> GE String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Options -> SE a -> GE Csd
forall a. Tuple a => Maybe Int -> Options -> SE a -> GE Csd
toCsd Maybe Int
forall a. Maybe a
Nothing Options
finalOptions SE a
sigs

renderEff :: (Sigs a, Sigs b) => (a -> SE b) -> IO String
renderEff :: (a -> SE b) -> IO String
renderEff = Options -> (a -> SE b) -> IO String
forall a b. (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO String
renderEffBy Options
forall a. Default a => a
def

renderEffBy :: (Sigs a, Sigs b) => Options -> (a -> SE b) -> IO String
renderEffBy :: Options -> (a -> SE b) -> IO String
renderEffBy Options
options a -> SE b
eff = do
    Options
finalOptions <- (Maybe Options -> Options) -> IO (Maybe Options) -> IO Options
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Options -> (Options -> Options) -> Maybe Options -> Options
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Options
options (Options
options Options -> Options -> Options
forall a. Monoid a => a -> a -> a
`mappend` )) IO (Maybe Options)
getUserOptions
    Options -> GE String -> IO String
forall a. Options -> GE a -> IO a
evalGE Options
finalOptions (GE String -> IO String) -> GE String -> IO String
forall a b. (a -> b) -> a -> b
$ (Csd -> String) -> GE Csd -> GE String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Csd -> String
renderCsd (GE Csd -> GE String) -> GE Csd -> GE String
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Options -> SE b -> GE Csd
forall a. Tuple a => Maybe Int -> Options -> SE a -> GE Csd
toCsd (Int -> Maybe Int
forall a. a -> Maybe a
Just (Arity -> Int
arityIns (Arity -> Int) -> Arity -> Int
forall a b. (a -> b) -> a -> b
$ (a -> SE b) -> Arity
forall a b. (Tuple a, Tuple b) => (a -> SE b) -> Arity
funArity a -> SE b
eff)) Options
finalOptions (a -> SE b
eff (a -> SE b) -> SE a -> SE b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE a
forall a. Sigs a => SE a
getIns)

renderHistory :: Maybe Int -> Int -> Options -> GE Csd
renderHistory :: Maybe Int -> Int -> Options -> GE Csd
renderHistory Maybe Int
mnchnls_i Int
nchnls Options
opt = do
    Maybe Instr
keyEventListener <- GE (Maybe Instr)
getKeyEventListener
    History
hist1 <- GE History
getHistory
    DepT GE ()
udos <- (String -> DepT GE ()) -> GE String -> GE (DepT GE ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> DepT GE ()
forall (m :: * -> *). Monad m => String -> DepT m ()
verbatim (GE String -> GE (DepT GE ())) -> GE String -> GE (DepT GE ())
forall a b. (a -> b) -> a -> b
$ IO String -> GE String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> GE String) -> IO String -> GE String
forall a b. (a -> b) -> a -> b
$ History -> IO String
renderUdoPlugins History
hist1
    E
instr0 <- DepT GE () -> GE E
forall (m :: * -> *). (Functor m, Monad m) => DepT m () -> m E
execDepT (DepT GE () -> GE E) -> DepT GE () -> GE E
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int -> Options -> DepT GE () -> History -> DepT GE ()
getInstr0 Maybe Int
mnchnls_i Int
nchnls Options
opt DepT GE ()
udos History
hist1
    InstrId
terminatorInstrId <- SE () -> GE InstrId
saveInstr (SE () -> GE InstrId) -> GE (SE ()) -> GE InstrId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GE (SE ())
terminatorInstr
    DepT GE ()
expr2 <- InstrId -> GE (DepT GE ())
getSysExpr InstrId
terminatorInstrId
    InstrId -> GE ()
saveAlwaysOnInstr (InstrId -> GE ()) -> GE InstrId -> GE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE () -> GE InstrId
saveInstr (DepT GE () -> SE ()
forall a. Dep a -> SE a
SE DepT GE ()
expr2)
    DepT GE ()
expr3 <- GE (DepT GE ())
guiInstrExp
    InstrId -> GE ()
saveAlwaysOnInstr (InstrId -> GE ()) -> GE InstrId -> GE ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SE () -> GE InstrId
saveInstr (DepT GE () -> SE ()
forall a. Dep a -> SE a
SE DepT GE ()
expr3)
    History
hist2 <- GE History
getHistory
    let namedIntruments :: [Instr]
namedIntruments = ((String, E) -> Instr) -> [(String, E)] -> [Instr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
name, E
body) -> InstrId -> E -> Instr
Instr (String -> InstrId
InstrLabel String
name) E
body) ([(String, E)] -> [Instr]) -> [(String, E)] -> [Instr]
forall a b. (a -> b) -> a -> b
$ NamedInstrs -> [(String, E)]
unNamedInstrs (NamedInstrs -> [(String, E)]) -> NamedInstrs -> [(String, E)]
forall a b. (a -> b) -> a -> b
$ History -> NamedInstrs
namedInstrs History
hist2
    let orc :: Orc
orc = E -> [Instr] -> Orc
Orc E
instr0 (([Instr]
namedIntruments [Instr] -> [Instr] -> [Instr]
forall a. [a] -> [a] -> [a]
++ ) ([Instr] -> [Instr]) -> [Instr] -> [Instr]
forall a b. (a -> b) -> a -> b
$ Maybe Instr -> [Instr] -> [Instr]
forall a. Maybe a -> [a] -> [a]
maybeAppend Maybe Instr
keyEventListener ([Instr] -> [Instr]) -> [Instr] -> [Instr]
forall a b. (a -> b) -> a -> b
$ ((InstrId, E) -> Instr) -> [(InstrId, E)] -> [Instr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((InstrId -> E -> Instr) -> (InstrId, E) -> Instr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry InstrId -> E -> Instr
Instr) ([(InstrId, E)] -> [Instr]) -> [(InstrId, E)] -> [Instr]
forall a b. (a -> b) -> a -> b
$ Instrs -> [(InstrId, E)]
instrsContent (Instrs -> [(InstrId, E)]) -> Instrs -> [(InstrId, E)]
forall a b. (a -> b) -> a -> b
$ History -> Instrs
instrs History
hist2)
    History
hist3 <- GE History
getHistory
    let flags :: Flags
flags   = History -> Flags -> Flags
reactOnMidi History
hist3 (Flags -> Flags) -> Flags -> Flags
forall a b. (a -> b) -> a -> b
$ Options -> Flags
csdFlags Options
opt
        sco :: Sco
sco     = Maybe Double -> [(Int, Gen)] -> [(InstrId, [CsdEvent])] -> Sco
Sco (Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Maybe TotalDur -> Double
pureGetTotalDurForF0 (Maybe TotalDur -> Double) -> Maybe TotalDur -> Double
forall a b. (a -> b) -> a -> b
$ History -> Maybe TotalDur
totalDur History
hist3)
                      (IdMap Gen -> [(Int, Gen)] -> [(Int, Gen)]
forall a. IdMap a -> [(Int, a)] -> [(Int, a)]
renderGens (History -> IdMap Gen
genMap History
hist3) (History -> [(Int, Gen)]
writeGenMap History
hist3)) ([(InstrId, [CsdEvent])] -> Sco) -> [(InstrId, [CsdEvent])] -> Sco
forall a b. (a -> b) -> a -> b
$
                      (((InstrId -> (InstrId, [CsdEvent]))
-> [InstrId] -> [(InstrId, [CsdEvent])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InstrId -> (InstrId, [CsdEvent])
alwaysOn ([InstrId] -> [(InstrId, [CsdEvent])])
-> [InstrId] -> [(InstrId, [CsdEvent])]
forall a b. (a -> b) -> a -> b
$ History -> [InstrId]
alwaysOnInstrs History
hist3) [(InstrId, [CsdEvent])]
-> [(InstrId, [CsdEvent])] -> [(InstrId, [CsdEvent])]
forall a. [a] -> [a] -> [a]
++ ([(InstrId, CsdEvent)] -> [(InstrId, [CsdEvent])]
forall a a. [(a, a)] -> [(a, [a])]
getNoteEvents ([(InstrId, CsdEvent)] -> [(InstrId, [CsdEvent])])
-> [(InstrId, CsdEvent)] -> [(InstrId, [CsdEvent])]
forall a b. (a -> b) -> a -> b
$ History -> [(InstrId, CsdEvent)]
notes History
hist3))
    let plugins :: [Plugin]
plugins = History -> [Plugin]
getPlugins History
hist3
    Csd -> GE Csd
forall (m :: * -> *) a. Monad m => a -> m a
return (Csd -> GE Csd) -> Csd -> GE Csd
forall a b. (a -> b) -> a -> b
$ Flags -> Orc -> Sco -> [Plugin] -> Csd
Csd Flags
flags Orc
orc Sco
sco [Plugin]
plugins
    where
        renderGens :: IdMap a -> [(Int, a)] -> [(Int, a)]
renderGens IdMap a
gens [(Int, a)]
writeGens = (((a, Int) -> (Int, a)) -> [(a, Int)] -> [(Int, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Int) -> (Int, a)
forall a b. (a, b) -> (b, a)
swap ([(a, Int)] -> [(Int, a)]) -> [(a, Int)] -> [(Int, a)]
forall a b. (a -> b) -> a -> b
$ Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map a Int -> [(a, Int)]) -> Map a Int -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ IdMap a -> Map a Int
forall a. IdMap a -> Map a Int
idMapContent  IdMap a
gens) [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
++ [(Int, a)]
writeGens
        maybeAppend :: Maybe a -> [a] -> [a]
maybeAppend Maybe a
ma = ([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id (:) Maybe a
ma
        getNoteEvents :: [(a, a)] -> [(a, [a])]
getNoteEvents = ((a, a) -> (a, [a])) -> [(a, a)] -> [(a, [a])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, a) -> (a, [a])) -> [(a, a)] -> [(a, [a])])
-> ((a, a) -> (a, [a])) -> [(a, a)] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ \(a
instrId, a
evt) -> (a
instrId, [a
evt])

        getPlugins :: History -> [Plugin]
getPlugins History
hist = case History -> Maybe Lang
cabbageGui History
hist of
                Maybe Lang
Nothing -> []
                Just Lang
x  -> [(String -> String -> Plugin
Plugin String
"Cabbage" (SimpleDoc -> ShowS
displayS (Float -> Int -> Doc -> SimpleDoc
renderPretty Float
1 Int
10000 (Doc -> SimpleDoc) -> Doc -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ Lang -> Doc
ppCabbage Lang
x) String
""))]

getInstr0 :: Maybe Int -> Int -> Options -> Dep () -> History -> Dep ()
getInstr0 :: Maybe Int -> Int -> Options -> DepT GE () -> History -> DepT GE ()
getInstr0 Maybe Int
mnchnls_i Int
nchnls Options
opt DepT GE ()
udos History
hist = do
    DepT GE ()
macroses
    (Double, Double)
defaultScaleUI <- (Options -> (Double, Double))
-> DepT GE Options -> DepT GE (Double, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Options -> (Double, Double)
defScaleUI (DepT GE Options -> DepT GE (Double, Double))
-> DepT GE Options -> DepT GE (Double, Double)
forall a b. (a -> b) -> a -> b
$ GE Options -> DepT GE Options
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GE Options
getOptions
    DepT GE ()
globalConstants
    DepT GE ()
midiAssigns
    DepT GE ()
midiInitCtrls
    DepT GE ()
initGlobals
    IdMap Gen -> BandLimitedMap -> DepT GE ()
forall (m :: * -> *).
Monad m =>
IdMap Gen -> BandLimitedMap -> DepT m ()
renderBandLimited (History -> IdMap Gen
genMap History
hist) (History -> BandLimitedMap
bandLimitedMap History
hist)
    History -> DepT GE ()
userInstr0 History
hist
    DepT GE ()
forall (m :: * -> *). Monad m => DepT m ()
chnUpdateUdo
    DepT GE ()
udos
    DepT GE ()
sf2
    DepT GE ()
jackos
    (Double, Double) -> [Panel] -> DepT GE ()
forall (m :: * -> *).
Monad m =>
(Double, Double) -> [Panel] -> DepT m ()
guiStmt (Double, Double)
defaultScaleUI ([Panel] -> DepT GE ()) -> [Panel] -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ History -> [Panel]
getPanels History
hist
    where
        globalConstants :: DepT GE ()
globalConstants = do
            Int -> DepT GE ()
forall (m :: * -> *). Monad m => Int -> DepT m ()
setSr       (Int -> DepT GE ()) -> Int -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ Options -> Int
defSampleRate Options
opt
            Int -> DepT GE ()
forall (m :: * -> *). Monad m => Int -> DepT m ()
setKsmps    (Int -> DepT GE ()) -> Int -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ Options -> Int
defBlockSize Options
opt
            Int -> DepT GE ()
forall (m :: * -> *). Monad m => Int -> DepT m ()
setNchnls   (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
nchnls)
            Double -> DepT GE ()
forall (m :: * -> *). Monad m => Double -> DepT m ()
setZeroDbfs Double
1
            DepT GE () -> (Int -> DepT GE ()) -> Maybe Int -> DepT GE ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> DepT GE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Int -> DepT GE ()
forall (m :: * -> *). Monad m => Int -> DepT m ()
setNchnls_i Maybe Int
mnchnls_i

        midiAssigns :: DepT GE ()
midiAssigns   = (MidiAssign -> DepT GE ()) -> [MidiAssign] -> DepT GE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MidiAssign -> DepT GE ()
forall (m :: * -> *). Monad m => MidiAssign -> DepT m ()
renderMidiAssign ([MidiAssign] -> DepT GE ()) -> [MidiAssign] -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ History -> [MidiAssign]
midis History
hist
        midiInitCtrls :: DepT GE ()
midiInitCtrls = (MidiCtrl -> DepT GE ()) -> [MidiCtrl] -> DepT GE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MidiCtrl -> DepT GE ()
forall (m :: * -> *). Monad m => MidiCtrl -> DepT m ()
renderMidiCtrl   ([MidiCtrl] -> DepT GE ()) -> [MidiCtrl] -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ History -> [MidiCtrl]
midiCtrls History
hist

        initGlobals :: DepT GE ()
initGlobals = (DepT GE (), DepT GE ()) -> DepT GE ()
forall a b. (a, b) -> a
fst ((DepT GE (), DepT GE ()) -> DepT GE ())
-> (DepT GE (), DepT GE ()) -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ Globals -> (DepT GE (), DepT GE ())
forall (m :: * -> *). Monad m => Globals -> (DepT m (), DepT m ())
renderGlobals (Globals -> (DepT GE (), DepT GE ()))
-> Globals -> (DepT GE (), DepT GE ())
forall a b. (a -> b) -> a -> b
$ History -> Globals
globals (History -> Globals) -> History -> Globals
forall a b. (a -> b) -> a -> b
$ History
hist

        sf2 :: DepT GE ()
sf2 = ((String, [(Int, Int, Int)]) -> DepT GE ())
-> [(String, [(Int, Int, Int)])] -> DepT GE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> [(Int, Int, Int)] -> DepT GE ())
-> (String, [(Int, Int, Int)]) -> DepT GE ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> [(Int, Int, Int)] -> DepT GE ()
forall (m :: * -> *).
Monad m =>
String -> [(Int, Int, Int)] -> DepT m ()
sfSetList) ([(String, [(Int, Int, Int)])] -> DepT GE ())
-> [(String, [(Int, Int, Int)])] -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ [(SfSpec, Int)] -> [(String, [(Int, Int, Int)])]
forall c. [(SfSpec, c)] -> [(String, [(Int, Int, c)])]
sfGroup ([(SfSpec, Int)] -> [(String, [(Int, Int, Int)])])
-> [(SfSpec, Int)] -> [(String, [(Int, Int, Int)])]
forall a b. (a -> b) -> a -> b
$ History -> [(SfSpec, Int)]
sfTable History
hist
        sfGroup :: [(SfSpec, c)] -> [(String, [(Int, Int, c)])]
sfGroup = ([(SfSpec, c)] -> (String, [(Int, Int, c)]))
-> [[(SfSpec, c)]] -> [(String, [(Int, Int, c)])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(SfSpec, c)] -> (String, [(Int, Int, c)])
forall c. [(SfSpec, c)] -> (String, [(Int, Int, c)])
phi ([[(SfSpec, c)]] -> [(String, [(Int, Int, c)])])
-> ([(SfSpec, c)] -> [[(SfSpec, c)]])
-> [(SfSpec, c)]
-> [(String, [(Int, Int, c)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SfSpec, c) -> (SfSpec, c) -> Bool)
-> [(SfSpec, c)] -> [[(SfSpec, c)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(SfSpec, c)
a (SfSpec, c)
b -> (SfSpec, c) -> String
forall b. (SfSpec, b) -> String
getName (SfSpec, c)
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (SfSpec, c) -> String
forall b. (SfSpec, b) -> String
getName (SfSpec, c)
b) ([(SfSpec, c)] -> [[(SfSpec, c)]])
-> ([(SfSpec, c)] -> [(SfSpec, c)])
-> [(SfSpec, c)]
-> [[(SfSpec, c)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SfSpec, c) -> (SfSpec, c) -> Ordering)
-> [(SfSpec, c)] -> [(SfSpec, c)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((SfSpec, c) -> String) -> (SfSpec, c) -> (SfSpec, c) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (SfSpec, c) -> String
forall b. (SfSpec, b) -> String
getName)
            where
                getName :: (SfSpec, b) -> String
getName = SfSpec -> String
sfName (SfSpec -> String)
-> ((SfSpec, b) -> SfSpec) -> (SfSpec, b) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SfSpec, b) -> SfSpec
forall a b. (a, b) -> a
fst
                phi :: [(SfSpec, c)] -> (String, [(Int, Int, c)])
phi [(SfSpec, c)]
as = ((SfSpec, c) -> String
forall b. (SfSpec, b) -> String
getName ((SfSpec, c) -> String) -> (SfSpec, c) -> String
forall a b. (a -> b) -> a -> b
$ [(SfSpec, c)] -> (SfSpec, c)
forall a. [a] -> a
head [(SfSpec, c)]
as, ((SfSpec, c) -> (Int, Int, c)) -> [(SfSpec, c)] -> [(Int, Int, c)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(SfSpec
sf, c
index) -> (SfSpec -> Int
sfBank SfSpec
sf, SfSpec -> Int
sfProgram SfSpec
sf, c
index)) [(SfSpec, c)]
as)

        macroses :: DepT GE ()
macroses = [MacrosInit] -> (MacrosInit -> DepT GE ()) -> DepT GE ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (((String, MacrosInit) -> MacrosInit)
-> [(String, MacrosInit)] -> [MacrosInit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, MacrosInit) -> MacrosInit
forall a b. (a, b) -> b
snd ([(String, MacrosInit)] -> [MacrosInit])
-> [(String, MacrosInit)] -> [MacrosInit]
forall a b. (a -> b) -> a -> b
$ Map String MacrosInit -> [(String, MacrosInit)]
forall k a. Map k a -> [(k, a)]
M.toList (Map String MacrosInit -> [(String, MacrosInit)])
-> Map String MacrosInit -> [(String, MacrosInit)]
forall a b. (a -> b) -> a -> b
$ History -> Map String MacrosInit
macrosInits History
hist) ((MacrosInit -> DepT GE ()) -> DepT GE ())
-> (MacrosInit -> DepT GE ()) -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ \MacrosInit
x -> case MacrosInit
x of
            MacrosInitDouble String
name Double
value -> String -> Double -> DepT GE ()
forall (m :: * -> *). Monad m => String -> Double -> DepT m ()
initMacrosDouble String
name Double
value
            MacrosInitString String
name String
value -> String -> String -> DepT GE ()
forall (m :: * -> *). Monad m => String -> String -> DepT m ()
initMacrosString String
name String
value
            MacrosInitInt    String
name Int
value -> String -> Int -> DepT GE ()
forall (m :: * -> *). Monad m => String -> Int -> DepT m ()
initMacrosInt    String
name Int
value

        jackos :: DepT GE ()
jackos = DepT GE () -> (Jacko -> DepT GE ()) -> Maybe Jacko -> DepT GE ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> DepT GE ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (String -> DepT GE ()
forall (m :: * -> *). Monad m => String -> DepT m ()
verbatim (String -> DepT GE ()) -> (Jacko -> String) -> Jacko -> DepT GE ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Jacko -> String
renderJacko) (Maybe Jacko -> DepT GE ()) -> Maybe Jacko -> DepT GE ()
forall a b. (a -> b) -> a -> b
$ Options -> Maybe Jacko
csdJacko Options
opt


reactOnMidi :: History -> Flags -> Flags
reactOnMidi :: History -> Flags -> Flags
reactOnMidi History
h Flags
flags
    | History -> Bool
midiIsActive History
h Bool -> Bool -> Bool
&& Flags -> Bool
midiDeviceIsEmpty Flags
flags = Flags -> Flags
setMidiDevice Flags
flags
    | Bool
otherwise                                 = Flags
flags
    where
        midiIsActive :: History -> Bool
midiIsActive = Bool -> Bool
not (Bool -> Bool) -> (History -> Bool) -> History -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MidiAssign] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([MidiAssign] -> Bool)
-> (History -> [MidiAssign]) -> History -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> [MidiAssign]
midis
        midiDeviceIsEmpty :: Flags -> Bool
midiDeviceIsEmpty = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> (Flags -> Maybe String) -> Flags -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MidiRT -> Maybe String
midiDevice (MidiRT -> Maybe String)
-> (Flags -> MidiRT) -> Flags -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> MidiRT
midiRT
        setMidiDevice :: Flags -> Flags
setMidiDevice Flags
x = Flags
x { midiRT :: MidiRT
midiRT = (Flags -> MidiRT
midiRT Flags
x) { midiDevice :: Maybe String
midiDevice = String -> Maybe String
forall a. a -> Maybe a
Just String
"a" } }

getUserOptions :: IO (Maybe Options)
getUserOptions :: IO (Maybe Options)
getUserOptions = do
    Maybe Options
mHome <- IO String -> IO (Maybe Options)
forall a. Read a => IO String -> IO (Maybe a)
getAt IO String
getHomeDirectory
    Maybe Options
mCur  <- IO String -> IO (Maybe Options)
forall a. Read a => IO String -> IO (Maybe a)
getAt IO String
getCurrentDirectory
    Maybe Options -> IO (Maybe Options)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Options -> IO (Maybe Options))
-> Maybe Options -> IO (Maybe Options)
forall a b. (a -> b) -> a -> b
$ case (Maybe Options
mHome, Maybe Options
mCur) of
        (Maybe Options
_, Just Options
opt) -> Options -> Maybe Options
forall a. a -> Maybe a
Just Options
opt
        (Just Options
opt, Maybe Options
Nothing) -> Options -> Maybe Options
forall a. a -> Maybe a
Just Options
opt
        (Maybe Options
Nothing, Maybe Options
Nothing) -> Maybe Options
forall a. Maybe a
Nothing
    where
        getAt :: IO String -> IO (Maybe a)
getAt IO String
getPath = do
            String
fileName <- ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
rcFileAt IO String
getPath
            Bool
isExist <- String -> IO Bool
doesFileExist String
fileName
            if Bool
isExist
                then do
                    String
fileContent <- String -> IO String
readFile String
fileName
                    Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
fileContent
                else do
                    Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

rcFileAt :: FilePath -> String
rcFileAt :: ShowS
rcFileAt String
dir = String
dir String -> ShowS
</> String
".csound-expression-rc"

-- | Saves the user options in the current directory.
--
-- If it's saved in the User's home directory it becomes
-- global options.
saveUserOptions :: Options -> IO ()
saveUserOptions :: Options -> IO ()
saveUserOptions Options
opts = do
    String
fileName <- ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
rcFileAt IO String
getCurrentDirectory
    String -> String -> IO ()
writeFile String
fileName (Options -> String
forall a. Show a => a -> String
show Options
opts)