{-# LANGUAGE BangPatterns #-}

module HaskellWorks.Data.Json.Standard.Cursor.Index
  ( indexJson
  ) where

import Data.Word
import HaskellWorks.Data.BalancedParens.Simple
import HaskellWorks.Data.Json.Standard.Cursor.Generic

import qualified Data.ByteString                             as BS
import qualified Data.Vector.Storable                        as DVS
import qualified HaskellWorks.Data.ByteString                as BS
import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW

indexJson :: String -> IO ()
indexJson :: String -> IO ()
indexJson String
filename = do
  ByteString
bs <- String -> IO ByteString
BS.mmap String
filename
  -- We use the SLOW reference implementation because we are writing to a file and will never query.
  let GenericCursor ByteString
_ !Vector Word64
ib (SimpleBalancedParens !Vector Word64
bp) Word64
_ = ByteString
-> GenericCursor
     ByteString (Vector Word64) (SimpleBalancedParens (Vector Word64))
SLOW.fromByteString ByteString
bs
  let wib :: Vector Word8
wib = Vector Word64 -> Vector Word8
forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast Vector Word64
ib :: DVS.Vector Word8
  let wbp :: Vector Word8
wbp = Vector Word64 -> Vector Word8
forall a b. (Storable a, Storable b) => Vector a -> Vector b
DVS.unsafeCast Vector Word64
bp :: DVS.Vector Word8
  String -> ByteString -> IO ()
BS.writeFile (String
filename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".ib.idx") (Vector Word8 -> ByteString
forall a. ToByteString a => a -> ByteString
BS.toByteString Vector Word8
wib)
  String -> ByteString -> IO ()
BS.writeFile (String
filename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".bp.idx") (Vector Word8 -> ByteString
forall a. ToByteString a => a -> ByteString
BS.toByteString Vector Word8
wbp)