-- | 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
   , runNRT

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

import qualified Vivid.SC.Server.Commands as SCCmd

import Vivid.Actions.Class
import Vivid.Actions.IO () -- maybe not in the future
import Vivid.OSC
import Vivid.OSC.Bundles (encodeOSCBundles)
import Vivid.SCServer
-- import Vivid.SCServer.State
import Vivid.SynthDef (encodeSD, sdToLiteral)
import Vivid.SynthDef.Types

import Control.Applicative
-- import Control.Arrow (first, second)
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (get, modify, execStateT, StateT)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (writeFile, hPut)
import qualified Data.ByteString.UTF8 as UTF8
import Data.Char (toLower)
import Data.Hashable (hash)
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

-- We keep track of the maximum timestamp so that the generated audio file doesn't cut off before a final 'wait' finishes:
type NRT = StateT (Timestamp, Maximum Timestamp, Map Timestamp [Either ByteString OSC]) IO

instance VividAction NRT where
   callOSC :: OSC -> NRT ()
   callOSC message = do
      now <- getTime
      modify ((\f (a,b,c)->(a,b,f c)) (Map.insertWith (<>) now [Right message]))

   callBS :: ByteString -> NRT ()
   callBS message = do
      now <- getTime
      modify $ \(a,b,x) ->
         (a, b, Map.insertWith (<>) now [Left message] x)

   sync :: NRT ()
   sync = return ()

   waitForSync :: SyncId -> NRT ()
   waitForSync _ = return ()

   wait :: Real n => n -> NRT ()
   wait t = modify $ \(oldT, maxT, c) ->
      let newT = oldT `addSecs` realToFrac t
      in (newT, Maximum newT `max` maxT, c)

   getTime :: NRT Timestamp
   getTime = (\(t,_,_) -> t) <$> get

   newBufferId :: NRT BufferId
   newBufferId = liftIO newBufferId

   newNodeId :: NRT NodeId
   newNodeId = liftIO newNodeId

   newSyncId :: NRT SyncId
   newSyncId = liftIO newSyncId

   fork :: NRT () -> NRT ()
   fork action = do
      (timeOfFork, oldMaxTime, _) <- get
      action
      modify $ \(_timeAfterFork_ignore, newMaxTime, c) ->
           -- this 'max' probably isn't necessary:
         (timeOfFork, newMaxTime `max` oldMaxTime :: Maximum Timestamp, c)

   defineSD :: SynthDef a -> NRT ()
   defineSD synthDef = do
      modify . (\f (a,b,c)->(a,b,f c)) $ Map.insertWith mappendIfNeeded (Timestamp 0) [
           Right $ SCCmd.d_recv [sdToLiteral synthDef] Nothing
         ]
    where
      mappendIfNeeded :: (Ord a) {- , Monoid m)-} => [a] -> [a] -> [a]
      mappendIfNeeded maybeSubset maybeSuperset =
         if Set.fromList maybeSubset `Set.isSubsetOf` Set.fromList maybeSuperset
            then maybeSuperset
            else maybeSubset <> maybeSuperset

runNRT :: NRT a -> IO [OSCBundle]
runNRT action = do
   (_, Maximum maxTSeen, protoBundles_woLast)
      <- execStateT action (Timestamp 0, Maximum (Timestamp 0), Map.empty)
   let protoBundles = Map.insertWith (<>) maxTSeen [] protoBundles_woLast
   return [ OSCBundle t as | (t, as) <- Map.toAscList protoBundles ]


-- | 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 path action =
   (BS.writeFile path . encodeOSCBundles) =<< runNRT 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 = writeNRTWith defaultNRTArgs

writeNRTWith ::  NRTArgs -> FilePath -> NRT a -> IO ()
writeNRTWith nrtArgs fPath nrtActions = do
   when ('\'' `elem` fPath) $ error "Didnt have time to implement filepaths with single quotes"
   contents <- encodeOSCBundles <$> runNRT nrtActions

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

   tempDir <- canonicalizePath =<< getTemporaryDirectory
   tempFile <- bracket
      (openBinaryTempFile tempDir "vivid_nrt_.osc")
      (\(_, tempFileHandle) ->
         hClose tempFileHandle)
      (\(tempFile, tempFileHandle) -> do
         BS.hPut tempFileHandle $ contents
         pure tempFile)

   ExitSuccess <- system $ mconcat [
        --  ${SHELL}
        "/bin/sh -c "
      , " \"" -- Note these beginning and ending quotes
      , " scsynth"
      , " -o ", show $ _nrtArgs_numChans nrtArgs
      , " -N "
      , tempFile
      , " _ '", fPath, "' "
      , show $ _nrtArgs_sampleRate nrtArgs," ", fileType, " int16 "
      , " \""
      ]

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

   pure ()


data NRTArgs
   = NRTArgs {
    _nrtArgs_sampleRate :: Int
   ,_nrtArgs_numChans :: Int
   }
 deriving (Show, Read, Eq, Ord)

defaultNRTArgs :: NRTArgs
defaultNRTArgs = NRTArgs {
    _nrtArgs_sampleRate = 48000
   ,_nrtArgs_numChans = 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 b) = compare a b
   Maximum a <= Maximum b = a <= b
   Maximum a < Maximum b = a < b
   Maximum a > Maximum b = a > b
   Maximum a >= Maximum b = a >= b
   max (Maximum a) (Maximum b) = Maximum $ max a b
   min (Maximum a) (Maximum b) = Maximum $ min a b

instance Eq a => Eq (Maximum a) where
   Maximum a == Maximum b = a == b