-- |
-- Module      :  Phonetic.Languages.Simplified.Array.Ukrainian.ReadProperties
-- Copyright   :  (c) OleksandrZhabenko 2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Functions to read the properties data from the files with the special Haskell-like syntaxis.

{-# LANGUAGE BangPatterns #-}

module Phonetic.Languages.Simplified.Array.Ukrainian.ReadProperties where

import CaseBi.Arr (getBFstLSorted')
import Languages.Phonetic.Ukrainian.Syllable.Double.ArrInt8
import Text.Read (readMaybe)
import Data.Maybe
import Interpreter.StringConversion
import Melodics.Ukrainian.ArrInt8


{-| [(1,\"\1072\"),(2,\"\1077\"),(3,\"\1086\"),(4,\"\1091\"),(5,\"\1080\"),(6,\"\1110\"),
(7,\"\1100\"),(8,\"\1076\1079\"),(10,\"\1078\"),(15,\"\1073\"),(17,\"\1076\"),(19,\"\1169\"),(21,\"\1075\"),
(23,\"\1076\1078\"),(25,\"\1079\"),(27,\"\1081\"),(28,\"\1083\"),(30,\"\1084\"),(32,\"\1085\"),(34,\"\1088\"),
(36,\"\1074\"),(38,\"\1094\"),(39,\"\1095\"),(41,\"\1096\"),(43,\"\1092\"),(45,\"\1082\"),(47,\"\1087\"),
(49,\"\1089\"),(50,\"\1090\"),(52,\"\1093\"),(54,\"\1089\1100\"),(66,\"\1094\1100\"),(101,\"-\")]
@
UZ \'A\' D       дз (plain)                 8
UZ \'A\' K       дз (palatalized)           9
UZ \'B\' D       ж  (plain)                 10
UZ \'B\' K       ж  (semi-palatalized)      11
UZ \'C\' S       й                          27
UZ \'D\' N       сь                         54
UZ \'E\' L       ч  (plain)                 39
UZ \'E\' M       ч  (semi-palatalized)      40
UZ \'F\' L       ш  (plain)                 41
UZ \'F\' M       ш  (semi-palatalized)      42
    G                                     55
    H                                     56
    I                                     57
    J                                     58
    K                                     59
    L                                     60
    M                                     61
    N          нт                         62
    O          ст                         63
    P          ть                         64
    Q          дзь                        12
    R          зь                         13
    S          нь                         65
    T          дь                         14
UZ \'a\' W       а                          1
UZ \'b\' D       б  (plain)                 15
UZ \'b\' K       б  (semi-palatalized)      16
UZ \'c\' D       ц  (plain)                 38
UZ \'d\' D       д  (plain)                 17
UZ \'d\' K       д  (palatalized)           18
UZ \'e\' W       е                          2
UZ \'f\' L       ф  (plain)                 43
UZ \'f\' M       ф  (semi-palatalized)      44
UZ \'g\' D       ґ  (plain)                 19
UZ \'g\' K       ґ  (semi-palatalized)      20
UZ \'h\' D       г  (plain)                 21
UZ \'h\' K       г  (semi-palatalized)      22
UZ \'i\' W       і                          6
UZ \'j\' D       дж (plain)                 23
UZ \'j\' K       дж (palatalized)           24
UZ \'k\' L       к  (plain)                 45
UZ \'k\' M       к  (semi-palatalized)      46
UZ \'l\' S       л  (plain)                 28
UZ \'l\' O       л  (palatalized)           29
UZ \'m\' S       м  (plain)                 30
UZ \'m\' O       м  (semi-palatalized)      31
UZ \'n\' S       н  (plain)                 32
UZ \'n\' O       н  (palatalized)           33
UZ \'o\' W       о                          3
UZ \'p\' L       п  (plain)                 47
UZ \'p\' M       п  (semi-palatalized)      48
UZ \'q\' E       ь                          7
UZ \'r\' S       р  (plain)                 34
UZ \'r\' O       р  (palatalized)           35
UZ \'s\' L       с  (plain)                 49
UZ \'t\' L       т  (plain)                 50
UZ \'t\' M       т  (palatalized)           51
UZ \'u\' W       у                          4
UZ \'v\' S       в  (plain)                 36
UZ \'v\' O       в  (semi-palatalized)      37
UZ \'w\' N       ць                         66
UZ \'x\' L       х  (plain)                 52
UZ \'x\' M       х  (semi-palatalized)      53
UZ \'y\' W       и                          5
UZ \'z\' D       з  (plain)                 25
UZ \'z\' K       з  (palatalized)           26
@
-}
sound8s :: FlowSound
sound8s :: FlowSound
sound8s = [Sound8
1,Sound8
2,Sound8
3,Sound8
4,Sound8
5,Sound8
6,Sound8
7,Sound8
8,Sound8
9,Sound8
10,Sound8
11,Sound8
15,Sound8
16,Sound8
17,Sound8
18,Sound8
19,Sound8
20,Sound8
21,Sound8
22,Sound8
23,Sound8
24,Sound8
25,Sound8
26,Sound8
27,Sound8
28,Sound8
29,Sound8
30,Sound8
31,Sound8
32,Sound8
33,Sound8
34,Sound8
35,Sound8
36,Sound8
37,Sound8
38,Sound8
39,Sound8
40,Sound8
41,Sound8
42,
   Sound8
43,Sound8
44,Sound8
45,Sound8
46,Sound8
47,Sound8
48,Sound8
49,Sound8
50,Sound8
51,Sound8
52,Sound8
53,Sound8
54,Sound8
66,Sound8
101]



{-|

The first number is the default value that corresponds usually to the word gap duration (and here is not important).
The next 52 'Double' numbers become the durations of the above specified 'Sound8' values respectively, the order
must be preserved (if you consider it important, well, it should be!). If some number in the file cannot be read
as a 'Double' number the function uses the first one that can be instead (the default value). If no such is specified
at all, then the default number is 1.0 for all the 'Sound8' sound representations that is hardly correct.

-}
readSound8ToDouble :: String -> (Double,[(Sound8, Double)])
readSound8ToDouble :: String -> (Double, [(Sound8, Double)])
readSound8ToDouble String
xs
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = (Double
1.0,forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
sound8s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
10000 forall a b. (a -> b) -> a -> b
$ Double
1.0)
 | Bool
otherwise =
    let wws :: [String]
wws = String -> [String]
lines String
xs
        dbls :: [Maybe Double]
dbls = forall a b. (a -> b) -> [a] -> [b]
map (\String
ks -> forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Double) [String]
wws
        dbH :: Double
dbH
         | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Double]
dbls Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isNothing [Maybe Double]
dbls = Double
1.0
         | Bool
otherwise = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ [Maybe Double]
dbls
        dbSs :: [Double]
dbSs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Maybe a -> a
fromMaybe Double
dbH) [Maybe Double]
dbls
        (Double
firstD,[(Sound8, Double)]
lsts)
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Double]
dbls = (Double
1.0,forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
sound8s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
10000 forall a b. (a -> b) -> a -> b
$ Double
1.0)
          | Bool
otherwise = (Double
dbH,forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
sound8s ([Double]
dbSs forall a. Monoid a => a -> a -> a
`mappend` forall a. Int -> a -> [a]
replicate Int
10000 Double
1.0))
            in (Double
firstD,[(Sound8, Double)]
lsts)

divide2SDDs :: String -> [String]
divide2SDDs :: String -> [String]
divide2SDDs String
ys
 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
tss = [[String] -> String
unlines [String]
kss]
 | Bool
otherwise = [String] -> String
unlines [String]
kss forall a. a -> [a] -> [a]
: String -> [String]
divide2SDDs ([String] -> String
unlines [String]
rss)
     where wwss :: [String]
wwss = String -> [String]
lines String
ys
           ([String]
kss,[String]
tss) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
==Char
'*')) [String]
wwss
           rss :: [String]
rss = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
== Char
'*')) [String]
tss

readSyllableDurations :: FilePath -> IO [[[[Sound8]]] -> [[Double]]]
readSyllableDurations :: String -> IO [[[FlowSound]] -> [[Double]]]
readSyllableDurations String
file = do
  String
xs <- String -> IO String
readFileIfAny String
file
  let yss :: [String]
yss = forall a. Int -> [a] -> [a]
take Int
9 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
divide2SDDs forall a b. (a -> b) -> a -> b
$ String
xs
      readData :: [(Double, [(Sound8, Double)])]
readData = forall a b. (a -> b) -> [a] -> [b]
map String -> (Double, [(Sound8, Double)])
readSound8ToDouble [String]
yss
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(Double
d,[(Sound8, Double)]
zs) -> forall a.
SyllableDurations4 a =>
(a -> Double) -> [[[a]]] -> [[Double]]
syllableDurationsGDc (forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Double
d [(Sound8, Double)]
zs)) forall a b. (a -> b) -> a -> b
$ [(Double, [(Sound8, Double)])]
readData