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 Foreign.Ptr
import Foreign.ForeignPtr

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
    { 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 }
    | 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