{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE NoImplicitPrelude, BangPatterns #-}
module Phladiprelio.General.Datatype3 (
Read0
, isA
, isB
, isC
, readSimple3
, basicSplit
, line2Strings
, read3
, readEq4G
, readEq4
) where
import GHC.Base
import GHC.List
import Data.List (groupBy)
import Data.Char (isDigit, isSpace,isLetter)
import Text.Read (readMaybe)
import Text.Show (Show(..))
import GHC.Num ((*),(+))
import Data.Maybe (fromMaybe)
import Data.Tuple (snd)
-- | Is a way to read duration of the additional added time period into the line.
readU2 :: String -> Double
readU2 xs@(y:ys) = fromMaybe 1.0 (readMaybe (y:'.':(if null ys then "0" else ys))::Maybe Double)
readU2 _ = 1.0
{-# INLINE readU2 #-}
splitL0 :: String -> [String]
splitL0 = groupBy (\x y -> (isDigit x && isDigit y) || (x /= '_' && x /= '=' && not (isDigit x) && y /= '_' && y /= '=' && not (isDigit y)) || ((x == '=' || x == '_') && isDigit y))
{-# INLINE splitL0 #-}
data Read0 = A {-# UNPACK #-} !Double | B {-# UNPACK #-} !Double | C String deriving (Eq, Show)
reRead3 :: String -> Read0
reRead3 xs =
case splitAt 1 xs of
("=",ts) -> A (readU2 ts)
("_",ts) -> B (readU2 ts)
_ -> C xs
isA :: Read0 -> Bool
isA (A _) = True
isA _ = False
isB :: Read0 -> Bool
isB (B _) = True
isB _ = False
isC :: Read0 -> Bool
isC (C _) = True
isC _ = False
filterReads :: [Read0] -> [Read0]
filterReads xs@(B y:A t:us) = B y : filterReads (dropWhile isA us)
filterReads xs@(A y:A t:us) = A y : filterReads (dropWhile isA us)
filterReads xs@(t:ts) = t:filterReads ts
filterReads _ = []
basicSplit :: String -> [Read0]
basicSplit = filterReads . map reRead3 . splitL0
{-# INLINE basicSplit #-}
readSimple3
:: (String -> Bool) -- ^ 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'.
-> Double
-> (String -> [Double])
-> [Read0]
-> [Double]
readSimple3 p temp fConvA rs@(C xs:A x:ts) -- This branch is fixed in the version 0.6.0.0 because earlier it has an issue.
| null qs = readSimple3 p temp fConvA ts
| null q1 = xl1 : readSimple3 p xl1 fConvA ts
| otherwise = q1 `mappend` (xl1 : readSimple3 p xl1 fConvA ts)
where qs
| p xs = fConvA xs
| otherwise = []
(q1,q2s) = splitAtEnd 1 qs
ql1 = head q2s
xl1=x*ql1
readSimple3 p temp fConvA rs@(C xs:ys@(B x:ts)) = qs `mappend` qqs `mappend` readSimple3 p ql fConvA ws
where (ks, ws) = span isB ys
qs
| p xs = fConvA xs
| otherwise = []
ql
| null qs = 0.0
| otherwise = last qs
qqs = map (\(B k) -> k * ql) ks
readSimple3 p temp fConvA rs@(B x:ts) = qqs `mappend` readSimple3 p temp fConvA ws
where (ks, ws) = span isB rs
qqs = map (\(B k) -> k * temp) ks
readSimple3 p temp fConvA [C xs] = qs
where qs
| p xs = fConvA xs
| otherwise = []
readSimple3 _ _ _ _ = []
{-# INLiNABLE readSimple3 #-}
read3
:: (String -> Bool) -- ^ 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'.
-> Double
-> (String -> [Double])
-> String
-> [Double]
read3 p temp fConvA = filter (/= 0.0) . readSimple3 p temp fConvA . basicSplit
{-# INLINE read3 #-}
splitAtEnd :: Int -> [a] -> ([a], [a])
splitAtEnd n = (\(x,y,_,_) -> (y,x)) . foldr f v
where v = ([],[],0,n)
f x (zs,ts,k,n)
| k < n = (x : zs,[],k + 1,n)
| otherwise = (zs,x : ts,k + 1,n)
-- | Is a specialized version of 'Data.SubG.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 n = (\(xs,_,_) -> xs) . foldr f v
where v = ([],0,n)
f x (zs,k,n)
| k < n = ([],k + 1,n)
| otherwise = (x : zs,k,n)
line2Strings
:: (String -> Bool) -- ^ 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 -> [String])
-> [Read0]
-> [String]
line2Strings p gConvC xs@(C ts:tt@(A x):ys) = ks `mappend` ((ql `mappend` (if null ql then [] else '=':showRead0AsInsert tt)) : line2Strings p gConvC ys)
where (ks, qs)
| p ts = splitAtEnd 1 . gConvC $ ts
| otherwise = ([],[])
ql
| null qs = []
| otherwise = head qs
line2Strings p gConvC xs@(C ys:ts) = gConvC ys `mappend` line2Strings p gConvC ts
line2Strings p gConvC xs@(y@(B x):ts) = showRead0AsInsert y : line2Strings p gConvC ts
line2Strings _ _ _ = []
{-# INLINABLE line2Strings #-}
-- | Is intended to be used in the "music" mode for PhLADiPreLiO.
readEq4G
:: (String -> Bool) -- ^ 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 -> [Double])
-> (String -> [String])
-> [Read0]
-> [(String, Double)]
readEq4G p fConvA gConvC xs = zip ks rs
where ks = line2Strings p gConvC xs
rs = filter (/= 0.0) . readSimple3 p 1.0 fConvA $ xs
{-# INLINABLE readEq4G #-}
readEq4
:: (String -> [Double])
-> (String -> [String])
-> [Read0]
-> [(String, Double)]
readEq4 = readEq4G (not . null . filter (not . isSpace))
{-# INLINE readEq4 #-}
showRead0AsInsert :: Read0 -> String
showRead0AsInsert d@(A t) = '=':(filter (/= '.') . show $ t)
showRead0AsInsert d@(B t) = '_':(filter (/= '.') . show $ t)
showRead0AsInsert d@(C ts) = ts
{-# INLINE showRead0AsInsert #-}