IntermediateF.hs

-- |
-- Module      :  DobutokO.Sound.IntermediateF
-- 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.IntermediateF (
  -- * Basic functions to work with intermediate files \"result\*wav\"
  getFileRSizes
  , getFileRSizesS
  , getFileRSizesS2
  , getFileRTuples
  , listVDirectory
  , isHighQ
  , shouldBeReplaced
  , indexesFromMrk
  -- * Functions to edit the melody by editing the intermediate files \"result\*wav\"
  , playAndMark
  , playAMrk
  , pAnR1
  , pAnR2
  , pAnR_
  -- * Additional functions
  -- ** Get information
  , infoFromV
  , internalConv
  , ixFromRes
  , ixInterv
  , thisOne
  -- ** Process and Edit
  , playSeqAR
  , playSeqARV
  , playSeqARV2
  , playCollect1Dec
  , playCollectDec
  , replaceWithHQs
) where

import Control.Concurrent (myThreadId,forkIO,threadDelay,killThread)
import qualified Data.List as L (sort)
import Control.Exception (onException)
import Data.List (isPrefixOf,isSuffixOf,(\\))
import Data.Char (isDigit,isSpace)
import qualified Data.Vector as V 
import System.Directory
import SoXBasics (playA,durationA)
import EndOfExe (showE)
import System.Process (readProcessWithExitCode)
import Data.Maybe (fromJust)

-- | Gets sizes of the \"result\*.wav\" files in the current directory. 
getFileRSizes :: IO (V.Vector Integer)
getFileRSizes = do
  dirN <- listDirectory "."
  let dirN1 = V.fromList . L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN
  sizes <- V.mapM getFileSize dirN1
  return sizes

-- | Similar to 'getFileRSizes', but sizes are 'Int', not 'Integer'. For most cases it is more memory efficient.
getFileRSizesS :: IO (V.Vector Int)
getFileRSizesS = do
  dirN0 <- listDirectory "."
  let dirN2 = V.fromList . L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN0
  sizes1 <- V.mapM getFileSize dirN2
  return . V.map fromIntegral $ sizes1

-- | Variant of 'getFileRSizes' function.
getFileRSizesS2 :: IO (V.Vector Int)
getFileRSizesS2 = getFileRSizes >>= \s -> return . V.map fromIntegral $ s

-- | Gets 'V.Vector' of tuples of the pairs of \"result\*.wav\" files and their respective sizes.
getFileRTuples :: IO (V.Vector (FilePath,Integer))
getFileRTuples = do
  dirN <- listDirectory "."
  let dirN0 = L.sort . filter (isPrefixOf "result") . filter (isSuffixOf ".wav") $ dirN
  sizes0 <- mapM getFileSize dirN0
  let tpls = V.fromList . zip dirN0 $ sizes0
  return tpls

-- | Gets 'V.Vector' of the filenames for \"result\*.wav\" files in the current directory.
listVDirectory :: IO (V.Vector FilePath)
listVDirectory = do
  dir0N <- listDirectory "."
  let diNN = V.fromList . L.sort . filter (\s -> isPrefixOf "result" s && isSuffixOf ".wav" s) $ dir0N
  return diNN

-- | During function evaluation you can listen to the sound files and mark them with \"1\" and \"0\". The first one means that the sound is considered
-- of higher quality and is intended to be used as a replacement for the worse sounds markd by \"0\". The function returns a 'V.Vector' of specially formatted
-- 'String' that represents only those files that are connected with the replacement procedure.
playAndMark :: V.Vector FilePath -> IO (V.Vector String)
playAndMark vec
  | V.null vec = return V.empty
  | otherwise = V.imapM (\i xs -> do
      duration <- durationA $ V.unsafeIndex vec i
      putStrLn "Listen to the next sound, please. Please, do not enter anything while sound plays. "
      forkIO $ do
        myThread <- myThreadId
        playA xs
        killThread myThread
      threadDelay (read (show $ truncate (duration * fromIntegral 1000000))::Int)
      putStr "How do you mark the file that has just been played now -- if of high quality, print \"1\", if of low quality, print \"0\", "
      putStrLn "if it is just accepted, press \'Enter\'. "  
      mark0 <- getLine
      putStrLn "-----------------------------------------------------------------------------------------"
      let mark = take 1 mark0
      case mark of
        "1" -> return $ show i ++ "*" ++ xs
        "0" -> return $ show i ++ "**" ++ xs
        _   -> return []) vec >>= V.filterM (\t -> return . not . null $ t) 

