{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ScopedTypeVariables #-}

module HaskellWorks.Data.Xml.Succinct.Cursor.MMap
  ( SlowCursor
  , FastCursor
  , mmapSlowCursor
  , mmapFastCursor
  ) where

import Data.Word
import Foreign.ForeignPtr
import HaskellWorks.Data.BalancedParens.RangeMin2
import HaskellWorks.Data.BalancedParens.Simple
import HaskellWorks.Data.Bits.BitShown
import HaskellWorks.Data.RankSelect.CsPoppy1
import HaskellWorks.Data.Vector.Storable
import HaskellWorks.Data.Xml.Succinct.Cursor
import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
import HaskellWorks.Data.Xml.Succinct.Cursor.Types

import qualified Data.ByteString.Internal                as BSI
import qualified HaskellWorks.Data.Xml.Internal.ToIbBp64 as I
import qualified System.IO.MMap                          as IO

mmapSlowCursor :: FilePath -> IO SlowCursor
mmapSlowCursor :: FilePath -> IO SlowCursor
mmapSlowCursor FilePath
filePath = do
  (ForeignPtr Word8
fptr :: ForeignPtr Word8, Int
offset, Int
size) <- FilePath
-> Mode -> Maybe (Int64, Int) -> IO (ForeignPtr Word8, Int, Int)
forall a.
FilePath
-> Mode -> Maybe (Int64, Int) -> IO (ForeignPtr a, Int, Int)
IO.mmapFileForeignPtr FilePath
filePath Mode
IO.ReadOnly Maybe (Int64, Int)
forall a. Maybe a
Nothing
  let !bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr (ForeignPtr Word8 -> ForeignPtr Word8
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr Word8
fptr) Int
offset Int
size
  let blankedXml :: BlankedXml
blankedXml = ByteString -> BlankedXml
bsToBlankedXml ByteString
bs
  let (Vector Word64
ib, Vector Word64
bp) = Int -> [(ByteString, ByteString)] -> (Vector Word64, Vector Word64)
construct64UnzipN (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) (BlankedXml -> [(ByteString, ByteString)]
I.toIbBp64 BlankedXml
blankedXml)
  let !cursor :: SlowCursor
cursor = XmlCursor :: forall t v w. t -> v -> w -> Word64 -> XmlCursor t v w
XmlCursor
        { cursorText :: ByteString
cursorText      = ByteString
bs
        , interests :: BitShown (Vector Word64)
interests       = Vector Word64 -> BitShown (Vector Word64)
forall a. a -> BitShown a
BitShown Vector Word64
ib
        , balancedParens :: SimpleBalancedParens (Vector Word64)
balancedParens  = Vector Word64 -> SimpleBalancedParens (Vector Word64)
forall a. a -> SimpleBalancedParens a
SimpleBalancedParens Vector Word64
bp
        , cursorRank :: Word64
cursorRank      = Word64
1
        }

  SlowCursor -> IO SlowCursor
forall (m :: * -> *) a. Monad m => a -> m a
return SlowCursor
cursor

mmapFastCursor :: FilePath -> IO FastCursor
mmapFastCursor :: FilePath -> IO FastCursor
mmapFastCursor FilePath
filename = do
  -- Load the XML file into memory as a raw cursor.
  -- The raw XML data is `text`, and `ib` and `bp` are the indexes.
  -- `ib` and `bp` can be persisted to an index file for later use to avoid
  -- re-parsing the file.
  XmlCursor !ByteString
text (BitShown !Vector Word64
ib) (SimpleBalancedParens !Vector Word64
bp) Word64
_ <- FilePath -> IO SlowCursor
mmapSlowCursor FilePath
filename
  let !bpCsPoppy :: CsPoppy1
bpCsPoppy = Vector Word64 -> CsPoppy1
makeCsPoppy Vector Word64
bp
  let !rangeMinMax :: RangeMin2 CsPoppy1
rangeMinMax = CsPoppy1 -> RangeMin2 CsPoppy1
forall a. AsVector64 a => a -> RangeMin2 a
mkRangeMin2 CsPoppy1
bpCsPoppy
  let !ibCsPoppy :: CsPoppy1
ibCsPoppy = Vector Word64 -> CsPoppy1
makeCsPoppy Vector Word64
ib
  FastCursor -> IO FastCursor
forall (m :: * -> *) a. Monad m => a -> m a
return (FastCursor -> IO FastCursor) -> FastCursor -> IO FastCursor
forall a b. (a -> b) -> a -> b
$ ByteString
-> CsPoppy1 -> RangeMin2 CsPoppy1 -> Word64 -> FastCursor
forall t v w. t -> v -> w -> Word64 -> XmlCursor t v w
XmlCursor ByteString
text CsPoppy1
ibCsPoppy RangeMin2 CsPoppy1
rangeMinMax Word64
1