-- |
-- Module      :  Melodics.Ukrainian
-- Copyright   :  (c) OleksandrZhabenko 2019-2020
-- License     :  MIT
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions provide functionality of a musical instrument synthesizer or for Ukrainian speech synthesis
-- especially for poets, translators and writers.
--

module Melodics.Ukrainian (
  appendS16LEFile
  , convertToProperUkrainian
  , takeData
  , isUkrainian
  -- ** Since 0.9.0.0 version -- transformation function.
  , new2OldRepresentation
) where

import qualified Data.Vector.Unboxed as V
import qualified Data.Vector as VB
import qualified Data.ByteString.Char8 as B
import System.IO
import CaseBi.Unboxed (getBFst')
import qualified CaseBi as X (getBFst')
import qualified Melodics.ByteString.Ukrainian as MU (convertToProperUkrainianS)
import Paths_mmsyn6ukr

{-
-- Inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html
-}

-- | Function to take raw sound data from the \".wav\" file given.
takeData :: FilePath -> IO B.ByteString
takeData :: FilePath -> IO ByteString
takeData FilePath
file = do
  ByteString
data1 <- FilePath -> IO ByteString
B.readFile FilePath
file
  let dataN :: ByteString
dataN = Int -> ByteString -> ByteString
B.drop Int
44 ByteString
data1 in ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
dataN

-- | The function that actually produces a .raw file. The mapping table is given in the @Map.txt@ file.
appendS16LEFile ::  VB.Vector String -> Handle -> IO ()
appendS16LEFile :: Vector FilePath -> Handle -> IO ()
appendS16LEFile Vector FilePath
xs Handle
hdl | Bool -> Bool
not (Vector FilePath -> Bool
forall a. Vector a -> Bool
VB.null Vector FilePath
xs) =
  do
    [FilePath]
dataFileList <- (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO FilePath
getDataFileName
      [FilePath
"-.wav", FilePath
"0.wav", FilePath
"1.wav", FilePath
"A.wav", FilePath
"B.wav", FilePath
"C.wav", FilePath
"D.wav", FilePath
"E.wav", FilePath
"F.wav", FilePath
"G.wav", FilePath
"H.wav",
        FilePath
"I.wav", FilePath
"J.wav", FilePath
"K.wav", FilePath
"L.wav", FilePath
"M.wav", FilePath
"N.wav", FilePath
"O.wav", FilePath
"P.wav", FilePath
"Q.wav", FilePath
"R.wav",
          FilePath
"S.wav", FilePath
"T.wav", FilePath
"U.wav", FilePath
"V.wav", FilePath
"W.wav", FilePath
"X.wav", FilePath
"Y.wav", FilePath
"Z.wav", FilePath
"a.wav", FilePath
"b.wav", FilePath
"c.wav",
            FilePath
"d.wav", FilePath
"e.wav", FilePath
"f.wav"]
    Vector ByteString
dataList <- (FilePath -> IO ByteString)
-> Vector FilePath -> IO (Vector ByteString)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
VB.mapM FilePath -> IO ByteString
takeData (Vector FilePath -> IO (Vector ByteString))
-> ([FilePath] -> Vector FilePath)
-> [FilePath]
-> IO (Vector ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Vector FilePath
forall a. [a] -> Vector a
VB.fromList ([FilePath] -> IO (Vector ByteString))
-> [FilePath] -> IO (Vector ByteString)
forall a b. (a -> b) -> a -> b
$! [FilePath]
dataFileList
    (FilePath -> IO ()) -> Vector FilePath -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VB.mapM_ (\FilePath
u ->
      if (ByteString -> Bool) -> Vector ByteString -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
VB.all (\ByteString
z -> ByteString -> Int
B.length ByteString
z Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Vector ByteString
dataList
        then let rs :: FilePath
rs =  FilePath -> FilePath
forall a. [a] -> [a]
tail (FilePath -> FilePath)
-> (Handle -> FilePath) -> Handle -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (FilePath -> FilePath)
-> (Handle -> FilePath) -> Handle -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') (FilePath -> FilePath)
-> (Handle -> FilePath) -> Handle -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath
forall a. Show a => a -> FilePath
show (Handle -> FilePath) -> Handle -> FilePath
forall a b. (a -> b) -> a -> b
$ Handle
hdl in do
          Handle -> IO ()
hClose Handle
hdl
          Bool
closedHdl <- Handle -> IO Bool
hIsClosed Handle
hdl
          if Bool
closedHdl
            then do
                   FilePath -> ByteString -> IO ()
B.appendFile FilePath
rs (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector ByteString
dataList Vector ByteString -> Int -> ByteString
forall a. Vector a -> Int -> a
VB.! ((Int, Vector (FilePath, Int)) -> FilePath -> Int
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
X.getBFst' (Int
0, [(FilePath, Int)] -> Vector (FilePath, Int)
forall a. [a] -> Vector a
VB.fromList [(FilePath
"-", Int
0), (FilePath
"0", Int
1), (FilePath
"1", Int
2), (FilePath
"а", Int
3), (FilePath
"б", Int
4),
                     (FilePath
"в", Int
5), (FilePath
"г", Int
6), (FilePath
"д", Int
7), (FilePath
"дж", Int
8), (FilePath
"дз", Int
9), (FilePath
"е", Int
10), (FilePath
"ж", Int
11), (FilePath
"з", Int
12), (FilePath
"и", Int
13),
                        (FilePath
"й", Int
14), (FilePath
"к", Int
15), (FilePath
"л", Int
16), (FilePath
"м", Int
17), (FilePath
"н", Int
18), (FilePath
"о", Int
19), (FilePath
"п", Int
20), (FilePath
"р", Int
21),
                          (FilePath
"с", Int
22), (FilePath
"сь", Int
23), (FilePath
"т", Int
24), (FilePath
"у", Int
25), (FilePath
"ф", Int
26), (FilePath
"х", Int
27), (FilePath
"ц", Int
28), (FilePath
"ць", Int
29), (FilePath
"ч", Int
30),
                            (FilePath
"ш", Int
31), (FilePath
"ь", Int
32), (FilePath
"і", Int
33), (FilePath
"ґ", Int
34)]) FilePath
u)
            else FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"File is not closed!"
        else FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Data sound file is not read!") Vector FilePath
xs
    Handle -> IO ()
hClose Handle
hdl
                       | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | The function that converts a written Ukrainian text into the sounding in the program phonetical respesentation.
-- It is not exact phonetically but you can make for yourself a general impression of the Ukrainian sounding.
convertToProperUkrainian :: String -> VB.Vector String
convertToProperUkrainian :: FilePath -> Vector FilePath
convertToProperUkrainian = FilePath -> Vector FilePath
new2OldRepresentation (FilePath -> Vector FilePath)
-> (FilePath -> FilePath) -> FilePath -> Vector FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
MU.convertToProperUkrainianS

new2OldRepresentation :: String -> VB.Vector String
new2OldRepresentation :: FilePath -> Vector FilePath
new2OldRepresentation FilePath
xs = [FilePath] -> Vector FilePath
forall a. [a] -> Vector a
VB.fromList ([FilePath] -> Vector FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> Vector FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> FilePath) -> FilePath -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Char -> FilePath
f (FilePath -> Vector FilePath) -> FilePath -> Vector FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
xs
  where f :: Char -> FilePath
f = (FilePath, Vector (Char, FilePath)) -> Char -> FilePath
forall a b. Ord a => (b, Vector (a, b)) -> a -> b
X.getBFst' (FilePath
"",[(Char, FilePath)] -> Vector (Char, FilePath)
forall a. [a] -> Vector a
VB.fromList ([(Char, FilePath)] -> Vector (Char, FilePath))
-> ([FilePath] -> [(Char, FilePath)])
-> [FilePath]
-> Vector (Char, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> [(Char, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip FilePath
"-01ABCDEFabcdefghijklmnopqrstuvwxyz" ([FilePath] -> Vector (Char, FilePath))
-> [FilePath] -> Vector (Char, FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath
"-",FilePath
"0",FilePath
"1",FilePath
"дз",FilePath
"ж",FilePath
"й",FilePath
"сь",FilePath
"ч",FilePath
"ш",FilePath
"а",FilePath
"б",
              FilePath
"ц",FilePath
"д",FilePath
"е",FilePath
"ф",FilePath
"ґ",FilePath
"г",FilePath
"і",FilePath
"дж",FilePath
"к",FilePath
"л",FilePath
"м",FilePath
"н",FilePath
"о",FilePath
"п",FilePath
"ь",FilePath
"р",FilePath
"с",FilePath
"т",FilePath
"у",FilePath
"в",FilePath
"ць",FilePath
"х",FilePath
"и",FilePath
"з"])

isUkrainian :: Char -> Bool
isUkrainian :: Char -> Bool
isUkrainian Char
y | (Char
y Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\1040' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\1065') Bool -> Bool -> Bool
|| (Char
y Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\1070' Bool -> Bool -> Bool
&& Char
y Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\1097') = Bool
True
              | Bool
otherwise = (Bool, Vector (Char, Bool)) -> Char -> Bool
forall a b.
(Ord a, Unbox a, Unbox b) =>
(b, Vector (a, b)) -> a -> b
getBFst' (Bool
False, [(Char, Bool)] -> Vector (Char, Bool)
forall a. Unbox a => [a] -> Vector a
V.fromList ([(Char, Bool)] -> Vector (Char, Bool))
-> (FilePath -> [(Char, Bool)]) -> FilePath -> Vector (Char, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> (Char, Bool)) -> FilePath -> [(Char, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> (Char
x, Bool
True)) (FilePath -> Vector (Char, Bool))
-> FilePath -> Vector (Char, Bool)
forall a b. (a -> b) -> a -> b
$ FilePath
"'-\700\1028\1030\1031\1068\1100\1102\1103\1108\1110\1111\1168\1169\8217") Char
y