-- |
-- Module      :  DobutokO.Sound.Functional
-- 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.

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -threaded #-}

module DobutokO.Sound.Functional (
  -- * Use additional function as a parameter
  oberSoXSynth2FDN
  , oberSoXSynth2FDN_B
  -- ** Just simple function application
  , oberSoXSynth2FDN_S
  -- *** With additional filtering
  , oberSoXSynth2FDN_Sf
  , oberSoXSynth2FDN_Sf3
) where

import Numeric
import Data.List (isPrefixOf,sort,sortBy,nubBy)
import Data.Maybe (isNothing,fromJust)
import qualified Data.Vector as V
import System.Process
import EndOfExe
import System.Directory
import Melodics.Ukrainian
import DobutokO.Sound hiding (oberSoXSynth2FDN)

-- | Similar to 'oberSoXSynth2DN' but instead of 'oberTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with
-- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is experimental feature, so
-- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the
-- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'.
--
-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.
-- But for a lot of functions this works well.
-- 
-- It is recommended to fully compute the \"f\" function before using it in the 'oberSoXSynth2FDN'.
oberSoXSynth2FDN :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> String -> IO ()
oberSoXSynth2FDN f (x, y) zs
 | V.null . convertToProperUkrainian $ zs = oberSoXSynth x
 | otherwise = do
    let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
        g0    = V.fromList . nubBy (\(!x1,_) (!x2,_) -> x1 == x2) . V.toList . V.map (\(noteX, !amplX) ->
           if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,
             abs (amplX - (fromIntegral . truncate $ amplX)))) . f
        g k   = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) .
                   V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k 
        v0    = g note0
        v1    = if isNothing note1 then V.empty
                else g . fromJust $ note1
        ts = showFFloat (Just 4) y $ show 0 
        oberSoXSynthHelp vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
        oberSoXSynthHelp2 vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
       showFFloat (Just 4) note0 $ show 0] ""
    if isNothing note1 then do
      oberSoXSynthHelp v0
    else do 
      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
         showFFloat (Just 4) (fromJust note1) $ show 0] ""
      oberSoXSynthHelp v0
      oberSoXSynthHelp2 v1
    paths0 <- listDirectory "."
    let paths = sort . filter (isPrefixOf "test") $ paths0
    _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
    mapM_ removeFile paths

-- | Similar to 'oberSoXSynth2DN' but instead of 'oberTones' function, it uses volatile function @f::Double -> Vector (Double, Double)@ with
-- somewhat sophisticated mechanism to normalize the resulting 'V.Vector' elements @(Double, Double)@. The last one is experimental feature, so
-- it is your responsibility to provide a function so that it does not lead to clipping. In such a case, the result of application of the
-- 'convertToProperUkrainian' to the 'String' parameter must not be 'V.empty'. The function also tries to perform filtering to avoid possible beating.
-- The third 'Double' parameter in the tuple is used as a limit for frequencies difference in Hz to be filtered out from the resulting sound. It is
-- considered to be from the range @[0.1..10.0]@.
--
-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.
-- But for a lot of functions this works well.
-- 
-- It is recommended to fully compute the \"f\" function before using it in the 'oberSoXSynth2FDN_B'.
oberSoXSynth2FDN_B :: (Double -> V.Vector (Double, Double)) -> (Double, Double, Double) -> String -> IO ()
oberSoXSynth2FDN_B f (x, y, limB) zs
 | V.null . convertToProperUkrainian $ zs = oberSoXSynth x
 | otherwise = do
    let limA0 = abs ((limB / fromIntegral 10) - (fromIntegral . truncate $ (limB / fromIntegral 10))) * fromIntegral 10
        limA  = if compare limA0 0.1 == LT then 0.1 else limA0
        note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
        g0    = V.fromList . nubBy (\(!x1,_) (!x2,_) -> compare (abs (x1 - x2)) limA == LT) . V.toList . V.map (\(noteX, !amplX) ->
           if noteX <= 0.0 then (fromIntegral 2 * note0, abs (amplX - (fromIntegral . truncate $ amplX))) else (closestNote noteX,
             abs (amplX - (fromIntegral . truncate $ amplX)))) . f
        g k   = V.takeWhile (\(!w,!z) -> compare w (V.unsafeIndex notes 107) /= GT && compare (abs z) 0.001 == GT) .
                   V.imap (\i (_,!z0) -> (fromIntegral (i + 1) * (fst . V.unsafeIndex (g0 k) $ 0), z0)) . g0 $ k 
        v0    = g note0
        v1    = if isNothing note1 then V.empty
                else g . fromJust $ note1
        ts = showFFloat (Just 4) y $ show 0 
        oberSoXSynthHelp vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
        oberSoXSynthHelp2 vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
       showFFloat (Just 4) note0 $ show 0] ""
    if isNothing note1 then do
      oberSoXSynthHelp v0
    else do 
      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
         showFFloat (Just 4) (fromJust note1) $ show 0] ""
      oberSoXSynthHelp v0
      oberSoXSynthHelp2 v1
    paths0 <- listDirectory "."
    let paths = sort . filter (isPrefixOf "test") $ paths0
    _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
    mapM_ removeFile paths    

