{-# LANGUAGE RecordWildCards #-}

import Foreign.C.Types (CFloat(..))
import qualified Sound.JACK as Jack
import qualified Sound.JACK.Audio as Audio

import Options.Applicative

import Data.Maybe

import System.Directory
import System.FilePath
import System.Posix.Files
import System.Posix.IO
import System.Environment
import System.Process

import Control.Concurrent
import Control.Concurrent.MVar

import qualified Control.Monad.Trans.Class as Trans
import qualified Control.Monad.Exception.Synchronous as Sync

import Control.Exception
import System.IO.Error

import System.INotify

import Data.Char

data Options = Options
               { input :: String
               , output :: String
               , client :: String
               , run :: Maybe String
               , initialLevel :: Float
               , stateDir :: FilePath
               }

optionParser :: Parser Options
optionParser = Options <$>
               (fromMaybe "in" <$> optional (strOption ( long "input"
                                                         <> metavar "STRING"
                                                       )
                                            )
               )
               <*> (fromMaybe "out" <$> optional (strOption ( long "output"
                                                              <> metavar "STRING"
                                                            )
                                                 )
                   )
               <*> strOption ( long "client"
                               <> metavar "STRING"
                             )
               <*> optional ( strOption ( long "run"
                                          <> metavar "FILE"
                                        )
                            )
               <*> (fromMaybe 0 <$> optional (option auto ( long "level"
                                                            <> metavar "FLOAT"
                                                          )
                                             )
                   )
               <*> strOption ( long "dir"
                               <> metavar "DIRECTORY"
                             )

main :: IO ()
main = execParser opts >>= trivmix
  where
    opts = info (helper <*> optionParser)
           ( fullDesc
             <> progDesc "Setup a JACK mixing input/output pair controlled by fifos in a state directory"
             <> header "Trivmix - A trivial mixer"
           )

trivmix :: Options -> IO ()
trivmix Options{..} = onDirectory stateDir $ do
  level <- newMVar initialLevel
  let levelFile = stateDir </> "level"
  onLevelFile levelFile initialLevel $ withINotify $ \n -> do
    addWatch n [Modify] levelFile (const $ handleLevel level levelFile)
    Jack.handleExceptions $
      Jack.withClientDefault client $ \client' ->
      Jack.withPort client' input $ \input' ->
      Jack.withPort client' output $ \output' -> do
        Trans.lift $ do
          case run of
            Nothing -> return ()
            Just run' -> do
              (_, _, _, ph) <- createProcess $ (proc run' [client ++ ":" ++ input, client ++ ":" ++ output]) { delegate_ctlc = True }
              return ()
        Audio.withProcessMono client' input' (mix level) output' $
          Jack.withActivation client' $ Trans.lift Jack.waitForBreak

onDirectory :: FilePath -> IO () -> IO ()
onDirectory stateDir io = do
  exists <- doesDirectoryExist stateDir
  createDirectoryIfMissing True stateDir
  finally io $ if exists then removeDirectory stateDir else return ()
  
mix :: MVar Float -> CFloat -> IO CFloat
mix level input = do
  level' <- readMVar level
  return $ (CFloat level') * input

onLevelFile :: FilePath -> Float -> IO a -> IO a
onLevelFile file initial action = do
  exists <- doesFileExist file
  let acquire = case exists of
        True -> return ()
        False -> createFile file mode >>= closeFd >> writeFile file (show initial ++ "\n")
      mode = foldl unionFileModes nullFileMode [ ownerReadMode
                                               , ownerWriteMode
                                               , groupReadMode
                                               , groupWriteMode
                                               ]
      release = case exists of
        True -> return ()
        False -> removeFile file
  bracket_ acquire release action

handleLevel :: MVar Float -> FilePath -> IO ()
handleLevel level file = catch action handler
  where
    action = readFile file >>= readIO . stripSpace >>= swapMVar level >>= const (return ())
    handler e = if isUserError e
                then readMVar level >>= \l -> writeFile file (show l ++ "\n")
                else throw e
    stripSpace = reverse . stripSpace' . reverse . stripSpace'
    stripSpace' [] = []
    stripSpace' l@(x:xs) = if isSpace x
                          then stripSpace' xs
                          else l