hw-json-0.0.0.4: test/HaskellWorks/Data/Json/Succinct/CursorSpec.hs
{-# 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.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
import HaskellWorks.Data.Bits.BitShow
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.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 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
cd = TC.depth
ss = TC.subtreeSize
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
it "depth at first child of array" $ do
let cursor = "[null]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])
(fc >=> cd) cursor `shouldBe` Just 2
it "depth at second child of array" $ do
let cursor = "[null, {\"field\": 1}]" :: JsonCursor String (BitShown [Bool]) (SimpleBalancedParens [Bool])
(fc >=> ns >=> cd) 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])
(fc >=> ns >=> fc >=> cd) 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])
(fc >=> ns >=> fc >=> ns >=> cd) 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)))
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)))
it "Loads same Json consistentally from different backing vectors" $ do
let cursor8 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word8)) (SimpleBalancedParens (DVS.Vector Word8))
let cursor16 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word16)) (SimpleBalancedParens (DVS.Vector Word16))
let cursor32 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word32)) (SimpleBalancedParens (DVS.Vector Word32))
let cursor64 = "{\n \"widget\": {\n \"debug\": \"on\" } }" :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))
cursorText cursor8 `shouldBe` cursorText cursor16
cursorText cursor8 `shouldBe` cursorText cursor32
cursorText cursor8 `shouldBe` cursorText cursor64
let ic8 = bitShow $ interests cursor8
let ic16 = bitShow $ interests cursor16
let ic32 = bitShow $ interests cursor32
let ic64 = bitShow $ interests cursor64
ic16 `shouldBeginWith` ic8
ic32 `shouldBeginWith` ic16
ic64 `shouldBeginWith` ic32
shouldBeginWith :: (Eq a, Show a) => [a] -> [a] -> IO ()
shouldBeginWith as bs = take (length bs) as `shouldBe` bs
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)
, GenJsonValueAt BS.ByteString BS.ByteString (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 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 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 (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
(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
it "can get subtree size" $ do
( ss) cursor `shouldBe` Just 16
(fc >=> ss) cursor `shouldBe` Just 1
(fc >=> ns >=> ss) cursor `shouldBe` Just 14
(fc >=> ns >=> fc >=> ss) cursor `shouldBe` Just 1
(fc >=> ns >=> fc >=> ns >=> ss) cursor `shouldBe` Just 1
(fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor `shouldBe` Just 1
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor `shouldBe` Just 10
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor `shouldBe` Just 1
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor `shouldBe` Just 1
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor `shouldBe` Just 1
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor `shouldBe` Just 6
it "can get token at cursor" $ do
(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 "name" )
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "main_window" )
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenString "dimensions" )
(fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor `shouldBe` Just (JsonTokenBracketL )