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

-- |
-- Module      :  Phladiprelio.General.General.EmphasisG
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- Some functionality for SaaW mode of operation for PhLADiPreLiO.
-- 

module Phladiprelio.General.EmphasisG where

import GHC.Base
import GHC.Num ((+),(-))
import GHC.Real (fromIntegral)
import Text.Show (Show (..))
import Data.Tuple (fst,snd)
import GHC.List 
import Data.List (words)
import Phladiprelio.General.Base
import Phladiprelio.General.Syllables
import GHC.Int
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
import Data.Char (toUpper)
import GHC.Arr
import Data.List (scanl',intersperse)
import CaseBi.Arr (getBFst',getBFstL',getBFstLSorted')
import Data.Lists.FLines (newLineEnding)
import Data.Traversable (traverse)
import Control.Applicative
import System.IO (stderr,hPutStr,getLine)

data SyllWeightsG = SyG {
  point :: ![PRS]
  , order :: !Int8 -- Is intended to begin at -128 up to 127 (maximum 256 entries).
  , weight :: !Double
}

showFSG :: FlowSoundG -> String
showFSG = map charS
{-# INLINE showFSG #-}

type FlowSoundG = [PRS]

instance Show SyllWeightsG where
  show (SyG ps i w) = showFSG ps `mappend` (' ':show i) `mappend` (' ':show w) `mappend` newLineEnding

weightSyllablesIO :: [FlowSoundG] -> IO [SyllWeightsG]
weightSyllablesIO = traverse (\(i,xs) -> (\d1 -> (SyG xs i d1)) <$> weightSyllAIO False xs)  . zip ([-128..127]::[Int8])

weightStringIO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> IO ([[FlowSoundG]],[SyllWeightsG],[[[Int8]]])
weightStringIO wrs ks arr hs us vs xs = weightSyllablesIO fss >>= \zs -> pure (tsss, zs, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)
  where tsss = createSyllablesPL wrs ks arr hs us vs xs
        fss = [ ts | tss <- tsss , ts <- tss ]

weightStringNIO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Int 
  ->  String 
  -> IO ([[FlowSoundG]],[[SyllWeightsG]],[[[Int8]]])
weightStringNIO wrs ks arr hs us vs n xs = traverse (\_-> weightSyllablesIO fss) [1..n] >>= \zss -> pure (tsss, zss, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)
  where tsss = createSyllablesPL wrs ks arr hs us vs xs
        fss = [ ts | tss <- tsss , ts <- tss ]

weights2SyllableDurationsDArr :: [SyllWeightsG] -> Array Int (Int8,Double)
weights2SyllableDurationsDArr xs = listArray (0,l-1) . map (\(SyG _ i w) -> (i,w)) $ xs
  where l = length xs

weights2SyllableDurationsD :: [SyllWeightsG] -> [[[Int8]]] -> [[Double]]
weights2SyllableDurationsD xs = map (map (k (getBFst' (4.0, weights2SyllableDurationsDArr xs))))
  where k f = foldl' (\y x -> f x + y) 0
{-# INLINE weights2SyllableDurationsD #-}

helper1F :: [Int8] -> [[[Int8]]]
helper1F (x:y:ys) = map (:[]) [x..y-1]:helper1F (y:ys)
helper1F _ = []

weightSyllAIO :: Bool -> FlowSoundG -> IO Double
weightSyllAIO upper xs
  | null xs = pure 4.0
  | otherwise = 
    (\d -> fromMaybe 4.0 (readMaybe d::Maybe Double)) <$> (hPutStr stderr ("?  " `mappend` ((if upper then map toUpper else id) . showFSG $ xs) `mappend` "   ") *> getLine) -- Well, definitely it should not be 'stderr' here, but 'stdout' gives some strange behaviour, probably related to optimizations or some strange 'Handle' behaviour. (?)


data ReadyForConstructionPL = StrG String | FSLG [[[Int8]]] deriving (Eq,Ord)

showR :: ReadyForConstructionPL -> String
showR (StrG xs) = xs
showR (FSLG tsss) = show tsss

isStr :: ReadyForConstructionPL -> Bool
isStr (StrG _) = True
isStr _ = False

isFSL :: ReadyForConstructionPL -> Bool
isFSL (FSLG _) = True
isFSL _ = False

fromReadyFCPLS :: ReadyForConstructionPL -> Maybe String
fromReadyFCPLS (StrG xs) = Just xs
fromReadyFCPLS _ = Nothing

fromReadyFCPLF :: ReadyForConstructionPL -> Maybe [[[Int8]]]
fromReadyFCPLF (FSLG xsss) = Just xsss
fromReadyFCPLF _ = Nothing

helper2F :: [b] -> [a] -> [c] -> [[d]] -> [([b],[a],[c])]
helper2F vs xs ys tss = let (us,ks,rs) = unzip3 . zip3 vs xs $ ys in
  helper2F' us ks rs tss
    where helper2F' us@(_:_) ks@(_:_) rs@(_:_) tss@(ts:wss) =
            let l = length ts
                (wws,vvs) = splitAt l us
                (qs,ps) = splitAt l ks
                (ns,ms) = splitAt l rs
                in (wws,qs,ns):helper2F' vvs ps ms wss
          helper2F' _ _ _ _ = []
 
convF1 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [[FlowSoundG]]
convF1 wrs ks arr hs us vs xs
 | null xs = []
 | otherwise = [ tss | tss <- createSyllablesPL wrs ks arr hs us vs xs ]

convF3 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [([String],[[Int8]],[FlowSoundG])]
convF3 wrs ks arr hs us vs xs
 | null xs = [([],[],[])]
 | otherwise = helper2F (concatMap (map showFSG) tsss) (map (:[]) ([-128..127]::[Int8])) [ ts | tss <- qss, ts <- tss ] qss
    where tsss = createSyllablesPL wrs ks arr hs us vs xs
          qss = [ tss | tss <- tsss ]

convF3W 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> [(String,[[Int8]])]
convF3W wrs ks arr hs us vs xs
 | null xs = [([],[])]
 | otherwise = zipWith (\(_,ys,_) ts -> (ts,ys)) (convF3 wrs ks arr hs us vs xs) . words $ xs

convFI 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> String 
  -> [[[Int8]]]
convFI wrs ks arr hs us vs ts = map f . words
  where !f = getBFstL' [] (convF3W wrs ks arr hs us vs ts)

convFSL 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String 
  -> ReadyForConstructionPL 
  -> String
convFSL wrs ps arr hs us vs ts r@(StrG xs) = concat . concat . intersperse [" "] . map (\(ks,_,_)-> ks) . convF3 wrs ps arr hs us vs $ xs
   where js =  unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 wrs ps arr hs us vs $ ts
convFSL wrs ps arr hs us vs ts r@(FSLG tsss) =  concat . concat . intersperse [" "] . map (map (getBFstLSorted' " " ks) ) $ tsss
   where js = unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 wrs ps arr hs us vs $ ts
         ks = zip (concat . fst $ js) (concat . snd $ js)

weightsString3IO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Bool 
  -> String 
  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)
weightsString3IO wrs ps arr hs us vs bool bs 
 | bool = do
   (syllDs1,sylws,fsls0) <- weightStringIO wrs ps arr hs us vs bs
   let syllableDurationsD2s = [weights2SyllableDurationsD sylws]
   return (syllDs1,syllableDurationsD2s,FSLG fsls0) 
 | otherwise = return ([],[],FSLG [])

weightsString3NIO 
  :: GWritingSystemPRPLX -- ^ Data used to obtain the phonetic language representation of the text.
  -> [(Char,Char)] -- ^ The pairs of the 'Char' that corresponds to the similar phonetic languages consonant phenomenon
      -- (e. g. allophones). Must be sorted in the ascending order to be used correctly.
  -> CharPhoneticClassification -- ^ The 'Array' 'Int' 'PRS' must be sorted in the ascending order to be used in the module correctly.
  -> SegmentRulesG
  -> String -- ^ Corresponds to the 100 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> String -- ^ Corresponds to the 101 delimiter in the @ukrainian-phonetics-basic-array@ package.
  -> Int 
  -> Bool 
  -> String 
  -> IO ([[FlowSoundG]],[[[[Int8]]] -> [[Double]]],ReadyForConstructionPL)
weightsString3NIO wrs ps arr hs us vs n bool bs 
 | bool = (\(syllDs1,sylws,fsls0) -> (syllDs1,map weights2SyllableDurationsD sylws,FSLG fsls0)) <$> weightStringNIO wrs ps arr hs us vs n bs
 | otherwise = pure ([],[],FSLG [])