packages feed

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 view
@@ -1,5 +1,5 @@ # hw-json-[![v0.0-branch](https://circleci.com/gh/haskell-works/hw-json/tree/v0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-json/tree/v0.0-branch)+[![0.0-branch](https://circleci.com/gh/haskell-works/hw-json/tree/0.0-branch.svg?style=svg)](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