New create-bp-index command

Author: newhoggy

app/App/Commands.hs

@@ -1,6 +1,7 @@
 module App.Commands where
 
 import App.Commands.Count
+import App.Commands.CreateBpIndex
 import App.Commands.CreateIbIndex
 import App.Commands.CreateIndex
 import App.Commands.Demo
@@ -16,4 +17,5 @@ commandsGeneral = subparser $ mempty
   <>  cmdCount
   <>  cmdCreateIndex
   <>  cmdCreateIbIndex
+  <>  cmdCreateBpIndex
   <>  cmdDemo

app/App/Commands/CreateBpIndex.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module App.Commands.CreateBpIndex
+  ( cmdCreateBpIndex
+  ) 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
+
+runCreateBpIndex :: Z.CreateBpIndexOptions -> IO ()
+runCreateBpIndex opt = do
+  let input     = opt ^. the @"input"
+  let output  = opt ^. the @"output"
+
+  lbs <- LBS.readFile input
+  let blankedXml = lbsToBlankedXml lbs
+  let ib = toBalancedParens64' blankedXml
+  LBS.writeFile output (LBS.fromChunks ib)
+
+  return ()
+
+optsCreateBpIndex :: Parser Z.CreateBpIndexOptions
+optsCreateBpIndex = Z.CreateBpIndexOptions
+  <$> strOption
+      (   long "input"
+      <>  help "Input file"
+      <>  metavar "FILE"
+      )
+  <*> strOption
+      (   long "output"
+      <>  help "Balanced parens output"
+      <>  metavar "FILE"
+      )
+
+cmdCreateBpIndex :: Mod CommandFields (IO ())
+cmdCreateBpIndex = command "create-bp-index"  $ flip info idm $ runCreateBpIndex <$> optsCreateBpIndex

app/App/Commands/CreateIbIndex.hs

@@ -23,12 +23,12 @@ import qualified Data.ByteString.Lazy as LBS
 runCreateIbIndex :: Z.CreateIbIndexOptions -> IO ()
 runCreateIbIndex opt = do
   let input     = opt ^. the @"input"
-  let ibOutput  = opt ^. the @"ibOutput"
+  let output  = opt ^. the @"output"
 
   lbs <- LBS.readFile input
   let blankedXml = lbsToBlankedXml lbs
   let ib = toInterestBits64' blankedXml
-  LBS.writeFile ibOutput (LBS.fromChunks ib)
+  LBS.writeFile output (LBS.fromChunks ib)
 
   return ()
 
@@ -40,7 +40,7 @@ optsCreateIbIndex = Z.CreateIbIndexOptions
       <>  metavar "FILE"
       )
   <*> strOption
-      (   long "ib-output"
+      (   long "output"
       <>  help "Interest Bits output"
       <>  metavar "FILE"
       )

app/App/Commands/Types.hs

@@ -5,6 +5,7 @@ module App.Commands.Types
   ( CountOptions(..)
   , CreateIndexOptions(..)
   , CreateIbIndexOptions(..)
+  , CreateBpIndexOptions(..)
   , DemoOptions(..)
   ) where
 
@@ -27,6 +28,11 @@ data CreateIndexOptions = CreateIndexOptions
   } deriving (Eq, Show, Generic)
 
 data CreateIbIndexOptions = CreateIbIndexOptions
-  { input    :: FilePath
-  , ibOutput :: FilePath
+  { input  :: FilePath
+  , output :: FilePath
+  } deriving (Eq, Show, Generic)
+
+data CreateBpIndexOptions = CreateBpIndexOptions
+  { input  :: FilePath
+  , output :: FilePath
   } deriving (Eq, Show, Generic)

hw-xml.cabal

@@ -141,6 +141,7 @@ executable hw-xml
                         App.Commands.Count
                         App.Commands.CreateIbIndex
                         App.Commands.CreateIndex
+                        App.Commands.CreateBpIndex
                         App.Commands.Demo
                         App.Commands.Types
                         App.Options