{-# OPTIONS -funbox-strict-fields #-} module Text.PageIO.Types (module Text.PageIO.Types, module Text.PageIO.LabelMap) where import Text.PageIO.LabelMap (LabelMap, Label, toLabel, fromLabel) import Data.ByteString.Internal (inlinePerformIO, memcmp, ByteString(..)) import Data.Char (isDigit) import Foreign.Ptr import Foreign.ForeignPtr import qualified Data.ByteString.Char8 as S newtype Page = MkPage { pageLines :: [Value] } deriving (Show, Eq, Ord) type Col = Int type Row = Int type FractionDigits = Int data FieldFormat = FGeneral | FNumeric FractionDigits | FDate deriving (Show, Eq, Ord) type Value = ByteString data Box = MkBox { boxLeft :: !Col , boxTop :: !Row , boxRight :: Col , boxBottom :: !Row } deriving (Show, Eq, Ord) data Sheet = MkSheet { sheetName :: !Label , sheetBox :: !Box , sheetPatterns :: !(LabelMap Pattern) , sheetFields :: !(LabelMap Field) , sheetFrames :: ![Frame] , sheetGroupBy :: ![Label] -- , sheetPositioning :: CharPos | GridPos -- , sheetUseBlockSortPriority :: Bool } deriving (Show, Eq, Ord) data Pattern = MkPattern { patternBox :: !Box , patternMatch :: !Match , patternUseWildcards :: !Bool } deriving (Show, Eq, Ord) data Scope = SPage | SDoc deriving (Show, Eq, Ord) data Variable = VPage | VSum{ vScope :: !Scope, vLabel :: !Label } | VCount{ vScope :: !Scope, vLabel :: !Label } | VLabel{ vLabel :: !Label } | VLiteral{ vValue :: !Value } deriving (Show, Eq, Ord) data Field = MkField { fieldBox :: !Box , fieldVariable :: !(Maybe Variable) , fieldKeepSpaces :: !Bool , fieldFormat :: !FieldFormat } deriving (Show, Eq, Ord) data Frame = MkFrame { frameBox :: !Box , frameBlocks :: !(LabelMap Block) } deriving (Show, Eq, Ord) data Operator = ONot !Operator | OContains | OEq | OEndsWith | OStartsWith deriving (Show, Eq, Ord) data Filter = MkFilter { filterField :: !Label , filterOperator :: !Operator , filterMatch :: !Match } deriving (Show, Eq, Ord) data OrderBy a = DAscending !a | DDescending !a deriving (Show, Eq) instance Functor OrderBy where fmap f (DAscending x) = DAscending (f x) fmap f (DDescending x) = DDescending (f x) instance Ord a => Ord (OrderBy a) where compare (DAscending x) (DAscending y) = compare x y compare (DDescending x) (DDescending y) = compare y x compare DAscending{} _ = LT compare _ _ = GT data Block = MkBlock { blockLines :: !Row , blockPatterns :: !(LabelMap Pattern) , blockFields :: !(LabelMap Field) , blockOrderBy :: ![OrderBy Label] , blockFilterBy :: ![Filter] -- , blockRule :: Rule -- , blockSortPriority :: Priority } deriving (Show, Eq, Ord) newtype Match = MkMatch { matchValue :: Value } deriving (Show, Eq, Ord) {-# INLINE matches #-} matches :: Value -> Match -> Bool matches (PS x1 s1 l1) (MkMatch (PS x2 s2 l2)) | l2 > l1 = False | otherwise = inlinePerformIO $ withForeignPtr x1 $ \p1 -> withForeignPtr x2 $ \p2 -> do let valuePtr = p1 `plusPtr` s1 matchPtr = p2 `plusPtr` s2 sz = fromIntegral l2 maxOffset = l1 - l2 go n = if n > maxOffset then return False else do rv <- memcmp matchPtr (valuePtr `plusPtr` n) sz if rv == 0 then return True else go (n+1) in go 0 valToIntVal :: Value -> Value valToIntVal = S.filter isDigit . S.takeWhile (/= '.') valToInt :: Value -> Int valToInt val = case S.readInt (valToIntVal val) of Just (num, _) -> num _ -> 0