New create-ib-index command

Author: newhoggy

app/App/Commands.hs

@@ -1,9 +1,10 @@
 module App.Commands where
 
 import App.Commands.Count
+import App.Commands.CreateIbIndex
 import App.Commands.CreateIndex
 import App.Commands.Demo
-import Data.Semigroup           ((<>))
+import Data.Semigroup             ((<>))
 import Options.Applicative
 
 commands :: Parser (IO ())
@@ -14,4 +15,5 @@ commandsGeneral = subparser $ mempty
   <>  commandGroup "Commands:"
   <>  cmdCount
   <>  cmdCreateIndex
+  <>  cmdCreateIbIndex
   <>  cmdDemo

app/App/Commands/CreateIbIndex.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module App.Commands.CreateIbIndex
+  ( cmdCreateIbIndex
+  ) where
+
+import Control.Lens
+import Data.Generics.Product.Any
+import Data.Semigroup                                   ((<>))
+import HaskellWorks.Data.Xml.Internal.ToIbBp64
+import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
+import Options.Applicative                              hiding (columns)
+
+import qualified App.Commands.Types   as Z
+import qualified Data.ByteString.Lazy as LBS
+
+runCreateIbIndex :: Z.CreateIbIndexOptions -> IO ()
+runCreateIbIndex opt = do
+  let input     = opt ^. the @"input"
+  let ibOutput  = opt ^. the @"ibOutput"
+
+  lbs <- LBS.readFile input
+  let blankedXml = lbsToBlankedXml lbs
+  let ib = toInterestBits64' blankedXml
+  LBS.writeFile ibOutput (LBS.fromChunks ib)
+
+  return ()
+
+optsCreateIbIndex :: Parser Z.CreateIbIndexOptions
+optsCreateIbIndex = Z.CreateIbIndexOptions
+  <$> strOption
+      (   long "input"
+      <>  help "Input file"
+      <>  metavar "FILE"
+      )
+  <*> strOption
+      (   long "ib-output"
+      <>  help "Interest Bits output"
+      <>  metavar "FILE"
+      )
+
+cmdCreateIbIndex :: Mod CommandFields (IO ())
+cmdCreateIbIndex = command "create-ib-index"  $ flip info idm $ runCreateIbIndex <$> optsCreateIbIndex

app/App/Commands/CreateIndex.hs

@@ -11,7 +11,6 @@ module App.Commands.CreateIndex
   ) where
 
 import Control.Lens
-import Control.Monad
 import Data.Generics.Product.Any
 import Data.Semigroup                             ((<>))
 import HaskellWorks.Data.Xml.Succinct.Cursor.MMap
@@ -23,14 +22,14 @@ import qualified HaskellWorks.Data.ByteString.Lazy as LBS
 
 runCreateIndex :: Z.CreateIndexOptions -> IO ()
 runCreateIndex opt = do
-  let input         = opt ^. the @"input"
-  let maybeIbOutput = opt ^. the @"ibOutput"
-  let maybeBpOutput = opt ^. the @"bpOutput"
+  let input     = opt ^. the @"input"
+  let ibOutput  = opt ^. the @"ibOutput"
+  let bpOutput  = opt ^. the @"bpOutput"
 
   cursor <- mmapSlowCursor input
 
-  forM_ maybeIbOutput $ flip LBS.writeFile (LBS.toLazyByteString (cursor ^. the @"interests"      . the @1))
-  forM_ maybeBpOutput $ flip LBS.writeFile (LBS.toLazyByteString (cursor ^. the @"balancedParens" . the @1))
+  LBS.writeFile ibOutput (LBS.toLazyByteString (cursor ^. the @"interests"      . the @1))
+  LBS.writeFile bpOutput (LBS.toLazyByteString (cursor ^. the @"balancedParens" . the @1))
 
   return ()
 
@@ -41,19 +40,15 @@ optsCreateIndex = Z.CreateIndexOptions
       <>  help "Input file"
       <>  metavar "FILE"
       )
-  <*> optional
-      ( strOption
-        (   long "ib-output"
-        <>  help "Interest Bits output"
-        <>  metavar "FILE"
-        )
+  <*> strOption
+      (   long "ib-output"
+      <>  help "Interest Bits output"
+      <>  metavar "FILE"
       )
-  <*> optional
-      ( strOption
-        (   long "bp-output"
-        <>  help "Balanced Parens output"
-        <>  metavar "FILE"
-        )
+  <*> strOption
+      (   long "bp-output"
+      <>  help "Balanced Parens output"
+      <>  metavar "FILE"
       )
 
 cmdCreateIndex :: Mod CommandFields (IO ())

app/App/Commands/Types.hs

@@ -4,6 +4,7 @@
 module App.Commands.Types
   ( CountOptions(..)
   , CreateIndexOptions(..)
+  , CreateIbIndexOptions(..)
   , DemoOptions(..)
   ) where
 
@@ -21,6 +22,11 @@ data CountOptions = CountOptions
 
 data CreateIndexOptions = CreateIndexOptions
   { input    :: FilePath
-  , ibOutput :: Maybe FilePath
-  , bpOutput :: Maybe FilePath
+  , ibOutput :: FilePath
+  , bpOutput :: FilePath
+  } deriving (Eq, Show, Generic)
+
+data CreateIbIndexOptions = CreateIbIndexOptions
+  { input    :: FilePath
+  , ibOutput :: FilePath
   } deriving (Eq, Show, Generic)

hw-xml.cabal

@@ -139,6 +139,7 @@ executable hw-xml
   other-modules:        Paths_hw_xml
                         App.Commands
                         App.Commands.Count
+                        App.Commands.CreateIbIndex
                         App.Commands.CreateIndex
                         App.Commands.Demo
                         App.Commands.Types

src/HaskellWorks/Data/Xml/Succinct/Cursor/BlankedXml.hs

@@ -4,12 +4,14 @@ module HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
   , FromBlankedXml(..)
   , getBlankedXml
   , bsToBlankedXml
+  , lbsToBlankedXml
   ) where
 
-import HaskellWorks.Data.ByteString
 import HaskellWorks.Data.Xml.Conduit.Blank
 
-import qualified Data.ByteString as BS
+import qualified Data.ByteString              as BS
+import qualified Data.ByteString.Lazy         as LBS
+import qualified HaskellWorks.Data.ByteString as BS
 
 newtype BlankedXml = BlankedXml [BS.ByteString] deriving (Eq, Show)
 
@@ -20,4 +22,7 @@ class FromBlankedXml a where
   fromBlankedXml :: BlankedXml -> a
 
 bsToBlankedXml :: BS.ByteString -> BlankedXml
-bsToBlankedXml bs = BlankedXml (blankXml (chunkedBy 4064 bs))
+bsToBlankedXml bs = BlankedXml (blankXml (BS.chunkedBy 4064 bs))
+
+lbsToBlankedXml :: LBS.ByteString -> BlankedXml
+lbsToBlankedXml lbs = BlankedXml (blankXml (BS.resegmentPadded 4096 (LBS.toChunks lbs)))