{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module      :  Melodics.Ukrainian.Arr
-- 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.Arr (
  appendS16LEFile
  , convertToProperUkrainian
  , isUkrainian
) 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.Arr
import qualified Data.Foldable as F
import GHC.Arr
import qualified Melodics.ByteString.Ukrainian.Arr as MU (convertToProperUkrainianS,isUkrainianL)
import Paths_mmsyn6ukr_array

{-|
The first version has been initially inspired by: https://mail.haskell.org/pipermail/beginners/2011-October/008649.html
-}

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

isUkrainian :: Char -> Bool
isUkrainian :: Char -> Bool
isUkrainian = Char -> Bool
MU.isUkrainianL