diff --git a/app/App/Commands/CreateIndex.hs b/app/App/Commands/CreateIndex.hs --- a/app/App/Commands/CreateIndex.hs +++ b/app/App/Commands/CreateIndex.hs @@ -1,20 +1,22 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module App.Commands.CreateIndex ( cmdCreateIndex ) where -import App.Commands.Types import Control.Lens import Control.Monad +import Data.Generics.Product.Any import Data.Maybe -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>)) import Data.Word import Foreign -import Options.Applicative hiding (columns) +import Options.Applicative hiding (columns) -import qualified App.Lens as L +import qualified App.Commands.Types as Z import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BSI import qualified Data.ByteString.Lazy as LBS @@ -34,12 +36,12 @@ {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module ("HLint: ignore Redundant do" :: String) #-} -runCreateIndexStandard :: CreateIndexOptions -> IO () +runCreateIndexStandard :: Z.CreateIndexOptions -> IO () runCreateIndexStandard opts = do - let filePath = opts ^. L.filePath - let outputIbFile = opts ^. L.outputIbFile & fromMaybe (filePath <> ".ib.idx") - let outputBpFile = opts ^. L.outputBpFile & fromMaybe (filePath <> ".bp.idx") - case opts ^. L.method of + let filePath = opts ^. the @"filePath" + let outputIbFile = opts ^. the @"outputIbFile" & fromMaybe (filePath <> ".ib.idx") + let outputBpFile = opts ^. the @"outputBpFile" & fromMaybe (filePath <> ".bp.idx") + case opts ^. the @"method" of "original" -> do (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size @@ -80,25 +82,25 @@ IO.hPutStrLn IO.stderr $ "Unknown method " <> show unknown IO.exitFailure -runCreateIndexSimple :: CreateIndexOptions -> IO () +runCreateIndexSimple :: Z.CreateIndexOptions -> IO () runCreateIndexSimple opts = do - let filePath = opts ^. L.filePath - let outputIbFile = opts ^. L.outputIbFile & fromMaybe (filePath <> ".ib.idx") - let outputBpFile = opts ^. L.outputBpFile & fromMaybe (filePath <> ".bp.idx") + let filePath = opts ^. the @"filePath" + let outputIbFile = opts ^. the @"outputIbFile" & fromMaybe (filePath <> ".ib.idx") + let outputBpFile = opts ^. the @"outputBpFile" & fromMaybe (filePath <> ".bp.idx") (fptr :: ForeignPtr Word8, offset, size) <- IO.mmapFileForeignPtr filePath IO.ReadOnly Nothing let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size let SISI.SemiIndex _ ibs bps = SISI.buildSemiIndex bs LBS.writeFile outputIbFile (LBS.toLazyByteString ibs) LBS.writeFile outputBpFile (LBS.toLazyByteString bps) -runCreateIndex :: CreateIndexOptions -> IO () -runCreateIndex opts = case opts ^. L.backend of +runCreateIndex :: Z.CreateIndexOptions -> IO () +runCreateIndex opts = case opts ^. the @"backend" of "standard" -> runCreateIndexStandard opts "simple" -> runCreateIndexSimple opts unknown -> IO.hPutStrLn IO.stderr $ "Unknown backend " <> show unknown -optsCreateIndex :: Parser CreateIndexOptions -optsCreateIndex = CreateIndexOptions +optsCreateIndex :: Parser Z.CreateIndexOptions +optsCreateIndex = Z.CreateIndexOptions <$> strOption ( long "input" <> short 'i' diff --git a/app/App/Commands/Demo.hs b/app/App/Commands/Demo.hs --- a/app/App/Commands/Demo.hs +++ b/app/App/Commands/Demo.hs @@ -1,15 +1,17 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module App.Commands.Demo ( cmdDemo ) where -import App.Commands.Types import Control.Lens import Control.Monad import Control.Monad.ST +import Data.Generics.Product.Any import Data.Semigroup ((<>)) import Data.Word import Foreign.ForeignPtr @@ -24,7 +26,7 @@ import HaskellWorks.Data.Vector.AsVector8 import Options.Applicative hiding (columns) -import qualified App.Lens as L +import qualified App.Commands.Types as Z import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BSI import qualified Data.ByteString.Lazy as LBS @@ -59,12 +61,12 @@ DVSM.set (DVSM.take 8 bpmv) 0 return (DVSM.length (DVSM.drop 8 ibmv), DVSM.length (DVSM.drop 8 bpmv)) -runDemo :: DemoOptions -> IO () +runDemo :: Z.DemoOptions -> IO () runDemo opts = do - let filePath = opts ^. L.filePath - case opts ^. L.method of + let filePath = opts ^. the @"filePath" + case opts ^. the @"method" of "original" -> do - !cursor <- loadCursor (opts ^. L.filePath) + !cursor <- loadCursor (opts ^. the @"filePath") let !json = lightJsonAt cursor let q = MQuery (DL.singleton json) @@ -84,8 +86,8 @@ m -> IO.hPutStrLn IO.stderr $ "Unrecognised method: " <> show m -optsDemo :: Parser DemoOptions -optsDemo = DemoOptions +optsDemo :: Parser Z.DemoOptions +optsDemo = Z.DemoOptions <$> strOption ( long "input" <> short 'i' diff --git a/app/App/Commands/Types.hs b/app/App/Commands/Types.hs --- a/app/App/Commands/Types.hs +++ b/app/App/Commands/Types.hs @@ -1,17 +1,22 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} + module App.Commands.Types ( CreateIndexOptions(..) , DemoOptions(..) ) where +import GHC.Generics + data CreateIndexOptions = CreateIndexOptions - { _createIndexOptionsFilePath :: FilePath - , _createIndexOptionsBackend :: String - , _createIndexOptionsMethod :: String - , _createIndexOptionsOutputIbFile :: Maybe FilePath - , _createIndexOptionsOutputBpFile :: Maybe FilePath - } deriving (Eq, Show) + { filePath :: FilePath + , backend :: String + , method :: String + , outputIbFile :: Maybe FilePath + , outputBpFile :: Maybe FilePath + } deriving (Eq, Show, Generic) data DemoOptions = DemoOptions - { _demoOptionsFilePath :: FilePath - , _demoOptionsMethod :: FilePath - } deriving (Eq, Show) + { filePath :: FilePath + , method :: FilePath + } deriving (Eq, Show, Generic) diff --git a/app/App/Lens.hs b/app/App/Lens.hs deleted file mode 100644 --- a/app/App/Lens.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module App.Lens where - -import App.Commands.Types -import Control.Lens - -makeFields ''CreateIndexOptions -makeFields ''DemoOptions diff --git a/hw-json.cabal b/hw-json.cabal --- a/hw-json.cabal +++ b/hw-json.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-json -version: 1.0.0.1 +version: 1.0.0.2 synopsis: Memory efficient JSON parser description: Memory efficient JSON parser. Please see README.md category: Data @@ -45,18 +45,19 @@ common bits-extra { build-depends: bits-extra >= 0.0.1 && < 0.1 } common bytestring { build-depends: bytestring >= 0.10.6 && < 0.11 } common criterion { build-depends: criterion >= 1.4 && < 1.6 } -common directory { build-depends: directory >= 1.3 && < 1.4 } +common directory { build-depends: directory >= 1.3 && < 1.4 } common dlist { build-depends: dlist >= 0.8 && < 0.9 } +common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 1.2 } common hedgehog { build-depends: hedgehog >= 0.5 && < 0.7 } common hspec { build-depends: hspec >= 2.4 && < 3 } common hw-balancedparens { build-depends: hw-balancedparens >= 0.2.0.1 && < 0.3 } common hw-bits { build-depends: hw-bits >= 0.7.0.5 && < 0.8 } common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } -common hw-json-simd { build-depends: hw-json-simd >= 0.1.0.1 && < 0.2 } +common hw-json-simd { build-depends: hw-json-simd >= 0.1.0.2 && < 0.2 } common hw-mquery { build-depends: hw-mquery >= 0.2.0.0 && < 0.3 } common hw-parser { build-depends: hw-parser >= 0.1 && < 0.2 } common hw-prim { build-depends: hw-prim >= 0.6.2.21 && < 0.7 } -common hw-rankselect { build-depends: hw-rankselect >= 0.12.0.4 && < 0.13 } +common hw-rankselect { build-depends: hw-rankselect >= 0.13 && < 0.14 } common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } common hw-simd { build-depends: hw-simd >= 0.1.1.2 && < 0.2 } common lens { build-depends: lens >= 4 && < 5 } @@ -99,9 +100,10 @@ , text , vector , word8 - hs-source-dirs: src - ghc-options: -O2 -msse4.2 - + hs-source-dirs: src + ghc-options: -O2 -msse4.2 + other-modules: Paths_hw_json + autogen-modules: Paths_hw_json exposed-modules: HaskellWorks.Data.Json HaskellWorks.Data.Json.Backend.Simple.Cursor @@ -144,15 +146,12 @@ HaskellWorks.Data.Json.Query HaskellWorks.Data.Json.Type HaskellWorks.Data.Json.Value - other-modules: - Paths_hw_json - autogen-modules: - Paths_hw_json executable hw-json import: base, config , bytestring , dlist + , generic-lens , hw-balancedparens , hw-json-simd , hw-mquery @@ -164,16 +163,15 @@ , optparse-applicative , semigroups , vector - main-is: Main.hs + main-is: Main.hs + hs-source-dirs: app + ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2 + build-depends: hw-json other-modules: App.Commands App.Commands.CreateIndex App.Commands.Demo App.Commands.Types - App.Lens - hs-source-dirs: app - ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2 - build-depends: hw-json test-suite hw-json-test import: base, config @@ -189,11 +187,12 @@ , hw-rankselect-base , transformers , vector - type: exitcode-stdio-1.0 - main-is: Spec.hs - build-depends: hw-json + type: exitcode-stdio-1.0 + main-is: Spec.hs + build-depends: hw-json hs-source-dirs: test - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tools: hspec-discover other-modules: HaskellWorks.Data.Json.Backend.Simple.CursorSpec HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.BalancedParensSpec @@ -207,7 +206,6 @@ HaskellWorks.Data.Json.TypeSpec HaskellWorks.Data.Json.ValueSpec Paths_hw_json - build-tools: hspec-discover benchmark bench import: base, config @@ -216,9 +214,9 @@ , directory , mmap , semigroups - type: exitcode-stdio-1.0 - main-is: Main.hs + type: exitcode-stdio-1.0 + main-is: Main.hs hs-source-dirs: bench - ghc-options: -O2 -msse4.2 - build-depends: hw-json - other-modules: Paths_hw_json + ghc-options: -O2 -msse4.2 + build-depends: hw-json + other-modules: Paths_hw_json diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs +++ b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs @@ -27,6 +27,8 @@ bitShow (balancedParensOf2 "" ) === "" bitShow (balancedParensOf2 " \n \r \t ") === "" bitShow (balancedParensOf2 "1234 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (balancedParensOf2 "-1.1e-1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" bitShow (balancedParensOf2 "false " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" bitShow (balancedParensOf2 "true " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" bitShow (balancedParensOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs +++ b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs @@ -32,6 +32,8 @@ BitShown (interestBitsOf "" ) === fromString "" BitShown (interestBitsOf " \n \r \t ") === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" BitShown (interestBitsOf "1234 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "1.1 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + BitShown (interestBitsOf "-1.1e-2 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" BitShown (interestBitsOf "false " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" BitShown (interestBitsOf "true " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" BitShown (interestBitsOf "\"hello\" " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" @@ -48,6 +50,9 @@ bitShow (interestBitsOf2 "" ) === "" bitShow (interestBitsOf2 " \n \r \t ") === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" bitShow (interestBitsOf2 "1234 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "-1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" + bitShow (interestBitsOf2 "-1.1e-2 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" bitShow (interestBitsOf2 "false " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" bitShow (interestBitsOf2 "true " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" bitShow (interestBitsOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"