Merge pull request #75 from haskell-works/new-create-blanked-xml-command

New create-banked-xml command

Author: newhoggy

app/App/Commands.hs

@@ -1,11 +1,12 @@
 module App.Commands where
 
 import App.Commands.Count
+import App.Commands.CreateBlankedXml
 import App.Commands.CreateBpIndex
 import App.Commands.CreateIbIndex
 import App.Commands.CreateIndex
 import App.Commands.Demo
-import Data.Semigroup             ((<>))
+import Data.Semigroup                ((<>))
 import Options.Applicative
 
 commands :: Parser (IO ())
@@ -16,6 +17,7 @@ commandsGeneral = subparser $ mempty
   <>  commandGroup "Commands:"
   <>  cmdCount
   <>  cmdCreateIndex
+  <>  cmdCreateBlankedXml
   <>  cmdCreateIbIndex
   <>  cmdCreateBpIndex
   <>  cmdDemo

app/App/Commands/CreateBlankedXml.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module App.Commands.CreateBlankedXml
+  ( cmdCreateBlankedXml
+  ) 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
+
+runCreateBlankedXml :: Z.CreateBlankedXmlOptions -> IO ()
+runCreateBlankedXml opt = do
+  let input     = opt ^. the @"input"
+  let output  = opt ^. the @"output"
+
+  lbs <- LBS.readFile input
+  let blankedXml = lbsToBlankedXml lbs
+  LBS.writeFile output (LBS.fromChunks (blankedXml ^. the @1))
+
+  return ()
+
+optsCreateBlankedXml :: Parser Z.CreateBlankedXmlOptions
+optsCreateBlankedXml = Z.CreateBlankedXmlOptions
+  <$> strOption
+      (   long "input"
+      <>  help "Input file"
+      <>  metavar "FILE"
+      )
+  <*> strOption
+      (   long "output"
+      <>  help "Blanked XML output"
+      <>  metavar "FILE"
+      )
+
+cmdCreateBlankedXml :: Mod CommandFields (IO ())
+cmdCreateBlankedXml = command "create-blanked-xml"  $ flip info idm $ runCreateBlankedXml <$> optsCreateBlankedXml

app/App/Commands/Types.hs

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

hw-xml.cabal

@@ -139,9 +139,10 @@ executable hw-xml
   other-modules:        Paths_hw_xml
                         App.Commands
                         App.Commands.Count
+                        App.Commands.CreateBlankedXml
+                        App.Commands.CreateBpIndex
                         App.Commands.CreateIbIndex
                         App.Commands.CreateIndex
-                        App.Commands.CreateBpIndex
                         App.Commands.Demo
                         App.Commands.Types
                         App.Options

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 
 module HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
   ( BlankedXml(..)
@@ -7,13 +8,16 @@ module HaskellWorks.Data.Xml.Succinct.Cursor.BlankedXml
   , lbsToBlankedXml
   ) where
 
+import GHC.Generics
 import HaskellWorks.Data.Xml.Conduit.Blank
 
 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)
+newtype BlankedXml = BlankedXml
+  { unblankedXml :: [BS.ByteString]
+  } deriving (Eq, Show, Generic)
 
 getBlankedXml :: BlankedXml -> [BS.ByteString]
 getBlankedXml (BlankedXml bs) = bs