-- |
-- Module      :  Phladiprelio.Ukrainian.ReadDurations
-- Copyright   :  (c) OleksandrZhabenko 2021-2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Functions to read the properties data from the files with the special Haskell-like syntaxis.

{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}

module Phladiprelio.Ukrainian.ReadDurations where

import GHC.Base
import CaseBi.Arr (getBFstLSorted')
import Phladiprelio.Ukrainian.SyllableWord8
import Text.Read (readMaybe)
import Data.Maybe
import System.IO
import GHC.List
import Data.List (unlines,lines)
import System.Directory (doesFileExist)
import Phladiprelio.Ukrainian.Melodics
import GHC.Word
import Phladiprelio.General.Datatype3 (zippedDouble2Word8) 

{-| For more information on implementation, please refer to the link:
 
<https://oleksandr-zhabenko.github.io/uk/rhythmicity/PhLADiPreLiO.Eng.21.html#ability-to-use-your-own-durations-of-representations-of-sounds-or-phonetic-phenomena> 
-}
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]



{-|

Since the version 0.5.0.0 the semantics changed. Now, there is no duration for the pause between words. 
The 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 5 for all the 'Sound8' sound representations.

-}
readSound8ToWord8 :: String -> (Word8,[(Sound8, Word8)])
readSound8ToWord8 :: String -> (Word8, [(Sound8, Word8)])
readSound8ToWord8 String
xs
 | String -> Bool
forall a. [a] -> Bool
null String
xs = (Word8
5,FlowSound -> [Word8] -> [(Sound8, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
sound8s ([Word8] -> [(Sound8, Word8)])
-> (Word8 -> [Word8]) -> Word8 -> [(Sound8, Word8)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
10000 (Word8 -> [(Sound8, Word8)]) -> Word8 -> [(Sound8, Word8)]
forall a b. (a -> b) -> a -> b
$ Word8
5)
 | 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
        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
5) [Maybe Double]
dbls in (Word8
5,[(Sound8, Double)] -> [(Sound8, Word8)]
forall {b1} {b2} {a}.
(Fractional b1, Num b2, Enum b2, Ord b1) =>
[(a, b1)] -> [(a, b2)]
zippedDouble2Word8 ([(Sound8, Double)] -> [(Sound8, Word8)])
-> ([Double] -> [(Sound8, Double)])
-> [Double]
-> [(Sound8, Word8)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlowSound -> [Double] -> [(Sound8, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip FlowSound
sound8s ([Double] -> [(Sound8, Word8)]) -> [Double] -> [(Sound8, Word8)]
forall a b. (a -> b) -> a -> b
$ [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)

divide2SDDs :: String -> [String]
divide2SDDs :: String -> [String]
divide2SDDs String
ys
 | [String] -> Bool
forall a. [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 a. (a -> Bool) -> [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 a. (a -> Bool) -> [a] -> Bool
any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'*')) [String]
tss

readSyllableDurations :: FilePath -> IO [[[[Sound8]]] -> [[Word8]]]
readSyllableDurations :: String -> IO [[[FlowSound]] -> [[Word8]]]
readSyllableDurations String
file = do
  Bool
exists <- String -> IO Bool
doesFileExist String
file
  if Bool
exists then do 
   String
xs <- String -> IO String
readFile 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 :: [(Word8, [(Sound8, Word8)])]
readData = (String -> (Word8, [(Sound8, Word8)]))
-> [String] -> [(Word8, [(Sound8, Word8)])]
forall a b. (a -> b) -> [a] -> [b]
map String -> (Word8, [(Sound8, Word8)])
readSound8ToWord8 [String]
yss
   [[[FlowSound]] -> [[Word8]]] -> IO [[[FlowSound]] -> [[Word8]]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[[FlowSound]] -> [[Word8]]] -> IO [[[FlowSound]] -> [[Word8]]])
-> ([(Word8, [(Sound8, Word8)])] -> [[[FlowSound]] -> [[Word8]]])
-> [(Word8, [(Sound8, Word8)])]
-> IO [[[FlowSound]] -> [[Word8]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8, [(Sound8, Word8)]) -> [[FlowSound]] -> [[Word8]])
-> [(Word8, [(Sound8, Word8)])] -> [[[FlowSound]] -> [[Word8]]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Word8
d,[(Sound8, Word8)]
zs) -> (Sound8 -> Word8) -> [[FlowSound]] -> [[Word8]]
forall a.
SyllableDurations4 a =>
(a -> Word8) -> [[[a]]] -> [[Word8]]
syllableDurationsGDc (Word8 -> [(Sound8, Word8)] -> Sound8 -> Word8
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Word8
d [(Sound8, Word8)]
zs)) ([(Word8, [(Sound8, Word8)])] -> IO [[[FlowSound]] -> [[Word8]]])
-> [(Word8, [(Sound8, Word8)])] -> IO [[[FlowSound]] -> [[Word8]]]
forall a b. (a -> b) -> a -> b
$ [(Word8, [(Sound8, Word8)])]
readData
  else [[[FlowSound]] -> [[Word8]]] -> IO [[[FlowSound]] -> [[Word8]]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []