{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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 Data.Monoid
import Foreign.Ptr
import Foreign.ForeignPtr
import qualified Data.ByteString.Char8 as S

newtype Page = MkPage { pageLines :: [Value] }
    deriving (Show, Eq, Ord, Monoid)

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]
    , sheetOrderBy  :: ![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 }
    | VSubStr{ vLabel :: !Label, vDrop :: !Int, vTake :: !Int }
    | VReplace{ vLabel :: !Label, vMatchReplace :: ![(Value, Value)]}
    | 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]
    , blockGroupBy          :: ![Label]
    , blockFilterBy         :: ![Filter]
--  , blockRule             :: Rule
--  , blockSortPriority     :: Priority
    , blockUsePriority      :: !Bool
    }
    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

{-# INLINE matchSubstring #-}
matchSubstring :: Value -> Match -> (Maybe Int)
matchSubstring (PS x1 s1 l1) (MkMatch (PS x2 s2 l2))
    | l2 > l1   = Nothing
    | 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 Nothing else do
                        rv <- memcmp matchPtr (valuePtr `plusPtr` n) sz
                        if rv == 0 then return (Just n) else go (n+1)
                 in go 0