-- | Similar to 'oberSoXSynth2FDN' but it does not make any normalizing transformations with the 'V.Vector' argument. To be used properly, it is needed
-- that every second element in the tuple in the 'V.Vector' argument must be in the range [-1.0..1.0] and every first element must be in between
-- 16.351597831287414 and 7902.132820097988 (Hz).
--
-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.
-- But for a lot of functions this works well.
-- 
-- It is recommended to fully compute the \"f\" function before using it in the 'oberSoXSynth2FDN_S'.
oberSoXSynth2FDN_S :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> String -> IO ()
oberSoXSynth2FDN_S f (x, y) zs
 | V.null . convertToProperUkrainian $ zs = oberSoXSynth x
 | otherwise = do
    let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
        v0    = f note0
        v1    = if isNothing note1 then V.empty
                else f . fromJust $ note1
        ts = showFFloat (Just 4) y $ show 0 
        oberSoXSynthHelp vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
        oberSoXSynthHelp2 vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
       showFFloat (Just 4) note0 $ show 0] ""
    if isNothing note1 then do
      oberSoXSynthHelp v0
    else do 
      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
         showFFloat (Just 4) (fromJust note1) $ show 0] ""
      oberSoXSynthHelp v0
      oberSoXSynthHelp2 v1
    paths0 <- listDirectory "."
    let paths = sort . filter (isPrefixOf "test") $ paths0
    _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
    mapM_ removeFile paths

-- | Similar to 'oberSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller
-- by absolute value than 0.001.
--
-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.
-- But for a lot of functions this works well.
-- 
-- It is recommended to fully compute the \"f\" function before using it in the 'oberSoXSynth2FDN_Sf'.
oberSoXSynth2FDN_Sf :: (Double -> V.Vector (Double, Double)) -> (Double, Double) -> String -> IO ()
oberSoXSynth2FDN_Sf f (x, y) zs
 | V.null . convertToProperUkrainian $ zs = oberSoXSynth x
 | otherwise = do
    let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
        v0    = V.filter (\(_,!z) -> compare (abs z) 0.001 == GT) . f $ note0
        v1    = if isNothing note1 then V.empty
                else V.filter (\(_,!z) -> compare z 0.001 == GT) . f . fromJust $ note1
        ts = showFFloat (Just 4) y $ show 0 
        oberSoXSynthHelp vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
        oberSoXSynthHelp2 vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
       showFFloat (Just 4) note0 $ show 0] ""
    if isNothing note1 then do
      oberSoXSynthHelp v0
    else do 
      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
         showFFloat (Just 4) (fromJust note1) $ show 0] ""
      oberSoXSynthHelp v0
      oberSoXSynthHelp2 v1
    paths0 <- listDirectory "."
    let paths = sort . filter (isPrefixOf "test") $ paths0
    _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
    mapM_ removeFile paths

-- | Similar to 'oberSoXSynth2FDN_S' but additionally the program filters out from the resulting 'V.Vector' after \"f\" application values that are smaller
-- than the third 'Double' parameter by an absolute value in the triple of @Double@'s. 
--
-- Be aware that the result can be rather unpredictable (the program can even obtain segmentation fault) for not very suitable function.
-- But for a lot of functions this works well.
-- 
-- It is recommended to fully compute the \"f\" function before using it in the 'oberSoXSynth2FDN_Sf3'.
oberSoXSynth2FDN_Sf3 :: (Double -> V.Vector (Double, Double)) -> (Double, Double, Double) -> String -> IO ()
oberSoXSynth2FDN_Sf3 f (x, y, t0) zs
 | V.null . convertToProperUkrainian $ zs = oberSoXSynth x
 | otherwise = do
    let note0 = closestNote (if x /= 0.0 then abs x else V.unsafeIndex notes 0)
        note1 = dNote (V.unsafeIndex (intervalsFromString zs) 0) note0
        v0    = V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f $ note0
        v1    = if isNothing note1 then V.empty
                else V.filter (\(_,!z) -> compare (abs z) t0 == GT) . f . fromJust $ note1
        ts = showFFloat (Just 4) y $ show 0 
        oberSoXSynthHelp vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test0" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
        oberSoXSynthHelp2 vec =
          let l  = V.length vec in V.imapM_ (\i (noteN, !amplN) -> readProcessWithExitCode (fromJust (showE "sox"))
            ["-r22050", "-n", "test1" ++ show (i + 2) ++ ".wav", "synth", ts,"sine", showFFloat (Just 4) noteN $ show 0,
              "vol", showFFloat (Just 4) (amplN / fromIntegral l) $ show 0] "") vec
    _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testA.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
       showFFloat (Just 4) note0 $ show 0] ""
    if isNothing note1 then do
      oberSoXSynthHelp v0
    else do 
      _ <- readProcessWithExitCode (fromJust (showE "sox")) ["-r22050", "-n", "testB.wav", "synth", showFFloat (Just 4) y $ show 0,"sine",
         showFFloat (Just 4) (fromJust note1) $ show 0] ""
      oberSoXSynthHelp v0
      oberSoXSynthHelp2 v1
    paths0 <- listDirectory "."
    let paths = sort . filter (isPrefixOf "test") $ paths0
    _ <- readProcessWithExitCode (fromJust (showE "sox")) (["--combine", "mix"] ++ paths ++ ["result.wav","vol","0.3"]) ""
    mapM_ removeFile paths