{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Phladiprelio.Ukrainian.PropertiesFuncRepG2
-- Copyright   :  (c) Oleksandr Zhabenko 2020-2023
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@yahoo.com
--
-- 

{-# LANGUAGE BangPatterns, NoImplicitPrelude #-}

module Phladiprelio.Ukrainian.Emphasis where

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

data SyllWeights = Sy {
  point :: !FlowSound
  , order :: !Int8 -- Is intended to begin at -128 up to 0 (maximum 129 entries).
  , weight :: !Double
}

instance Show SyllWeights where
  show (Sy ps i w) = showFS ps `mappend` (' ':show i) `mappend` (' ':show w) `mappend` newLineEnding

weightSyllablesIO :: [FlowSound] -> IO [SyllWeights]
weightSyllablesIO = traverse (\(i,xs) -> (\d1 -> (Sy xs i d1)) <$> weightSyllAIO False xs)  . zip ([-128..0]::[Int8])

weightStringIO :: String -> IO ([[FlowSound]],[SyllWeights],[[FlowSound]])
weightStringIO xs = weightSyllablesIO fss >>= \zs -> pure (tsss, zs, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)
  where tsss = createSyllablesUkrS xs
        fss = [ ts | tss <- tsss , ts <- tss ]

weightStringNIO :: Int ->  String -> IO ([[FlowSound]],[[SyllWeights]],[[FlowSound]])
weightStringNIO n xs = traverse (\_-> weightSyllablesIO fss) [1..n] >>= \zss -> pure (tsss, zss, helper1F . scanl' (+) (-128::Int8) . map (fromIntegral . length) $ tsss)
  where tsss = createSyllablesUkrS xs
        fss = [ ts | tss <- tsss , ts <- tss ]

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

weights2SyllableDurationsD :: [SyllWeights] -> [[[Sound8]]] -> [[Double]]
weights2SyllableDurationsD xs = syllableDurationsGD (getBFst' (4.0, weights2SyllableDurationsDArr xs))
{-# INLINE weights2SyllableDurationsD #-}

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

weightSyllAIO :: Bool -> FlowSound -> 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) . showFS $ 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 ReadyForConstructionUkr = Str String | FSL [[FlowSound]] deriving (Eq,Ord)

showR :: ReadyForConstructionUkr -> String
showR (Str xs) = xs
showR (FSL tsss) = show tsss

isStr :: ReadyForConstructionUkr -> Bool
isStr (Str _) = True
isStr _ = False

isFSL :: ReadyForConstructionUkr -> Bool
isFSL (FSL _) = True
isFSL _ = False

fromReadyFCUkrS :: ReadyForConstructionUkr -> Maybe String
fromReadyFCUkrS (Str xs) = Just xs
fromReadyFCUkrS _ = Nothing

fromReadyFCUkrF :: ReadyForConstructionUkr -> Maybe [[FlowSound]]
fromReadyFCUkrF (FSL xsss) = Just xsss
fromReadyFCUkrF _ = Nothing

helper2F :: [b] -> [a] -> [a] -> [[a]] -> [([b],[a],[a])]
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 :: String -> [[FlowSound]]
convF1 xs
 | null xs = []
 | otherwise = [ tss | tss <- createSyllablesUkrS xs ]

convF3 :: String -> [([String],[FlowSound],[FlowSound])]
convF3 xs
 | null xs = [([],[],[])]
 | otherwise = helper2F (concatMap (map showFS) tsss) (map (:[]) ([-128..0]::[Int8])) [ ts | tss <- qss, ts <- tss ] qss
    where tsss = createSyllablesUkrS xs
          qss = [ tss | tss <- tsss ]

convF3W :: String -> [(String,[FlowSound])]
convF3W xs
 | null xs = [([],[])]
 | otherwise = zipWith (\(_,ys,_) ts -> (ts,ys)) (convF3 xs) . words $ xs

convFI :: String -> String -> [[FlowSound]]
convFI ts = map f . words
  where !f = getBFstL' [] (convF3W ts)

convFSL :: String -> ReadyForConstructionUkr -> String
convFSL ts r@(Str xs) = concat . concat . intersperse [" "] . map (\(ks,_,_)-> ks) . convF3 $ xs
   where js =  unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 $ ts
convFSL ts r@(FSL tsss) =  concat . concat . intersperse [" "] . map (map (getBFstLSorted' " " ks) ) $ tsss
   where js = unzip . map (\(rs,ps,_) -> (ps,rs)) . convF3 $ ts
         ks = zip (concat . fst $ js) (concat . snd $ js)

weightsString3IO :: Bool -> String -> IO ([[FlowSound]],[[[FlowSound]] -> [[Double]]],ReadyForConstructionUkr)
weightsString3IO bool bs 
 | bool = do
   (syllDs1,sylws,fsls0) <- weightStringIO bs
   let syllableDurationsD2s = [weights2SyllableDurationsD sylws]
   return (syllDs1,syllableDurationsD2s,FSL fsls0) 
 | otherwise = return ([],[],FSL [])

weightsString3NIO :: Int -> Bool -> String -> IO ([[FlowSound]],[[[FlowSound]] -> [[Double]]],ReadyForConstructionUkr)
weightsString3NIO n bool bs 
 | bool = (\(syllDs1,sylws,fsls0) -> (syllDs1,map weights2SyllableDurationsD sylws,FSL fsls0)) <$> weightStringNIO n bs
 | otherwise = pure ([],[],FSL [])