-- |
-- Module      :  DobutokO.Sound.Executable
-- Copyright   :  (c) OleksandrZhabenko 2020
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- A program and a library to create experimental music
-- from a mono audio and a Ukrainian text.

{-# OPTIONS_GHC -threaded #-}

module DobutokO.Sound.Executable (
  -- * Basic functions for the executable
  dobutokO2
  , recAndProcess
) where

import CaseBi (getBFst')
import Numeric (showFFloat)
import Control.Exception (onException)
import System.Environment (getArgs)
import Data.List (isPrefixOf)
import Data.Maybe (fromJust)
import Data.Char (isDigit)
import System.Process
import EndOfExe (showE)
import qualified Data.Vector as V (fromList)
import System.Directory
import SoXBasics
import Processing_mmsyn7ukr
import DobutokO.Sound hiding (dobutokO2, recAndProcess)

-- | Function that actually makes processing in the @dobutokO2@ executable. Please, check before executing
-- whether there is no \"x.wav\", \"test*\", \"result*\" and \"end.wav\" files in the current directory, because they can be overwritten.
dobutokO2 :: IO ()
dobutokO2 = do
  arggs <- getArgs
  let arg1 = concat . take 1 $ arggs
      file = concat . drop 1 . take 2 $ arggs
      args = unwords . drop 2 $ arggs
  exist2 <- doesFileExist file
  getBFst' (dobutokO2H exist2 args file, V.fromList . fmap (\(xs, f) -> (xs,f exist2 args file)) $ [("0",o2help),("1",dobutokO2H1),("2",dobutokO2H2),
    ("3",dobutokO2H3),("4",dobutokO2H4),("5",dobutokO2H5)]) arg1

dobutokO2H1 :: Bool -> String -> FilePath -> IO ()
dobutokO2H1 exist2 args file = do
  [_,_,octave,ampLS,time2] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5] else [1..5])
  let octave1 = read octave::Int
      ampL = read ampLS::Double
      time3 = read time2::Double
  oberSoXSynthNGen file octave1 ampL time3 args
{-# INLINE dobutokO2H1 #-}

dobutokO2H2 :: Bool -> String -> FilePath -> IO ()
dobutokO2H2 exist2 args file = do
  [_,_,octave,ampLS,time2,wws] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6] else [1..6])
  let octave1 = read octave::Int
      ampL = read ampLS::Double
      time3 = read time2::Double
  uniqOberSoXSynthNGen file octave1 ampL time3 args wws
{-# INLINE dobutokO2H2 #-}

dobutokO2H3 :: Bool -> String -> FilePath -> IO ()
dobutokO2H3 exist2 args file = do
  [_,_,octave,ampLS,time2,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7] else [1,2,3,4,5,7])
  let octave1 = read octave::Int
      ampL = read ampLS::Double
      time3 = read time2::Double
  oberSoXSynthNGen2 file octave1 ampL time3 args tts
{-# INLINE dobutokO2H3 #-}

dobutokO2H4 :: Bool -> String -> FilePath -> IO ()
dobutokO2H4 exist2 args file = do
  [_,_,octave,ampLS,time2,wws,tts] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7] else [1..7])
  let octave1 = read octave::Int
      ampL = read ampLS::Double
      time3 = read time2::Double
  uniqOberSoXSynthNGen3 file octave1 ampL time3 args wws tts
{-# INLINE dobutokO2H4 #-}

dobutokO2H5 :: Bool -> String -> FilePath -> IO ()
dobutokO2H5 exist2 args file = do
  [_,_,octave,ampLS,time2,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,7,8,9] else [1,2,3,4,5,7,8,9])
  let octave1 = read octave::Int
      ampL = read ampLS::Double
      time3 = read time2::Double
      dAmpl = read dAmpl0::Double
  oberSoXSynthNGen3 file octave1 ampL time3 dAmpl args tts vs
{-# INLINE dobutokO2H5 #-}

dobutokO2H :: Bool -> String -> FilePath -> IO ()
dobutokO2H exist2 args file = do
  [_,_,octave,ampLS,time2,wws,tts,dAmpl0,vs] <- mapM (recAndProcess file) (if exist2 then [0,2,3,4,5,6,7,8,9] else [1..9])
  let octave1 = read octave::Int
      ampL = read ampLS::Double
      time3 = read time2::Double
      dAmpl = read dAmpl0::Double
  uniqOberSoXSynthNGen4 file octave1 ampL time3 dAmpl args wws tts vs
{-# INLINE dobutokO2H #-}

-- | Takes textual input from the stdin and prints it as one 'String' to the stdout.
o2help :: Bool -> String -> FilePath -> IO ()
o2help _ _ _ = do
  xs <- getContents
  let ys = unwords . lines $ xs in do
    putStrLn ""
    putStrLn "-------------------------------------------------------------------------------------------------------------"
    putStrLn ys

----------------------------------------------------------------------------------------------------------------------------------------------------

-- | Function records and processes the sound data needed to generate the \"end.wav\" file in the 'dobutokO2' function. Please, check before executing
-- whether there is no \"x.wav\" file in the current directory, because it can be overwritten.
recAndProcess :: FilePath -> Int -> IO String
recAndProcess file x =
  getBFst' (processD, V.fromList [(0,processD0 file),(1,processD1),(2,processD2 file),(3,processD3),(4,processD4),(5,processD5),(7,processD7),
    (8,processD8),(9,processD9)]) x

