hw-json 0.0.0.4 → 0.1.0.0
raw patch · 16 files changed
+586/−357 lines, 16 filesdep +errorsdep ~basedep ~hw-primdep ~hw-rankselectPVP ok
version bump matches the API change (PVP)
Dependencies added: errors
Dependency ranges changed: base, hw-prim, hw-rankselect
API changes (from Hackage documentation)
- HaskellWorks.Data.Json.Extract: extractJsonSnippet :: ByteString -> Maybe (JsonType, ByteString)
- HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor: class FromJsonCursor t v w a
- HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor: fromJsonCursor :: FromJsonCursor t v w a => JsonCursor t v w -> a
- HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor: instance (HaskellWorks.Data.TreeCursor.TreeCursor (HaskellWorks.Data.Json.Succinct.Cursor.Internal.JsonCursor Data.ByteString.Internal.ByteString v w), HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1.Rank1 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1.Select1 v, HaskellWorks.Data.Bits.BitWise.TestBit w) => HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor.FromJsonCursor Data.ByteString.Internal.ByteString v w (HaskellWorks.Data.Json.Value.Internal.GenJsonValue Data.ByteString.Internal.ByteString Data.ByteString.Internal.ByteString)
- HaskellWorks.Data.Json.Succinct.Cursor.Internal: instance (HaskellWorks.Data.Succinct.BalancedParens.Internal.BalancedParens w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0.Rank0 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1.Rank1 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1.Select1 v, HaskellWorks.Data.Bits.BitWise.TestBit w) => HaskellWorks.Data.Json.Type.JsonTypeAt (HaskellWorks.Data.Json.Succinct.Cursor.Internal.JsonCursor Data.ByteString.Internal.ByteString v w)
- HaskellWorks.Data.Json.Succinct.Cursor.Internal: instance (HaskellWorks.Data.Succinct.BalancedParens.Internal.BalancedParens w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0.Rank0 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1.Rank1 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1.Select1 v, HaskellWorks.Data.Bits.BitWise.TestBit w) => HaskellWorks.Data.Json.Type.JsonTypeAt (HaskellWorks.Data.Json.Succinct.Cursor.Internal.JsonCursor GHC.Base.String v w)
- HaskellWorks.Data.Json.Succinct.Cursor.Internal: instance (HaskellWorks.Data.Succinct.BalancedParens.Internal.BalancedParens w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0.Rank0 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1.Rank1 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1.Select1 v, HaskellWorks.Data.Bits.BitWise.TestBit w) => HaskellWorks.Data.Json.Value.Internal.GenJsonValueAt Data.ByteString.Internal.ByteString Data.ByteString.Internal.ByteString (HaskellWorks.Data.Json.Succinct.Cursor.Internal.JsonCursor Data.ByteString.Internal.ByteString v w)
- HaskellWorks.Data.Json.Value.ByteString: type JsonValue = GenJsonValue ByteString ByteString
- HaskellWorks.Data.Json.Value.Internal: JsonArray :: [GenJsonValue s n] -> GenJsonValue s n
- HaskellWorks.Data.Json.Value.Internal: JsonBool :: Bool -> GenJsonValue s n
- HaskellWorks.Data.Json.Value.Internal: JsonNull :: GenJsonValue s n
- HaskellWorks.Data.Json.Value.Internal: JsonNumber :: n -> GenJsonValue s n
- HaskellWorks.Data.Json.Value.Internal: JsonObject :: (Map s (GenJsonValue s n)) -> GenJsonValue s n
- HaskellWorks.Data.Json.Value.Internal: JsonString :: s -> GenJsonValue s n
- HaskellWorks.Data.Json.Value.Internal: class GenJsonValueAt s n a
- HaskellWorks.Data.Json.Value.Internal: data GenJsonValue s n
- HaskellWorks.Data.Json.Value.Internal: instance (GHC.Classes.Eq s, GHC.Classes.Eq n) => GHC.Classes.Eq (HaskellWorks.Data.Json.Value.Internal.GenJsonValue s n)
- HaskellWorks.Data.Json.Value.Internal: instance (GHC.Show.Show s, GHC.Show.Show n) => GHC.Show.Show (HaskellWorks.Data.Json.Value.Internal.GenJsonValue s n)
- HaskellWorks.Data.Json.Value.Internal: jsonValueAt :: GenJsonValueAt s n a => a -> Maybe (GenJsonValue s n)
+ HaskellWorks.Data.Json.CharLike: class JsonCharLike c
+ HaskellWorks.Data.Json.CharLike: instance HaskellWorks.Data.Json.CharLike.JsonCharLike GHC.Word.Word8
+ HaskellWorks.Data.Json.CharLike: isBraceLeft :: JsonCharLike c => c -> Bool
+ HaskellWorks.Data.Json.CharLike: isBracketLeft :: JsonCharLike c => c -> Bool
+ HaskellWorks.Data.Json.CharLike: isChar_f :: JsonCharLike c => c -> Bool
+ HaskellWorks.Data.Json.CharLike: isChar_n :: JsonCharLike c => c -> Bool
+ HaskellWorks.Data.Json.CharLike: isChar_t :: JsonCharLike c => c -> Bool
+ HaskellWorks.Data.Json.CharLike: isLeadingDigit2 :: JsonCharLike c => c -> Bool
+ HaskellWorks.Data.Json.CharLike: isQuotDbl :: JsonCharLike c => c -> Bool
+ HaskellWorks.Data.Json.Succinct.Index: JsonIndexArray :: [JsonIndex] -> JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: JsonIndexBool :: Bool -> JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: JsonIndexNull :: JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: JsonIndexNumber :: ByteString -> JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: JsonIndexObject :: [(ByteString, JsonIndex)] -> JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: JsonIndexString :: ByteString -> JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: class JsonIndexAt a
+ HaskellWorks.Data.Json.Succinct.Index: data JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: instance (HaskellWorks.Data.Succinct.BalancedParens.Internal.BalancedParens w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0.Rank0 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1.Rank1 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1.Select1 v, HaskellWorks.Data.Bits.BitWise.TestBit w) => HaskellWorks.Data.Json.Succinct.Index.JsonIndexAt (HaskellWorks.Data.Json.Succinct.Cursor.Internal.JsonCursor Data.ByteString.Internal.ByteString v w)
+ HaskellWorks.Data.Json.Succinct.Index: instance GHC.Classes.Eq HaskellWorks.Data.Json.Succinct.Index.JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: instance GHC.Show.Show HaskellWorks.Data.Json.Succinct.Index.JsonIndex
+ HaskellWorks.Data.Json.Succinct.Index: jsonIndexAt :: JsonIndexAt a => a -> Either DecodeError JsonIndex
+ HaskellWorks.Data.Json.Type: instance (HaskellWorks.Data.Succinct.BalancedParens.Internal.BalancedParens w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0.Rank0 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1.Rank1 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1.Select1 v, HaskellWorks.Data.Bits.BitWise.TestBit w) => HaskellWorks.Data.Json.Type.JsonTypeAt (HaskellWorks.Data.Json.Succinct.Cursor.Internal.JsonCursor Data.ByteString.Internal.ByteString v w)
+ HaskellWorks.Data.Json.Type: instance (HaskellWorks.Data.Succinct.BalancedParens.Internal.BalancedParens w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0.Rank0 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1.Rank1 w, HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1.Select1 v, HaskellWorks.Data.Bits.BitWise.TestBit w) => HaskellWorks.Data.Json.Type.JsonTypeAt (HaskellWorks.Data.Json.Succinct.Cursor.Internal.JsonCursor GHC.Base.String v w)
+ HaskellWorks.Data.Json.Value: JsonArray :: [JsonValue] -> JsonValue
+ HaskellWorks.Data.Json.Value: JsonBool :: Bool -> JsonValue
+ HaskellWorks.Data.Json.Value: JsonNull :: JsonValue
+ HaskellWorks.Data.Json.Value: JsonNumber :: Double -> JsonValue
+ HaskellWorks.Data.Json.Value: JsonObject :: [(String, JsonValue)] -> JsonValue
+ HaskellWorks.Data.Json.Value: JsonString :: String -> JsonValue
+ HaskellWorks.Data.Json.Value: class FromJsonValue a
+ HaskellWorks.Data.Json.Value: class JsonValueAt a
+ HaskellWorks.Data.Json.Value: data JsonValue
+ HaskellWorks.Data.Json.Value: fromJsonValue :: FromJsonValue a => JsonValue -> Either DecodeError a
+ HaskellWorks.Data.Json.Value: instance GHC.Classes.Eq HaskellWorks.Data.Json.Value.JsonValue
+ HaskellWorks.Data.Json.Value: instance GHC.Show.Show HaskellWorks.Data.Json.Value.JsonValue
+ HaskellWorks.Data.Json.Value: instance HaskellWorks.Data.Json.Value.FromJsonValue HaskellWorks.Data.Json.Value.JsonValue
+ HaskellWorks.Data.Json.Value: instance HaskellWorks.Data.Json.Value.JsonValueAt HaskellWorks.Data.Json.Succinct.Index.JsonIndex
+ HaskellWorks.Data.Json.Value: jsonValueAt :: JsonValueAt a => a -> Either DecodeError JsonValue
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigit :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigitAlphaLower :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigitAlphaUpper :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseHexDigitNumeric :: Parser t => Parser t Int
+ HaskellWorks.Data.Json.Value.Internal: parseJsonString :: (Parser t, IsString t) => Parser t String
- HaskellWorks.Data.Json.Token.Tokenize: toChar :: IsChar c => c -> Char
+ HaskellWorks.Data.Json.Token.Tokenize: toChar :: c -> Char
Files
- README.md +1/−1
- bench/Main.hs +3/−40
- hw-json.cabal +20/−18
- src/HaskellWorks/Data/Json.hs +2/−0
- src/HaskellWorks/Data/Json/CharLike.hs +23/−0
- src/HaskellWorks/Data/Json/Extract.hs +0/−45
- src/HaskellWorks/Data/Json/Succinct/Cursor/FromJsonCursor.hs +0/−33
- src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs +7/−83
- src/HaskellWorks/Data/Json/Succinct/Index.hs +58/−0
- src/HaskellWorks/Data/Json/Type.hs +54/−2
- src/HaskellWorks/Data/Json/Value.hs +53/−4
- src/HaskellWorks/Data/Json/Value/ByteString.hs +0/−8
- src/HaskellWorks/Data/Json/Value/Internal.hs +55/−11
- test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs +9/−112
- test/HaskellWorks/Data/Json/TypeSpec.hs +157/−0
- test/HaskellWorks/Data/Json/ValueSpec.hs +144/−0
README.md view
@@ -1,5 +1,5 @@ # hw-json-[](https://circleci.com/gh/haskell-works/hw-json/tree/v0.0-branch)+[](https://circleci.com/gh/haskell-works/hw-json/tree/0.0-branch) Conduits for tokenizing streams.
bench/Main.hs view
@@ -17,23 +17,9 @@ import HaskellWorks.Data.Json.Conduit import HaskellWorks.Data.Json.Conduit.Blank import HaskellWorks.Data.Json.Succinct.Cursor-import HaskellWorks.Data.Positioning import HaskellWorks.Data.Succinct.BalancedParens.Simple-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic import System.IO.MMap -setupEnvBs :: Int -> IO BS.ByteString-setupEnvBs n = return $ BS.pack (take n (cycle [maxBound, 0]))--setupEnvBss :: Int -> Int -> IO [BS.ByteString]-setupEnvBss n k = setupEnvBs n >>= \v -> return (replicate k v)--setupEnvVector :: Int -> IO (DVS.Vector Word64)-setupEnvVector n = return $ DVS.fromList (take n (cycle [maxBound, 0]))--setupEnvVectors :: Int -> Int -> IO [DVS.Vector Word64]-setupEnvVectors n k = setupEnvVector n >>= \v -> return (replicate k v)- setupEnvJson :: FilePath -> IO BS.ByteString setupEnvJson filepath = do (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing@@ -43,30 +29,15 @@ loadJson :: BS.ByteString -> JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) loadJson bs = fromByteString bs :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)) -benchRankSelect :: [Benchmark]-benchRankSelect =- [ env (setupEnvVector 1000000) $ \bv -> bgroup "Rank"- [ bench "Rank - Once" (whnf (rank1 bv) 1)- , bench "Select - Once" (whnf (select1 bv) 1)- , bench "Rank - Many" (nf (map (getCount . rank1 bv)) [0, 1000..10000000])- ]- ]- runCon :: Conduit i [] BS.ByteString -> i -> BS.ByteString runCon con bs = BS.concat $ runListConduit con [bs] -runCon2 :: Conduit i [] o -> [i] -> [o]-runCon2 con is = let os = runListConduit con is in seq (length os) os--runCon3 :: Conduit i [] BS.ByteString -> [i] -> [BS.ByteString]-runCon3 con is = let os = runListConduit con is in seq (BS.length (last os)) os- jsonToInterestBits3 :: MonadThrow m => Conduit BS.ByteString m BS.ByteString jsonToInterestBits3 = blankJson =$= blankedJsonToInterestBits benchRankJson40Conduits :: [Benchmark] benchRankJson40Conduits =- [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "Json40"+ [ env (setupEnvJson "corpus/part40.json") $ \bs -> bgroup "Json40" [ bench "Run blankJson " (whnf (runCon blankJson ) bs) , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs) , bench "loadJson " (whnf loadJson bs)@@ -75,7 +46,7 @@ benchRankJson80Conduits :: [Benchmark] benchRankJson80Conduits =- [ env (setupEnvJson "/Users/jky/Downloads/part80.json") $ \bs -> bgroup "Json40"+ [ env (setupEnvJson "corpus/part80.json") $ \bs -> bgroup "Json40" [ bench "Run blankJson " (whnf (runCon blankJson ) bs) , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs) , bench "loadJson" (whnf loadJson bs)@@ -84,18 +55,10 @@ benchRankJsonBigConduits :: [Benchmark] benchRankJsonBigConduits =- [ env (setupEnvJson "/Users/jky/Downloads/78mb.json") $ \bs -> bgroup "JsonBig"+ [ env (setupEnvJson "corpus/78mb.json") $ \bs -> bgroup "JsonBig" [ bench "Run blankJson " (whnf (runCon blankJson ) bs) , bench "Run jsonToInterestBits3 " (whnf (runCon jsonToInterestBits3 ) bs) , bench "loadJson" (whnf loadJson bs)- ]- ]--benchBlankedJsonToBalancedParens :: [Benchmark]-benchBlankedJsonToBalancedParens =- [ env (setupEnvJson "/Users/jky/Downloads/part40.json") $ \bs -> bgroup "JsonBig"- [ bench "blankedJsonToBalancedParens2" (whnf (runCon2 blankedJsonToBalancedParens) [bs])- , bench "blankedJsonToBalancedParens2" (whnf (runCon3 blankedJsonToBalancedParens2) [bs]) ] ]
hw-json.cabal view
@@ -1,5 +1,5 @@ name: hw-json-version: 0.0.0.4+version: 0.1.0.0 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-json#readme@@ -11,22 +11,23 @@ category: Data, Conduit build-type: Simple extra-source-files: README.md-cabal-version: >= 1.10+cabal-version: >= 1.22 executable hw-json-example hs-source-dirs: app main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2- build-depends: base >= 4+ build-depends: base >= 4 && < 5 , bytestring , conduit , criterion+ , errors , hw-bits , hw-conduit , hw-diagnostics , hw-json- , hw-prim- , hw-rankselect+ , hw-prim >= 0.0.3.1+ , hw-rankselect >= 0.0.0.5 , mmap , resourcet , vector@@ -35,26 +36,25 @@ library hs-source-dirs: src exposed-modules: HaskellWorks.Data.Json+ , HaskellWorks.Data.Json.CharLike , HaskellWorks.Data.Json.Conduit , HaskellWorks.Data.Json.Conduit.Blank , HaskellWorks.Data.Json.Conduit.Words- , HaskellWorks.Data.Json.Extract , HaskellWorks.Data.Json.Succinct , HaskellWorks.Data.Json.Succinct.Cursor , HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens , HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson- , HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor , HaskellWorks.Data.Json.Succinct.Cursor.InterestBits , HaskellWorks.Data.Json.Succinct.Cursor.Internal , HaskellWorks.Data.Json.Succinct.Cursor.Token+ , HaskellWorks.Data.Json.Succinct.Index , HaskellWorks.Data.Json.Token.Tokenize , HaskellWorks.Data.Json.Token.Types , HaskellWorks.Data.Json.Token , HaskellWorks.Data.Json.Type , HaskellWorks.Data.Json.Value- , HaskellWorks.Data.Json.Value.ByteString , HaskellWorks.Data.Json.Value.Internal- build-depends: base >= 4.7 && < 5+ build-depends: base >= 4 && < 5 , array , attoparsec , bytestring@@ -63,8 +63,8 @@ , hw-bits , hw-conduit , hw-parser- , hw-prim- , hw-rankselect+ , hw-prim >= 0.0.3.1+ , hw-rankselect >= 0.0.0.5 , mono-traversable , resourcet , text@@ -72,7 +72,7 @@ , word8 default-language: Haskell2010- ghc-options: -rtsopts -with-rtsopts=-N -Wall -O2 -Wall -msse4.2+ ghc-options: -Wall -O2 -msse4.2 test-suite hw-json-test type: exitcode-stdio-1.0@@ -81,7 +81,9 @@ other-modules: HaskellWorks.Data.Json.Token.TokenizeSpec , HaskellWorks.Data.Json.Succinct.CursorSpec , HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec- build-depends: base+ , HaskellWorks.Data.Json.TypeSpec+ , HaskellWorks.Data.Json.ValueSpec+ build-depends: base >= 4 && < 5 , attoparsec , bytestring , containers@@ -90,8 +92,8 @@ , hw-bits , hw-conduit , hw-json- , hw-prim- , hw-rankselect+ , hw-prim >= 0.0.3.1+ , hw-rankselect >= 0.0.0.5 , mmap , parsec , QuickCheck@@ -111,15 +113,15 @@ Main-Is: Main.hs GHC-Options: -O2 -Wall -msse4.2 Default-Language: Haskell2010- Build-Depends: base >= 4 && < 5+ Build-Depends: base >= 4 && < 5 , bytestring , conduit , criterion , hw-bits , hw-conduit , hw-json- , hw-prim- , hw-rankselect+ , hw-prim >= 0.0.3.1+ , hw-rankselect >= 0.0.0.5 , mmap , resourcet , vector
src/HaskellWorks/Data/Json.hs view
@@ -9,3 +9,5 @@ import HaskellWorks.Data.Json.Succinct as X import HaskellWorks.Data.Json.Token as X+import HaskellWorks.Data.Json.Type as X+import HaskellWorks.Data.Json.Value as X
+ src/HaskellWorks/Data/Json/CharLike.hs view
@@ -0,0 +1,23 @@+module HaskellWorks.Data.Json.CharLike where++import Data.Word+import Data.Word8+import HaskellWorks.Data.Json.Conduit.Words++class JsonCharLike c where+ isLeadingDigit2 :: c -> Bool+ isQuotDbl :: c -> Bool+ isChar_t :: c -> Bool+ isChar_f :: c -> Bool+ isChar_n :: c -> Bool+ isBraceLeft :: c -> Bool+ isBracketLeft :: c -> Bool++instance JsonCharLike Word8 where+ isLeadingDigit2 = isLeadingDigit+ isQuotDbl = (== _quotedbl)+ isChar_t = (== _t)+ isChar_f = (== _f)+ isChar_n = (== _n)+ isBraceLeft = (== _braceleft)+ isBracketLeft = (== _bracketleft)
− src/HaskellWorks/Data/Json/Extract.hs
@@ -1,45 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module HaskellWorks.Data.Json.Extract- ( extractJsonSnippet- ) where--import qualified Data.ByteString as BS-import Data.Word8-import HaskellWorks.Data.Json.Conduit.Words-import HaskellWorks.Data.Json.Type--data ExtractJsonState- = ExtractJsonStringEscaped- | ExtractJsonStringInJson- | ExtractJsonStringInNumber- | ExtractJsonStringInString--extractJsonSnippet :: BS.ByteString -> Maybe (JsonType, BS.ByteString)-extractJsonSnippet bs = case extractJsonSnippet' 0 ExtractJsonStringInJson bs of- Just (jsonType, len) -> Just (jsonType, BS.take len bs)- Nothing -> Nothing--extractJsonSnippet' :: Int -> ExtractJsonState -> BS.ByteString -> Maybe (JsonType, Int)-extractJsonSnippet' n ExtractJsonStringInJson bs = case BS.uncons bs of- Just (!c, !cs) | isLeadingDigit c -> extractJsonSnippet' (n + 1) ExtractJsonStringInNumber cs- Just (!c, !cs) | c == _quotedbl -> extractJsonSnippet' (n + 1) ExtractJsonStringInString cs- Just (!c, _) | c == _t -> Just (JsonTypeBool, n + 1)- Just (!c, _) | c == _f -> Just (JsonTypeBool, n + 1)- Just (!c, _) | c == _n -> Just (JsonTypeNull, n + 1)- Just (!c, _) | c == _braceleft -> Just (JsonTypeObject, n + 1)- Just (!c, _) | c == _bracketleft -> Just (JsonTypeArray, n + 1)- Just _ -> Nothing- Nothing -> Nothing-extractJsonSnippet' n ExtractJsonStringInString bs = case BS.uncons bs of- Just (!c, !cs) | c == _backslash -> extractJsonSnippet' (n + 1) ExtractJsonStringEscaped cs- Just (!c, _) | c == _quotedbl -> Just (JsonTypeString, n + 1)- Just (_ , !cs) -> extractJsonSnippet' (n + 1) ExtractJsonStringInString cs- Nothing -> Nothing-extractJsonSnippet' n ExtractJsonStringEscaped bs = case BS.uncons bs of- Just (_, !cs) -> extractJsonSnippet' (n + 1) ExtractJsonStringInString cs- Nothing -> Nothing-extractJsonSnippet' n ExtractJsonStringInNumber bs = case BS.uncons bs of- Just (!c, !cs) | isTrailingDigit c -> extractJsonSnippet' (n + 1) ExtractJsonStringInNumber cs- Just _ -> Just (JsonTypeNumber, n)- Nothing -> Just (JsonTypeNumber, n)
− src/HaskellWorks/Data/Json/Succinct/Cursor/FromJsonCursor.hs
@@ -1,33 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor where--import qualified Data.ByteString as BS-import HaskellWorks.Data.Bits.BitWise-import HaskellWorks.Data.Json.Succinct.Cursor.Internal-import HaskellWorks.Data.Json.Succinct.Cursor.Token-import HaskellWorks.Data.Json.Value-import HaskellWorks.Data.Json.Token.Types-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1-import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1-import HaskellWorks.Data.TreeCursor--class FromJsonCursor t v w a where- fromJsonCursor :: JsonCursor t v w -> a--instance (TreeCursor (JsonCursor BS.ByteString v w), Rank1 w, Select1 v, TestBit w) => FromJsonCursor BS.ByteString v w (GenJsonValue BS.ByteString BS.ByteString) where- fromJsonCursor k = case jsonTokenAt k of- Just JsonTokenBraceL -> undefined- Just JsonTokenBraceR -> undefined- Just JsonTokenBracketL -> undefined- Just JsonTokenBracketR -> undefined- Just JsonTokenComma -> undefined- Just JsonTokenColon -> undefined- Just JsonTokenWhitespace -> undefined- Just (JsonTokenString _) -> undefined- Just (JsonTokenBoolean value) -> JsonBool value- Just (JsonTokenNumber _) -> undefined- Just JsonTokenNull -> undefined- Nothing -> undefined
src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs view
@@ -9,29 +9,21 @@ , jsonCursorPos ) where -import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BSC-import Data.ByteString.Internal as BSI-import Data.Char-import qualified Data.List as L-import qualified Data.Map as M+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import Data.ByteString.Internal as BSI import Data.String-import qualified Data.Vector.Storable as DVS+import qualified Data.Vector.Storable as DVS import Data.Word-import Data.Word8 import Foreign.ForeignPtr import HaskellWorks.Data.Bits.BitShown-import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.FromByteString import HaskellWorks.Data.FromForeignRegion-import HaskellWorks.Data.Json.Extract-import qualified HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens as CBP+import qualified HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens as CBP import HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import HaskellWorks.Data.Json.Succinct.Cursor.InterestBits-import HaskellWorks.Data.Json.Type-import HaskellWorks.Data.Json.Value.Internal import HaskellWorks.Data.Positioning-import qualified HaskellWorks.Data.Succinct.BalancedParens as BP+import qualified HaskellWorks.Data.Succinct.BalancedParens as BP import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0 import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1@@ -104,7 +96,7 @@ 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 = let mq = BP.nextSibling (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq+ 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@@ -115,75 +107,7 @@ subtreeSize :: JsonCursor t v u -> Maybe Count subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) -wIsJsonNumberDigit :: Word8 -> Bool-wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen- jsonCursorPos :: (Rank1 w, Select1 v, VectorLike s) => 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) => JsonTypeAt (JsonCursor String v w) where- jsonTypeAtPosition p k = case vDrop (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 (vDrop (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) => GenJsonValueAt BS.ByteString BS.ByteString (JsonCursor BS.ByteString v w) where- jsonValueAt :: JsonCursor BS.ByteString v w -> Maybe (GenJsonValue BS.ByteString BS.ByteString)- jsonValueAt k = case extractJsonSnippet remainder of- Just (JsonTypeArray , _) -> Just $ JsonArray (arrayValuesAt k)- Just (JsonTypeBool , bs) -> case BS.uncons bs of- Just (c, _) | c == _t -> Just $ JsonBool True- Just (c, _) | c == _f -> Just $ JsonBool False- _ -> Nothing- Just (JsonTypeNull , _) -> Just JsonNull- Just (JsonTypeNumber, bs) -> Just $ JsonNumber bs- Just (JsonTypeObject, _) -> Just $ JsonObject (mapValuesAt k)- Just (JsonTypeString, bs) -> Just $ JsonString bs- Nothing -> Nothing- where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))- ik = interests k- bpk = balancedParens k- remainder = (vDrop (toCount p) (cursorText k))- genArrayValue :: JsonCursor BS.ByteString v w -> Maybe (GenJsonValue ByteString ByteString, JsonCursor ByteString v w)- genArrayValue j = (,) <$> jsonValueAt j <*> nextSibling j- arrayValuesAt :: JsonCursor BS.ByteString v w -> [GenJsonValue BS.ByteString BS.ByteString]- arrayValuesAt j = case firstChild j of- Just c -> L.unfoldr genArrayValue c- Nothing -> []- mapValuesAt :: JsonCursor BS.ByteString v w -> M.Map ByteString (GenJsonValue ByteString ByteString)- mapValuesAt j = M.fromList (pairwise (arrayValuesAt j) >>= asField)- asField :: (GenJsonValue ByteString ByteString, GenJsonValue ByteString ByteString) -> [(ByteString, GenJsonValue ByteString ByteString)]- asField (a, b) = case a of- JsonString s -> [(s, b)]- _ -> []- pairwise :: [a] -> [(a, a)]- pairwise (a:b:rs) = (a, b) : pairwise rs- pairwise _ = []
+ src/HaskellWorks/Data/Json/Succinct/Index.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Succinct.Index where++import Control.Arrow+import Control.Monad+import qualified Data.ByteString as BS+import qualified Data.List as L+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Decode+import HaskellWorks.Data.Json.CharLike+import HaskellWorks.Data.Json.Succinct+import HaskellWorks.Data.Positioning+import qualified HaskellWorks.Data.Succinct.BalancedParens as BP+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.TreeCursor+import HaskellWorks.Data.Vector.VectorLike++data JsonIndex+ = JsonIndexString BS.ByteString+ | JsonIndexNumber BS.ByteString+ | JsonIndexObject [(BS.ByteString, JsonIndex)]+ | JsonIndexArray [JsonIndex]+ | JsonIndexBool Bool+ | JsonIndexNull+ deriving (Eq, Show)++class JsonIndexAt a where+ jsonIndexAt :: a -> Either DecodeError JsonIndex++instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (JsonCursor BS.ByteString v w) where+ jsonIndexAt k = case vUncons 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 = vDrop (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)]+ _ -> []
src/HaskellWorks/Data/Json/Type.hs view
@@ -1,7 +1,27 @@-module HaskellWorks.Data.Json.Type where+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-} -import HaskellWorks.Data.Positioning+module HaskellWorks.Data.Json.Type+ ( JsonType(..)+ , JsonTypeAt(..)+ ) where +import qualified Data.ByteString as BS+import Data.Char+import Data.Word8+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Json.Succinct+import HaskellWorks.Data.Positioning+import qualified HaskellWorks.Data.Succinct.BalancedParens as BP+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.Vector.VectorLike++wIsJsonNumberDigit :: Word8 -> Bool+wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen+ data JsonType = JsonTypeArray | JsonTypeBool@@ -14,3 +34,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 (JsonCursor String v w) where+ jsonTypeAtPosition p k = case vDrop (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 (vDrop (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
src/HaskellWorks/Data/Json/Value.hs view
@@ -1,5 +1,54 @@-module HaskellWorks.Data.Json.Value- ( module X- ) where+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} -import HaskellWorks.Data.Json.Value.Internal as X+module HaskellWorks.Data.Json.Value where++import qualified Data.Attoparsec.ByteString.Char8 as ABC+import qualified Data.ByteString as BS+import HaskellWorks.Data.Decode+import HaskellWorks.Data.Json.Succinct.Index+import HaskellWorks.Data.Json.Value.Internal++data JsonValue+ = JsonString String+ | JsonNumber Double+ | JsonObject [(String, JsonValue)]+ | JsonArray [JsonValue]+ | JsonBool Bool+ | JsonNull+ deriving (Eq, Show)++class JsonValueAt a where+ jsonValueAt :: a -> Either DecodeError JsonValue++class FromJsonValue a where+ fromJsonValue :: JsonValue -> Either DecodeError a++instance JsonValueAt JsonIndex where+ jsonValueAt i = case i of+ 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)+ 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+ ABC.Fail {} -> Left (DecodeError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'"))+ 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+ JsonIndexArray es -> JsonArray <$> mapM jsonValueAt es+ JsonIndexBool v -> Right (JsonBool v)+ JsonIndexNull -> Right JsonNull+ where 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++instance FromJsonValue JsonValue where+ fromJsonValue = Right
− src/HaskellWorks/Data/Json/Value/ByteString.hs
@@ -1,8 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--module HaskellWorks.Data.Json.Value.ByteString where--import Data.ByteString-import HaskellWorks.Data.Json.Value.Internal--type JsonValue = GenJsonValue ByteString ByteString
src/HaskellWorks/Data/Json/Value/Internal.hs view
@@ -1,17 +1,61 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} module HaskellWorks.Data.Json.Value.Internal where -import Data.Map+import Control.Applicative+import qualified Data.Attoparsec.ByteString.Char8 as ABC+import qualified Data.Attoparsec.Types as T+import Data.Bits+import Data.Char+import Data.String+import HaskellWorks.Data.Parser as P -data GenJsonValue s n- = JsonString s- | JsonNumber n- | JsonObject (Map s (GenJsonValue s n))- | JsonArray [GenJsonValue s n]- | JsonBool Bool- | JsonNull- deriving (Eq, Show)+parseHexDigitNumeric :: P.Parser t => T.Parser t Int+parseHexDigitNumeric = do+ c <- satisfyChar (\c -> '0' <= c && c <= '9')+ return $ ord c - ord '0' -class GenJsonValueAt s n a where- jsonValueAt :: a -> Maybe (GenJsonValue s n)+parseHexDigitAlphaLower :: P.Parser t => T.Parser t Int+parseHexDigitAlphaLower = do+ c <- satisfyChar (\c -> 'a' <= c && c <= 'z')+ return $ ord c - ord 'a' + 10++parseHexDigitAlphaUpper :: P.Parser t => T.Parser t Int+parseHexDigitAlphaUpper = do+ c <- satisfyChar (\c -> 'A' <= c && c <= 'Z')+ return $ ord c - ord 'A' + 10++parseHexDigit :: P.Parser t => T.Parser t Int+parseHexDigit = parseHexDigitNumeric <|> parseHexDigitAlphaLower <|> parseHexDigitAlphaUpper++parseJsonString :: (P.Parser t, IsString t) => T.Parser t String+parseJsonString = do+ _ <- string "\""+ value <- many (verbatimChar <|> escapedChar <|> escapedCode)+ _ <- string "\""+ return value+ where+ verbatimChar = satisfyChar (ABC.notInClass "\"\\") <?> "invalid string character"+ escapedChar = do+ _ <- string "\\"+ ( char '"' >> return '"' ) <|>+ ( char 'b' >> return '\b' ) <|>+ ( char 'n' >> return '\n' ) <|>+ ( char 'f' >> return '\f' ) <|>+ ( char 'r' >> return '\r' ) <|>+ ( char 't' >> return '\t' ) <|>+ ( char '\\' >> return '\\' ) <|>+ ( char '\'' >> return '\'' ) <|>+ ( char '/' >> return '/' )+ escapedCode = do+ _ <- string "\\u"+ a <- parseHexDigit+ b <- parseHexDigit+ c <- parseHexDigit+ d <- parseHexDigit+ return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d
test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs view
@@ -13,7 +13,6 @@ import Control.Monad import qualified Data.ByteString as BS-import qualified Data.Map as M import Data.String import qualified Data.Vector.Storable as DVS import Data.Word@@ -22,24 +21,21 @@ import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.Succinct.Cursor as C+import HaskellWorks.Data.Json.Succinct.Index import HaskellWorks.Data.Json.Token-import HaskellWorks.Data.Json.Type-import HaskellWorks.Data.Json.Value import HaskellWorks.Data.Succinct.BalancedParens.Internal import HaskellWorks.Data.Succinct.BalancedParens.Simple import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0 import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1 import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512-import qualified HaskellWorks.Data.TreeCursor as TC+import qualified HaskellWorks.Data.TreeCursor as TC import Test.Hspec {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module ("HLint: redundant bracket" :: String) #-} -type JsonValue = GenJsonValue BS.ByteString BS.ByteString- fc = TC.firstChild ns = TC.nextSibling pn = TC.parent@@ -49,42 +45,6 @@ spec :: Spec spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do describe "Cursor for [Bool]" $ do- it "initialises to beginning of empty object" $ do- let cursor = "{}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeObject- it "initialises to beginning of empty object preceded by spaces" $ do- let cursor = " {}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeObject- it "initialises to beginning of number" $ do- let cursor = "1234" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeNumber- it "initialises to beginning of string" $ do- let cursor = "\"Hello\"" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeString- it "initialises to beginning of array" $ do- let cursor = "[]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeArray- it "initialises to beginning of boolean true" $ do- let cursor = "true" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeBool- it "initialises to beginning of boolean false" $ do- let cursor = "false" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeBool- it "initialises to beginning of null" $ do- let cursor = "null" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- jsonTypeAt cursor `shouldBe` Just JsonTypeNull- it "cursor can navigate to first child of array" $ do- let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull- it "cursor can navigate to second child of array" $ do- let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject- it "cursor can navigate to first child of object at second child of array" $ do- let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- it "cursor can navigate to first child of object at second child of array" $ do- let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])- (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNumber it "depth at top" $ do let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) cd cursor `shouldBe` Just 1@@ -136,56 +96,26 @@ , TestBit u , FromForeignRegion (JsonCursor BS.ByteString t u) , IsString (JsonCursor BS.ByteString t u)- , GenJsonValueAt BS.ByteString BS.ByteString (JsonCursor BS.ByteString t u))+ , JsonIndexAt (JsonCursor BS.ByteString t u)+ ) => String -> (JsonCursor BS.ByteString t u) -> SpecWith () genSpec t _ = do describe ("Json cursor of type " ++ t) $ do let forJson (cursor :: JsonCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor)- forJson "{}" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeObject- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonObject M.empty :: JsonValue)- forJson " {}" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeObject- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonObject M.empty :: JsonValue)- forJson "1234" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeNumber- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonNumber "1234" :: JsonValue)- forJson "\"Hello\"" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeString- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonString "\"Hello\"" :: JsonValue)- forJson "[]" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeArray- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonArray [] :: JsonValue)- forJson "true" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeBool- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonBool True :: JsonValue)- forJson "false" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeBool- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonBool False :: JsonValue)- forJson "null" $ \cursor -> do- it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeNull- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonNull :: JsonValue) forJson "[null]" $ \cursor -> do- it "should have correct type" $ (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull- it "should have correct value" $ jsonValueAt cursor `shouldBe` Just (JsonArray [JsonNull] :: JsonValue)- it "should have correct value" $ ((fc >=> jsonValueAt) cursor) `shouldBe` Just (JsonNull :: JsonValue)- it "depth at top" $ cd cursor `shouldBe` Just 1+ it "depth at top" $ cd cursor `shouldBe` Just 1 it "depth at first child of array" $ (fc >=> cd) cursor `shouldBe` Just 2 forJson "[null, {\"field\": 1}]" $ \cursor -> do- it "cursor can navigate to second child of array" $ do- (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject- ((fc >=> ns >=> jsonValueAt) cursor) `shouldBe` Just (JsonObject (M.fromList [("\"field\"", JsonNumber "1")]) :: JsonValue)- jsonValueAt cursor `shouldBe` Just (JsonArray [JsonNull, JsonObject (M.fromList [("\"field\"", JsonNumber "1")])] :: JsonValue)- it "cursor can navigate to first child of object at second child of array" $ do- (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- it "cursor can navigate to first child of object at second child of array" $ do- (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNumber it "depth at second child of array" $ do (fc >=> ns >=> cd) cursor `shouldBe` Just 2 it "depth at first child of object at second child of array" $ do (fc >=> ns >=> fc >=> cd) cursor `shouldBe` Just 3 it "depth at first child of object at second child of array" $ do (fc >=> ns >=> fc >=> ns >=> cd) cursor `shouldBe` Just 3+ describe "For empty json array" $ do+ let cursor = "[null]" :: JsonCursor BS.ByteString t u+ it "can navigate down and forwards" $ do+ jsonIndexAt cursor `shouldBe` Right (JsonIndexArray [JsonIndexNull]) describe "For sample Json" $ do let cursor = "{ \ \ \"widget\": { \@@ -196,39 +126,6 @@ \ } \ \ } \ \}" :: JsonCursor BS.ByteString t u- it "can navigate down and forwards" $ do- let array = JsonArray [JsonNumber "500", JsonNumber "600.01e-02", JsonBool True, JsonBool False, JsonNull] :: JsonValue- let object1 = JsonObject (M.fromList [("\"name\"", JsonString "\"main_window\""), ("\"dimensions\"", array)]) :: JsonValue- let object2 = JsonObject (M.fromList [("\"debug\"", JsonString "\"on\""), ("\"window\"", object1)]) :: JsonValue- let object3 = JsonObject (M.fromList [("\"widget\"", object2)]) :: JsonValue- ( jsonValueAt) cursor `shouldBe` Just (object3 :: JsonValue)- (fc >=> jsonValueAt) cursor `shouldBe` Just (JsonString "\"widget\"" :: JsonValue)- (fc >=> ns >=> jsonValueAt) cursor `shouldBe` Just (object2 :: JsonValue)- (fc >=> ns >=> fc >=> jsonValueAt) cursor `shouldBe` Just (JsonString "\"debug\"" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonString "\"on\"" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonString "\"window\"" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonValueAt) cursor `shouldBe` Just (object1 :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonValueAt) cursor `shouldBe` Just (JsonString "\"name\"" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonString "\"main_window\"" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonString "\"dimensions\"" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonValueAt) cursor `shouldBe` Just (array :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonValueAt) cursor `shouldBe` Just (JsonNumber "500" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonNumber "600.01e-02" :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonBool True :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonBool False :: JsonValue)- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> jsonValueAt) cursor `shouldBe` Just (JsonNull :: JsonValue)- it "can navigate down and forwards" $ do- ( jsonTypeAt) cursor `shouldBe` Just JsonTypeObject- (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject- (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString- (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeArray it "can navigate up" $ do ( pn) cursor `shouldBe` Nothing (fc >=> pn) cursor `shouldBe` Just cursor
+ test/HaskellWorks/Data/Json/TypeSpec.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module HaskellWorks.Data.Json.TypeSpec (spec) where++import Control.Monad+import qualified Data.ByteString as BS+import Data.String+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Succinct.Cursor as C+import HaskellWorks.Data.Json.Succinct.Index+import HaskellWorks.Data.Json.Type+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import qualified HaskellWorks.Data.TreeCursor as TC+import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: redundant bracket" :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling++spec :: Spec+spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do+ describe "Cursor for [Bool]" $ do+ it "initialises to beginning of empty object" $ do+ let cursor = "{}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeObject+ it "initialises to beginning of empty object preceded by spaces" $ do+ let cursor = " {}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeObject+ it "initialises to beginning of number" $ do+ let cursor = "1234" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeNumber+ it "initialises to beginning of string" $ do+ let cursor = "\"Hello\"" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeString+ it "initialises to beginning of array" $ do+ let cursor = "[]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeArray+ it "initialises to beginning of boolean true" $ do+ let cursor = "true" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeBool+ it "initialises to beginning of boolean false" $ do+ let cursor = "false" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeBool+ it "initialises to beginning of null" $ do+ let cursor = "null" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ jsonTypeAt cursor `shouldBe` Just JsonTypeNull+ it "cursor can navigate to first child of array" $ do+ let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull+ it "cursor can navigate to second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject+ it "cursor can navigate to first child of object at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ it "cursor can navigate to first child of object at second child of array" $ do+ let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])+ (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNumber+ genSpec "DVS.Vector Word8" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)))+ genSpec "DVS.Vector Word16" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))+ genSpec "DVS.Vector Word32" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))+ genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+ genSpec "Poppy512" (undefined :: JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))++genSpec :: forall t u.+ ( Eq t+ , Show t+ , Select1 t+ , Eq u+ , Show u+ , Rank0 u+ , Rank1 u+ , BalancedParens u+ , TestBit u+ , FromForeignRegion (JsonCursor BS.ByteString t u)+ , IsString (JsonCursor BS.ByteString t u)+ , JsonIndexAt (JsonCursor BS.ByteString t u)+ )+ => String -> (JsonCursor BS.ByteString t u) -> SpecWith ()+genSpec t _ = do+ describe ("Json cursor of type " ++ t) $ do+ let forJson (cursor :: JsonCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor)+ forJson "{}" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeObject+ forJson " {}" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeObject+ forJson "1234" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeNumber+ forJson "\"Hello\"" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeString+ forJson "[]" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeArray+ forJson "true" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeBool+ forJson "false" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeBool+ forJson "null" $ \cursor -> do+ it "should have correct type" $ jsonTypeAt cursor `shouldBe` Just JsonTypeNull+ forJson "[null]" $ \cursor -> do+ it "should have correct type" $ (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull+ forJson "[null, {\"field\": 1}]" $ \cursor -> do+ it "cursor can navigate to second child of array" $ do+ (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject+ it "cursor can navigate to first child of object at second child of array" $ do+ (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ it "cursor can navigate to first child of object at second child of array" $ do+ (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNumber+ describe "For empty json array" $ do+ let cursor = "[null]" :: JsonCursor BS.ByteString t u+ it "can navigate down and forwards" $ do+ ( jsonTypeAt) cursor `shouldBe` Just JsonTypeArray+ (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeNull+ (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Nothing+ (fc >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Nothing+ describe "For sample Json" $ do+ let cursor = "{ \+ \ \"widget\": { \+ \ \"debug\": \"on\", \+ \ \"window\": { \+ \ \"name\": \"main_window\", \+ \ \"dimensions\": [500, 600.01e-02, true, false, null] \+ \ } \+ \ } \+ \}" :: JsonCursor BS.ByteString t u+ it "can navigate down and forwards" $ do+ ( jsonTypeAt) cursor `shouldBe` Just JsonTypeObject+ (fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ (fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject+ (fc >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ (fc >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeObject+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeString+ (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTypeAt) cursor `shouldBe` Just JsonTypeArray
+ test/HaskellWorks/Data/Json/ValueSpec.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module HaskellWorks.Data.Json.ValueSpec (spec) where++import Control.Monad+import qualified Data.ByteString as BS+import Data.String+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitShown+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Decode+import HaskellWorks.Data.FromForeignRegion+import HaskellWorks.Data.Json.Succinct.Cursor as C+import HaskellWorks.Data.Json.Succinct.Index+import HaskellWorks.Data.Json.Value+import HaskellWorks.Data.Succinct.BalancedParens.Internal+import HaskellWorks.Data.Succinct.BalancedParens.Simple+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512+import qualified HaskellWorks.Data.TreeCursor as TC+import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}+{-# ANN module ("HLint: redundant bracket" :: String) #-}++fc = TC.firstChild+ns = TC.nextSibling+cd = TC.depth++spec :: Spec+spec = describe "HaskellWorks.Data.Json.ValueSpec" $ do+ genSpec "DVS.Vector Word8" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8)))+ genSpec "DVS.Vector Word16" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16)))+ genSpec "DVS.Vector Word32" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32)))+ genSpec "DVS.Vector Word64" (undefined :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+ genSpec "Poppy512" (undefined :: JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64)))++jsonValueVia :: JsonIndexAt (JsonCursor BS.ByteString t u)+ => Maybe (JsonCursor BS.ByteString t u) -> Either DecodeError JsonValue+jsonValueVia mk = case mk of+ Just k -> (jsonIndexAt >=> jsonValueAt) k+ Nothing -> Left (DecodeError "No such element")++genSpec :: forall t u.+ ( Eq t+ , Show t+ , Select1 t+ , Eq u+ , Show u+ , Rank0 u+ , Rank1 u+ , BalancedParens u+ , TestBit u+ , FromForeignRegion (JsonCursor BS.ByteString t u)+ , IsString (JsonCursor BS.ByteString t u)+ , JsonIndexAt (JsonCursor BS.ByteString t u)+ )+ => String -> (JsonCursor BS.ByteString t u) -> SpecWith ()+genSpec t _ = do+ describe ("Json cursor of type " ++ t) $ do+ let forJson (cursor :: JsonCursor BS.ByteString t u) f = describe ("of value " ++ show cursor) (f cursor)+ forJson "{}" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonObject [])+ forJson " {}" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonObject [])+ forJson "1234" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonNumber 1234)+ forJson "\"Hello\"" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonString "Hello")+ forJson "[]" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [])+ forJson "true" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonBool True)+ forJson "false" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonBool False)+ forJson "null" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right JsonNull+ forJson "[null]" $ \cursor -> do+ it "should have correct value" $ jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [JsonNull])+ it "should have correct value" $ jsonValueVia (fc cursor) `shouldBe` Right JsonNull+ it "depth at top" $ cd cursor `shouldBe` Just 1+ it "depth at first child of array" $ (fc >=> cd) cursor `shouldBe` Just 2+ forJson "[null, {\"field\": 1}]" $ \cursor -> do+ it "cursor can navigate to second child of array" $ do+ jsonValueVia ((fc >=> ns) cursor) `shouldBe` Right ( JsonObject [("field", JsonNumber 1)] )+ jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [JsonNull, JsonObject [("field", JsonNumber 1)]])+ it "depth at second child of array" $ do+ (fc >=> ns >=> cd) cursor `shouldBe` Just 2+ it "depth at first child of object at second child of array" $ do+ (fc >=> ns >=> fc >=> cd) cursor `shouldBe` Just 3+ it "depth at first child of object at second child of array" $ do+ (fc >=> ns >=> fc >=> ns >=> cd) cursor `shouldBe` Just 3+ describe "For empty json array" $ do+ let cursor = "[]" :: JsonCursor BS.ByteString t u+ it "can navigate down and forwards" $ do+ jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [])+ describe "For empty json array" $ do+ let cursor = "[null]" :: JsonCursor BS.ByteString t u+ it "can navigate down and forwards" $ do+ jsonValueVia (Just cursor) `shouldBe` Right (JsonArray [JsonNull])+ describe "For sample Json" $ do+ let cursor = "{ \+ \ \"widget\": { \+ \ \"debug\": \"on\", \+ \ \"window\": { \+ \ \"name\": \"main_window\", \+ \ \"dimensions\": [500, 600.01e-02, true, false, null] \+ \ } \+ \ } \+ \}" :: JsonCursor BS.ByteString t u+ it "can navigate down and forwards" $ 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+ let object2 = JsonObject ([("debug", JsonString "on"), ("window", object1)]) :: JsonValue+ let object3 = JsonObject ([("widget", object2)]) :: JsonValue+ jsonValueVia (Just cursor) `shouldBe` Right object3+ jsonValueVia ((fc ) cursor) `shouldBe` Right (JsonString "widget" )+ jsonValueVia ((fc >=> ns ) cursor) `shouldBe` Right (object2 )+ jsonValueVia ((fc >=> ns >=> fc ) cursor) `shouldBe` Right (JsonString "debug" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns ) cursor) `shouldBe` Right (JsonString "on" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns ) cursor) `shouldBe` Right (JsonString "window" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) `shouldBe` Right (object1 )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) `shouldBe` Right (JsonString "name" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) `shouldBe` Right (JsonString "main_window" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) `shouldBe` Right (JsonString "dimensions" )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) `shouldBe` Right (array )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor) `shouldBe` Right (JsonNumber 500 )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor) `shouldBe` Right (JsonNumber 600.01e-02 )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor) `shouldBe` Right (JsonBool True )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor) `shouldBe` Right (JsonBool False )+ jsonValueVia ((fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns) cursor) `shouldBe` Right JsonNull