-- |
-- Module      :  Composition.Sound.Process
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music from a file (or its part) and a Ukrainian text. 
-- It can also generate a timbre for the notes. Uses SoX inside.

{-# OPTIONS_GHC -threaded #-}

module Composition.Sound.Process (
  -- * Basic functions for the executable
  recAndProcess
  , processD1
  --, processD2
  , d3H
  , d4H
  , d5H
  , d7H
  , d8H
  , d9H
) where

import Data.List (isPrefixOf)
import CaseBi.Arr (getBFstLSorted')
import Numeric (showFFloat)
import Control.Exception (onException)
import Sound.Control.Exception.FinalException
import System.Exit
import Data.Maybe (fromJust,isJust)
import Data.Char (isDigit,isSpace)
import System.Process
import System.Info (os)
import EndOfExe (showE)
import System.Directory

-- | 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 =
  getBFstLSorted' processD [(0,processD0 file),(1,processD1), (3,processD3),(4,processD4),(5,processD5),
    (7,processD7), (8,processD8),(9,processD9),(11,processD_1),(99,processD99),(999,processD99)]

failureNotification :: IO ()
failureNotification = do
  putStrLn "The process was not successful may be because of the not valid data. Please, specify the valid data as requested."
  putStrLn "_______________________________________________________________________"

processD_1 :: IO String
processD_1 = onException (do
  putStr "Please, specify two \'Int\' numbers (with intermediate space character between them): the first one is a number of different notes there will be "
  putStr "in the result, and the second one is a number of enky, to which you would like all the main components (not taking into account their "
  putStr "respective lower bases of the intervals if any will exist) should belong. "
  putStrLn "If you specify as the first one 2 (possibly the simplest case), then to the second one you can define a number in the range [3..53]. "
  putStrLn "If you specify as the first one 3, then to the second one you can define a number in the range [2..35]. "
  putStrLn "If you specify as the first one 4, then to the second one you can define a number in the range [2..26]. "
  putStrLn "If you specify as the first one 6, then to the second one you can define a number in the range [1..17]. "
  putStrLn "If you specify as the first one 9, then to the second one you can define a number in the range [1..11]. "
  enka0 <- getLine
  let enka1 = take 2 . words . filter (\x -> isDigit x || isSpace x) $ enka0
      enka2 = read (head . take 1 $ enka1)::Int
      enka3
        | enka2 == 2 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 53) 3 == LT then 28 else (read (take 2 . head . tail $ enka1)::Int)
           `rem` 53
        | enka2 == 3 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 35) 2 == LT then 19 else (read (take 2 . head . tail $ enka1)::Int)
           `rem` 35
        | enka2 == 4 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 26) 2 == LT then 14 else (read (take 2 . head . tail $ enka1)::Int)
           `rem` 26
        | enka2 == 6 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 17) 1 == LT then 9 else (read (take 2 . head . tail $ enka1)::Int)
           `rem` 17
        | enka2 == 9 = if compare ((read (take 2 . head . tail $ enka1)::Int) `rem` 11) 1 == LT then 6 else (read (take 2 . head . tail $ enka1)::Int)
           `rem` 11
        | otherwise  = error "Not valid number in the second place. "
  return $ show enka2 ++ " " ++ show enka3 ) (failureNotification >> processD3)
{-# INLINE processD_1 #-}

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)::Float
  putStrLn "Please, wait for 0.5 second and produce the needed sound now."
  {- The following sample of code is taken from the recA function of the SoXBasics module in the @mmsyn7ukr@ package. -}
  if isJust (showE "sox") && take 5 os == "mingw" then do
   (code, _, _) <- readProcessWithExitCode (fromJust (showE "sox")) ["-t","waveaudio","-d","-b16", "-c1", "-esigned-integer", "-L", "x.wav", "trim", "0.5", showFFloat Nothing time0 $ show 0] ""
   if code /= ExitSuccess
    then do
      e0 <- doesFileExist "x.wav"
      if e0
        then do
          removeFile "x.wav"
          catchEnd (NotRecorded "x.wav")
        else catchEnd (NotRecorded "x.wav")
     else do
      e1 <- doesFileExist "x.wav"
      if e1
        then return ()
        else catchEnd (NotRecorded "x.wav")
  else if isJust (showE "rec") then do
   (code, _, _) <- readProcessWithExitCode (fromJust (showE "rec")) ["-b16", "-c1", "-esigned-integer", "-L", "x.wav", "trim", "0.5", showFFloat Nothing time0 $ show 0] ""
   if code /= ExitSuccess
    then do
      e0 <- doesFileExist "x.wav"
      if e0
        then do
          removeFile "x.wav"
          catchEnd (NotRecorded "x.wav")
        else catchEnd (NotRecorded "x.wav")
    else do
      e1 <- doesFileExist "x.wav"
      if e1
        then return ()
        else catchEnd (NotRecorded "x.wav")
   else catchEnd ExecutableNotProperlyInstalled -- End of the sample code for 'recA'
  putStrLn ""
  return "") (do
    dir0 <- listDirectory "."
    let paths = filter (== "x.wav") dir0
    mapM_ removeFile paths
    putStrLn ""
    failureNotification 
    processD1)
{-# INLINE processD1 #-}

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]"
  fmap d3H getLine) (failureNotification >> processD3)
{-# INLINE processD3 #-}

d3H :: String -> String
d3H xs = show $ (read (take 1 xs)::Int) `rem` 9
{-# INLINE d3H #-}

processD4 :: IO String
processD4 = onException (do
  putStr "Please, specify the amplitude for the generated overtones 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."
  fmap d4H getLine) (failureNotification >> processD4)
{-# INLINE processD4 #-}

d4H :: String -> String
d4H xs
 | null xs = "1.0"
 | otherwise = let amplOb = (read (take 2 . filter isDigit $ xs)::Int) `rem` 100 in
    case amplOb of
      99 -> "1.0"
      _ -> if compare (amplOb `quot` 9) 1 == LT then "0.0" ++ show (amplOb + 1)
           else "0." ++ show (amplOb + 1)
{-# INLINE d4H #-}

processD5 :: IO String
processD5 = onException (do
  putStr "Please, specify the basic duration for the generated sounds as a Float 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."
  fmap d5H getLine) (failureNotification >> processD5)
{-# INLINE processD5 #-}

d5H :: String -> String
d5H xs
  | null xs = "0.5"
  | otherwise = let time1 = (read (filter (\z -> isDigit z || z == '.') xs)::Float) in
      if compare time1 0.1 /= LT && compare time1 4.0 /= GT then showFFloat (Just 4) time1 $ show 0
      else let mantissa = time1 - (fromIntegral . truncate $ time1)
               ceilP    = (truncate time1::Int) `rem` 4 in
             if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0)
             else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0)
{-# INLINE d5H #-}

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: "
  fmap d7H getLine) (failureNotification >> 
    processD7)
{-# INLINE processD7 #-}

d7H :: String -> String
d7H xs
  | null xs = "або"
  | otherwise = xs
{-# INLINE d7H #-}

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."
  fmap d8H getLine) (failureNotification >> processD8)
{-# INLINE processD8 #-}

d8H :: String -> String
d8H xs
  | null xs = "1.0"
  | otherwise = let dAmpl1 = (read (filter (\z -> isDigit z || z == '.') xs)::Float) in
    if compare dAmpl1 0.1 /= LT && compare dAmpl1 2.0 /= GT then showFFloat (Just 4) dAmpl1 $ show 0
    else let mantissa = dAmpl1 - (fromIntegral . truncate $ dAmpl1)
             ceilP    = (truncate dAmpl1::Int) `rem` 2 in
           if ceilP == 0 then "0." ++ showFFloat (Just 4) mantissa (show 0)
           else show ceilP ++ "." ++ showFFloat (Just 4) mantissa (show 0)
{-# INLINE d8H #-}

processD9 :: IO String
processD9 = onException (do
  putStrLn "Please, input the Ukrainian text that will be used to define the 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."
  fmap d9H getLine) (failureNotification >> processD9)
{-# INLINE processD9 #-}

d9H :: String -> String
d9H xs
  | null xs = "й"
  | otherwise = xs
{-# INLINE d9H #-}

processD :: IO String
processD = onException (do
  putStrLn "Please, input the Ukrainian text that will be used to create a special timbre for the notes: "
  getLine) (failureNotification >> processD)
{-# INLINE processD #-}

processD99 :: IO String
processD99 = onException (do
  putStr "Please, input the lists of Int in Haskell syntaxis (e. g. [1,3..56], or [3..45], or [2..]) of the indices for the files to be played "
  putStr "with SoX effects applied to. The lists must be separated with newline (just press \"Enter\"), empty lists are ignored. If index is an "
  putStrLn "element of several input lists then if its number of occurrences in all the lists is odd, then it is played, otherwise it is not. "
  putStrLn "To end the input, just press the combination that means the end of input (e. g. for Unices, it's probably Ctrl + D). "
  getContents) (failureNotification >> processD)
{-# INLINE processD99 #-}

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