phladiprelio-general-datatype-0.5.1.0: Phladiprelio/General/Datatype.hs

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

module Phladiprelio.General.Datatype where

import GHC.Base
import GHC.List
import Data.List (groupBy)
import Data.Char (isDigit, isSpace)
import Text.Read (readMaybe)
import Text.Show (Show(..))
import GHC.Num ((*))
import Data.Maybe (fromMaybe)
import Data.Tuple (snd)

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 = drop 1 us
         (ws, qs) = span isDigit vs
readBasic0G _ _ _ _ _ = []

readBasicG p = readBasic0G p 1.0
{-# INLINE readBasicG #-}

readHead
 :: (String -> [a])
 -> ([a] -> [Double])
 -> String 
 -> Double
readHead fConvA fConvD xs = h  
   where hs = fConvD . fConvA $ xs
         h 
           | null hs = 1.0
           | otherwise = head hs

splF js@(_:_) 
  = case span (== '_') js of
      (~is,[]) -> []
      ~(is, rs) -> let (bs, ds) = span isDigit rs in bs : splF ds
splF [] = []

data Read2 = D [Double] | S [Char] deriving (Eq, Show)

readBasic1G 
 :: String 
 -> [Read2]
readBasic1G xs = xss
   where f xs@('_':ys) = D (map readU2 . splF $ ys)
         f xs = S xs
         xss = map f . groupBy (\x y -> (isDigit y || y == '_') && (isDigit x || x == '_') || not (or [isDigit x, isDigit y, x == '_', y == '_'])) $ xs

showDoubleAsInsert :: Double -> String
showDoubleAsInsert d
  | d <= 0 = []
  | otherwise = '_':(filter (/= '.') . show $ d)
{-# INLINE showDoubleAsInsert #-}

readBasic2G 
 :: (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 -> [a])
 -> ([a] -> [Double])
 -> [Read2]
 -> [Double]
readBasic2G p fConvA fConvD xs@(D ys:S t:ts) = map (* h) ys `mappend` readBasic2G p fConvA fConvD (S t:ts)
   where h = readHead fConvA fConvD t
readBasic2G p fConvA fConvD xs@(S ys:D ts:ks) = dc `mappend` map (* l) ts `mappend` readBasic2G p fConvA fConvD ks
   where dc = fConvD . fConvA $ ys
         l = last dc
readBasic2G p fConvA fConvD [S ys] = fConvD . fConvA $ ys
readBasic2G _ _ _ _ = []

readBasic3G p fConvA fConvD = readBasic2G p fConvA fConvD .  readBasic1G
{-# INLINABLE readBasic3G #-}

readBasic3 = readBasic3G (not . null . filter (not . isSpace))
{-# INLINABLE readBasic3 #-}

-- | Is intended to be used in the "music" mode for PhLADiPreLiO.
readBasic4G 
 :: (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 -> [a])
 -> ([a] -> [Double])
 -> (String -> [b])
 -> ([b] -> [String])
 -> [Read2]
 -> [(String, Double)]
readBasic4G p fConvA fConvD gConvB gConvS xs@(D ys:S t:ts) = map (\y -> (showDoubleAsInsert y, y * h)) ys `mappend` readBasic4G p fConvA fConvD gConvB gConvS (S t:ts)
   where h = readHead fConvA fConvD t
readBasic4G p fConvA fConvD gConvB gConvS xs@(S ys:D ts:ks) = dc `mappend` map (\y -> (showDoubleAsInsert y, y * l)) ts `mappend` readBasic4G p fConvA fConvD gConvB gConvS ks
   where dc =  zip (gConvS . gConvB $ ys) (fConvD . fConvA $ ys)
         dl = last dc
         l = snd dl
readBasic4G p fConvA fConvD gConvB gConvS [S ys] = zip (gConvS . gConvB $ ys) (fConvD . fConvA $ ys)
readBasic4G _ _ _ _ _ _ = []

readBasic4 = readBasic4G (not . null . filter (not . isSpace))
{-# INLINE readBasic4 #-}

-- | 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
{-# INLINABLE readU2 #-}

-- | Is a way to read duration of the additional added time period into the line.
readU3 :: Double -> String -> Double
readU3 def xs@(y:ys) = fromMaybe def (readMaybe (y:'.':(if null ys then "0" else ys))::Maybe Double)
readU3 def _ = def
{-# INLINABLE readU3 #-}