-- | Function 'playAndMark' applied to all the \"result\*.wav\" files in the current directory.
playAMrk :: IO (V.Vector String)
playAMrk = listVDirectory >>= playAndMark

-- | Function-predicate to check whether a file corresponding to its 'String' argument is needed to be replaced while processing.
shouldBeReplaced :: String -> Bool
shouldBeReplaced (x:y:xs)
  | x == '*' && y == '*' = True
  | otherwise = shouldBeReplaced (y:xs)
shouldBeReplaced _ = False

-- | Function-predicate to check whether a file corresponding to its 'String' argument is considered as one of higher quality and therefore can be used
-- to replace the not so suitable ones while processing.
isHighQ :: String -> Bool
isHighQ xs = (length . filter (== '*') $ xs) == 1

-- | Gets an index of the 'V.Vector' element corresponding to the 'String' generated by 'playAndMark' function.
indexesFromMrk :: String -> Int
indexesFromMrk xs = read (takeWhile (\t1 -> t1 /= '*') xs)::Int

-- | Used to obtain parameters for processment.
internalConv :: ([String],[String]) -> (V.Vector Int, V.Vector String)
internalConv (xss,yss) = (V.fromList . map indexesFromMrk $ xss,V.fromList . map (dropWhile (== '*')) $ yss)

-- | Axiliary function to get a 'String' of consequent digits in the name of the \"result\*.wav\" file.
ixFromRes :: String -> String
ixFromRes xs = (takeWhile (/= '.') xs) \\ "result"

-- | Given an index of the element in the 'listVDirectory' output returns a tuple of the boundaries of the indexes usable for playback. 
-- Note: index0 is probably from [0..], l1 is necessarily from [0..]. Interesting case is: 0 <= index0 < l1.
ixInterv :: Int -> IO (Int, Int)
ixInterv index0
  | compare index0 0 == LT = do
      dirV <- listVDirectory
      let l1 = V.length dirV
      case compare l1 13 of
        LT -> return (0,l1 - 1)
        _  -> return (0,11)
  | compare index0 7 == LT = do
      dirV <- listVDirectory
      let l1 = V.length dirV
      case compare index0 (l1 - 5) of
        GT -> return (0, l1 - 1) 
        _  -> return (0, index0 + 4)     
  | otherwise = do
      dirV <- listVDirectory
      let l1 = V.length dirV
      case compare l1 13 of
       LT -> return (0,l1 - 1)
       _  -> 
         case compare index0 (l1 - 5) of
           GT -> return (index0 - 7, l1 - 1)
           _  -> return (index0 - 7, index0 + 4)

-- | Parser to the result of 'listVDirectory' function to get the needed information.
infoFromV :: V.Vector String -> [(V.Vector Int, V.Vector String)]
infoFromV vec = map (internalConv . unzip . V.toList . V.map (break (== '*'))) [v1, v2]
  where (v1, v2) = V.partition shouldBeReplaced vec

-- | Plays a sequence of sounds in the interval of them obtained by 'ixInterv' function.
playSeqAR :: Int -> IO ()
playSeqAR index0 = do
  (minBnd,maxBnd) <- ixInterv index0
  dirV2 <- listVDirectory
  mapM_ (\i -> playA $ V.unsafeIndex dirV2 i) [minBnd..maxBnd]

-- | Plays a sequence of consequential sounds in the melody in the interval of them obtained by 'ixInterv' function for each element index
-- from 'V.Vector' of indexes.
playSeqARV :: V.Vector Int -> IO ()
playSeqARV vec = do
  dirV2 <- listVDirectory
  V.mapM_ (\i -> playA $ V.unsafeIndex dirV2 i) vec

-- | Plays a sequence of sounds considered of higher quality.
playSeqARV2 :: V.Vector String -> IO ()
playSeqARV2 vec = do
  let indexesHQs = fst . last . infoFromV $ vec  
  playSeqARV indexesHQs

-- | The same as 'playSeqARV2', but additionally collects the resulting 'Bool' values and then returns them. It is used to define, which sounds  from those of
-- higher quality will replace those ones considered to be replaced.
playCollectDec :: V.Vector String -> IO (V.Vector Bool)
playCollectDec vec = do
  dirV3 <- listVDirectory
  let indexesHQs = fst . last . infoFromV $ vec
  vecBools <- V.mapM (playCollect1Dec dirV3) indexesHQs
  return vecBools

