packages feed

succinct-0.0.0.1: components/succinct-dsv/app/App/Commands/CreateIndex.hs

{-# LANGUAGE BangPatterns #-}

module App.Commands.CreateIndex
  ( cmdCreateIndex
  ) where

import App.Char
import Control.Lens
import Control.Monad
import Data.Generics.Product.Any
import HaskellWorks.Data.ByteString.Lazy
import Options.Applicative               hiding (columns)

import qualified App.Commands.Options.Type     as Z
import qualified App.IO                        as IO
import qualified Data.ByteString.Builder       as B
import qualified Data.ByteString.Lazy          as LBS
import qualified Data.Succinct.Dsv.Lazy.Cursor as SVL
import qualified System.IO                     as IO

runCreateIndex :: Z.CreateIndexOptions -> IO ()
runCreateIndex opts = do
  let !filePath   = opts ^. the @"filePath"
  let !delimiter  = opts ^. the @"delimiter"

  !bs <- IO.readInputFile filePath

  let !cursor   = SVL.makeCursor delimiter bs
  let !markers  = cursor & SVL.dsvCursorMarkers
  let !newlines = cursor & SVL.dsvCursorNewlines
  let !filePathNoDash = if filePath == "-" then "stdin" else filePath

  hOutMarkers  <- IO.openFile (filePathNoDash ++ ".markers.idx") IO.WriteMode
  hOutNewlines <- IO.openFile (filePathNoDash ++ ".newlines.idx") IO.WriteMode

  forM_ (zip markers newlines) $ \(markerV, newlineV) -> do
    LBS.hPut hOutMarkers  (toLazyByteString markerV)
    LBS.hPut hOutNewlines (toLazyByteString newlineV)

  B.hPutBuilder hOutMarkers (B.word8 0xff) -- Telomere byte
  IO.hClose hOutMarkers

  B.hPutBuilder hOutNewlines (B.word8 0xff) -- Telomere byte
  IO.hClose hOutNewlines

  return ()

optsCreateIndex :: Parser Z.CreateIndexOptions
optsCreateIndex = Z.CreateIndexOptions
  <$> strOption
        (   long "input"
        <>  short 'i'
        <>  help "Input DSV file"
        <>  metavar "STRING"
        )
  <*> option readWord8
        (   long "input-delimiter"
        <>  short 'd'
        <>  help "DSV delimiter"
        <>  metavar "CHAR"
        )

cmdCreateIndex :: Mod CommandFields (IO ())
cmdCreateIndex = command "create-index"  $ flip info idm $ runCreateIndex <$> optsCreateIndex