-- | Actions. 'Vivid.Actions.Class.VividAction' has 3 instances:
-- 
--   - "Vivid.Actions.IO" : happens right here, right now
--   - "Vivid.Actions.Scheduled" : happens at some point in the (maybe near) future.
--        The timing is precise, unlike IO
--   - "Vivid.Actions.NRT" : non-realtime. Writes to an audio file

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

{-# LANGUAGE NoIncoherentInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE NoUndecidableInstances #-}

-- For 'MonoOrPoly':
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}

module Vivid.Actions (
     synth
   , synthG
   , synthNamed
   , synthNamedG
   , newSynthBefore
   , synthBefore
   , newSynthAfter
   , synthAfter
   , newSynthAtHead
   , synthHead
   , synthOn
   , newSynthAtTail
   , synthTail

   , newGroup
   , newGroupBefore
   , newGroupAfter
   , newGroupAtHead
   , newGroupAtTail
   , newParGroup
   , newParGroupBefore
   , newParGroupAfter
   , newParGroupAtHead
   , newParGroupAtTail

   , set
   , play
   , free
   , freeSynth
   , release
   , releaseIn
   , freeBuf
   , quitSCServer
   , module Vivid.Actions.Class
   -- , module Vivid.Actions.IO
   , module Vivid.Actions.NRT
   , module Vivid.Actions.Scheduled

   , makeSynth
   ) where

import Vivid.OSC
import qualified Vivid.SC.Server.Commands as SCCmd
import Vivid.SC.Server.Types
import Vivid.SC.SynthDef.Types (CalculationRate(..))
import Vivid.SC.Server.Types

import Vivid.Actions.Class
import Vivid.Actions.IO ()
import Vivid.Actions.NRT
import Vivid.Actions.Scheduled
import Vivid.SCServer.Connection (closeSCServerConnection)
import Vivid.SCServer (defaultGroup)
import Vivid.SCServer.Types
import Vivid.SynthDef (getSDHashName, sd {- , SDBody -}) -- SynthDef(..), SDBody, Signal)
-- import Vivid.SynthDef.Types (SDName(..))
import Vivid.SynthDef.TypesafeArgs

import Control.Arrow (first) -- , second)
import qualified Data.ByteString.UTF8 as UTF8
import Data.ByteString (ByteString)
import Data.Int
import Data.Monoid

-- for "play":
import qualified Data.Map as Map
-- import Data.Map (Map)

-- for "play":
import Vivid.SynthDef (makeSynthDef)
-- import Vivid.SynthDef.FromUA (NoDefaults(..))
import Vivid.SynthDef.Types
import Vivid.UGens.InOut (out)

-- todo: this segfaults if you have a kr output i think:
-- e.g.:
   -- let foo = kOut_mono 100 =<< (phasor (end_ 999) ? KR)
   -- play $ foo
   -- it has the same output as sclang:
   -- putStrLn $ sdLitPretty $ sdToLiteral $ sd () $ foo >> out 0 []
   -- same as:
   -- synthdefcatcher: SynthDef(\a, {Out.kr(100, Phasor.kr(end: 999))}).send(~hsServ)
