diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,5 @@ # hw-json + [![master](https://circleci.com/gh/haskell-works/hw-json/tree/master.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-json/tree/master) `hw-json` is a succinct JSON parsing library. @@ -34,12 +35,11 @@ ```haskell -- CMD -- Mem (MB) ---------------------------------------------------------- -- -------- -import Control.DeepSeq -- 94 -import Data.Aeson -- 100 -import qualified Data.ByteString.Lazy as BSL -- 104 -bs <- BSL.readFile "../corpus/bench/hospitalisation.json" -- 105 -let !x = deepseq bs bs -- 146 -let !y = decode json78m :: Maybe Value -- 669 +import Control.DeepSeq -- 345 +import Data.Aeson -- 371 +import qualified Data.ByteString.Lazy as LBS -- 376 +!bs <- LBS.readFile "corpus/bench/hospitalisation.json" -- 380 +let !y = decode bs :: Maybe Value -- 928 ``` ### Parsing large Json files in Haskell with hw-json @@ -47,20 +47,12 @@ ```haskell -- CMD -- Mem (MB) --------------------------------------------------------------------- -- -------- -import Foreign -- 93 -import Control.Monad -- 95 -import Data.Word -- 96 -import HaskellWorks.Data.BalancedParens.Simple -- 97 -import HaskellWorks.Data.Bits.BitShown -- 98 -import HaskellWorks.Data.FromForeignRegion -- 99 -import HaskellWorks.Data.Json.Backend.Standard.Cursor -- 106 -import System.IO.MMap -- 109 -import qualified Data.ByteString as BS -- 110 -import qualified Data.Vector.Storable as DVS -- 111 -import qualified HaskellWorks.Data.ByteString as BS -- 112 -import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST -- 114 -bs <- BS.mmap "../corpus/bench/hospitalisation.json" -- 115 -let !cursor = FAST.makeCursor bs -- 203 +import qualified HaskellWorks.Data.ByteString as BS -- 351 +import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as JCF -- 353 + +!jsonBs <- BS.mmap "corpus/bench/hospitalisation.json" -- 355 +let !ibip = JCF.simdToIbBp jsonBs -- 358 +let !c = JCF.fromBsIbBp jsonBs ibip -- 495 ``` ## Examples @@ -69,32 +61,18 @@ ```haskell import Control.Monad -import Data.String -import Data.Word -import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.FromForeignRegion -import HaskellWorks.Data.Json.Backend.Standard.Cursor -import HaskellWorks.Data.Json.Internal.Token.Types -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.RankSelect.CsPoppy -import System.IO.MMap -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Json.Backend.Standard.Cursor as C -import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST -import qualified HaskellWorks.Data.TreeCursor as TC +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as JCF +import qualified HaskellWorks.Data.TreeCursor as TC let fc = TC.firstChild let ns = TC.nextSibling let pn = TC.parent let ss = TC.subtreeSize -let cursor = FAST.makeCursor "[null, {\"field\": 1}]" -cursor +let jsonBs = "[null, {\"field\": 1}]" :: BS.ByteString +let ibip = JCF.simdToIbBp jsonBs +let cursor = JCF.fromBsIbBp jsonBs ibip fc cursor (fc >=> ns) cursor ``` @@ -105,20 +83,18 @@ import Control.Monad import Data.Function import Data.List -import HaskellWorks.Data.Json.Backend.Standard.Load.Cursor -import HaskellWorks.Data.Json.Backend.Standard.Load.Partial -import HaskellWorks.Data.Json.Backend.Standard.Load.Raw import HaskellWorks.Data.Json.PartialValue +import HaskellWorks.Data.Json.Standard.Cursor.Load.Cursor +import HaskellWorks.Data.Json.Standard.Load.Partial import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.Micro -import HaskellWorks.Data.MQuery.Row import qualified Data.DList as DL -!cursor <- loadPartial "../corpus/bench/78mb.json" -!cursor <- loadCursorWithIndex "../corpus/bench/78mb.json" -!cursor <- loadCursor "../corpus/bench/78mb.json" -!cursor <- loadCursorWithCsPoppyIndex "../corpus/bench/78mb.json" +!cursor <- loadPartial "corpus/bench/78mb.json" +!cursor <- loadCursorWithIndex "corpus/bench/78mb.json" +!cursor <- loadCursor "corpus/bench/78mb.json" +!cursor <- loadCursorWithCsPoppyIndex "corpus/bench/78mb.json" let !json = jsonPartialJsonValueAt cursor let q = MQuery (DL.singleton json) diff --git a/app/App/Commands.hs b/app/App/Commands.hs --- a/app/App/Commands.hs +++ b/app/App/Commands.hs @@ -1,9 +1,9 @@ module App.Commands where import App.Commands.Count +import App.Commands.CountAeson import App.Commands.CreateIndex import App.Commands.Demo -import Data.Semigroup ((<>)) import Options.Applicative commands :: Parser (IO ()) @@ -14,4 +14,5 @@ <> commandGroup "Commands:" <> cmdCreateIndex <> cmdCount + <> cmdCountAeson <> cmdDemo diff --git a/app/App/Commands/Count.hs b/app/App/Commands/Count.hs --- a/app/App/Commands/Count.hs +++ b/app/App/Commands/Count.hs @@ -11,7 +11,6 @@ import Control.Lens import Control.Monad import Data.Generics.Product.Any -import Data.Semigroup ((<>)) import Data.Word import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.LightJson @@ -88,7 +87,7 @@ <> metavar "FILE" ) <*> optional optsFileIndex - <*> option auto + <*> strOption ( long "expression" <> help "JSON expression" <> metavar "EXPRESSION" diff --git a/app/App/Commands/CountAeson.hs b/app/App/Commands/CountAeson.hs new file mode 100644 --- /dev/null +++ b/app/App/Commands/CountAeson.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module App.Commands.CountAeson + ( cmdCountAeson + ) where + +import Control.Lens +import Data.Generics.Product.Any +import Options.Applicative hiding (columns) + +import qualified App.Commands.Types as Z +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashMap.Strict as SHM +import qualified System.IO as IO + +runCountAeson :: Z.CountAesonOptions -> IO () +runCountAeson opts = do + let inputFile = opts ^. the @"inputFile" + let expression = opts ^. the @"expression" + + lbs <- LBS.readFile inputFile + + let lbsLines = LBS.split 10 lbs + + let count :: Int = sum $ flip fmap lbsLines $ \lbsLine -> case J.decode lbsLine of + Just (J.Object v) -> if SHM.member expression v then 1 else 0 + _ -> 0 + + IO.putStrLn $ "Count: " <> show count + + return () + +optsCountAeson :: Parser Z.CountAesonOptions +optsCountAeson = Z.CountAesonOptions + <$> strOption + ( long "input" + <> short 'i' + <> help "Input JSON file" + <> metavar "FILE" + ) + <*> strOption + ( long "expression" + <> help "JSON expression" + <> metavar "EXPRESSION" + ) + +cmdCountAeson :: Mod CommandFields (IO ()) +cmdCountAeson = command "count-aeson" $ flip info idm $ runCountAeson <$> optsCountAeson 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 @@ -11,7 +11,6 @@ import Control.Monad import Data.Generics.Product.Any import Data.Maybe -import Data.Semigroup ((<>)) import Data.Word import Foreign import Options.Applicative hiding (columns) 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 @@ -11,7 +11,6 @@ import Control.Lens import Control.Monad import Data.Generics.Product.Any -import Data.Semigroup ((<>)) import Data.Word import Foreign.ForeignPtr import HaskellWorks.Data.Json.LightJson 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 @@ -2,7 +2,8 @@ {-# LANGUAGE DuplicateRecordFields #-} module App.Commands.Types - ( CountOptions(..) + ( CountAesonOptions(..) + , CountOptions(..) , CreateIndexOptions(..) , DemoOptions(..) , FileIndexes(..) @@ -27,6 +28,11 @@ data CountOptions = CountOptions { inputFile :: FilePath , indexes :: Maybe FileIndexes + , expression :: Text + } deriving (Eq, Show, Generic) + +data CountAesonOptions = CountAesonOptions + { inputFile :: FilePath , expression :: Text } deriving (Eq, Show, Generic) diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -2,7 +2,6 @@ import App.Commands import Control.Monad -import Data.Semigroup ((<>)) import Options.Applicative main :: IO () diff --git a/doctest/DoctestDriver.hs b/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} +#else +module Main where + +import qualified System.IO as IO + +main :: IO () +main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4" +#endif 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.3.1.1 +version: 1.3.2.0 synopsis: Memory efficient JSON parser description: Memory efficient JSON parser. Please see README.md category: Data @@ -9,10 +9,10 @@ bug-reports: https://github.com/haskell-works/hw-json/issues author: John Ky maintainer: newhoggy@gmail.com -copyright: 2016-2019 John Ky +copyright: 2016-2020 John Ky license: BSD-3-Clause license-file: LICENSE -tested-with: GHC == 8.8.1, GHC == 8.6.5, GHC == 8.4.4, GHC == 8.2.2 +tested-with: GHC == 8.10.1, GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4 build-type: Simple extra-source-files: README.md corpus/5000B.json @@ -37,42 +37,43 @@ manual: False default: False -common base { build-depends: base >= 4 && < 5 } - -common aeson { build-depends: aeson >= 1.4.3.0 && < 1.5 } -common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.8.2 && < 0.7 } -common array { build-depends: array >= 0.5 && < 0.6 } -common attoparsec { build-depends: attoparsec >= 0.13 && < 0.14 } -common bits-extra { build-depends: bits-extra >= 0.0.1.3 && < 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 dlist { build-depends: dlist >= 0.8 && < 0.9 } -common generic-lens { build-depends: generic-lens >= 1.2.0.1 && < 1.3 } -common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } -common hspec { build-depends: hspec >= 2.4 && < 3 } -common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.0 && < 0.4 } -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.2 && < 0.2 } -common hw-json-simple-cursor { build-depends: hw-json-simple-cursor >= 0.1.0.1 && < 0.2 } -common hw-json-standard-cursor { build-depends: hw-json-standard-cursor >= 0.2.0.1 && < 0.3 } -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.32 && < 0.7 } -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 } -common mmap { build-depends: mmap >= 0.5 && < 0.6 } -common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.16 } -common scientific { build-depends: scientific >= 0.3.6.2 && < 0.4 } -common text { build-depends: text >= 1.2 && < 1.3 } -common transformers { build-depends: transformers >= 0.4 && < 0.6 } -common vector { build-depends: vector >= 0.12 && < 0.13 } -common word8 { build-depends: word8 >= 0.1 && < 0.2 } +common base { build-depends: base >= 4.11 && < 5 } -common semigroups { if impl(ghc < 8 ) { build-depends: semigroups >= 0.16 && < 0.19 } } +common aeson { build-depends: aeson >= 1.4.3.0 && < 1.5 } +common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.8.2 && < 0.7 } +common array { build-depends: array >= 0.5 && < 0.6 } +common attoparsec { build-depends: attoparsec >= 0.13 && < 0.14 } +common bits-extra { build-depends: bits-extra >= 0.0.1.3 && < 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 dlist { build-depends: dlist >= 0.8 && < 0.9 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } +common generic-lens { build-depends: generic-lens >= 1.2.0.1 && < 1.3 } +common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } +common hspec { build-depends: hspec >= 2.4 && < 3 } +common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.0 && < 0.4 } +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.2 && < 0.2 } +common hw-json-simple-cursor { build-depends: hw-json-simple-cursor >= 0.1.0.1 && < 0.2 } +common hw-json-standard-cursor { build-depends: hw-json-standard-cursor >= 0.2.0.1 && < 0.3 } +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.32 && < 0.7 } +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 } +common mmap { build-depends: mmap >= 0.5 && < 0.6 } +common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.16 } +common scientific { build-depends: scientific >= 0.3.6.2 && < 0.4 } +common text { build-depends: text >= 1.2 && < 1.3 } +common transformers { build-depends: transformers >= 0.4 && < 0.6 } +common unordered-containers { build-depends: unordered-containers >= 0.2 && < 0.3 } +common vector { build-depends: vector >= 0.12 && < 0.13 } +common word8 { build-depends: word8 >= 0.1 && < 0.2 } common config default-language: Haskell2010 @@ -83,6 +84,9 @@ ghc-options: -mbmi2 -msse4.2 cpp-options: -DBMI2_ENABLED +common hw-json + build-depends: hw-json + library import: base, config , aeson @@ -102,7 +106,6 @@ , hw-rankselect-base , hw-simd , mmap - , semigroups , text , vector , word8 @@ -132,10 +135,12 @@ executable hw-json import: base, config + , aeson , bytestring , dlist , generic-lens , hw-balancedparens + , hw-json , hw-json-simd , hw-json-simple-cursor , hw-json-standard-cursor @@ -146,16 +151,16 @@ , lens , mmap , optparse-applicative - , semigroups , text + , unordered-containers , vector main-is: Main.hs hs-source-dirs: app ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: hw-json other-modules: App.Commands App.Commands.CreateIndex App.Commands.Count + App.Commands.CountAeson App.Commands.Demo App.Commands.Types @@ -169,6 +174,7 @@ , hw-balancedparens , hw-bits , hw-hspec-hedgehog + , hw-json , hw-json-simple-cursor , hw-json-standard-cursor , hw-prim @@ -180,7 +186,6 @@ , vector type: exitcode-stdio-1.0 main-is: Spec.hs - build-depends: hw-json hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tool-depends: hspec-discover:hspec-discover @@ -191,18 +196,27 @@ HaskellWorks.Data.Json.Token.TokenizeSpec HaskellWorks.Data.Json.TypeSpec HaskellWorks.Data.Json.ValueSpec - Paths_hw_json benchmark bench import: base, config , bytestring , criterion , directory + , hw-json , hw-json-standard-cursor , mmap - , semigroups type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bench - build-depends: hw-json - other-modules: Paths_hw_json + +test-suite hw-json-doctest + import: base, config + , doctest + , doctest-discover + , hw-json + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: DoctestDriver.hs + HS-Source-Dirs: doctest + build-tool-depends: doctest-discover:doctest-discover diff --git a/src/HaskellWorks/Data/Json/Internal/Slurp.hs b/src/HaskellWorks/Data/Json/Internal/Slurp.hs --- a/src/HaskellWorks/Data/Json/Internal/Slurp.hs +++ b/src/HaskellWorks/Data/Json/Internal/Slurp.hs @@ -24,11 +24,29 @@ | InNumber | InIdent +-- | Slurp a JSON string +-- +-- Examples: +-- +-- >>> :set -XOverloadedStrings +-- >>> slurpText "\"Hello\"" +-- Right "Hello" +-- >>> slurpText "123" +-- Left "34: Failed reading: satisfy" slurpText :: BS.ByteString -> Either Text Text slurpText bs = case PBS.parseOnly AP.jstring bs of Right t -> Right t Left e -> Left (T.pack e) +-- | Slurp a JSON number +-- +-- Examples: +-- +-- >>> :set -XOverloadedStrings +-- >>> slurpNumber "123, true" +-- "123" +-- >>> slurpNumber "\"Hello\"" +-- "\"Hello\"" slurpNumber :: BS.ByteString -> BS.ByteString slurpNumber bs = let (!cs, _) = BS.unfoldrN (BS.length bs) genNumber (InJson, bs) in cs where genNumber :: (JsonState, BS.ByteString) -> Maybe (Word8, (JsonState, BS.ByteString)) diff --git a/src/HaskellWorks/Data/Json/LightJson.hs b/src/HaskellWorks/Data/Json/LightJson.hs --- a/src/HaskellWorks/Data/Json/LightJson.hs +++ b/src/HaskellWorks/Data/Json/LightJson.hs @@ -33,10 +33,12 @@ import Prelude hiding (drop) import Text.PrettyPrint.ANSI.Leijen -import qualified Data.ByteString as BS -import qualified Data.List as L -import qualified Data.Text as T -import qualified HaskellWorks.Data.BalancedParens as BP +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import qualified Data.List as L +import qualified Data.Text as T +import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.Json.Simple.Cursor as JSC data LightJson c = LightJsonString Text @@ -48,11 +50,14 @@ | LightJsonError Text deriving Show -instance Eq (LightJson c) where +instance LightJsonAt c => Eq (LightJson c) where (==) (LightJsonString a) (LightJsonString b) = a == b (==) (LightJsonNumber a) (LightJsonNumber b) = a == b (==) (LightJsonBool a) (LightJsonBool b) = a == b + (==) (LightJsonObject a) (LightJsonObject b) = fmap (fmap lightJsonAt) a == fmap (fmap lightJsonAt) b + (==) (LightJsonArray a) (LightJsonArray b) = fmap lightJsonAt a == fmap lightJsonAt b (==) LightJsonNull LightJsonNull = True + (==) (LightJsonError a) (LightJsonError b) = a == b (==) _ _ = False data LightJsonField c = LightJsonField Text (LightJson c) @@ -144,3 +149,21 @@ asField (a, b) = case lightJsonAt a of LightJsonString s -> [(s, b)] _ -> [] + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (JSC.JsonCursor BS.ByteString v w) where + lightJsonAt k = if kra `mod` 2 == 1 + then let i = fromIntegral (kpa - 1) :: Int in + if i < BS.length kt + then case BSU.unsafeIndex kt i of + 91 -> LightJsonArray [] + 123 -> LightJsonObject [] + _ -> LightJsonError "Invalid collection character" + else LightJsonError "Index out of bounds" + else LightJsonError "Unaligned cursor" + where kpa = select1 kib kta + km + kib = JSC.interests k + kra = JSC.cursorRank k + ksa = kra + 1 + kta = ksa `div` 2 + km = ksa `mod` 2 + kt = JSC.cursorText k diff --git a/test/HaskellWorks/Data/Json/Simple/CursorSpec.hs b/test/HaskellWorks/Data/Json/Simple/CursorSpec.hs --- a/test/HaskellWorks/Data/Json/Simple/CursorSpec.hs +++ b/test/HaskellWorks/Data/Json/Simple/CursorSpec.hs @@ -14,6 +14,7 @@ ) where import Control.Monad +import HaskellWorks.Data.Json.LightJson import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec @@ -82,3 +83,5 @@ (V.snippet <$> (fc >=> fc >=> fc ) k) === Just "11" (V.snippet <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing (V.snippet <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can lightJsonAt" $ requireTest $ do + lightJsonAt k === LightJsonArray []