Merge pull request #76 from haskell-works/new-stream-method-for-create-index

New stream method for create-index

Author: newhoggy

app/App/Commands/CreateBlankedXml.hs

@@ -13,7 +13,6 @@ module App.Commands.CreateBlankedXml
 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)
 

app/App/Commands/CreateIndex.hs

@@ -10,28 +10,57 @@ module App.Commands.CreateIndex
   ( cmdCreateIndex
   ) where
 
+import App.Options
 import Control.Lens
+import Control.Monad
 import Data.Generics.Product.Any
-import Data.Semigroup                             ((<>))
+import Data.Semigroup                                   ((<>))
+import HaskellWorks.Data.Xml.Internal.ToIbBp64
+import HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
 import HaskellWorks.Data.Xml.Succinct.Cursor.MMap
-import Options.Applicative                        hiding (columns)
+import Options.Applicative                              hiding (columns)
 
 import qualified App.Commands.Types                as Z
+import qualified Data.ByteString                   as BS
 import qualified Data.ByteString.Lazy              as LBS
+import qualified Data.Text.IO                      as TIO
 import qualified HaskellWorks.Data.ByteString.Lazy as LBS
+import qualified Options.Applicative               as OA
+import qualified System.Exit                       as IO
+import qualified System.IO                         as IO
 
 runCreateIndex :: Z.CreateIndexOptions -> IO ()
 runCreateIndex opt = do
   let input     = opt ^. the @"input"
   let ibOutput  = opt ^. the @"ibOutput"
   let bpOutput  = opt ^. the @"bpOutput"
+  let method    = opt ^. the @"method"
 
-  cursor <- mmapSlowCursor input
+  case method of
+    "memory" -> do
+      cursor <- mmapSlowCursor input
 
-  LBS.writeFile ibOutput (LBS.toLazyByteString (cursor ^. the @"interests"      . the @1))
-  LBS.writeFile bpOutput (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))
+    "stream" -> do
+      lbs <- LBS.readFile input
+      let blankedXml = lbsToBlankedXml lbs
+      let ibBp = toIbBp64 blankedXml
 
-  return ()
+      hIbOutput <- IO.openFile ibOutput IO.WriteMode
+      hBpOutput <- IO.openFile bpOutput IO.WriteMode
+
+      forM_ ibBp $ \(ib, bp) -> do
+        BS.hPut hIbOutput ib
+        BS.hPut hBpOutput bp
+
+      IO.hClose hIbOutput
+      IO.hClose hBpOutput
+
+      return ()
+    unknown -> do
+      TIO.hPutStrLn IO.stderr $ "Unsupported method: " <> unknown
+      IO.exitFailure
 
 optsCreateIndex :: Parser Z.CreateIndexOptions
 optsCreateIndex = Z.CreateIndexOptions
@@ -50,6 +79,12 @@ optsCreateIndex = Z.CreateIndexOptions
       <>  help "Balanced Parens output"
       <>  metavar "FILE"
       )
+  <*> textOption
+      (   long "method"
+      <>  help "Method"
+      <>  metavar "METHOD"
+      <>  OA.value "memory"
+      )
 
 cmdCreateIndex :: Mod CommandFields (IO ())
 cmdCreateIndex = command "create-index"  $ flip info idm $ runCreateIndex <$> optsCreateIndex

app/App/Commands/Types.hs

@@ -26,6 +26,7 @@ data CreateIndexOptions = CreateIndexOptions
   { input    :: FilePath
   , ibOutput :: FilePath
   , bpOutput :: FilePath
+  , method   :: Text
   } deriving (Eq, Show, Generic)
 
 data CreateBlankedXmlOptions = CreateBlankedXmlOptions