-- | Given a UGen graph, just start playing it right away.
-- 
--   e.g.
-- 
--   > play $ do
--   >    s <- 0.2 ~* lpf (in_ whiteNoise, freq_ 440)
--   >    out 0 [s, s]
-- 
--   The "out" is optional, too -- so you can write
-- 
--   > play $ 0.2 ~* lpf (in_ whiteNoise, freq_ 440)
-- 
--   and an "out" will be added, in stereo
play :: (VividAction m, MonoOrPoly s) => SDBody' '[] s -> m (Synth '[])
play monoOrPolyVersion = do
   let polyVersion = getPoly monoOrPolyVersion
   let sdUGens :: [(UGenName, CalculationRate)]
       sdUGens =
          map (\x -> (_ugenName x, _ugenCalculationRate x)) $
             Map.elems $ _sdUGens $ makeSynthDef SDName_Hash () polyVersion
       -- Note this doesn't check that it's the last one that's
       --   the "Out":
   let sdWithOut = sd () $
          if any (==(UGName_S "Out", AR)) sdUGens
             then polyVersion
             else do
                foo <- polyVersion
                out (0::Int) $ foo
   -- TODO: maybe 'defineSD'/'sync' first?:
   -- Or maybe that's the job of 'synth' so do it there
   synth sdWithOut ()

class MonoOrPoly s where
   getPoly :: SDBody' a s -> SDBody' a [Signal]

instance MonoOrPoly [Signal] where
   getPoly :: SDBody' a [Signal] -> SDBody' a [Signal]
   getPoly = id

instance MonoOrPoly Signal where
   getPoly :: SDBody' a Signal -> SDBody' a [Signal]
   -- getPoly s = (:[]) <$> s
   -- should this be stereo? a lot of uses call for something else
   getPoly s = do
      s' <- s
      return [s', s']

-- | 'G'radually-typed version of 'freeSynth' or 'free'. Note that this
--   allows you to attempt to free a NodeId of a Group as if it were a
--   synth. Be careful!
freeG :: (VividAction m, SynthOrNodeId n) => n -> m ()
freeG (getNodeId -> nodeId) =
   callOSC $ SCCmd.n_free nodeId

free, freeSynth :: VividAction m => Synth a -> m ()
-- | Shorter name for 'freeSynth'
free = freeSynth
-- | Immediately stop a synth playing
-- 
--   This can create a \"clipping\" artifact if the sound goes from a high
--   amplitude to 0 in an instant -- you can avoid that with e.g.
--   'Vivid.UGens.lag' or with an envelope (especially 'envGate')
freeSynth = freeG

-- | Assuming your \"gate\" argument is on an EnvGen or similar, will release the synth
--   over the EnvGen-specified fade time
-- 
--   If you'd like to specify a fade time in the moment, check out 'releaseIn'
release :: (Elem "gate" args, VividAction m) => Synth args -> m ()
release s = set s (0 ::I "gate")

-- | Assumes your \"gate\" is on an EnvGen or related
-- 
--   Specify a fade time and release
releaseIn :: (Elem "gate" args, VividAction m, Real n) => n -> Synth args -> m ()
releaseIn releaseSecs s =
     -- 'abs' but give positive values yo!:
   set s (toI $ negate $ 1 + abs releaseSecs ::I "gate")

-- | Set the given parameters of a running synth
-- 
--   e.g.
-- 
--   >>> let setTest = sd (0.05 ::I "pan") $ out 0 =<< pan2 (in_ $ 0.1 ~* whiteNoise, pos_ (A::A "pan"))
--   >>> s <- synth setTest ()
--   >>> set s (-0.05 ::I "pan")
-- 
--   Any parameters not referred to will be unaffected, and any you specify that don't exist
--   will be (silently) ignored
set :: (VividAction m, Subset (InnerVars params) sdArgs, VarList params) => Synth sdArgs -> params -> m ()
set (Synth nodeId) params = do
   let (as, _) = makeTypedVarList params
   callOSC $ SCCmd.n_set nodeId (map (\(k,v)->(k, Right v)) as)

-- | Create a real live music-playing synth from a boring, dead SynthDef.
-- 
--   If you haven't defined the SynthDef on the server, this will do it automatically
--   (Note that this may cause jitters in musical timing)
-- 
--   Given...
-- 
--   >>> let foo = sd () $ out 0 [0.1 ~* whiteNoise]
-- 
--   ...you can create a synth with...
-- 
--   >>> synth foo ()
-- 
--   Careful!: The SC server doesn't keep track of your nodes for you,
--   so if you do something like...
-- 
--   >>> s <- synth someSynth ()
--   >>> s <- synth oops ()           -- 's' is overwritten
-- 
--   ...you've got no way to refer to the first synth you've created, and if you
--   want to stop it you have to 'cmdPeriod'
-- 
--   (If you want to interop with SC's language (or other SC clients),
--   use 'sdNamed' and 'synthNamed')
synth :: (VividAction m, VarList params, Subset (InnerVars params) args) => SynthDef args -> params -> m (Synth args)
synth theSD params = do
   Synth <$> synthG theSD params

-- | Make a synth, \"G\"radually typed -- doesn't check that _ is a subset of _
--   Useful e.g. if you want to send a bunch of args, some of which may be discarded
-- 
--   (Personally I'd recommend not using this function)
-- 
--   >>>  let s = undefined :: SynthDef '["ok"]
--   >>>  synth s (4::I "ok", 5::I "throwaway")
--   >>>     <interactive>:
--   >>>         Could not deduce (Elem "ignore" '[]) arising from a use of ‘synth’
--   >>>  synthG s (4::I "ok", 5::I "throwaway")
--   >>>   (works)
synthG :: (VividAction m, VarList params) => SynthDef a -> params -> m NodeId
synthG theSD params = do
   defineSD theSD -- 'defineSD' only defines it if it hasn't been yet

   makeSynth (synthName theSD) params SCCmd.AddToHead defaultGroup

synthName :: SynthDef a -> ByteString
synthName theSD = case theSD of
        SynthDef (SDName_Named n) _ _ -> n
        SynthDef SDName_Hash _ _ -> getSDHashName theSD

synthNamed :: (VividAction m, VarList params) => String -> params -> m (Synth a)
synthNamed name params = Synth <$>
   makeSynth (UTF8.fromString name) params SCCmd.AddToHead defaultGroup

synthNamedG :: (VividAction m, VarList params) => String -> params -> m NodeId
synthNamedG name params =
   makeSynth (UTF8.fromString name) params SCCmd.AddToHead defaultGroup

makeSynth :: (VividAction m, VarList params, IsNode node) => ByteString -> params -> SCCmd.AddAction -> node -> m NodeId
makeSynth theSynthName params addAction (getNodeId -> targetNodeId) = do
   nodeId <- newNodeId
   callOSC $ SCCmd.s_new theSynthName nodeId addAction targetNodeId (map (\(k,v)->(k,Right v)) paramList)
   pure nodeId
 where
   paramList :: [(ByteString, Float)]
   paramList =
      [ (UTF8.fromString k, v) | (k, v) <- (fst $ makeTypedVarList params) ]


-- Can dedupe all these!:

-- TODO: instead of e.g. 'synthBefore', 'parGroupBefore' etc, can just do 'parGroup AddBefore'

-- | Create a synth at the head of the target group (see \"Order of Execution\")
newSynthAtHead
  , synthHead
  , synthOn
  , newSynthAtTail
  , synthTail
  :: (VividAction m, VarList params, Subset (InnerVars params) args, IsGroup group)
  => group -> SynthDef args -> params -> m (Synth args)
newSynthAtHead targetNode theSD params = do
   defineSD theSD
   Synth <$> makeSynth (synthName theSD) params SCCmd.AddToHead targetNode
-- | Alias for 'newSynthAtHead'
synthHead = newSynthAtHead
-- | Alias for 'newSynthAtHead'
synthOn = newSynthAtHead
-- | Create a synth at the tail of the target group (see \"Order of Execution\")
newSynthAtTail targetNode theSD params = do
   defineSD theSD
   Synth <$> makeSynth (synthName theSD) params SCCmd.AddToTail targetNode
-- | Alias for 'newSynthAtTail'
synthTail = newSynthAtTail

-- | Create a synth just before the target node (see \"Order of Execution\")
newSynthBefore
  , synthBefore
  , newSynthAfter
  , synthAfter
  :: (VividAction m, VarList params, Subset (InnerVars params) args, IsNode node)
  => node -> SynthDef args -> params -> m (Synth args)
newSynthBefore targetNode theSD params = do
   defineSD theSD
   Synth <$> makeSynth (synthName theSD) params SCCmd.AddBefore targetNode
-- | Alias for 'newSynthBefore'
synthBefore = newSynthBefore
-- | Create a synth just after the target node (see \"Order of Execution\")
newSynthAfter targetNode theSD params = do
   defineSD theSD
   Synth <$> makeSynth (synthName theSD) params SCCmd.AddAfter targetNode
-- | Alias for 'newSynthAfter'
synthAfter = newSynthAfter

-- | Stop the SuperCollider server
quitSCServer :: IO ()
quitSCServer = do
   callOSC $ SCCmd.quit
   closeSCServerConnection

-- | Synchronous
freeBuf :: VividAction m => BufferId -> m ()
freeBuf bufId = oscWSync $ \syncId ->
   callOSC $ SCCmd.b_free bufId (Just $ SCCmd.sync syncId)

newGroup :: VividAction m => m Group
newGroup = newGroupAtHead defaultGroup

newParGroup :: VividAction m => m ParGroup
newParGroup = newParGroupAtHead defaultGroup

newGroupBefore, newGroupAfter :: (IsNode node, VividAction m) => node -> m Group
newGroupBefore = makeGroup SCCmd.AddBefore
newGroupAfter = makeGroup SCCmd.AddAfter

newGroupAtHead, newGroupAtTail :: (IsGroup group, VividAction m) => group -> m Group
newGroupAtHead = makeGroup SCCmd.AddToHead
newGroupAtTail = makeGroup SCCmd.AddToTail

newParGroupBefore, newParGroupAfter :: (IsNode node, VividAction m) => node -> m ParGroup
newParGroupBefore = makeParGroup SCCmd.AddBefore
newParGroupAfter = makeParGroup SCCmd.AddAfter

newParGroupAtHead, newParGroupAtTail :: (IsGroup group, VividAction m) => group -> m ParGroup
newParGroupAtHead = makeParGroup SCCmd.AddToHead
newParGroupAtTail = makeParGroup SCCmd.AddToTail

makeGroup :: (IsNode target, VividAction m) => SCCmd.AddAction -> target -> m Group
makeGroup = makeSomeKindaGroup SCCmd.g_new Group

makeParGroup :: (IsNode target, VividAction m) => SCCmd.AddAction -> target -> m ParGroup
makeParGroup = makeSomeKindaGroup SCCmd.p_new ParGroup

type GroupCmd = NodeId -> SCCmd.AddAction -> NodeId -> OSC

makeSomeKindaGroup :: (IsNode target, VividAction m) => (GroupCmd) -> (NodeId -> group) -> SCCmd.AddAction -> target -> m group
makeSomeKindaGroup createCommand constructor addAction (getNodeId -> targetNode) = do
   nodeId <- newNodeId
   callOSC $ createCommand nodeId addAction targetNode
   sync
   pure $ constructor nodeId