{-# OPTIONS_GHC -funbox-strict-fields #-} {-# LANGUAGE NoImplicitPrelude, BangPatterns #-} module Phladiprelio.General.Datatype where import GHC.Base import GHC.List import Data.Char (isDigit, isSpace) import Text.Read (readMaybe) import GHC.Num ((*)) import Data.Maybe (fromMaybe) data Phladiprelio t a b = Phl { inputData :: t a, convF :: t a -> t b } -- | Universal data, can be used e. g. for phladiprelio-general series of packages. data BasicLan a = L1 !a | L2 !Double deriving (Eq, Ord) -- | Specific for Ukranian data type for phladiprelio-ukrainian series of packages. data BasicUkr = U1 {-# UNPACK #-} !Char | U2 !Double deriving (Eq, Ord) readBasic0 :: Double -> (String -> [a]) -> ([a] -> [Double]) -> String -> [Double] readBasic0 = readBasic0G (not . null . filter (not . isSpace)) readBasic = readBasic0 1.0 {-# INLINE readBasic #-} readBasic0G :: (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 -> [a]) -> ([a] -> [Double]) -> String -> [Double] readBasic0G p temp fConvA fConvD xs@('_':ys) = (readU2 ws * temp) : readBasic0G p temp fConvA fConvD qs where (ws, qs) = span isDigit ys readBasic0G p temp fConvA fConvD xs@(_:_) | null us = dc | otherwise = dc `mappend` ((readU2 ws * d) : readBasic0G p d fConvA fConvD qs) where (ts, us) = break (== '_') xs dc | null ts || not (p ts) = [temp] | otherwise = fConvD . fConvA $ ts d = last dc vs = dropWhile (== '_') us (ws, qs) = span isDigit vs readBasic0G _ _ _ _ _ = [] readBasicG p = readBasic0G p 1.0 {-# INLINE readBasicG #-} -- | 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:'.':ys)::Maybe Double) readU2 _ = 1.0 {-# INLINABLE readU2 #-}