{-# LANGUAGE DeriveGeneric #-}

module HaskellWorks.Data.Dsv.Lazy.Cursor.Type where

import Control.DeepSeq (NFData)
import Data.Word
import GHC.Generics (Generic)

import qualified Data.ByteString.Lazy as LBS
import qualified Data.Vector.Storable as DVS

data DsvCursor = DsvCursor
  { DsvCursor -> ByteString
dsvCursorText     :: !LBS.ByteString
  , DsvCursor -> [Vector Word64]
dsvCursorMarkers  :: ![DVS.Vector Word64]
  , DsvCursor -> [Vector Word64]
dsvCursorNewlines :: ![DVS.Vector Word64]
  , DsvCursor -> Word64
dsvCursorPosition :: !Word64
  } deriving (DsvCursor -> DsvCursor -> Bool
(DsvCursor -> DsvCursor -> Bool)
-> (DsvCursor -> DsvCursor -> Bool) -> Eq DsvCursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DsvCursor -> DsvCursor -> Bool
$c/= :: DsvCursor -> DsvCursor -> Bool
== :: DsvCursor -> DsvCursor -> Bool
$c== :: DsvCursor -> DsvCursor -> Bool
Eq, Int -> DsvCursor -> ShowS
[DsvCursor] -> ShowS
DsvCursor -> String
(Int -> DsvCursor -> ShowS)
-> (DsvCursor -> String)
-> ([DsvCursor] -> ShowS)
-> Show DsvCursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DsvCursor] -> ShowS
$cshowList :: [DsvCursor] -> ShowS
show :: DsvCursor -> String
$cshow :: DsvCursor -> String
showsPrec :: Int -> DsvCursor -> ShowS
$cshowsPrec :: Int -> DsvCursor -> ShowS
Show, (forall x. DsvCursor -> Rep DsvCursor x)
-> (forall x. Rep DsvCursor x -> DsvCursor) -> Generic DsvCursor
forall x. Rep DsvCursor x -> DsvCursor
forall x. DsvCursor -> Rep DsvCursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DsvCursor x -> DsvCursor
$cfrom :: forall x. DsvCursor -> Rep DsvCursor x
Generic)

instance NFData DsvCursor