{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

{- |
Module      :  Aftovolio.General.Datatype3
Copyright   :  (c) OleksandrZhabenko 2023-2024
License     :  MIT
Stability   :  Experimental
Maintainer  :  oleksandr.zhabenko@yahoo.com
-}
module Aftovolio.General.Datatype3 (
    Read0,
    isA,
    isB,
    isC,
    readU2,
    readSimple3,
    basicSplit,
    line2Strings,
    read3,
    readEq4G,
    readEq4,
    zippedDouble2Word8,
) where

import Data.Char (isDigit, isLetter, isSpace)
import qualified Data.Foldable as F (foldr)
import Data.List (find, groupBy, maximumBy, minimumBy)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import qualified Data.Sequence as S
import Data.Tuple (fst, snd)
import GHC.Base
import GHC.Float (int2Double)
import GHC.List
import GHC.Num ((*), (+), (-))
import GHC.Real (floor, fromIntegral, (/))
import GHC.Word
import ListQuantizer (round2GL)
import Text.Read (readMaybe)
import Text.Show (Show (..))

-- | Is a way to read duration of the additional added time period into the line.
readU2 :: String -> Double
readU2 :: String -> Double
readU2 (Char
y : String
ys) = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1.0 (String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (Char
y Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'.' Char -> String -> String
forall a. a -> [a] -> [a]
: (if String -> Bool
forall a. [a] -> Bool
null String
ys then String
"0" else String
ys)) :: Maybe Double)
readU2 String
_ = Double
1.0
{-# INLINE readU2 #-}

-- | Splits a 'String' into list of 'String' so that they can be read by other functions here into respective datatypes.
splitL0 :: String -> [String]
splitL0 :: String -> [String]
splitL0 =
    (Char -> Char -> Bool) -> String -> [String]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy
        ( \Char
x Char
y ->
            (Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
y)
                Bool -> Bool -> Bool
|| ( Char
x
                        Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_'
                        Bool -> Bool -> Bool
&& Char
x
                        Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'='
                        Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isDigit Char
x)
                        Bool -> Bool -> Bool
&& Char
y
                        Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_'
                        Bool -> Bool -> Bool
&& Char
y
                        Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'='
                        Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isDigit Char
y)
                   )
                Bool -> Bool -> Bool
|| ((Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') Bool -> Bool -> Bool
&& Char -> Bool
isDigit Char
y)
        )
{-# INLINE splitL0 #-}

data Read0 = A {-# UNPACK #-} !Double | B {-# UNPACK #-} !Double | C String
    deriving (Read0 -> Read0 -> Bool
(Read0 -> Read0 -> Bool) -> (Read0 -> Read0 -> Bool) -> Eq Read0
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Read0 -> Read0 -> Bool
== :: Read0 -> Read0 -> Bool
$c/= :: Read0 -> Read0 -> Bool
/= :: Read0 -> Read0 -> Bool
Eq, Int -> Read0 -> String -> String
[Read0] -> String -> String
Read0 -> String
(Int -> Read0 -> String -> String)
-> (Read0 -> String) -> ([Read0] -> String -> String) -> Show Read0
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Read0 -> String -> String
showsPrec :: Int -> Read0 -> String -> String
$cshow :: Read0 -> String
show :: Read0 -> String
$cshowList :: [Read0] -> String -> String
showList :: [Read0] -> String -> String
Show)

-- | Converts a specially formatted 'String' into a 'Read0' value.
reRead3 :: String -> Read0
reRead3 :: String -> Read0
reRead3 String
xs =
    case String -> Maybe (Char, String)
forall a. [a] -> Maybe (a, [a])
uncons String
xs of
        Just (Char
'=', String
ts) -> Double -> Read0
A (String -> Double
readU2 String
ts)
        Just (Char
'_', String
ts) -> Double -> Read0
B (String -> Double
readU2 String
ts)
        Maybe (Char, String)
_ -> String -> Read0
C String
xs

isA :: Read0 -> Bool
isA :: Read0 -> Bool
isA (A Double
_) = Bool
True
isA Read0
_ = Bool
False

isB :: Read0 -> Bool
isB :: Read0 -> Bool
isB (B Double
_) = Bool
True
isB Read0
_ = Bool
False

isC :: Read0 -> Bool
isC :: Read0 -> Bool
isC (C String
_) = Bool
True
isC Read0
_ = Bool
False

filterReads :: [Read0] -> S.Seq Read0
filterReads :: [Read0] -> Seq Read0
filterReads xs :: [Read0]
xs@(B Double
y : A Double
t : [Read0]
us) = Double -> Read0
B Double
y Read0 -> Seq Read0 -> Seq Read0
forall a. a -> Seq a -> Seq a
S.<| [Read0] -> Seq Read0
filterReads ((Read0 -> Bool) -> [Read0] -> [Read0]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Read0 -> Bool
isA [Read0]
us)
filterReads xs :: [Read0]
xs@(A Double
y : A Double
t : [Read0]
us) = Double -> Read0
A Double
y Read0 -> Seq Read0 -> Seq Read0
forall a. a -> Seq a -> Seq a
S.<| [Read0] -> Seq Read0
filterReads ((Read0 -> Bool) -> [Read0] -> [Read0]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Read0 -> Bool
isA [Read0]
us)
filterReads xs :: [Read0]
xs@(Read0
t : [Read0]
ts) = Read0
t Read0 -> Seq Read0 -> Seq Read0
forall a. a -> Seq a -> Seq a
S.<| [Read0] -> Seq Read0
filterReads [Read0]
ts
filterReads [Read0]
_ = Seq Read0
forall a. Seq a
S.empty

-- | A preparatory function for the further ones here.
basicSplit :: String -> S.Seq Read0
basicSplit :: String -> Seq Read0
basicSplit = [Read0] -> Seq Read0
filterReads ([Read0] -> Seq Read0)
-> (String -> [Read0]) -> String -> Seq Read0
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Read0) -> [String] -> [Read0]
forall a b. (a -> b) -> [a] -> [b]
map String -> Read0
reRead3 ([String] -> [Read0]) -> (String -> [String]) -> String -> [Read0]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitL0
{-# INLINE basicSplit #-}

readSimple3 ::
    -- | A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.
    (String -> Bool) ->
    Double ->
    (String -> [Word8]) ->
    -- | Is should be obtained using 'basicSplit' function here.
    S.Seq Read0 ->
    [Word8]
readSimple3 :: (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
temp String -> [Word8]
fConvA rs :: Seq Read0
rs@(C String
xs S.:<| A Double
x S.:<| Seq Read0
ts) -- This branch is fixed in the version 0.6.0.0 because earlier it has an issue.
    | [Word8] -> Bool
forall a. [a] -> Bool
null [Word8]
qs = (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
temp String -> [Word8]
fConvA Seq Read0
ts
    | [Word8] -> Bool
forall a. [a] -> Bool
null [Word8]
q1 = Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
xl1 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
xl1 String -> [Word8]
fConvA Seq Read0
ts
    | Bool
otherwise = [Word8]
q1 [Word8] -> [Word8] -> [Word8]
forall a. Monoid a => a -> a -> a
`mappend` (Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
xl1 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
xl1 String -> [Word8]
fConvA Seq Read0
ts)
  where
    qs :: [Word8]
qs
        | String -> Bool
p String
xs = String -> [Word8]
fConvA String
xs
        | Bool
otherwise = []
    ([Word8]
q1, [Word8]
q2s) = Int -> [Word8] -> ([Word8], [Word8])
forall a. Int -> [a] -> ([a], [a])
splitAtEnd Int
1 [Word8]
qs
    ql1 :: Word8
ql1 = [Word8] -> Word8
forall a. HasCallStack => [a] -> a
head [Word8]
q2s
    xl1 :: Double
xl1 = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word8 -> Double
word8ToDouble Word8
ql1) Double
255.0
readSimple3 String -> Bool
p Double
temp String -> [Word8]
fConvA rs :: Seq Read0
rs@(C String
xs S.:<| ys :: Seq Read0
ys@(B Double
x S.:<| Seq Read0
ts)) = [Word8]
qs [Word8] -> [Word8] -> [Word8]
forall a. Monoid a => a -> a -> a
`mappend` [Word8]
qqs [Word8] -> [Word8] -> [Word8]
forall a. Monoid a => a -> a -> a
`mappend` (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
ql String -> [Word8]
fConvA Seq Read0
ws
  where
    (!Seq Read0
ks, Seq Read0
ws) = (Read0 -> Bool) -> Seq Read0 -> (Seq Read0, Seq Read0)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.spanl Read0 -> Bool
isB Seq Read0
ys
    !qs :: [Word8]
qs
        | String -> Bool
p String
xs = String -> [Word8]
fConvA String
xs
        | Bool
otherwise = []
    !ql :: Double
ql
        | [Word8] -> Bool
forall a. [a] -> Bool
null [Word8]
qs = Double
0.0
        | Bool
otherwise = Word8 -> Double
word8ToDouble (Word8 -> Double) -> ([Word8] -> Word8) -> [Word8] -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> Word8
forall a. HasCallStack => [a] -> a
last ([Word8] -> Double) -> [Word8] -> Double
forall a b. (a -> b) -> a -> b
$ [Word8]
qs
    qqs :: [Word8]
qqs = (Read0 -> [Word8] -> [Word8]) -> [Word8] -> Seq Read0 -> [Word8]
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\(B Double
k) [Word8]
js -> Double -> Word8
double2Word8 (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ql) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
js) [] Seq Read0
ks
readSimple3 String -> Bool
p Double
temp String -> [Word8]
fConvA rs :: Seq Read0
rs@(B Double
x S.:<| Seq Read0
ts) = [Word8]
qqs [Word8] -> [Word8] -> [Word8]
forall a. Monoid a => a -> a -> a
`mappend` (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
temp String -> [Word8]
fConvA Seq Read0
ws
  where
    (Seq Read0
ks, Seq Read0
ws) = (Read0 -> Bool) -> Seq Read0 -> (Seq Read0, Seq Read0)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.spanl Read0 -> Bool
isB Seq Read0
rs
    qqs :: [Word8]
qqs = (Read0 -> [Word8] -> [Word8]) -> [Word8] -> Seq Read0 -> [Word8]
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\(B Double
k) [Word8]
js -> Double -> Word8
double2Word8 (Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
temp) Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
js) [] Seq Read0
ks
readSimple3 String -> Bool
p Double
temp String -> [Word8]
fConvA (C String
xs S.:<| Seq Read0
_) = [Word8]
qs
  where
    qs :: [Word8]
qs
        | String -> Bool
p String
xs = String -> [Word8]
fConvA String
xs
        | Bool
otherwise = []
readSimple3 String -> Bool
_ Double
_ String -> [Word8]
_ Seq Read0
_ = []

-- | Is intended to 'floor' the values greater than 255.0 to 255::'Word8' and to be used for non-negative 'Double'.
double2Word8 :: Double -> Word8
double2Word8 :: Double -> Word8
double2Word8 = Double -> Word8
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Word8) -> (Double -> Double) -> Double -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
255.0
{-# INLINE double2Word8 #-}

-- | Is done using intermediate 'Int' representation.
word8ToDouble :: Word8 -> Double
word8ToDouble :: Word8 -> Double
word8ToDouble = Int -> Double
int2Double (Int -> Double) -> (Word8 -> Int) -> Word8 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE word8ToDouble #-}

read3 ::
    -- | A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.
    (String -> Bool) ->
    Double ->
    (String -> [Word8]) ->
    String ->
    [Word8]
read3 :: (String -> Bool)
-> Double -> (String -> [Word8]) -> String -> [Word8]
read3 String -> Bool
p Double
temp String -> [Word8]
fConvA = (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) ([Word8] -> [Word8]) -> (String -> [Word8]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
temp String -> [Word8]
fConvA (Seq Read0 -> [Word8])
-> (String -> Seq Read0) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Seq Read0
basicSplit
{-# INLINE read3 #-}

splitAtEnd :: Int -> [a] -> ([a], [a])
splitAtEnd :: forall a. Int -> [a] -> ([a], [a])
splitAtEnd Int
n = (\([a]
x, [a]
y, Int
_) -> ([a]
y, [a]
x)) (([a], [a], Int) -> ([a], [a]))
-> ([a] -> ([a], [a], Int)) -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ([a], [a], Int) -> ([a], [a], Int))
-> ([a], [a], Int) -> [a] -> ([a], [a], Int)
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> ([a], [a], Int) -> ([a], [a], Int)
forall {a}. a -> ([a], [a], Int) -> ([a], [a], Int)
f ([a], [a], Int)
forall {a} {a}. ([a], [a], Int)
v
  where
    v :: ([a], [a], Int)
v = ([], [], Int
0)
    f :: a -> ([a], [a], Int) -> ([a], [a], Int)
f a
x ([a]
zs, [a]
ts, Int
k)
        | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
zs, [], Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = ([a]
zs, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ts, Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

{- | Is a specialized version of 'Data.InsertLeft.dropFromEndG' function variant from the @subG@ package. Is taken from there to
reduce the dependencies. Is not intended to be exported at all.
-}
dropFromEnd :: Int -> [a] -> [a]
dropFromEnd :: forall a. Int -> [a] -> [a]
dropFromEnd Int
n = (\([a]
xs, Int
_) -> [a]
xs) (([a], Int) -> [a]) -> ([a] -> ([a], Int)) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ([a], Int) -> ([a], Int)) -> ([a], Int) -> [a] -> ([a], Int)
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> ([a], Int) -> ([a], Int)
forall {a}. a -> ([a], Int) -> ([a], Int)
f ([a], Int)
forall {a}. ([a], Int)
v
  where
    v :: ([a], Int)
v = ([], Int
0)
    f :: a -> ([a], Int) -> ([a], Int)
f a
x ([a]
zs, Int
k)
        | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = ([], Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
zs, Int
k)

line2Strings ::
    -- | A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.
    (String -> Bool) ->
    (String -> [String]) ->
    -- | Is should be obtained using 'basicSplit' function here.
    S.Seq Read0 ->
    [String]
line2Strings :: (String -> Bool) -> (String -> [String]) -> Seq Read0 -> [String]
line2Strings String -> Bool
p String -> [String]
gConvC xs :: Seq Read0
xs@(C String
ts S.:<| tt :: Read0
tt@(A Double
x) S.:<| Seq Read0
ys)
    | [String] -> Bool
forall a. [a] -> Bool
null [String]
qs = [String]
ks [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` (String -> Bool) -> (String -> [String]) -> Seq Read0 -> [String]
line2Strings String -> Bool
p String -> [String]
gConvC Seq Read0
ys
    | Bool
otherwise =
        [String]
ks
            [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` ((String
ql String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` (Char
'=' Char -> String -> String
forall a. a -> [a] -> [a]
: Read0 -> String
showRead0AsInsert Read0
tt)) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> Bool) -> (String -> [String]) -> Seq Read0 -> [String]
line2Strings String -> Bool
p String -> [String]
gConvC Seq Read0
ys)
  where
    ([String]
ks, [String]
qs)
        | String -> Bool
p String
ts = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAtEnd Int
1 ([String] -> ([String], [String]))
-> (String -> [String]) -> String -> ([String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
gConvC (String -> ([String], [String])) -> String -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ String
ts
        | Bool
otherwise = ([], [])
    ql :: String
ql = [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
qs
line2Strings String -> Bool
p String -> [String]
gConvC xs :: Seq Read0
xs@(C String
ys S.:<| Seq Read0
ts) = String -> [String]
gConvC String
ys [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
`mappend` (String -> Bool) -> (String -> [String]) -> Seq Read0 -> [String]
line2Strings String -> Bool
p String -> [String]
gConvC Seq Read0
ts
line2Strings String -> Bool
p String -> [String]
gConvC xs :: Seq Read0
xs@(y :: Read0
y@(B Double
x) S.:<| Seq Read0
ts) = Read0 -> String
showRead0AsInsert Read0
y String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> Bool) -> (String -> [String]) -> Seq Read0 -> [String]
line2Strings String -> Bool
p String -> [String]
gConvC Seq Read0
ts
line2Strings String -> Bool
_ String -> [String]
_ Seq Read0
_ = []

-- | Is intended to be used in the "music" mode for AFTOVolio.
readEq4G ::
    -- | A special function to check whether the 'String' contains needed information. Must return 'True' for the 'String' that contains the needed for usual processment information, otherwise — 'False'.
    (String -> Bool) ->
    (String -> [Word8]) ->
    (String -> [String]) ->
    -- | Is should be obtained using 'basicSplit' function here.
    S.Seq Read0 ->
    [(String, Word8)]
readEq4G :: (String -> Bool)
-> (String -> [Word8])
-> (String -> [String])
-> Seq Read0
-> [(String, Word8)]
readEq4G String -> Bool
p String -> [Word8]
fConvA String -> [String]
gConvC Seq Read0
xs = [String] -> [Word8] -> [(String, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
ks [Word8]
rs
  where
    ks :: [String]
ks = (String -> Bool) -> (String -> [String]) -> Seq Read0 -> [String]
line2Strings String -> Bool
p String -> [String]
gConvC Seq Read0
xs
    rs :: [Word8]
rs = (Word8 -> Bool) -> [Word8] -> [Word8]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) ([Word8] -> [Word8])
-> (Seq Read0 -> [Word8]) -> Seq Read0 -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool)
-> Double -> (String -> [Word8]) -> Seq Read0 -> [Word8]
readSimple3 String -> Bool
p Double
1.0 String -> [Word8]
fConvA (Seq Read0 -> [Word8]) -> Seq Read0 -> [Word8]
forall a b. (a -> b) -> a -> b
$ Seq Read0
xs
{-# INLINE readEq4G #-}

readEq4 ::
    (String -> [Word8]) ->
    (String -> [String]) ->
    -- | Is should be obtained using 'basicSplit' function here.
    S.Seq Read0 ->
    [(String, Word8)]
readEq4 :: (String -> [Word8])
-> (String -> [String]) -> Seq Read0 -> [(String, Word8)]
readEq4 = (String -> Bool)
-> (String -> [Word8])
-> (String -> [String])
-> Seq Read0
-> [(String, Word8)]
readEq4G (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
null (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))
{-# INLINE readEq4 #-}

showRead0AsInsert :: Read0 -> String
showRead0AsInsert :: Read0 -> String
showRead0AsInsert d :: Read0
d@(A Double
t) = Char
'=' Char -> String -> String
forall a. a -> [a] -> [a]
: ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (String -> String) -> (Double -> String) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
t)
showRead0AsInsert d :: Read0
d@(B Double
t) = Char
'_' Char -> String -> String
forall a. a -> [a] -> [a]
: ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (String -> String) -> (Double -> String) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
t)
showRead0AsInsert d :: Read0
d@(C String
ts) = String
ts
{-# INLINE showRead0AsInsert #-}

-- | Is intended to be used to transform the earlier data for AFTOVolio representations durations from 'Double' to 'Word8' values. It was used during the transition from the ukrainian-phonetics-basic-array-0.7.1.1 to ukrainian-phonetics-basic-array-0.10.0.0.
zippedDouble2Word8 :: [(a, b)] -> [(a, b)]
zippedDouble2Word8 [(a, b)]
xs = ((a, b) -> (a, b)) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
t, b
u) -> (a
t, b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
15 (Maybe b -> b) -> (b -> Maybe b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
hh (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
u)) [(a, b)]
xs
  where
    !h :: b
h = (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> ([(a, b)] -> (a, b)) -> [(a, b)] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> (a, b)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> b
forall a b. (a, b) -> b
snd) ([(a, b)] -> b) -> [(a, b)] -> b
forall a b. (a -> b) -> a -> b
$ [(a, b)]
xs
    !lt :: b
lt = (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> ([(a, b)] -> (a, b)) -> [(a, b)] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> (a, b)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((a, b) -> b) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> b
forall a b. (a, b) -> b
snd) ([(a, b)] -> b) -> [(a, b)] -> b
forall a b. (a -> b) -> a -> b
$ [(a, b)]
xs
    !del :: b
del = (b
lt b -> b -> b
forall a. Num a => a -> a -> a
- b
h) b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
14.0
    !ys :: [b]
ys = Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
take Int
15 ([b] -> [b]) -> (b -> [b]) -> b -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b) -> b -> [b]
forall a. (a -> a) -> a -> [a]
iterate (b -> b -> b
forall a. Num a => a -> a -> a
+ b
del) (b -> [b]) -> b -> [b]
forall a b. (a -> b) -> a -> b
$ b
h
    !zs :: [(b, b)]
zs = [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b
1 .. b
15] [b]
ys
    gg :: b -> b
gg !b
u = b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
lt (Maybe b -> b) -> (b -> Maybe b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ([b] -> b -> Ordering) -> [b] -> b -> Maybe b
forall a.
Ord a =>
Bool -> ([a] -> a -> Ordering) -> [a] -> a -> Maybe a
round2GL Bool
True (\[b]
_ b
_ -> Ordering
EQ) [b]
ys (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
u
    hh :: b -> Maybe b
hh !b
u = ((b, b) -> b) -> Maybe (b, b) -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, b) -> b
forall a b. (a, b) -> a
fst (Maybe (b, b) -> Maybe b)
-> ([(b, b)] -> Maybe (b, b)) -> [(b, b)] -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, b) -> Bool) -> [(b, b)] -> Maybe (b, b)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b -> b
gg b
u) (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> b
forall a b. (a, b) -> b
snd) ([(b, b)] -> Maybe b) -> [(b, b)] -> Maybe b
forall a b. (a -> b) -> a -> b
$ [(b, b)]
zs