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]
}
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]
}
deriving (Show, Eq, Ord)
newtype Match = MkMatch { matchValue :: Value }
deriving (Show, Eq, Ord)
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