diff --git a/hw-json.cabal b/hw-json.cabal --- a/hw-json.cabal +++ b/hw-json.cabal @@ -1,5 +1,5 @@ name: hw-json -version: 0.0.0.2 +version: 0.0.0.3 synopsis: Conduits for tokenizing streams. description: Please see README.md homepage: http://github.com/haskell-works/hw-json#readme @@ -84,6 +84,7 @@ build-depends: base , attoparsec , bytestring + , containers , conduit , hspec , hw-bits diff --git a/src/HaskellWorks/Data/Json/Succinct/Cursor/CursorType.hs b/src/HaskellWorks/Data/Json/Succinct/Cursor/CursorType.hs --- a/src/HaskellWorks/Data/Json/Succinct/Cursor/CursorType.hs +++ b/src/HaskellWorks/Data/Json/Succinct/Cursor/CursorType.hs @@ -27,29 +27,29 @@ deriving (Eq, Show) class HasJsonCursorType k where - jsonCursorType :: k -> JsonCursorType + jsonCursorType :: k -> Maybe JsonCursorType -jsonCursorType' :: Char -> JsonCursorType +jsonCursorType' :: Char -> Maybe JsonCursorType jsonCursorType' c = case c of - '[' -> JsonCursorArray - 't' -> JsonCursorBool - 'f' -> JsonCursorBool - '0' -> JsonCursorNumber - '1' -> JsonCursorNumber - '2' -> JsonCursorNumber - '3' -> JsonCursorNumber - '4' -> JsonCursorNumber - '5' -> JsonCursorNumber - '6' -> JsonCursorNumber - '7' -> JsonCursorNumber - '8' -> JsonCursorNumber - '9' -> JsonCursorNumber - '+' -> JsonCursorNumber - '-' -> JsonCursorNumber - 'n' -> JsonCursorNull - '{' -> JsonCursorObject - '"' -> JsonCursorString - _ -> error "Invalid JsonCursor cursorRank" + '[' -> Just JsonCursorArray + 't' -> Just JsonCursorBool + 'f' -> Just JsonCursorBool + '0' -> Just JsonCursorNumber + '1' -> Just JsonCursorNumber + '2' -> Just JsonCursorNumber + '3' -> Just JsonCursorNumber + '4' -> Just JsonCursorNumber + '5' -> Just JsonCursorNumber + '6' -> Just JsonCursorNumber + '7' -> Just JsonCursorNumber + '8' -> Just JsonCursorNumber + '9' -> Just JsonCursorNumber + '+' -> Just JsonCursorNumber + '-' -> Just JsonCursorNumber + 'n' -> Just JsonCursorNull + '{' -> Just JsonCursorObject + '"' -> Just JsonCursorString + _ -> Nothing jsonCursorPos :: (Rank1 w, Select1 v, VectorLike s) => JsonCursor s v w -> Position jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) diff --git a/src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs b/src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs --- a/src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs +++ b/src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs @@ -2,16 +2,19 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} module HaskellWorks.Data.Json.Succinct.Cursor.Internal ( JsonCursor(..) ) where -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import Data.ByteString.Internal as BSI +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import Data.ByteString.Internal as BSI +import qualified Data.List as L +import qualified Data.Map as M 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 @@ -19,15 +22,17 @@ import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.FromByteString import HaskellWorks.Data.FromForeignRegion -import HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens +import HaskellWorks.Data.Json.Extract +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 import HaskellWorks.Data.Positioning -import 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 import HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Vector.VectorLike @@ -40,67 +45,67 @@ } deriving (Eq, Show) -instance (FromBlankedJson (JsonInterestBits a), FromBlankedJson (JsonBalancedParens b)) +instance (FromBlankedJson (JsonInterestBits a), FromBlankedJson (CBP.JsonBalancedParens b)) => FromByteString (JsonCursor BS.ByteString a b) where fromByteString bs = JsonCursor { cursorText = bs , interests = getJsonInterestBits (fromBlankedJson blankedJson) - , balancedParens = getJsonBalancedParens (fromBlankedJson blankedJson) + , balancedParens = CBP.getJsonBalancedParens (fromBlankedJson blankedJson) , cursorRank = 1 } where blankedJson :: BlankedJson blankedJson = fromByteString bs -instance IsString (JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])) where - fromString :: String -> JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) +instance IsString (JsonCursor String (BitShown [Bool]) (BP.SimpleBalancedParens [Bool])) where + fromString :: String -> JsonCursor String (BitShown [Bool]) (BP.SimpleBalancedParens [Bool]) fromString s = JsonCursor { cursorText = s , cursorRank = 1 , interests = getJsonInterestBits (fromBlankedJson blankedJson) - , balancedParens = getJsonBalancedParens (fromBlankedJson blankedJson) + , balancedParens = CBP.getJsonBalancedParens (fromBlankedJson blankedJson) } where blankedJson :: BlankedJson blankedJson = fromByteString (BSC.pack s) -instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))) where +instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where fromString = fromByteString . BSC.pack -instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) where +instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where fromString = fromByteString . BSC.pack -instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) where +instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where fromString = fromByteString . BSC.pack -instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) where +instance IsString (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where fromString = fromByteString . BSC.pack -instance IsString (JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) where +instance IsString (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where fromString = fromByteString . BSC.pack -instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))) where +instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (BP.SimpleBalancedParens (DVS.Vector Word8))) where fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))) where +instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (BP.SimpleBalancedParens (DVS.Vector Word16))) where fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))) where +instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (BP.SimpleBalancedParens (DVS.Vector Word32))) where fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))) where +instance FromForeignRegion (JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (BP.SimpleBalancedParens (DVS.Vector Word64))) where fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) -instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (SimpleBalancedParens (DVS.Vector Word64))) where +instance FromForeignRegion (JsonCursor BS.ByteString Poppy512 (BP.SimpleBalancedParens (DVS.Vector Word64))) where fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where - firstChild :: JsonCursor t v u -> JsonCursor t v u - firstChild k = k { cursorRank = BP.firstChild (balancedParens k) (cursorRank k) } + firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u) + firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq - nextSibling :: JsonCursor t v u -> JsonCursor t v u - nextSibling k = k { cursorRank = BP.nextSibling (balancedParens k) (cursorRank k) } + 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 - parent :: JsonCursor t v u -> JsonCursor t v u - parent k = k { cursorRank = BP.parent (balancedParens k) (cursorRank k) } + parent :: JsonCursor t v u -> Maybe (JsonCursor t v u) + parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq depth :: JsonCursor t v u -> Count depth k = BP.depth (balancedParens k) (cursorRank k) @@ -111,31 +116,53 @@ wIsJsonNumberDigit :: Word8 -> Bool wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen -instance TestBit w => JsonTypeAt (JsonCursor BS.ByteString v w) where - jsonTypeAtPosition p k = if balancedParens k .?. p - then case cursorText k !!! p of - c | c == _bracketleft -> Just JsonTypeArray - c | c == _t -> Just JsonTypeBool - c | c == _n -> Just JsonTypeNull - c | wIsJsonNumberDigit c -> Just JsonTypeNumber - c | c == _braceleft -> Just JsonTypeObject - c | c == _quotedbl -> Just JsonTypeString +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (JsonCursor BS.ByteString v w) where + jsonTypeAtPosition p k = if bpk .?. p + then case BS.uncons (vDrop (toCount p) (cursorText k)) of + Just (c, _) | c == _bracketleft -> Just JsonTypeArray + 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 else Nothing + where bpk = balancedParens k - jsonTypeAt k = jsonTypeAtPosition (lastPositionOf (cursorRank k)) k + jsonTypeAt k = jsonTypeAtPosition p k + where p = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) + ik = interests k + bpk = balancedParens k -instance TestBit w => JsonValueAt BS.ByteString BS.ByteString (JsonCursor BS.ByteString v w) where +instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonValueAt BS.ByteString BS.ByteString (JsonCursor BS.ByteString v w) where jsonValueAt :: JsonCursor BS.ByteString v w -> Maybe (JsonValue BS.ByteString BS.ByteString) - jsonValueAt k = case jsonTypeAtPosition p k of - Just JsonTypeArray -> error "Not Implemented" - Just JsonTypeBool -> case cursorText k !!! p of - c | c == _t -> Just $ JsonBool True - c | c == _t -> Just $ JsonBool False - _ -> Nothing - Just JsonTypeNull -> Just JsonNull - Just JsonTypeNumber -> error "Not Implemented" - Just JsonTypeObject -> error "Not Implemented" - Just JsonTypeString -> error "Not Implemented" - Nothing -> Nothing - where p = lastPositionOf (cursorRank k) + 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 == _t -> 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 (JsonValue ByteString ByteString, JsonCursor ByteString v w) + genArrayValue j = (,) <$> jsonValueAt j <*> nextSibling j + arrayValuesAt :: JsonCursor BS.ByteString v w -> [JsonValue 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 (JsonValue ByteString ByteString) + mapValuesAt j = M.fromList (pairwise (arrayValuesAt j) >>= asField) + asField :: (JsonValue ByteString ByteString, JsonValue ByteString ByteString) -> [(ByteString, JsonValue 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 _ = [] diff --git a/test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs b/test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs --- a/test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs +++ b/test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs @@ -11,7 +11,9 @@ module HaskellWorks.Data.Json.Succinct.CursorSpec(spec) where +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 @@ -21,6 +23,7 @@ import HaskellWorks.Data.FromForeignRegion import HaskellWorks.Data.Json.Succinct.Cursor as C import HaskellWorks.Data.Json.Token +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 @@ -46,55 +49,55 @@ describe "Cursor for [Bool]" $ do it "initialises to beginning of empty object" $ do let cursor = "{}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorObject + jsonCursorType cursor `shouldBe` Just JsonCursorObject it "initialises to beginning of empty object preceded by spaces" $ do let cursor = " {}" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorObject + jsonCursorType cursor `shouldBe` Just JsonCursorObject it "initialises to beginning of number" $ do let cursor = "1234" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorNumber + jsonCursorType cursor `shouldBe` Just JsonCursorNumber it "initialises to beginning of string" $ do let cursor = "\"Hello\"" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorString + jsonCursorType cursor `shouldBe` Just JsonCursorString it "initialises to beginning of array" $ do let cursor = "[]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorArray + jsonCursorType cursor `shouldBe` Just JsonCursorArray it "initialises to beginning of boolean true" $ do let cursor = "true" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorBool + jsonCursorType cursor `shouldBe` Just JsonCursorBool it "initialises to beginning of boolean false" $ do let cursor = "false" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorBool + jsonCursorType cursor `shouldBe` Just JsonCursorBool it "initialises to beginning of null" $ do let cursor = "null" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType cursor `shouldBe` JsonCursorNull + jsonCursorType cursor `shouldBe` Just JsonCursorNull it "cursor can navigate to first child of array" $ do let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType (fc cursor) `shouldBe` JsonCursorNull + (fc >=> jsonCursorType) cursor `shouldBe` Just JsonCursorNull it "cursor can navigate to second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - jsonCursorType ((ns . fc) cursor) `shouldBe` JsonCursorObject + (fc >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorObject 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]) - jsonCursorType ((fc . ns . fc) cursor) `shouldBe` JsonCursorString + (fc >=> ns >=> fc >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString 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]) - jsonCursorType ((ns . fc . ns . fc) cursor) `shouldBe` JsonCursorNumber + (fc >=> ns >=> fc >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorNumber it "depth at top" $ do let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) cd cursor `shouldBe` 1 it "depth at first child of array" $ do let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - cd (fc cursor) `shouldBe` 2 + cd <$> fc cursor `shouldBe` Just 2 it "depth at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - cd ((ns . fc) cursor) `shouldBe` 2 + cd <$> (fc >=> ns) cursor `shouldBe` Just 2 it "depth at first child of object at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - cd ((fc . ns . fc) cursor) `shouldBe` 3 + cd <$> (fc >=> ns >=> fc) cursor `shouldBe` Just 3 it "depth at first child of object at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool]) - cd ((ns . fc . ns . fc) cursor) `shouldBe` 3 + cd <$> (fc >=> ns >=> fc >=> ns) cursor `shouldBe` Just 3 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))) @@ -131,121 +134,124 @@ , TestBit u , FromForeignRegion (JsonCursor BS.ByteString t u) , IsString (JsonCursor BS.ByteString t u) - , HasJsonCursorType (JsonCursor BS.ByteString t u)) + , HasJsonCursorType (JsonCursor BS.ByteString t u) + , JsonValueAt BS.ByteString BS.ByteString (JsonCursor BS.ByteString t u)) => String -> (JsonCursor BS.ByteString t u) -> SpecWith () genSpec t _ = do describe ("Cursor for (" ++ t ++ ")") $ do it "initialises to beginning of empty object" $ do let cursor = "{}" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorObject + jsonCursorType cursor `shouldBe` Just JsonCursorObject it "initialises to beginning of empty object preceded by spaces" $ do let cursor = " {}" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorObject + jsonCursorType cursor `shouldBe` Just JsonCursorObject + jsonValueAt cursor `shouldBe` Just (JsonObject M.empty :: JsonValue BS.ByteString BS.ByteString) it "initialises to beginning of number" $ do let cursor = "1234" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorNumber + jsonCursorType cursor `shouldBe` Just JsonCursorNumber it "initialises to beginning of string" $ do let cursor = "\"Hello\"" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorString + jsonCursorType cursor `shouldBe` Just JsonCursorString it "initialises to beginning of array" $ do let cursor = "[]" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorArray + jsonCursorType cursor `shouldBe` Just JsonCursorArray + jsonValueAt cursor `shouldBe` Just (JsonArray [] :: JsonValue BS.ByteString BS.ByteString) it "initialises to beginning of boolean true" $ do let cursor = "true" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorBool + jsonCursorType cursor `shouldBe` Just JsonCursorBool it "initialises to beginning of boolean false" $ do let cursor = "false" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorBool + jsonCursorType cursor `shouldBe` Just JsonCursorBool it "initialises to beginning of null" $ do let cursor = "null" :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorNull + jsonCursorType cursor `shouldBe` Just JsonCursorNull it "cursor can navigate to first child of array" $ do let cursor = "[null]" :: JsonCursor BS.ByteString t u - jsonCursorType (fc cursor) `shouldBe` JsonCursorNull + (fc >=> jsonCursorType) cursor `shouldBe` Just JsonCursorNull it "cursor can navigate to second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u - jsonCursorType ((ns . fc) cursor) `shouldBe` JsonCursorObject + (fc >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorObject it "cursor can navigate to first child of object at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u - jsonCursorType ((fc . ns . fc) cursor) `shouldBe` JsonCursorString + (fc >=> ns >=> fc >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString it "cursor can navigate to first child of object at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u - jsonCursorType ((ns . fc . ns . fc) cursor) `shouldBe` JsonCursorNumber + (fc >=> ns >=> fc >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorNumber it "depth at top" $ do let cursor = "[null]" :: JsonCursor BS.ByteString t u cd cursor `shouldBe` 1 it "depth at first child of array" $ do let cursor = "[null]" :: JsonCursor BS.ByteString t u - cd (fc cursor) `shouldBe` 2 + cd <$> (fc) cursor `shouldBe` Just 2 it "depth at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u - cd ((ns . fc) cursor) `shouldBe` 2 + cd <$> (fc >=> ns) cursor `shouldBe` Just 2 it "depth at first child of object at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u - cd ((fc . ns . fc) cursor) `shouldBe` 3 + cd <$> (fc >=> ns >=> fc) cursor `shouldBe` Just 3 it "depth at first child of object at second child of array" $ do let cursor = "[null, {\"field\": 1}]" :: JsonCursor BS.ByteString t u - cd ((ns . fc . ns . fc) cursor) `shouldBe` 3 + cd <$> (fc >=> ns >=> fc >=> ns) cursor `shouldBe` Just 3 it "can navigate down and forwards" $ do (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u - jsonCursorType cursor `shouldBe` JsonCursorObject - jsonCursorType (( fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . fc) cursor) `shouldBe` JsonCursorObject - jsonCursorType (( fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorObject - jsonCursorType (( fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType (( ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorString - jsonCursorType ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` JsonCursorNumber + (jsonCursorType ) cursor `shouldBe` Just JsonCursorObject + (fc >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorObject + (fc >=> ns >=> fc >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorObject + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorString + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> ns >=> jsonCursorType) cursor `shouldBe` Just JsonCursorNumber it "can navigate up" $ do (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u - ( pn . fc) cursor `shouldBe` cursor - ( pn . ns . fc) cursor `shouldBe` cursor - ( pn . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor - ( pn . ns . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor - ( pn . ns . ns . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor - ( pn . ns . ns . ns . fc . ns . fc) cursor `shouldBe` ( ns . fc) cursor - ( pn . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor - ( pn . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor - ( pn . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor - ( pn . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor - ( pn . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor - ( pn . ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor `shouldBe` (ns . ns . ns . fc . ns . fc) cursor + (fc >=> pn ) cursor `shouldBe` Just cursor + (fc >=> ns >=> pn ) cursor `shouldBe` Just cursor + (fc >=> ns >=> fc >=> pn ) cursor `shouldBe` (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> pn ) cursor `shouldBe` (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> pn ) cursor `shouldBe` (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn ) cursor `shouldBe` (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> pn ) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> pn ) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> pn ) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn ) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> pn ) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> ns >=> pn) cursor `shouldBe` (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor it "can get subtree size" $ do (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u - ss cursor `shouldBe` 45 - ss (( fc) cursor) `shouldBe` 1 - ss (( ns . fc) cursor) `shouldBe` 43 - ss (( fc . ns . fc) cursor) `shouldBe` 1 - ss (( ns . fc . ns . fc) cursor) `shouldBe` 1 - ss (( ns . ns . fc . ns . fc) cursor) `shouldBe` 1 - ss (( ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 9 - ss (( fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1 - ss (( ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1 - ss (( ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1 - ss (( ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1 - ss (( ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1 - ss ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` 1 + ss cursor `shouldBe` 45 + ss <$> (fc ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns ) cursor `shouldBe` Just 43 + ss <$> (fc >=> ns >=> fc ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor `shouldBe` Just 9 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns ) cursor `shouldBe` Just 1 + ss <$> (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> ns ) cursor `shouldBe` Just 1 it "can get token at cursor" $ do (fptr, offset, size) <- mmapFileForeignPtr "test/data/sample.json" ReadOnly Nothing let cursor = fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString t u - jsonTokenAt cursor `shouldBe` Just (JsonTokenBraceL ) - jsonTokenAt (( fc) cursor) `shouldBe` Just (JsonTokenString "widget" ) - jsonTokenAt (( ns . fc) cursor) `shouldBe` Just (JsonTokenBraceL ) - jsonTokenAt (( fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "debug" ) - jsonTokenAt (( ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "on" ) - jsonTokenAt (( ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "window" ) - jsonTokenAt (( ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenBraceL ) - jsonTokenAt (( fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "title" ) - jsonTokenAt (( ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "Sample Konfabulator Widget") - jsonTokenAt (( ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "name" ) - jsonTokenAt (( ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "main_window" ) - jsonTokenAt (( ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenString "width" ) - jsonTokenAt ((ns . ns . ns . ns . ns . fc . ns . ns . ns . fc . ns . fc) cursor) `shouldBe` Just (JsonTokenNumber 500.0 ) + (jsonTokenAt ) cursor `shouldBe` Just (JsonTokenBraceL ) + (fc >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "widget" ) + (fc >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenBraceL ) + (fc >=> ns >=> fc >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "debug" ) + (fc >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "on" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenBraceL ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "title" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "Sample Konfabulator Widget") + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "name" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "main_window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "width" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenNumber 500.0 )