diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -80,7 +80,7 @@ import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.RankSelect.Poppy512 +import HaskellWorks.Data.RankSelect.CsPoppy import System.IO.MMap import qualified Data.ByteString as BS 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 @@ -12,11 +12,10 @@ import Control.Monad import Control.Monad.ST import Data.Generics.Product.Any -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>)) import Data.Word import Foreign.ForeignPtr -import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Backend.Standard.Load.Cursor import HaskellWorks.Data.Json.LightJson import HaskellWorks.Data.Json.Query @@ -24,7 +23,7 @@ import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.Vector.AsVector8 -import Options.Applicative hiding (columns) +import Options.Applicative hiding (columns) import qualified App.Commands.Types as Z import qualified Data.ByteString as BS @@ -33,6 +32,7 @@ import qualified Data.DList as DL import qualified Data.Vector.Storable as DVS import qualified Data.Vector.Storable.Mutable as DVSM +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM import qualified HaskellWorks.Data.ByteString.Lazy as LBS import qualified HaskellWorks.Data.Json.Simd.Index.Standard as S import qualified Options.Applicative as OA @@ -77,14 +77,13 @@ case S.makeStandardJsonIbBps (LBS.resegmentPadded 512 (LBS.fromStrict bs)) of Right ibBps -> do let (!ib, !bp) = constructUnzipN size ibBps - let !cursor = JsonCursor bs (makeCsPoppy ib) (SimpleBalancedParens bp) 1 + let !cursor = GenericCursor bs (makeCsPoppy ib) (RM.mkRangeMin bp) 1 let !json = lightJsonAt cursor let q = MQuery (DL.singleton json) putPretty $ q >>= (entry >=> named "meta" >=> entry >=> named "view" >=> entry >=> named "columns" >=> item >=> entry >=> named "id") & count Left msg -> IO.hPutStrLn IO.stderr $ "Unable to create semi-index: " <> show msg m -> IO.hPutStrLn IO.stderr $ "Unrecognised method: " <> show m - optsDemo :: Parser Z.DemoOptions optsDemo = Z.DemoOptions diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -6,6 +6,7 @@ import Control.Monad import Criterion.Main import Data.List +import Data.Semigroup ((<>)) import Data.Word import Foreign import HaskellWorks.Data.Json.Internal.Backend.Standard.Blank @@ -57,8 +58,8 @@ let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries benchmarks <- forM files $ \file -> return [ env (setupEnvJson file) $ \bs -> bgroup file - [ bench "Run slow make cursor" (whnf SLOW.makeCursor bs) - , bench "Run fast make cursor" (whnf FAST.makeCursor bs) + [ bench "Run slow make cursor" (whnf SLOW.fromByteString bs) + , bench "Run fast make cursor" (whnf FAST.fromByteString bs) ] ] @@ -66,9 +67,8 @@ main :: IO () main = do - benchmarks <- mconcat <$> sequence - [ makeBenchBlankJson - , makeBenchJsonToInterestBits - , makeBenchMakeCursor - ] + benchmarks <- fmap mconcat $ sequence $ mempty + <> [makeBenchBlankJson] + <> [makeBenchJsonToInterestBits] + <> [makeBenchMakeCursor] defaultMain benchmarks 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.2 +version: 1.1.0.0 synopsis: Memory efficient JSON parser description: Memory efficient JSON parser. Please see README.md category: Data @@ -28,35 +28,35 @@ location: https://github.com/haskell-works/hw-json flag bmi2 - description: Enable bmi2 instruction set - manual: False - default: False + description: Enable bmi2 instruction set + manual: False + default: False flag sse42 - description: Enable sse4.2 instruction set - manual: False - default: False + description: Enable sse4.2 instruction set + manual: False + default: False common base { build-depends: base >= 4 && < 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 && < 0.1 } +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.1.0.0 && < 1.2 } -common hedgehog { build-depends: hedgehog >= 0.5 && < 0.7 } +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.2.0.1 && < 0.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-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-prim { build-depends: hw-prim >= 0.6.2.28 && < 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 } @@ -71,10 +71,10 @@ common semigroups { if impl(ghc < 8 ) { build-depends: semigroups >= 0.16 && < 0.19 } } common config - default-language: Haskell2010 - ghc-options: -Wall + default-language: Haskell2010 + ghc-options: -Wall -O2 -msse4.2 if flag(sse42) - ghc-options: -mbmi2 + ghc-options: -msse4.2 if flag(bmi2) && impl(ghc >= 8.4.1) ghc-options: -mbmi2 -msse4.2 cpp-options: -DBMI2_ENABLED @@ -100,10 +100,9 @@ , text , vector , word8 - hs-source-dirs: src - ghc-options: -O2 -msse4.2 - other-modules: Paths_hw_json - autogen-modules: Paths_hw_json + hs-source-dirs: src + other-modules: Paths_hw_json + autogen-modules: Paths_hw_json exposed-modules: HaskellWorks.Data.Json HaskellWorks.Data.Json.Backend.Simple.Cursor @@ -111,6 +110,10 @@ HaskellWorks.Data.Json.Backend.Simple.SemiIndex HaskellWorks.Data.Json.Backend.Simple.Value HaskellWorks.Data.Json.Backend.Standard.Cursor + HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast + HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic + HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow + HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific HaskellWorks.Data.Json.Backend.Standard.Fast HaskellWorks.Data.Json.Backend.Standard.Index HaskellWorks.Data.Json.Backend.Standard.Load.Cursor @@ -134,6 +137,7 @@ HaskellWorks.Data.Json.Internal.CharLike HaskellWorks.Data.Json.Internal.Doc HaskellWorks.Data.Json.Internal.Index + HaskellWorks.Data.Json.Internal.Orphans HaskellWorks.Data.Json.Internal.PartialIndex HaskellWorks.Data.Json.Internal.Slurp HaskellWorks.Data.Json.Internal.Token @@ -163,10 +167,10 @@ , optparse-applicative , semigroups , vector - main-is: Main.hs - hs-source-dirs: app - ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -msse4.2 - build-depends: hw-json + 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 @@ -187,12 +191,12 @@ , hw-rankselect-base , transformers , 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-tools: hspec-discover + 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-tools: hspec-discover other-modules: HaskellWorks.Data.Json.Backend.Simple.CursorSpec HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.BalancedParensSpec @@ -214,9 +218,8 @@ , directory , mmap , semigroups - 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 + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: bench + build-depends: hw-json + other-modules: Paths_hw_json diff --git a/src/HaskellWorks/Data/Json.hs b/src/HaskellWorks/Data/Json.hs --- a/src/HaskellWorks/Data/Json.hs +++ b/src/HaskellWorks/Data/Json.hs @@ -1,8 +1,3 @@ --- | --- Copyright: 2016 John Ky --- License: MIT --- --- Json module HaskellWorks.Data.Json ( module X ) where diff --git a/src/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs b/src/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs --- a/src/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs +++ b/src/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs @@ -17,7 +17,7 @@ import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.RankSelect.Poppy512 +import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.TreeCursor import Prelude hiding (drop) @@ -27,6 +27,7 @@ import qualified Data.Vector.Storable as DVS import qualified Foreign.ForeignPtr as F import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM import qualified HaskellWorks.Data.Json.Backend.Simple.SemiIndex as SI data JsonCursor t v w = JsonCursor @@ -46,11 +47,11 @@ } where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs -instance FromByteString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where +instance FromByteString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where fromByteString bs = JsonCursor { cursorText = bs - , interests = makePoppy512 ib - , balancedParens = BP.SimpleBalancedParens bp + , interests = makeCsPoppy ib + , balancedParens = RM.mkRangeMin (makeCsPoppy bp) , cursorRank = 1 } where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs @@ -58,13 +59,13 @@ instance FromForeignRegion (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) -instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where +instance FromForeignRegion (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) instance IsString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where fromString = fromByteString . BSC.pack -instance IsString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where +instance IsString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where fromString = fromByteString . BSC.pack instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where diff --git a/src/HaskellWorks/Data/Json/Backend/Simple/Fast.hs b/src/HaskellWorks/Data/Json/Backend/Simple/Fast.hs --- a/src/HaskellWorks/Data/Json/Backend/Simple/Fast.hs +++ b/src/HaskellWorks/Data/Json/Backend/Simple/Fast.hs @@ -2,37 +2,34 @@ {-# LANGUAGE TypeSynonymInstances #-} module HaskellWorks.Data.Json.Backend.Simple.Fast - ( makeCursor + ( fromByteString + , fromForeignRegion + , fromString ) where -import Data.Word import Foreign.ForeignPtr -import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.Backend.Simple.Cursor -import HaskellWorks.Data.RankSelect.Poppy512 +import HaskellWorks.Data.RankSelect.CsPoppy import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Internal as BSI -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM +import qualified HaskellWorks.Data.FromForeignRegion as F import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp as J import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp as J -class MakeCursor a where - makeCursor :: a -> JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) - -instance MakeCursor BS.ByteString where - makeCursor bs = JsonCursor - { cursorText = bs - , interests = makePoppy512 ib - , balancedParens = BP.SimpleBalancedParens bp - , cursorRank = 1 - } - where J.IbBp ib bp = J.toIbBp bs +fromByteString :: BS.ByteString -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromByteString bs = JsonCursor + { cursorText = bs + , interests = makeCsPoppy ib + , balancedParens = RM.mkRangeMin (makeCsPoppy bp) + , cursorRank = 1 + } + where J.IbBp ib bp = J.toIbBp bs -instance MakeCursor String where - makeCursor = makeCursor . BSC.pack +fromForeignRegion :: F.ForeignRegion -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance MakeCursor ForeignRegion where - makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size) +fromString :: String -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromString = fromByteString . BSC.pack diff --git a/src/HaskellWorks/Data/Json/Backend/Simple/Value.hs b/src/HaskellWorks/Data/Json/Backend/Simple/Value.hs --- a/src/HaskellWorks/Data/Json/Backend/Simple/Value.hs +++ b/src/HaskellWorks/Data/Json/Backend/Simple/Value.hs @@ -1,15 +1,14 @@ module HaskellWorks.Data.Json.Backend.Simple.Value where import Data.Maybe -import Data.Word import HaskellWorks.Data.Json.Backend.Simple.Cursor import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.RankSelect.Poppy512 +import HaskellWorks.Data.RankSelect.CsPoppy -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.BalancedParens as BP +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM data JsonValue = JsonValues JsonValues @@ -24,7 +23,7 @@ | JsonObject [(String, JsonValue)] deriving (Eq, Show) -snippetPos :: JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) -> (Count, Count) +snippetPos :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> (Count, Count) snippetPos k = (kpa, kpz) where kpa = select1 kib kta + km kpz = select1 kib ktz - km @@ -38,6 +37,6 @@ ktz = ksz `div` 2 km = ksa `mod` 2 -snippet :: JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) -> BS.ByteString +snippet :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> BS.ByteString snippet k = let (a, z) = snippetPos k in BS.take (fromIntegral (z - a + 1)) (BS.drop (fromIntegral (a - 1)) kt) where kt = cursorText k diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs --- a/src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} @@ -6,168 +5,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.Json.Backend.Standard.Cursor - ( JsonCursor(..) - , jsonCursorPos + {-# DEPRECATED "Use HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic instead" #-} + ( module X ) where -import Control.Arrow -import Control.Monad -import Data.Char -import Data.String -import Data.Word8 -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Drop -import HaskellWorks.Data.Json.DecodeError -import HaskellWorks.Data.Json.Internal.CharLike -import HaskellWorks.Data.Json.Internal.Index -import HaskellWorks.Data.Json.Internal.PartialIndex -import HaskellWorks.Data.Json.Internal.Slurp -import HaskellWorks.Data.Json.Internal.Word8 -import HaskellWorks.Data.Json.LightJson -import HaskellWorks.Data.Json.PartialValue -import HaskellWorks.Data.Json.Type -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.TreeCursor -import HaskellWorks.Data.Uncons -import Prelude hiding (drop) - -import qualified Data.ByteString as BS -import qualified Data.List as L -import qualified HaskellWorks.Data.BalancedParens as BP - -data JsonCursor t v w = JsonCursor - { cursorText :: !t - , interests :: !v - , balancedParens :: !w - , cursorRank :: !Count - } - deriving (Eq, Show) - -instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where - firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u) - firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq - - nextSibling :: JsonCursor t v u -> Maybe (JsonCursor t v u) - nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) - - parent :: JsonCursor t v u -> Maybe (JsonCursor t v u) - parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq - - depth :: JsonCursor t v u -> Maybe Count - depth k = BP.depth (balancedParens k) (cursorRank k) - - subtreeSize :: JsonCursor t v u -> Maybe Count - subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) - -jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position -jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) - where ik = interests k - bpk = balancedParens k - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (JsonCursor BS.ByteString v w) where - lightJsonAt k = case uncons remainder of - Just (!c, _) | isLeadingDigit2 c -> LightJsonNumber (slurpNumber remainder) - Just (!c, _) | isQuotDbl c -> LightJsonString (slurpString remainder) - Just (!c, _) | isChar_t c -> LightJsonBool True - Just (!c, _) | isChar_f c -> LightJsonBool False - Just (!c, _) | isChar_n c -> LightJsonNull - Just (!c, _) | isBraceLeft c -> LightJsonObject (mapValuesFrom (firstChild k)) - Just (!c, _) | isBracketLeft c -> LightJsonArray (arrayValuesFrom (firstChild k)) - Just _ -> LightJsonError "Invalid Json Type" - Nothing -> LightJsonError "End of data" - where ik = interests k - bpk = balancedParens k - p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) - remainder = drop (toCount p) (cursorText k) - arrayValuesFrom = L.unfoldr (fmap (id &&& nextSibling)) - mapValuesFrom j = pairwise (arrayValuesFrom j) >>= asField - pairwise (a:b:rs) = (a, b) : pairwise rs - pairwise _ = [] - asField (a, b) = case lightJsonAt a of - LightJsonString s -> [(s, b)] - _ -> [] - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (JsonCursor String v w) where - jsonTypeAtPosition p k = case drop (toCount p) (cursorText k) of - c:_ | fromIntegral (ord c) == _bracketleft -> Just JsonTypeArray - c:_ | fromIntegral (ord c) == _f -> Just JsonTypeBool - c:_ | fromIntegral (ord c) == _t -> Just JsonTypeBool - c:_ | fromIntegral (ord c) == _n -> Just JsonTypeNull - c:_ | wIsJsonNumberDigit (fromIntegral (ord c)) -> Just JsonTypeNumber - c:_ | fromIntegral (ord c) == _braceleft -> Just JsonTypeObject - c:_ | fromIntegral (ord c) == _quotedbl -> Just JsonTypeString - _ -> Nothing - - jsonTypeAt k = jsonTypeAtPosition p k - where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) - ik = interests k - bpk = balancedParens k - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (JsonCursor BS.ByteString v w) where - jsonTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of - Just (c, _) | c == _bracketleft -> Just JsonTypeArray - Just (c, _) | c == _f -> Just JsonTypeBool - Just (c, _) | c == _t -> Just JsonTypeBool - Just (c, _) | c == _n -> Just JsonTypeNull - Just (c, _) | wIsJsonNumberDigit c -> Just JsonTypeNumber - Just (c, _) | c == _braceleft -> Just JsonTypeObject - Just (c, _) | c == _quotedbl -> Just JsonTypeString - _ -> Nothing - - jsonTypeAt k = jsonTypeAtPosition p k - where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) - ik = interests k - bpk = balancedParens k - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (JsonCursor BS.ByteString v w) where - jsonPartialIndexAt k = case uncons remainder of - Just (!c, _) | isLeadingDigit2 c -> JsonPartialIndexNumber remainder - Just (!c, _) | isQuotDbl c -> JsonPartialIndexString remainder - Just (!c, _) | isChar_t c -> JsonPartialIndexBool True - Just (!c, _) | isChar_f c -> JsonPartialIndexBool False - Just (!c, _) | isChar_n c -> JsonPartialIndexNull - Just (!c, _) | isBraceLeft c -> JsonPartialIndexObject (mapValuesFrom (firstChild k)) - Just (!c, _) | isBracketLeft c -> JsonPartialIndexArray (arrayValuesFrom (firstChild k)) - Just _ -> JsonPartialIndexError "Invalid Json Type" - Nothing -> JsonPartialIndexError "End of data" - where ik = interests k - bpk = balancedParens k - p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) - remainder = drop (toCount p) (cursorText k) - arrayValuesFrom :: Maybe (JsonCursor BS.ByteString v w) -> [JsonPartialIndex] - arrayValuesFrom = L.unfoldr (fmap (jsonPartialIndexAt &&& nextSibling)) - mapValuesFrom j = pairwise (arrayValuesFrom j) >>= asField - pairwise (a:b:rs) = (a, b) : pairwise rs - pairwise _ = [] - asField (a, b) = case a of - JsonPartialIndexString s -> [(s, b)] - _ -> [] - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (JsonCursor BS.ByteString v w) where - jsonIndexAt k = case uncons remainder of - Just (!c, _) | isLeadingDigit2 c -> Right (JsonIndexNumber remainder) - Just (!c, _) | isQuotDbl c -> Right (JsonIndexString remainder) - Just (!c, _) | isChar_t c -> Right (JsonIndexBool True) - Just (!c, _) | isChar_f c -> Right (JsonIndexBool False) - Just (!c, _) | isChar_n c -> Right JsonIndexNull - Just (!c, _) | isBraceLeft c -> JsonIndexObject <$> mapValuesFrom (firstChild k) - Just (!c, _) | isBracketLeft c -> JsonIndexArray <$> arrayValuesFrom (firstChild k) - Just _ -> Left (DecodeError "Invalid Json Type") - Nothing -> Left (DecodeError "End of data" ) - where ik = interests k - bpk = balancedParens k - p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) - remainder = drop (toCount p) (cursorText k) - arrayValuesFrom j = sequence (L.unfoldr (fmap (jsonIndexAt &&& nextSibling)) j) - mapValuesFrom j = (pairwise >=> asField) <$> arrayValuesFrom j - pairwise (a:b:rs) = (a, b) : pairwise rs - pairwise _ = [] - asField (a, b) = case a of - JsonIndexString s -> [(s, b)] - _ -> [] - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialValueAt (JsonCursor BS.ByteString v w) where - jsonPartialJsonValueAt = jsonPartialJsonValueAt . jsonPartialIndexAt +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic as X diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Fast.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Fast.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Fast.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE TypeFamilies #-} + +module HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast + ( Cursor + ) where + +import Data.Word +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific +import HaskellWorks.Data.RankSelect.CsPoppy + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM + +data Fast + +instance SpecificCursor Fast where + type CursorOf Fast = Cursor + +type Cursor = GenericCursor BS.ByteString CsPoppy (RM.RangeMin (DVS.Vector Word64)) diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Generic.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Generic.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Generic.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic + ( GenericCursor(..) + , jsonCursorPos + ) where + +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.TreeCursor +import Prelude hiding (drop) + +import qualified HaskellWorks.Data.BalancedParens as BP + +data GenericCursor t v w = GenericCursor + { cursorText :: !t + , interests :: !v + , balancedParens :: !w + , cursorRank :: !Count + } + deriving (Eq, Show) + +instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (GenericCursor t v u) where + firstChild :: GenericCursor t v u -> Maybe (GenericCursor t v u) + firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + nextSibling :: GenericCursor t v u -> Maybe (GenericCursor t v u) + nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) + + parent :: GenericCursor t v u -> Maybe (GenericCursor t v u) + parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + depth :: GenericCursor t v u -> Maybe Count + depth k = BP.depth (balancedParens k) (cursorRank k) + + subtreeSize :: GenericCursor t v u -> Maybe Count + subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) + +jsonCursorPos :: (Rank1 w, Select1 v) => GenericCursor s v w -> Position +jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) + where ik = interests k + bpk = balancedParens k diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Slow.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Slow.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Slow.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TypeFamilies #-} + +module HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow + ( Cursor + ) where + +import Data.Word +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific + +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.BalancedParens as BP + +data Slow + +instance SpecificCursor Slow where + type CursorOf Slow = Cursor + +type Cursor = GenericCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64)) diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Specific.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Specific.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Cursor/Specific.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TypeFamilies #-} + +module HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific + ( SpecificCursor(..) + , jsonCursorPos + ) where + +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic + +class SpecificCursor w where + type CursorOf w diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Fast.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Fast.hs --- a/src/HaskellWorks/Data/Json/Backend/Standard/Fast.hs +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Fast.hs @@ -2,37 +2,35 @@ {-# LANGUAGE TypeSynonymInstances #-} module HaskellWorks.Data.Json.Backend.Standard.Fast - ( makeCursor + ( fromByteString + , fromForeignRegion + , fromString ) where -import Data.Word import Foreign.ForeignPtr -import HaskellWorks.Data.FromForeignRegion -import HaskellWorks.Data.Json.Backend.Standard.Cursor -import HaskellWorks.Data.RankSelect.Poppy512 +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic +import HaskellWorks.Data.RankSelect.CsPoppy import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Internal as BSI -import qualified Data.Vector.Storable as DVS import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM +import qualified HaskellWorks.Data.FromForeignRegion as F import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp as J -class MakeCursor a where - makeCursor :: a -> JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64)) - -instance MakeCursor BS.ByteString where - makeCursor bs = JsonCursor - { cursorText = bs - , interests = makePoppy512 ib - , balancedParens = BP.SimpleBalancedParens bp - , cursorRank = 1 - } - where J.IbBp ib bp = J.toIbBp bs - -instance MakeCursor String where - makeCursor = makeCursor . BSC.pack +fromByteString :: BS.ByteString -> Cursor +fromByteString bs = GenericCursor + { cursorText = bs + , interests = makeCsPoppy ib + , balancedParens = RM.mkRangeMin bp + , cursorRank = 1 + } + where J.IbBp ib bp = J.toIbBp bs -instance MakeCursor ForeignRegion where - makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size) +fromForeignRegion :: F.ForeignRegion -> Cursor +fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) +fromString :: String -> Cursor +fromString = fromByteString . BSC.pack diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Index.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Index.hs --- a/src/HaskellWorks/Data/Json/Backend/Standard/Index.hs +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Index.hs @@ -1,19 +1,23 @@ +{-# LANGUAGE BangPatterns #-} + module HaskellWorks.Data.Json.Backend.Standard.Index ( indexJson ) where import Data.Word import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Standard.Load.Cursor as L +import qualified Data.ByteString as BS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW indexJson :: String -> IO () indexJson filename = do - JsonCursor _ ib (SimpleBalancedParens bp) _ <- L.loadCursor filename + bs <- BS.mmap filename + -- We use the SLOW reference implementation because we are writing to a file and will never query. + let GenericCursor _ !ib (SimpleBalancedParens !bp) _ = SLOW.fromByteString bs let wib = DVS.unsafeCast ib :: DVS.Vector Word8 let wbp = DVS.unsafeCast bp :: DVS.Vector Word8 BS.writeFile (filename ++ ".ib.idx") (BS.toByteString wib) diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs --- a/src/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs @@ -3,51 +3,43 @@ module HaskellWorks.Data.Json.Backend.Standard.Load.Cursor ( loadCursor , loadCursorWithIndex - , loadCursorWithPoppy512Index , loadCursorWithCsPoppyIndex - , loadCursorWithPoppy512Index2 + , loadCursorWithCsPoppyIndex2 ) where import Data.Word import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Backend.Standard.Load.Raw import HaskellWorks.Data.RankSelect.CsPoppy -import HaskellWorks.Data.RankSelect.Poppy512 -import qualified Data.ByteString as BS -import qualified Data.ByteString.Internal as BSI -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW +import qualified Data.ByteString.Internal as BSI +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast as FAST +import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST -loadCursor :: String -> IO (JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))) +loadCursor :: String -> IO FAST.Cursor loadCursor path = do bs <- BS.mmap path - let !cursor = SLOW.makeCursor bs + let !cursor = FAST.fromByteString bs return cursor -loadCursorWithIndex :: String -> IO (JsonCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))) +loadCursorWithIndex :: String -> IO (GenericCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))) loadCursorWithIndex filename = do (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1 - return cursor - -loadCursorWithPoppy512Index :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) -loadCursorWithPoppy512Index filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1 + let cursor = GenericCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1 return cursor -loadCursorWithCsPoppyIndex :: String -> IO (JsonCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64))) +loadCursorWithCsPoppyIndex :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64))) loadCursorWithCsPoppyIndex filename = do (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 + let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 return cursor -loadCursorWithPoppy512Index2 :: String -> IO (JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512)) -loadCursorWithPoppy512Index2 filename = do +loadCursorWithCsPoppyIndex2 :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy)) +loadCursorWithCsPoppyIndex2 filename = do (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1 - :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512) + let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens (makeCsPoppy jsonBp)) 1 + :: GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy) return cursor diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs --- a/src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs @@ -6,47 +6,27 @@ ( loadPartial , loadPartialWithCsPoppyIndex , loadPartialWithIndex - , loadPartialWithPoppy512Index - , loadPartialWithPoppy512Index2 ) where import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Backend.Standard.Load.Raw import HaskellWorks.Data.Json.Internal.PartialIndex import HaskellWorks.Data.Json.PartialValue import HaskellWorks.Data.RankSelect.CsPoppy -import HaskellWorks.Data.RankSelect.Poppy512 -import qualified Data.ByteString.Internal as BSI - loadPartialWithIndex :: String -> IO JsonPartialValue loadPartialWithIndex filename = do (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1 - let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) - return jsonResult - -loadPartialWithPoppy512Index :: String -> IO JsonPartialValue -loadPartialWithPoppy512Index filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens jsonBp) 1 + let cursor = GenericCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1 let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) return jsonResult loadPartialWithCsPoppyIndex :: String -> IO JsonPartialValue loadPartialWithCsPoppyIndex filename = do (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 - let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) - return jsonResult - -loadPartialWithPoppy512Index2 :: String -> IO JsonPartialValue -loadPartialWithPoppy512Index2 filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = JsonCursor jsonBS (makePoppy512 jsonIb) (SimpleBalancedParens (makePoppy512 jsonBp)) 1 - :: JsonCursor BSI.ByteString Poppy512 (SimpleBalancedParens Poppy512) + let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) return jsonResult diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Slow.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Slow.hs --- a/src/HaskellWorks/Data/Json/Backend/Standard/Slow.hs +++ b/src/HaskellWorks/Data/Json/Backend/Standard/Slow.hs @@ -2,26 +2,24 @@ {-# LANGUAGE TypeSynonymInstances #-} module HaskellWorks.Data.Json.Backend.Standard.Slow - ( makeCursor + ( fromByteString + , fromForeignRegion + , fromString ) where -import Data.Word import Foreign.ForeignPtr -import HaskellWorks.Data.FromForeignRegion -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Internal as BSI -import qualified Data.Vector.Storable as DVS import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.FromForeignRegion as F import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp as J -class MakeCursor a where - makeCursor :: a -> JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64)) - -instance MakeCursor BS.ByteString where - makeCursor bs = JsonCursor +fromByteString :: BS.ByteString -> Cursor +fromByteString bs = GenericCursor { cursorText = bs , interests = ib , balancedParens = BP.SimpleBalancedParens bp @@ -29,8 +27,8 @@ } where J.IbBp ib bp = J.toIbBp bs -instance MakeCursor String where - makeCursor = makeCursor . BSC.pack +fromForeignRegion :: F.ForeignRegion -> Cursor +fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance MakeCursor ForeignRegion where - makeCursor (fptr, offset, size) = makeCursor (BSI.fromForeignPtr (castForeignPtr fptr) offset size) +fromString :: String -> Cursor +fromString = fromByteString . BSC.pack diff --git a/src/HaskellWorks/Data/Json/FromValue.hs b/src/HaskellWorks/Data/Json/FromValue.hs --- a/src/HaskellWorks/Data/Json/FromValue.hs +++ b/src/HaskellWorks/Data/Json/FromValue.hs @@ -3,9 +3,12 @@ module HaskellWorks.Data.Json.FromValue where +import Data.Text (Text) import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Value +import qualified Data.Text as T + class FromJsonValue a where fromJsonValue :: JsonValue -> Either DecodeError a @@ -14,28 +17,33 @@ instance FromJsonValue String where fromJsonValue v = case v of - JsonString r -> Right r - _ -> Left (DecodeError "Not a string") + JsonString r -> Right (T.unpack r) + _ -> Left (DecodeError "Not a string") +instance FromJsonValue Text where + fromJsonValue v = case v of + JsonString r -> Right r + _ -> Left (DecodeError "Not a string") + instance FromJsonValue Int where fromJsonValue v = case v of - JsonNumber r -> Right (floor r) - _ -> Left (DecodeError "Not an integer") + JsonNumber r -> Right (floor r) + _ -> Left (DecodeError "Not an integer") instance FromJsonValue Double where fromJsonValue v = case v of - JsonNumber r -> Right r - _ -> Left (DecodeError "Not a double") + JsonNumber r -> Right r + _ -> Left (DecodeError "Not a double") instance FromJsonValue Bool where fromJsonValue v = case v of - JsonBool r -> Right r - _ -> Left (DecodeError "Not a boolean") + JsonBool r -> Right r + _ -> Left (DecodeError "Not a boolean") instance FromJsonValue a => FromJsonValue [a] where fromJsonValue v = case v of - JsonArray xs -> mapM fromJsonValue xs - _ -> Left (DecodeError "Not an array") + JsonArray xs -> mapM fromJsonValue xs + _ -> Left (DecodeError "Not an array") instance (FromJsonValue a, FromJsonValue b) => FromJsonValue (a, b) where fromJsonValue v = case v of diff --git a/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs b/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs --- a/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs +++ b/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs @@ -6,7 +6,7 @@ import Data.ByteString.Internal as BSI import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank1 @@ -15,7 +15,7 @@ import qualified Data.Attoparsec.ByteString.Char8 as ABC -jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => JsonCursor ByteString v w -> Maybe (JsonToken String Double) +jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => GenericCursor ByteString v w -> Maybe (JsonToken String Double) jsonTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k) then case ABC.parse parseJsonToken (drop (toCount (jsonCursorPos k)) (cursorText k)) of ABC.Fail {} -> error "Failed to parse token in cursor" diff --git a/src/HaskellWorks/Data/Json/Internal/Index.hs b/src/HaskellWorks/Data/Json/Internal/Index.hs --- a/src/HaskellWorks/Data/Json/Internal/Index.hs +++ b/src/HaskellWorks/Data/Json/Internal/Index.hs @@ -1,12 +1,27 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} module HaskellWorks.Data.Json.Internal.Index where +import Control.Arrow +import Control.Monad +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.DecodeError -import Prelude hiding (drop) +import HaskellWorks.Data.Json.Internal.CharLike +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.TreeCursor +import HaskellWorks.Data.Uncons +import Prelude hiding (drop) -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified HaskellWorks.Data.BalancedParens as BP data JsonIndex = JsonIndexString BS.ByteString @@ -19,3 +34,26 @@ class JsonIndexAt a where jsonIndexAt :: a -> Either DecodeError JsonIndex + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (GenericCursor BS.ByteString v w) where + jsonIndexAt k = case uncons remainder of + Just (!c, _) | isLeadingDigit2 c -> Right (JsonIndexNumber remainder) + Just (!c, _) | isQuotDbl c -> Right (JsonIndexString remainder) + Just (!c, _) | isChar_t c -> Right (JsonIndexBool True) + Just (!c, _) | isChar_f c -> Right (JsonIndexBool False) + Just (!c, _) | isChar_n c -> Right JsonIndexNull + Just (!c, _) | isBraceLeft c -> JsonIndexObject <$> mapValuesFrom (firstChild k) + Just (!c, _) | isBracketLeft c -> JsonIndexArray <$> arrayValuesFrom (firstChild k) + Just _ -> Left (DecodeError "Invalid Json Type") + Nothing -> Left (DecodeError "End of data" ) + where ik = interests k + bpk = balancedParens k + p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + remainder = drop (toCount p) (cursorText k) + arrayValuesFrom j = sequence (L.unfoldr (fmap (jsonIndexAt &&& nextSibling)) j) + mapValuesFrom j = (pairwise >=> asField) <$> arrayValuesFrom j + pairwise (a:b:rs) = (a, b) : pairwise rs + pairwise _ = [] + asField (a, b) = case a of + JsonIndexString s -> [(s, b)] + _ -> [] diff --git a/src/HaskellWorks/Data/Json/Internal/Orphans.hs b/src/HaskellWorks/Data/Json/Internal/Orphans.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Internal/Orphans.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module HaskellWorks.Data.Json.Internal.Orphans where + +import Data.Text +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) + +import qualified Data.Text as T + +instance Pretty Text where + pretty s = pretty (T.unpack s) diff --git a/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs b/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs --- a/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs +++ b/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs @@ -1,7 +1,33 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + module HaskellWorks.Data.Json.Internal.PartialIndex where -import qualified Data.ByteString as BS +import Control.Arrow +import Control.Monad +import Data.String +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Internal.CharLike +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.TreeCursor +import HaskellWorks.Data.Uncons +import Prelude hiding (drop) +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified HaskellWorks.Data.BalancedParens as BP + data JsonPartialIndex = JsonPartialIndexString BS.ByteString | JsonPartialIndexNumber BS.ByteString @@ -14,3 +40,28 @@ class JsonPartialIndexAt a where jsonPartialIndexAt :: a -> JsonPartialIndex + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (GenericCursor BS.ByteString v w) where + jsonPartialIndexAt k = case uncons remainder of + Just (!c, _) | isLeadingDigit2 c -> JsonPartialIndexNumber remainder + Just (!c, _) | isQuotDbl c -> JsonPartialIndexString remainder + Just (!c, _) | isChar_t c -> JsonPartialIndexBool True + Just (!c, _) | isChar_f c -> JsonPartialIndexBool False + Just (!c, _) | isChar_n c -> JsonPartialIndexNull + Just (!c, _) | isBraceLeft c -> JsonPartialIndexObject (mapValuesFrom (firstChild k)) + Just (!c, _) | isBracketLeft c -> JsonPartialIndexArray (arrayValuesFrom (firstChild k)) + Just _ -> JsonPartialIndexError "Invalid Json Type" + Nothing -> JsonPartialIndexError "End of data" + where ik = interests k + bpk = balancedParens k + p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + remainder = drop (toCount p) (cursorText k) + arrayValuesFrom :: Maybe (GenericCursor BS.ByteString v w) -> [JsonPartialIndex] + arrayValuesFrom = L.unfoldr (fmap (jsonPartialIndexAt &&& nextSibling)) + mapValuesFrom j = pairwise (arrayValuesFrom j) >>= asField + pairwise (a:b:rs) = (a, b) : pairwise rs + pairwise _ = [] + asField (a, b) = case a of + JsonPartialIndexString s -> [(s, b)] + _ -> [] + 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 @@ -1,8 +1,13 @@ {-# LANGUAGE BangPatterns #-} -module HaskellWorks.Data.Json.Internal.Slurp where +module HaskellWorks.Data.Json.Internal.Slurp + ( JsonState(..) + , slurpText + , slurpNumber + ) where import Data.String +import Data.Text import Data.Word import Data.Word8 import HaskellWorks.Data.Json.Internal.Word8 @@ -11,6 +16,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.List as L +import qualified Data.Text as T data JsonState = Escaped @@ -19,8 +25,8 @@ | InNumber | InIdent -slurpString :: BS.ByteString -> String -slurpString bs = L.unfoldr genString (InJson, BSC.unpack bs) +slurpText :: BS.ByteString -> Text +slurpText bs = T.pack $ L.unfoldr genString (InJson, BSC.unpack bs) -- TODO optimise where genString :: (JsonState, String) -> Maybe (Char, (JsonState, String)) genString (InJson, ds) = case ds of (e:es) | e == '"' -> genString (InString , es) 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} @@ -8,27 +9,44 @@ module HaskellWorks.Data.Json.LightJson where import Control.Arrow +import Control.Monad import Data.String +import Data.Text (Text) +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Internal.CharLike import HaskellWorks.Data.Json.Internal.Doc +import HaskellWorks.Data.Json.Internal.Slurp import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.AtLeastSize import HaskellWorks.Data.MQuery.Entry import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.MQuery.Mini import HaskellWorks.Data.MQuery.Row -import Prelude hiding (drop) +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.TreeCursor +import HaskellWorks.Data.Uncons +import Prelude hiding (drop) +import Prelude hiding (drop) import Text.PrettyPrint.ANSI.Leijen -import qualified Data.ByteString as BS +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 data LightJson c - = LightJsonString String + = LightJsonString Text | LightJsonNumber BS.ByteString - | LightJsonObject [(String, c)] + | LightJsonObject [(Text, c)] | LightJsonArray [c] | LightJsonBool Bool | LightJsonNull - | LightJsonError String + | LightJsonError Text deriving Show instance Eq (LightJson c) where @@ -38,7 +56,7 @@ (==) LightJsonNull LightJsonNull = True (==) _ _ = False -data LightJsonField c = LightJsonField String (LightJson c) +data LightJsonField c = LightJsonField Text (LightJson c) class LightJsonAt a where lightJsonAt :: a -> LightJson a @@ -55,8 +73,8 @@ LightJsonArray vs -> hEncloseSep (text "[") (text "]") (text ",") ((pretty . lightJsonAt) `map` vs) LightJsonBool w -> red (text (show w)) LightJsonNull -> text "null" - LightJsonError s -> text " text s <> text ">" - where toLightJsonField :: (String, LightJson c) -> LightJsonField c + LightJsonError s -> text " text (T.unpack s) <> text ">" + where toLightJsonField :: (Text, LightJson c) -> LightJsonField c toLightJsonField (k, v) = LightJsonField k v instance Pretty (Micro (LightJson c)) where @@ -68,11 +86,14 @@ pretty (Micro (LightJsonArray _ )) = text "[..]" pretty (Micro (LightJsonBool w )) = red (text (show w)) pretty (Micro LightJsonNull ) = text "null" - pretty (Micro (LightJsonError s )) = text " text s <> text ">" + pretty (Micro (LightJsonError s )) = text " text (T.unpack s) <> text ">" instance Pretty (Micro (String, LightJson c)) where pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) +instance Pretty (Micro (Text, LightJson c)) where + pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) + instance LightJsonAt c => Pretty (Mini (LightJson c)) where pretty mjpv = case mjpv of Mini (LightJsonString s ) -> dullgreen (text (show s)) @@ -88,13 +109,39 @@ Mini (LightJsonArray _ ) -> text "[]" Mini (LightJsonBool w ) -> red (text (show w)) Mini LightJsonNull -> text "null" - Mini (LightJsonError s ) -> text " text s <> text ">" + Mini (LightJsonError s ) -> text " text (T.unpack s) <> text ">" instance LightJsonAt c => Pretty (Mini (String, LightJson c)) where pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv) +instance LightJsonAt c => Pretty (Mini (Text, LightJson c)) where + pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv) + instance LightJsonAt c => Pretty (MQuery (LightJson c)) where pretty = pretty . Row 120 . mQuery instance LightJsonAt c => Pretty (MQuery (Entry String (LightJson c))) where pretty (MQuery das) = pretty (Row 120 das) + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => LightJsonAt (GenericCursor BS.ByteString v w) where + lightJsonAt k = case uncons remainder of + Just (!c, _) | isLeadingDigit2 c -> LightJsonNumber (slurpNumber remainder) + Just (!c, _) | isQuotDbl c -> LightJsonString (slurpText remainder) + Just (!c, _) | isChar_t c -> LightJsonBool True + Just (!c, _) | isChar_f c -> LightJsonBool False + Just (!c, _) | isChar_n c -> LightJsonNull + Just (!c, _) | isBraceLeft c -> LightJsonObject (mapValuesFrom (firstChild k)) + Just (!c, _) | isBracketLeft c -> LightJsonArray (arrayValuesFrom (firstChild k)) + Just _ -> LightJsonError "Invalid Json Type" + Nothing -> LightJsonError "End of data" + where ik = interests k + bpk = balancedParens k + p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + remainder = drop (toCount p) (cursorText k) + arrayValuesFrom = L.unfoldr (fmap (id &&& nextSibling)) + mapValuesFrom j = pairwise (arrayValuesFrom j) >>= asField + pairwise (a:b:rs) = (a, b) : pairwise rs + pairwise _ = [] + asField (a, b) = case lightJsonAt a of + LightJsonString s -> [(s, b)] + _ -> [] diff --git a/src/HaskellWorks/Data/Json/PartialValue.hs b/src/HaskellWorks/Data/Json/PartialValue.hs --- a/src/HaskellWorks/Data/Json/PartialValue.hs +++ b/src/HaskellWorks/Data/Json/PartialValue.hs @@ -10,6 +10,7 @@ , JsonPartialValueAt(..) , asInteger , asString + , asText , castAsInteger , entry , hasKey @@ -21,7 +22,12 @@ ) where import Control.Arrow +import Data.String +import Data.Text (Text) +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.Doc +import HaskellWorks.Data.Json.Internal.Orphans () import HaskellWorks.Data.Json.Internal.PartialIndex import HaskellWorks.Data.Json.Internal.Value import HaskellWorks.Data.MQuery @@ -30,28 +36,34 @@ import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.MQuery.Mini import HaskellWorks.Data.MQuery.Row -import Text.PrettyPrint.ANSI.Leijen +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import Prelude hiding (drop) +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.ByteString as BS import qualified Data.DList as DL +import qualified Data.Text as T +import qualified HaskellWorks.Data.BalancedParens as BP data JsonPartialValue - = JsonPartialString String + = JsonPartialString Text | JsonPartialNumber Double - | JsonPartialObject [(String, JsonPartialValue)] + | JsonPartialObject [(Text, JsonPartialValue)] | JsonPartialArray [JsonPartialValue] | JsonPartialBool Bool | JsonPartialNull - | JsonPartialError String + | JsonPartialError Text deriving (Eq, Show, Ord) class JsonPartialValueAt a where jsonPartialJsonValueAt :: a -> JsonPartialValue -data JsonPartialField = JsonPartialField String JsonPartialValue +data JsonPartialField = JsonPartialField Text JsonPartialValue -jsonPartialValueString :: JsonPartialValue -> String +jsonPartialValueString :: JsonPartialValue -> Text jsonPartialValueString pjv = case pjv of JsonPartialString s -> s _ -> "" @@ -59,13 +71,13 @@ instance JsonPartialValueAt JsonPartialIndex where jsonPartialJsonValueAt i = case i of JsonPartialIndexString s -> case ABC.parse parseJsonString s of - ABC.Fail {} -> JsonPartialError ("Invalid string: '" ++ show (BS.take 20 s) ++ "...'") + ABC.Fail {} -> JsonPartialError ("Invalid string: '" <> T.pack (show (BS.take 20 s)) <> "...'") ABC.Partial _ -> JsonPartialError "Unexpected end of string" - ABC.Done _ r -> JsonPartialString r + ABC.Done _ r -> JsonPartialString (T.pack r) -- TODO optimise JsonPartialIndexNumber s -> case ABC.parse ABC.rational s of - ABC.Fail {} -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'") + ABC.Fail {} -> JsonPartialError ("Invalid number: '" <> T.pack (show (BS.take 20 s)) <> "...'") ABC.Partial f -> case f " " of - ABC.Fail {} -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'") + ABC.Fail {} -> JsonPartialError ("Invalid number: '" <> T.pack (show (BS.take 20 s)) <> "...'") ABC.Partial _ -> JsonPartialError "Unexpected end of number" ABC.Done _ r -> JsonPartialNumber r ABC.Done _ r -> JsonPartialNumber r @@ -73,13 +85,13 @@ JsonPartialIndexArray es -> JsonPartialArray (map jsonPartialJsonValueAt es) JsonPartialIndexBool v -> JsonPartialBool v JsonPartialIndexNull -> JsonPartialNull - JsonPartialIndexError s -> JsonPartialError s + JsonPartialIndexError s -> JsonPartialError (T.pack s) -- TODO optimise where parseString bs = case ABC.parse parseJsonString bs of - ABC.Fail {} -> JsonPartialError ("Invalid field: '" ++ show (BS.take 20 bs) ++ "...'") + ABC.Fail {} -> JsonPartialError ("Invalid field: '" <> T.pack (show (BS.take 20 bs)) <> "...'") ABC.Partial _ -> JsonPartialError "Unexpected end of field" - ABC.Done _ s -> JsonPartialString s + ABC.Done _ s -> JsonPartialString (T.pack s) -- TODO optimise -toJsonPartialField :: (String, JsonPartialValue) -> JsonPartialField +toJsonPartialField :: (Text, JsonPartialValue) -> JsonPartialField toJsonPartialField (k, v) = JsonPartialField k v instance Pretty JsonPartialField where @@ -94,7 +106,7 @@ JsonPartialArray vs -> hEncloseSep (text "[") (text "]") (text ",") (pretty `map` vs) JsonPartialBool w -> red (text (show w)) JsonPartialNull -> text "null" - JsonPartialError s -> text " text s <> text ">" + JsonPartialError s -> text " text (T.unpack s) <> text ">" instance Pretty (Micro JsonPartialValue) where pretty (Micro (JsonPartialString s )) = dullgreen (text (show s)) @@ -105,11 +117,14 @@ pretty (Micro (JsonPartialArray _ )) = text "[..]" pretty (Micro (JsonPartialBool w )) = red (text (show w)) pretty (Micro JsonPartialNull ) = text "null" - pretty (Micro (JsonPartialError s )) = text " text s <> text ">" + pretty (Micro (JsonPartialError s )) = text " text (T.unpack s) <> text ">" instance Pretty (Micro (String, JsonPartialValue)) where pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) +instance Pretty (Micro (Text, JsonPartialValue)) where + pretty (Micro (fieldName, jpv)) = red (text (show fieldName)) <> text ": " <> pretty (Micro jpv) + instance Pretty (Mini JsonPartialValue) where pretty mjpv = case mjpv of Mini (JsonPartialString s ) -> dullgreen (text (show s)) @@ -125,18 +140,21 @@ Mini (JsonPartialArray _ ) -> text "[]" Mini (JsonPartialBool w ) -> red (text (show w)) Mini JsonPartialNull -> text "null" - Mini (JsonPartialError s ) -> text " text s <> text ">" + Mini (JsonPartialError s ) -> text " text (T.unpack s) <> text ">" -instance Pretty (Mini (String, JsonPartialValue)) where +instance Pretty (Mini (Text, JsonPartialValue)) where pretty (Mini (fieldName, jpv)) = text (show fieldName) <> text ": " <> pretty (Mini jpv) instance Pretty (MQuery JsonPartialValue) where pretty = pretty . Row 120 . mQuery -instance Pretty (MQuery (Entry String JsonPartialValue)) where +instance Pretty (MQuery (Entry Text JsonPartialValue)) where pretty (MQuery das) = pretty (Row 120 das) -hasKV :: String -> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialValueAt (GenericCursor BS.ByteString v w) where + jsonPartialJsonValueAt = jsonPartialJsonValueAt . jsonPartialIndexAt + +hasKV :: Text -> JsonPartialValue -> JsonPartialValue -> MQuery JsonPartialValue hasKV k v (JsonPartialObject xs) = if (k, v) `elem` xs then MQuery (DL.singleton (JsonPartialObject xs)) else MQuery DL.empty hasKV _ _ _ = MQuery DL.empty @@ -145,13 +163,18 @@ JsonPartialArray es -> MQuery $ DL.fromList es _ -> MQuery DL.empty -entry :: JsonPartialValue -> MQuery (Entry String JsonPartialValue) +entry :: JsonPartialValue -> MQuery (Entry Text JsonPartialValue) entry jpv = case jpv of JsonPartialObject fs -> MQuery $ DL.fromList (uncurry Entry `map` fs) _ -> MQuery DL.empty asString :: JsonPartialValue -> MQuery String asString jpv = case jpv of + JsonPartialString s -> MQuery $ DL.singleton (T.unpack s) + _ -> MQuery DL.empty + +asText :: JsonPartialValue -> MQuery Text +asText jpv = case jpv of JsonPartialString s -> MQuery $ DL.singleton s _ -> MQuery DL.empty @@ -162,20 +185,20 @@ castAsInteger :: JsonPartialValue -> MQuery Integer castAsInteger jpv = case jpv of - JsonPartialString n -> MQuery $ DL.singleton (read n) + JsonPartialString n -> MQuery $ DL.singleton (read (T.unpack n)) JsonPartialNumber n -> MQuery $ DL.singleton (floor n) _ -> MQuery DL.empty -named :: String -> Entry String JsonPartialValue -> MQuery JsonPartialValue +named :: Text -> Entry Text JsonPartialValue -> MQuery JsonPartialValue named fieldName (Entry fieldName' jpv) | fieldName == fieldName' = MQuery $ DL.singleton jpv named _ _ = MQuery DL.empty -jsonKeys :: JsonPartialValue -> [String] +jsonKeys :: JsonPartialValue -> [Text] jsonKeys jpv = case jpv of JsonPartialObject fs -> fst `map` fs _ -> [] -hasKey :: String -> JsonPartialValue -> Bool +hasKey :: Text -> JsonPartialValue -> Bool hasKey fieldName jpv = fieldName `elem` jsonKeys jpv jsonSize :: JsonPartialValue -> MQuery JsonPartialValue diff --git a/src/HaskellWorks/Data/Json/Query.hs b/src/HaskellWorks/Data/Json/Query.hs --- a/src/HaskellWorks/Data/Json/Query.hs +++ b/src/HaskellWorks/Data/Json/Query.hs @@ -8,7 +8,7 @@ module HaskellWorks.Data.Json.Query where import Control.Arrow -import Data.String +import Data.Text (Text) import HaskellWorks.Data.Json.LightJson import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.Entry @@ -16,18 +16,19 @@ import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.DList as DL +import qualified Data.Text as T item :: LightJsonAt c => LightJson c -> MQuery (LightJson c) item jpv = case jpv of LightJsonArray es -> MQuery $ DL.fromList (lightJsonAt `map` es) _ -> MQuery DL.empty -entry :: LightJsonAt c => LightJson c -> MQuery (Entry String (LightJson c)) +entry :: LightJsonAt c => LightJson c -> MQuery (Entry Text (LightJson c)) entry jpv = case jpv of LightJsonObject fs -> MQuery $ DL.fromList ((uncurry Entry . second lightJsonAt) `map` fs) _ -> MQuery DL.empty -asString :: LightJson c -> MQuery String +asString :: LightJson c -> MQuery Text asString jpv = case jpv of LightJsonString s -> MQuery $ DL.singleton s _ -> MQuery DL.empty @@ -50,20 +51,20 @@ castAsInteger :: LightJson c -> MQuery Integer castAsInteger jpv = case jpv of - LightJsonString n -> MQuery $ DL.singleton (read n) + LightJsonString n -> MQuery $ DL.singleton (read (T.unpack n)) -- TODO Optimise LightJsonNumber _ -> asInteger jpv _ -> MQuery DL.empty -named :: String -> Entry String (LightJson c) -> MQuery (LightJson c) +named :: Text -> Entry Text (LightJson c) -> MQuery (LightJson c) named fieldName (Entry fieldName' jpv) | fieldName == fieldName' = MQuery $ DL.singleton jpv named _ _ = MQuery DL.empty -jsonKeys :: LightJson c -> [String] +jsonKeys :: LightJson c -> [Text] jsonKeys jpv = case jpv of LightJsonObject fs -> fst `map` fs _ -> [] -hasKey :: String -> LightJson c -> Bool +hasKey :: Text -> LightJson c -> Bool hasKey fieldName jpv = fieldName `elem` jsonKeys jpv jsonSize :: LightJson c -> MQuery Integer diff --git a/src/HaskellWorks/Data/Json/Type.hs b/src/HaskellWorks/Data/Json/Type.hs --- a/src/HaskellWorks/Data/Json/Type.hs +++ b/src/HaskellWorks/Data/Json/Type.hs @@ -7,9 +7,22 @@ , JsonTypeAt(..) ) where +import Data.Char +import Data.String +import Data.Word8 +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Internal.Word8 import HaskellWorks.Data.Positioning -import Prelude hiding (drop) +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import Prelude hiding (drop) +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.BalancedParens as BP + {-# ANN module ("HLint: Reduce duplication" :: String) #-} data JsonType @@ -24,3 +37,35 @@ class JsonTypeAt a where jsonTypeAtPosition :: Position -> a -> Maybe JsonType jsonTypeAt :: a -> Maybe JsonType + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor String v w) where + jsonTypeAtPosition p k = case drop (toCount p) (cursorText k) of + c:_ | fromIntegral (ord c) == _bracketleft -> Just JsonTypeArray + c:_ | fromIntegral (ord c) == _f -> Just JsonTypeBool + c:_ | fromIntegral (ord c) == _t -> Just JsonTypeBool + c:_ | fromIntegral (ord c) == _n -> Just JsonTypeNull + c:_ | wIsJsonNumberDigit (fromIntegral (ord c)) -> Just JsonTypeNumber + c:_ | fromIntegral (ord c) == _braceleft -> Just JsonTypeObject + c:_ | fromIntegral (ord c) == _quotedbl -> Just JsonTypeString + _ -> Nothing + + jsonTypeAt k = jsonTypeAtPosition p k + where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + ik = interests k + bpk = balancedParens k + +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor BS.ByteString v w) where + jsonTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of + Just (c, _) | c == _bracketleft -> Just JsonTypeArray + Just (c, _) | c == _f -> Just JsonTypeBool + Just (c, _) | c == _t -> Just JsonTypeBool + Just (c, _) | c == _n -> Just JsonTypeNull + Just (c, _) | wIsJsonNumberDigit c -> Just JsonTypeNumber + Just (c, _) | c == _braceleft -> Just JsonTypeObject + Just (c, _) | c == _quotedbl -> Just JsonTypeString + _ -> Nothing + + jsonTypeAt k = jsonTypeAtPosition p k + where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) + ik = interests k + bpk = balancedParens k diff --git a/src/HaskellWorks/Data/Json/Value.hs b/src/HaskellWorks/Data/Json/Value.hs --- a/src/HaskellWorks/Data/Json/Value.hs +++ b/src/HaskellWorks/Data/Json/Value.hs @@ -6,17 +6,19 @@ module HaskellWorks.Data.Json.Value where +import Data.Text (Text) import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Internal.Value import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.ByteString as BS +import qualified Data.Text as T data JsonValue - = JsonString String + = JsonString Text | JsonNumber Double - | JsonObject [(String, JsonValue)] + | JsonObject [(Text, JsonValue)] | JsonArray [JsonValue] | JsonBool Bool | JsonNull @@ -30,7 +32,7 @@ JsonIndexString s -> case ABC.parse parseJsonString s of ABC.Fail {} -> Left (DecodeError ("Invalid string: '" ++ show (BS.take 20 s) ++ "...'")) ABC.Partial _ -> Left (DecodeError "Unexpected end of string") - ABC.Done _ r -> Right (JsonString r) + ABC.Done _ r -> Right (JsonString (T.pack r)) -- TODO optimise JsonIndexNumber s -> case ABC.parse ABC.rational s of ABC.Fail {} -> Left (DecodeError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")) ABC.Partial f -> case f " " of @@ -38,11 +40,12 @@ ABC.Partial _ -> Left (DecodeError "Unexpected end of number") ABC.Done _ r -> Right (JsonNumber r) ABC.Done _ r -> Right (JsonNumber r) - JsonIndexObject fs -> JsonObject <$> mapM (\f -> (,) <$> parseString (fst f) <*> jsonValueAt (snd f)) fs + JsonIndexObject fs -> JsonObject <$> mapM (\f -> (,) <$> parseText (fst f) <*> jsonValueAt (snd f)) fs JsonIndexArray es -> JsonArray <$> mapM jsonValueAt es JsonIndexBool v -> Right (JsonBool v) JsonIndexNull -> Right JsonNull - where parseString bs = case ABC.parse parseJsonString bs of + where parseText bs = T.pack <$> parseString bs -- TODO optimise + parseString bs = case ABC.parse parseJsonString bs of ABC.Fail {} -> Left (DecodeError ("Invalid field: '" ++ show (BS.take 20 bs) ++ "...'")) ABC.Partial _ -> Left (DecodeError "Unexpected end of field") ABC.Done _ s -> Right s diff --git a/test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs b/test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs --- a/test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs +++ b/test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs @@ -18,7 +18,6 @@ import Hedgehog import Test.Hspec -import qualified Data.ByteString as BS import qualified HaskellWorks.Data.Json.Backend.Simple.Cursor as Z import qualified HaskellWorks.Data.Json.Backend.Simple.Fast as FAST import qualified HaskellWorks.Data.Json.Backend.Simple.Value as V @@ -26,7 +25,7 @@ {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: redundant bracket" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} fc = TC.firstChild ns = TC.nextSibling @@ -35,7 +34,7 @@ spec = describe "HaskellWorks.Data.Json.Backend.Simple.CursorSpec" $ do describe "Json cursor" $ do describe "For sample Json" $ do - let k = FAST.makeCursor ("[[11],[22]]" :: BS.ByteString) + let k = FAST.fromByteString "[[11],[22]]" -- [ [ 1 1 ] , [ 2 2 ] ] -- (( (( )) )( (( )) )) it "can navigate" $ requireTest $ do diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs +++ b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs @@ -11,23 +11,17 @@ module HaskellWorks.Data.Json.Backend.Standard.Succinct.CursorSpec(spec) where -import Data.Word -import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Json.Backend.Standard.Cursor import HaskellWorks.Data.Json.Backend.Standard.Succinct.GenCursorTest -import HaskellWorks.Data.RankSelect.Poppy512 import Test.Hspec -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: redundant bracket" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do - genTest "DVS.Vector Word64" (SLOW.makeCursor :: String -> JsonCursor BS.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))) - genTest "Poppy512" (FAST.makeCursor :: String -> JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) + genTest "DVS.Vector Word64" SLOW.fromString + genTest "CsPoppy" FAST.fromString diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs +++ b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs @@ -14,7 +14,7 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Internal.Token @@ -30,7 +30,7 @@ {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: redundant bracket" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} fc = TC.firstChild ns = TC.nextSibling @@ -47,7 +47,7 @@ , Rank1 u , BalancedParens u , TestBit u) - => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith () + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () genTest t mkCursor = do describe ("Json cursor of type " ++ t) $ do describe "For empty json array" $ do diff --git a/test/HaskellWorks/Data/Json/CorpusSpec.hs b/test/HaskellWorks/Data/Json/CorpusSpec.hs --- a/test/HaskellWorks/Data/Json/CorpusSpec.hs +++ b/test/HaskellWorks/Data/Json/CorpusSpec.hs @@ -15,7 +15,7 @@ import Control.Monad.IO.Class import HaskellWorks.Data.BalancedParens.Simple import HaskellWorks.Data.Bits.FromBitTextByteString -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec @@ -25,7 +25,7 @@ {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: redundant bracket" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} spec :: Spec spec = describe "HaskellWorks.Data.Json.Corpus" $ do @@ -35,7 +35,7 @@ inInterestBalancedParensBS <- liftIO $ BS.readFile "corpus/5000B.json.bp.idx" let inInterestBits = fromBitTextByteString inInterestBitsBS let inInterestBalancedParens = fromBitTextByteString inInterestBalancedParensBS - let !cursor = SLOW.makeCursor inJsonBS + let !cursor = SLOW.fromByteString inJsonBS let text = cursorText cursor let ib = interests cursor let SimpleBalancedParens bp = balancedParens cursor @@ -48,7 +48,7 @@ inInterestBalancedParensBS <- liftIO $ BS.readFile "corpus/issue-0001.json.bp.idx" let inInterestBits = fromBitTextByteString inInterestBitsBS let inInterestBalancedParens = fromBitTextByteString inInterestBalancedParensBS - let !cursor = SLOW.makeCursor inJsonBS + let !cursor = SLOW.fromByteString inJsonBS let text = cursorText cursor let ib = interests cursor let SimpleBalancedParens bp = balancedParens cursor diff --git a/test/HaskellWorks/Data/Json/TypeSpec.hs b/test/HaskellWorks/Data/Json/TypeSpec.hs --- a/test/HaskellWorks/Data/Json/TypeSpec.hs +++ b/test/HaskellWorks/Data/Json/TypeSpec.hs @@ -14,7 +14,7 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Type import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 @@ -30,15 +30,15 @@ {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: redundant bracket" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} fc = TC.firstChild ns = TC.nextSibling spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do - genSpec "DVS.Vector Word64" SLOW.makeCursor - genSpec "Poppy512" FAST.makeCursor + genSpec "DVS.Vector Word64" SLOW.fromString + genSpec "CsPoppy" FAST.fromString genSpec :: forall t u. ( Eq t @@ -50,7 +50,7 @@ , Rank1 u , BalancedParens u , TestBit u) - => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith () + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () genSpec t makeCursor = do describe ("Json cursor of type " ++ t) $ do let forJson s f = describe ("of value " ++ show s) (f (makeCursor s)) @@ -95,7 +95,7 @@ \ \"dimensions\": [500, 600.01e-02, true, false, null] \ \ } \ \ } \ - \}" :: JsonCursor BS.ByteString t u + \}" :: GenericCursor BS.ByteString t u it "can navigate down and forwards" $ requireTest $ do ( jsonTypeAt) cursor === Just JsonTypeObject (fc >=> jsonTypeAt) cursor === Just JsonTypeString diff --git a/test/HaskellWorks/Data/Json/ValueSpec.hs b/test/HaskellWorks/Data/Json/ValueSpec.hs --- a/test/HaskellWorks/Data/Json/ValueSpec.hs +++ b/test/HaskellWorks/Data/Json/ValueSpec.hs @@ -14,7 +14,7 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Json.Backend.Standard.Cursor +import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Internal.Index import HaskellWorks.Data.Json.Value @@ -32,15 +32,15 @@ {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: redundant bracket" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} fc = TC.firstChild ns = TC.nextSibling spec :: Spec spec = describe "HaskellWorks.Data.Json.ValueSpec" $ do - genSpec "DVS.Vector Word64" SLOW.makeCursor - genSpec "Poppy512" FAST.makeCursor + genSpec "DVS.Vector Word64" SLOW.fromString + genSpec "CsPoppy" FAST.fromString jsonValueVia :: ( BalancedParens u @@ -48,7 +48,7 @@ , Rank1 u , Select1 t , TestBit u) - => Maybe (JsonCursor BS.ByteString t u) -> Either DecodeError JsonValue + => Maybe (GenericCursor BS.ByteString t u) -> Either DecodeError JsonValue jsonValueVia mk = case mk of Just k -> (jsonIndexAt >=> jsonValueAt) k Nothing -> Left (DecodeError "No such element") @@ -63,7 +63,7 @@ , Rank1 u , BalancedParens u , TestBit u) - => String -> (String -> JsonCursor BS.ByteString t u) -> SpecWith () + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () genSpec t makeCursor = do describe ("Json cursor of type " ++ t) $ do let forJson s f = describe ("of value " ++ show s) (f (makeCursor s)) @@ -107,7 +107,7 @@ \ \"dimensions\": [500, 600.01e-02, true, false, null] \ \ } \ \ } \ - \}" :: JsonCursor BS.ByteString t u + \}" :: GenericCursor BS.ByteString t u it "can navigate down and forwards" $ requireTest $ do let array = JsonArray [JsonNumber 500, JsonNumber 600.01e-02, JsonBool True, JsonBool False, JsonNull] :: JsonValue let object1 = JsonObject ([("name", JsonString "main_window"), ("dimensions", array)]) :: JsonValue