-- |
-- 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 Phonetic.Languages.Array.Ukrainian.PropertiesFuncRepG2
import Phonetic.Languages.Array.Ukrainian.PropertiesSyllablesG2
import Languages.Phonetic.Ukrainian.Syllable.Double.Arr
import Text.Read (readMaybe)
import Data.Maybe
import Interpreter.StringConversion
import Languages.Phonetic.Ukrainian.Syllable.Arr (UZPP(..),UZPP2,PhoneticType(..))

uzpp2s :: [UZPP2]
uzpp2s :: [UZPP2]
uzpp2s = [Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'A' PhoneticType
K, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'B' PhoneticType
K, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'C' PhoneticType
S, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'D' PhoneticType
N, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
L, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'E' PhoneticType
M, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
L,
   Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'F' PhoneticType
M, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'a' PhoneticType
W, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'b' PhoneticType
K, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'c' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'd' PhoneticType
K, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'e' PhoneticType
W, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
L,
   Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'f' PhoneticType
M, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'g' PhoneticType
K, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'h' PhoneticType
K, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'i' PhoneticType
W, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'j' PhoneticType
K, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
L,
   Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'k' PhoneticType
M, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
S, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'l' PhoneticType
O, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
S, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'm' PhoneticType
O, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
S, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'n' PhoneticType
O, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'o' PhoneticType
W, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
L,
   Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'p' PhoneticType
M, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'q' PhoneticType
E, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
S, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'r' PhoneticType
O, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
's' PhoneticType
L, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
L, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
't' PhoneticType
M, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'u' PhoneticType
W, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
S,
   Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'v' PhoneticType
O, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'w' PhoneticType
N, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
L, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'x' PhoneticType
M, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'y' PhoneticType
W, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
D, Char -> PhoneticType -> UZPP2
forall a b. a -> b -> UZPP a b
UZ Char
'z' PhoneticType
K]

{-|
\"[UZ \'A\' D, UZ \'A\' K, UZ \'B\' D, UZ \'B\' K, UZ \'C\' S, UZ \'D\' N, UZ \'E\' L, UZ \'E\' M, UZ \'F\' L,
   UZ \'F\' M, UZ \'a\' W, UZ \'b\' D, UZ \'b\' K, UZ \'c\' D, UZ \'d\' D, UZ \'d\' K, UZ \'e\' W, UZ \'f\' L,
   UZ \'f\' M, UZ \'g\' D, UZ \'g\' K, UZ \'h\' D, UZ \'h\' K, UZ \'i\' W, UZ \'j\' D, UZ \'j\' K, UZ \'k\' L,
   UZ \'k\' M, UZ \'l\' S, UZ \'l\' O, UZ \'m\' S, UZ \'m\' O, UZ \'n\' S, UZ \'n\' O, UZ \'o\' W, UZ \'p\' L,
   UZ \'p\' M, UZ \'q\' E, UZ \'r\' S, UZ \'r\' O, UZ \'s\' L, UZ \'t\' L, UZ \'t\' M, UZ \'u\' W, UZ \'v\' S,
   UZ \'v\' O, UZ \'w\' N, UZ \'x\' L, UZ \'x\' M, UZ \'y\' W, UZ \'z\' D, UZ \'z\' K]\"
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 'UZPP2' 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 'UZPP2' sound representations that is hardly correct.

-}
readUZPP2ToDouble :: String -> (Double,[(UZPP2, Double)])
readUZPP2ToDouble :: String -> (Double, [(UZPP2, Double)])
readUZPP2ToDouble String
xs
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = (Double
1.0,[UZPP2] -> [Double] -> [(UZPP2, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UZPP2]
uzpp2s ([Double] -> [(UZPP2, Double)])
-> (Double -> [Double]) -> Double -> [(UZPP2, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
10000 (Double -> [(UZPP2, Double)]) -> Double -> [(UZPP2, Double)]
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 = (String -> Maybe Double) -> [String] -> [Maybe Double]
forall a b. (a -> b) -> [a] -> [b]
map (\String
ks -> String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
ks::Maybe Double) [String]
wws
        dbH :: Double
dbH
         | [Maybe Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Double]
dbls Bool -> Bool -> Bool
|| (Maybe Double -> Bool) -> [Maybe Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Maybe Double -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Double]
dbls = Double
1.0
         | Bool
otherwise = Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double)
-> ([Maybe Double] -> Maybe Double) -> [Maybe Double] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Double] -> Maybe Double
forall a. [a] -> a
head ([Maybe Double] -> Maybe Double)
-> ([Maybe Double] -> [Maybe Double])
-> [Maybe Double]
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Double -> Bool) -> [Maybe Double] -> [Maybe Double]
forall a. (a -> Bool) -> [a] -> [a]
filter Maybe Double -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe Double] -> Double) -> [Maybe Double] -> Double
forall a b. (a -> b) -> a -> b
$ [Maybe Double]
dbls
        dbSs :: [Double]
dbSs = (Maybe Double -> Double) -> [Maybe Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
dbH) [Maybe Double]
dbls
        (Double
firstD,[(UZPP2, Double)]
lsts)
          | [Maybe Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Maybe Double]
dbls = (Double
1.0,[UZPP2] -> [Double] -> [(UZPP2, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UZPP2]
uzpp2s ([Double] -> [(UZPP2, Double)])
-> (Double -> [Double]) -> Double -> [(UZPP2, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
10000 (Double -> [(UZPP2, Double)]) -> Double -> [(UZPP2, Double)]
forall a b. (a -> b) -> a -> b
$ Double
1.0)
          | Bool
otherwise = (Double
dbH,[UZPP2] -> [Double] -> [(UZPP2, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UZPP2]
uzpp2s ([Double]
dbSs [Double] -> [Double] -> [Double]
forall a. Monoid a => a -> a -> a
`mappend` Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
10000 Double
1.0))
            in (Double
firstD,[(UZPP2, Double)]
lsts)

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

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