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

-- |
-- Module      :  Melodics.Ukrainian.Arr
-- Copyright   :  (c) OleksandrZhabenko 2019-2022
-- 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 (
  appendULFile
  , convertToProperUkrainian
  , isUkrainian
) where

import qualified Data.ByteString.Char8 as B
import System.IO
import CaseBi.Arr
import qualified Data.Foldable as F
import GHC.Arr
import Melodics.Ukrainian.ArrInt8
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. Since 0.3.0.0 version changed the type.
appendULFile ::  FlowSound -> Handle -> IO ()
appendULFile :: FlowSound -> Handle -> IO ()
appendULFile FlowSound
xss Handle
hdl | Bool -> Bool
not (FlowSound -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FlowSound
xss) =
  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
"0.ul", FilePath
"A.ul", FilePath
"B.ul", FilePath
"C.ul", FilePath
"D.ul", FilePath
"E.ul", FilePath
"F.ul", FilePath
"G.ul", FilePath
"H.ul",
        FilePath
"I.ul", FilePath
"J.ul", FilePath
"K.ul", FilePath
"L.ul", FilePath
"M.ul", FilePath
"N.ul", FilePath
"O.ul", FilePath
"P.ul", FilePath
"Q.ul", FilePath
"R.ul",
          FilePath
"S.ul", FilePath
"T.ul", FilePath
"U.ul", FilePath
"V.ul", FilePath
"W.ul", FilePath
"X.ul", FilePath
"Y.ul", FilePath
"Z.ul", FilePath
"a.ul", FilePath
"b.ul", FilePath
"c.ul",
            FilePath
"d.ul", FilePath
"e.ul", FilePath
"f.ul"]
    [ByteString]
dataArray0 <- (FilePath -> IO ByteString) -> [FilePath] -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO ByteString
B.readFile ([FilePath] -> IO [ByteString]) -> [FilePath] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$! [FilePath]
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
32) [ByteString]
dataArray0
    (Sound8 -> IO ()) -> FlowSound -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Sound8
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 :: 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
$ Array Integer ByteString -> Int -> ByteString
forall i e. Array i e -> Int -> e
unsafeAt Array Integer ByteString
dataArray (Int -> ByteString) -> (Sound8 -> Int) -> Sound8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Sound8, Int)] -> Sound8 -> Int
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Int
0 [(Sound8
1,Int
1),(Sound8
2,Int
8),(Sound8
3,Int
17),(Sound8
4,Int
23),(Sound8
5,Int
11),(Sound8
6,Int
31),
                      (Sound8
7,Int
30),(Sound8
8,Int
7),(Sound8
10,Int
9),(Sound8
15,Int
2),(Sound8
17,Int
5),(Sound8
19,Int
32),(Sound8
21,Int
4),(Sound8
23,Int
6),(Sound8
25,Int
10),(Sound8
27,Int
12),(Sound8
28,Int
14),(Sound8
30,Int
15),(Sound8
32,Int
16),
                        (Sound8
34,Int
19),(Sound8
36,Int
3),(Sound8
38,Int
26),(Sound8
39,Int
28),(Sound8
41,Int
29),(Sound8
43,Int
24),(Sound8
45,Int
13),(Sound8
47,Int
18),(Sound8
49,Int
20),(Sound8
50,Int
22),(Sound8
52,Int
25),(Sound8
54,Int
21),
                          (Sound8
66,Int
27)] (Sound8 -> ByteString) -> Sound8 -> ByteString
forall a b. (a -> b) -> a -> b
$ Sound8
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!") FlowSound
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 :: FilePath -> [FilePath]
convertToProperUkrainian FilePath
xs = FlowSound -> [FilePath]
new2OldRepresentation (FlowSound -> [FilePath])
-> (FilePath -> FlowSound) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FlowSound
convertToProperUkrainianI8 (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
xs
  where new2OldRepresentation :: FlowSound -> [String]
        new2OldRepresentation :: FlowSound -> [FilePath]
new2OldRepresentation FlowSound
ys = (Sound8 -> FilePath) -> FlowSound -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Sound8 -> FilePath
f (FlowSound -> [FilePath]) -> FlowSound -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FlowSound
ys
          where f :: Sound8 -> FilePath
f = FilePath -> [(Sound8, FilePath)] -> Sound8 -> FilePath
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' FilePath
"" [(Sound8
1,FilePath
"\1072"),(Sound8
2,FilePath
"\1077"),(Sound8
3,FilePath
"\1086"),(Sound8
4,FilePath
"\1091"),(Sound8
5,FilePath
"\1080"),(Sound8
6,FilePath
"\1110"),
                      (Sound8
7,FilePath
"\1100"),(Sound8
8,FilePath
"\1076\1079"),(Sound8
10,FilePath
"\1078"),(Sound8
15,FilePath
"\1073"),(Sound8
17,FilePath
"\1076"),(Sound8
19,FilePath
"\1169"),(Sound8
21,FilePath
"\1075"),
                        (Sound8
23,FilePath
"\1076\1078"),(Sound8
25,FilePath
"\1079"),(Sound8
27,FilePath
"\1081"),(Sound8
28,FilePath
"\1083"),(Sound8
30,FilePath
"\1084"),(Sound8
32,FilePath
"\1085"),(Sound8
34,FilePath
"\1088"),
                          (Sound8
36,FilePath
"\1074"),(Sound8
38,FilePath
"\1094"),(Sound8
39,FilePath
"\1095"),(Sound8
41,FilePath
"\1096"),(Sound8
43,FilePath
"\1092"),(Sound8
45,FilePath
"\1082"),(Sound8
47,FilePath
"\1087"),
                            (Sound8
49,FilePath
"\1089"),(Sound8
50,FilePath
"\1090"),(Sound8
52,FilePath
"\1093"),(Sound8
54,FilePath
"\1089\1100"),(Sound8
66,FilePath
"\1094\1100"),(Sound8
101,FilePath
"-")]

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