-- | Actually replaces the file represented by 'FilePath' argument with no (then there is no replacement at all), or with just one,
-- or with a sequence of sounds being considered of higher quality to form a new melody. If the lengths of the second and the third
-- arguments differs from each other then the function uses as these arguments truncated vectors of the minimal of the two lengths. 
replaceWithHQs :: FilePath -> V.Vector Bool -> V.Vector FilePath -> IO ()
replaceWithHQs file0 vecBools stringHQs
 | V.length vecBools == V.length stringHQs =
   case V.length stringHQs of
    0 -> putStrLn "That's all!"
    1 | V.unsafeIndex vecBools 0 -> do
         copyFile (head . V.toList $ stringHQs) "resultI.wav"
         renameFile "resultI.wav" file0
      | otherwise -> putStrLn "Nothing has changed. "
    _ -> do
         let yss = V.toList . V.ifilter (\i _ -> V.unsafeIndex vecBools i == True) $ stringHQs
         case length yss of
          0 -> putStrLn "That's all!"
          1 -> copyFile (head yss) file0
          _ -> do
            (_,_,herr) <- readProcessWithExitCode (fromJust (showE "sox")) (yss ++ [file0]) ""
            putStrLn herr
 | otherwise =
  let stringHQ2s = V.take (min (V.length vecBools) (V.length stringHQs)) stringHQs
      vecBool2s  = V.take (min (V.length vecBools) (V.length stringHQs)) vecBools in replaceWithHQs file0 vecBool2s stringHQ2s

-- | 'IO' checkbox whether to add the sound played to the sequence of sounds that will replace the needed one.
thisOne :: IO Bool
thisOne = do
  putStrLn "Would you like to add this sound played just now to the sequence of sounds that will replace the needed one? "
  yes <- getLine
  putStrLn "-----------------------------------------------------------------------"
  return $ take 1 yes == "1"

-- | Plays a sound file considered to be of higher quality and then you define whether to use the played sound to replace that one considered to be replaced.
playCollect1Dec :: V.Vector String -> Int -> IO Bool
playCollect1Dec dirV2 i 
  | compare i 0 /= LT && compare i (V.length dirV2) /= GT = do 
     playA $ V.unsafeIndex dirV2 i
     thisOne
  | otherwise = error "DobutokO.Sound.IntermediateF.playCollect1Dec: wrong Int parameter! "

-- | Process the sound corresponding to the first element in the first argument. Returns a 'V.tail' of the first element of the first command line argument.
-- Replaces (if specified) the sound with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality.
pAnR1 :: V.Vector String -> IO (V.Vector String)
pAnR1 vec
 | V.null vec = putStrLn "You have processed all the marked files! " >> return V.empty
 | otherwise = do
    let [(indexes0,strings),(indexesHQ,stringHQs)] = infoFromV vec
    putStrLn "Please, listen to the melody and remember what sound you would like to replace and the surrounding sounds. "
    playSeqAR $ V.unsafeIndex indexes0 0
    putStrLn "---------------------------------------------------------------"
    putStrLn "Now, please, listen to a collection of sounds considered of higher quality which you can use to replace the needed one. "
    vecBools <- playCollectDec vec
    replaceWithHQs (V.unsafeIndex strings 0) vecBools stringHQs
    return $ V.map (\(ix,xs) -> show ix ++ "**" ++ xs) . V.zip (V.unsafeDrop 1 indexes0) $ (V.unsafeDrop 1 strings)

-- | Process the sounds consequently corresponding to the elements in the first argument.
-- Replaces (if specified) the sounds with a sequence of (or just one, or made no replacement at all) sounds considered of higher quality for every sound needed.
pAnR2 :: V.Vector String -> IO ()
pAnR2 vec
 | V.null vec = putStrLn "You have processed all the marked files! "
 | otherwise = onException (pAnR1 vec >>= pAnR2) (return ())

-- | Marks the needed files as of needed to be replaced or those ones considered of higher quality that will replace the needed ones. Then actually replaces them
-- as specified. Uses internally 'playAMrk' and 'pAnR2' functions. 
pAnR_ :: IO ()
pAnR_ = do
  vec <- playAMrk
  pAnR2 vec