processD0 :: FilePath -> IO String
processD0 file = onException (readProcessWithExitCode (fromJust (showE "sox")) [file, "x.wav", "-r22050", "channels", "1"] "" >> putStrLn "" >> return "") (do
  exist <- doesFileExist "x.wav"
  if exist then removeFile "x.wav"
  else putStr ""
  putStrLn ""
  putStr "The process was not successful may be because of the not valid data OR SoX cannot convert the given file to the .wav format. "
  putStrLn "Interrupt the program and start again with the valid file. "
  putStrLn "_______________________________________________________________________"
  processD0 file)
{-# INLINE processD0 #-}

processD1 :: IO String
processD1 = onException (do
  tempeRa 0
  putStrLn "Please, specify, how many seconds long sound data you would like to record."
  time <- getLine
  let time0 = read (filter (\t -> isDigit t || t == '.') $ time)::Double
  putStrLn "Please, wait for 0.5 second and produce the needed sound now."
  recA "x.wav" time0
  putStrLn ""
  return "") (do
    dir0 <- listDirectory "."
    let paths5 = filter (isPrefixOf "nx.") dir0
    mapM_ removeFile paths5
    putStrLn ""
    putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
    putStrLn "_______________________________________________________________________"
    processD1)
{-# INLINE processD1 #-}

processD2 :: FilePath -> IO String
processD2 file = onException (do
  exist3 <- doesFileExist file
  if exist3 then return ""
  else do
    putStr "Please, specify the control parameter for the SoX \"noisered\" effect in the range from 0.0 to 1.0. "
    putStrLn "The greater value causes more reduction with possibly removing some important sound data. The default value is 0.5 "
    putStrLn "To use the default value, you can simply press Enter."
    ctrlN <- getLine
    let addit = dropWhile (/= '.') . filter (\t -> isDigit t || t == '.') $ ctrlN
        noiseP = if null ctrlN then ""
                 else tail addit
    controlNoiseReduction $ '0':noiseP
    norm "_x.wav"
    if isPrefixOf "nx." file
      then putStr ""
      else renameFile "8_x.wav" file
    removeFile "x.wav"
    removeFile "_x.wav"
    dir <- listDirectory "."
    let paths4 = filter (isPrefixOf "nx.") dir
    mapM_ removeFile paths4
    putStrLn ""
    return "") (do
      putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
      putStrLn "_______________________________________________________________________"
      processD2 file)
{-# INLINE processD2 #-}

processD3 :: IO String
processD3 = onException (do
  putStr "Please, specify the octave number, to which you would like all the main components (not taking into account their respective lower pure quints) "
  putStrLn "should belong. The number should be better in the range [1..8]"
  octave0 <- getLine
  let octave = (read (take 1 octave0)::Int) `rem` 9
  return $ show octave ) (do
    putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
    putStrLn "_______________________________________________________________________"
    processD3)
{-# INLINE processD3 #-}

processD4 :: IO String
processD4 = onException (do
  putStr "Please, specify the amplitude for the generated obertones as an Int number in the range [0..99]. "
  putStrLn "The default one is 99"
  putStrLn "To use the default value, you can simply press Enter."
  amplOb0 <- getLine
  if null amplOb0 then return "1.0"
  else let amplOb = (read (take 2 . filter isDigit $ amplOb0)::Int) `rem` 100 in
    case amplOb of
      99 -> return "1.0"
      _ -> if compare (amplOb `quot` 9) 1 == LT then return $ "0.0" ++ show (amplOb + 1)
           else return $ "0." ++ show (amplOb + 1)) (do
             putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
             putStrLn "_______________________________________________________________________"
             processD4)
{-# INLINE processD4 #-}

processD5 :: IO String
processD5 = onException (do
  putStr "Please, specify the basic duration for the generated sounds as a Double number in the range [0.1..4.0]. "
  putStrLn "The default one is 0.5"
  putStrLn "To use the default value, you can simply press Enter."
  time0 <- getLine
  if null time0 then return "0.5"
  else let time1 = (read (filter (\z -> isDigit z || z == '.') $ time0)::Double) in
    if compare time1 0.1 /= LT && compare time1 4.0 /= GT then return (showFFloat (Just 4) time1 $ show 0)
    else let mantissa = time1 - (fromIntegral . truncate $ time1)
             ceilP    = (truncate time1::Int) `rem` 4 in
           if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0))
           else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (do
             putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
             putStrLn "_______________________________________________________________________"
             processD5)
{-# INLINE processD5 #-}

processD7 :: IO String
processD7 = onException (do
  putStrLn "Please, input the Ukrainian text that will be used to define signs for the harmonics coefficients to produce a special timbre for the notes: "
  tts <- getLine
  if null tts then return "або"
  else return tts) (do
    putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
    putStrLn "_______________________________________________________________________"
    processD7)
{-# INLINE processD7 #-}

processD8 :: IO String
processD8 = onException (do
  putStr "Please, specify in how many times the amplitude for the second lower note (if any) is greater than the amplitude for the main note. "
  putStrLn "The number is in the range [0.1..2.0]. The default one is 1.0"
  putStrLn "To use the default value, you can simply press Enter."
  dAmpl0 <- getLine
  if null dAmpl0 then return "1.0"
  else let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') $ dAmpl0)::Double) in
    if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then return (showFFloat (Just 4) dAmpl1 $ show 0)
    else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1)
             ceilP    = (truncate dAmpl1::Int) `rem` 2 in
           if ceilP == 0 then return ("0." ++ (showFFloat (Just 4) mantissa $ show 0))
           else return $ show ceilP ++ "." ++ (showFFloat (Just 4) mantissa $ show 0)) (do
             putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
             putStrLn "_______________________________________________________________________"
             processD8)
{-# INLINE processD8 #-}

processD9 :: IO String
processD9 = onException (do
  putStrLn "Please, input the Ukrainian text that will be used to define intervals to be used to produce the lower note for the given main one. "
  putStrLn "The default one is \"й\". "
  putStrLn "To use the default value, you can simply press Enter."
  vs <- getLine
  if null vs then return "й"
  else return vs) (do
    putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
    putStrLn "_______________________________________________________________________"
    processD9)
{-# INLINE processD9 #-}

processD :: IO String
processD = onException (do
  putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: "
  wws <- getLine
  return wws) (do
    putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
    putStrLn "_______________________________________________________________________"
    processD)
{-# INLINE processD #-}