diff --git a/app/App/Commands/Count.hs b/app/App/Commands/Count.hs --- a/app/App/Commands/Count.hs +++ b/app/App/Commands/Count.hs @@ -10,17 +10,17 @@ import Control.Lens import Control.Monad import Data.Generics.Product.Any -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>)) import Data.Word import HaskellWorks.Data.FromForeignRegion -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.LightJson import HaskellWorks.Data.Json.Query +import HaskellWorks.Data.Json.Standard.Cursor.Generic import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.TreeCursor -import Options.Applicative hiding (columns) +import Options.Applicative hiding (columns) import qualified App.Commands.Types as Z import qualified Data.ByteString as BS diff --git a/app/App/Commands/CreateIndex.hs b/app/App/Commands/CreateIndex.hs --- a/app/App/Commands/CreateIndex.hs +++ b/app/App/Commands/CreateIndex.hs @@ -16,22 +16,22 @@ import Foreign import Options.Applicative hiding (columns) -import qualified App.Commands.Types as Z -import qualified Data.ByteString as BS -import qualified Data.ByteString.Internal as BSI -import qualified Data.ByteString.Lazy as LBS -import qualified HaskellWorks.Data.ByteString as BS -import qualified HaskellWorks.Data.ByteString.Lazy as LBS -import qualified HaskellWorks.Data.Json.Backend.Simple.SemiIndex as SISI -import qualified HaskellWorks.Data.Json.Backend.Standard.SemiIndex as STSI -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.Blank as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 as J -import qualified HaskellWorks.Data.Json.Simd.Index.Standard as STSI -import qualified System.Exit as IO -import qualified System.IO as IO -import qualified System.IO.MMap as IO +import qualified App.Commands.Types as Z +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BSI +import qualified Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.ByteString as BS +import qualified HaskellWorks.Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Data.Json.Simd.Index.Standard as STSI +import qualified HaskellWorks.Data.Json.Simple.Cursor.SemiIndex as SISI +import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.Blank as J +import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.BlankedJson as J +import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.MakeIndex as J +import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.ToBalancedParens64 as J +import qualified HaskellWorks.Data.Json.Standard.Cursor.SemiIndex as STSI +import qualified System.Exit as IO +import qualified System.IO as IO +import qualified System.IO.MMap as IO {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module ("HLint: ignore Redundant do" :: String) #-} diff --git a/app/App/Commands/Demo.hs b/app/App/Commands/Demo.hs --- a/app/App/Commands/Demo.hs +++ b/app/App/Commands/Demo.hs @@ -12,18 +12,18 @@ import Control.Monad import Control.Monad.ST import Data.Generics.Product.Any -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>)) import Data.Word import Foreign.ForeignPtr -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Backend.Standard.Load.Cursor import HaskellWorks.Data.Json.LightJson import HaskellWorks.Data.Json.Query +import HaskellWorks.Data.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Standard.Cursor.Load.Cursor import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.Micro import HaskellWorks.Data.RankSelect.CsPoppy import HaskellWorks.Data.Vector.AsVector8 -import Options.Applicative hiding (columns) +import Options.Applicative hiding (columns) import qualified App.Commands.Types as Z import qualified Data.ByteString as BS diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,74 +1,10 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where -import Control.Monad import Criterion.Main -import Data.List -import Data.Semigroup ((<>)) -import Data.Word -import Foreign -import HaskellWorks.Data.Json.Internal.Backend.Standard.Blank -import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex -import System.IO.MMap -import qualified Data.ByteString as BS -import qualified Data.ByteString.Internal as BSI -import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST -import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW -import qualified System.Directory as IO - -setupEnvJson :: FilePath -> IO BS.ByteString -setupEnvJson filepath = do - (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr filepath ReadOnly Nothing - let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size - return bs - -jsonToInterestBits3 :: [BS.ByteString] -> [BS.ByteString] -jsonToInterestBits3 = blankedJsonToInterestBits . blankJson - -makeBenchBlankJson :: IO [Benchmark] -makeBenchBlankJson = do - entries <- IO.listDirectory "corpus/bench" - let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries - benchmarks <- forM files $ \file -> return - [ env (setupEnvJson file) $ \bs -> bgroup file - [ bench "Run blankJson" (whnf (BS.concat . blankJson) [bs]) - ] - ] - - return (join benchmarks) - -makeBenchJsonToInterestBits :: IO [Benchmark] -makeBenchJsonToInterestBits = do - entries <- IO.listDirectory "corpus/bench" - let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries - benchmarks <- forM files $ \file -> return - [ env (setupEnvJson file) $ \bs -> bgroup file - [ bench "Run blankJson" (whnf (BS.concat . jsonToInterestBits3) [bs]) - ] - ] - - return (join benchmarks) - -makeBenchMakeCursor :: IO [Benchmark] -makeBenchMakeCursor = do - entries <- IO.listDirectory "corpus/bench" - let files = ("corpus/bench/" ++) <$> (".json" `isSuffixOf`) `filter` entries - benchmarks <- forM files $ \file -> return - [ env (setupEnvJson file) $ \bs -> bgroup file - [ bench "Run slow make cursor" (whnf SLOW.fromByteString bs) - , bench "Run fast make cursor" (whnf FAST.fromByteString bs) - ] - ] - - return (join benchmarks) - main :: IO () main = do benchmarks <- fmap mconcat $ sequence $ mempty - <> [makeBenchBlankJson] - <> [makeBenchJsonToInterestBits] - <> [makeBenchMakeCursor] defaultMain benchmarks diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/Cursor.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Json.Backend.Simple.Cursor - ( JsonCursor(..) - , jsonCursorPos - ) where - -import Data.String -import Data.Word -import HaskellWorks.Data.FromByteString -import HaskellWorks.Data.FromForeignRegion -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.RankSelect.CsPoppy -import HaskellWorks.Data.TreeCursor -import Prelude hiding (drop) - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Internal as BSI -import qualified Data.Vector.Storable as DVS -import qualified Foreign.ForeignPtr as F -import qualified HaskellWorks.Data.BalancedParens as BP -import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM -import qualified HaskellWorks.Data.Json.Backend.Simple.SemiIndex as SI - -data JsonCursor t v w = JsonCursor - { cursorText :: !t - , interests :: !v - , balancedParens :: !w - , cursorRank :: !Count - } - deriving (Eq, Show) - -instance FromByteString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where - fromByteString bs = JsonCursor - { cursorText = bs - , interests = ib - , balancedParens = BP.SimpleBalancedParens bp - , cursorRank = 1 - } - where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs - -instance FromByteString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where - fromByteString bs = JsonCursor - { cursorText = bs - , interests = makeCsPoppy ib - , balancedParens = RM.mkRangeMin (makeCsPoppy bp) - , cursorRank = 1 - } - where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs - -instance FromForeignRegion (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where - fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) - -instance FromForeignRegion (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where - fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) - -instance IsString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where - fromString = fromByteString . BSC.pack - -instance IsString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where - fromString = fromByteString . BSC.pack - -instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where - firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u) - firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq - - nextSibling :: JsonCursor t v u -> Maybe (JsonCursor t v u) - nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) - - parent :: JsonCursor t v u -> Maybe (JsonCursor t v u) - parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq - - depth :: JsonCursor t v u -> Maybe Count - depth k = BP.depth (balancedParens k) (cursorRank k) - - subtreeSize :: JsonCursor t v u -> Maybe Count - subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) - -jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position -jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) - where ik = interests k - bpk = balancedParens k diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/Fast.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/Fast.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/Fast.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module HaskellWorks.Data.Json.Backend.Simple.Fast - ( fromByteString - , fromForeignRegion - , fromString - ) where - -import Foreign.ForeignPtr -import HaskellWorks.Data.Json.Backend.Simple.Cursor -import HaskellWorks.Data.RankSelect.CsPoppy - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Internal as BSI -import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM -import qualified HaskellWorks.Data.FromForeignRegion as F -import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp as J - -fromByteString :: BS.ByteString -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -fromByteString bs = JsonCursor - { cursorText = bs - , interests = makeCsPoppy ib - , balancedParens = RM.mkRangeMin (makeCsPoppy bp) - , cursorRank = 1 - } - where J.IbBp ib bp = J.toIbBp bs - -fromForeignRegion :: F.ForeignRegion -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) - -fromString :: String -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -fromString = fromByteString . BSC.pack diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Simple/SemiIndex.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiWayIf #-} - -module HaskellWorks.Data.Json.Backend.Simple.SemiIndex - ( buildSemiIndex - , SemiIndex(..) - ) where - -import Control.Monad.ST -import Data.Word - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Unsafe as BSU -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Bits.Writer.Storable as W -import qualified HaskellWorks.Data.Json.Internal.Word8 as W8 - -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} - -data Context = InJson | InString | InEscape deriving (Eq, Show) - -data SemiIndex v = SemiIndex - { semiIndexContext :: !Context - , semiIndexIb :: !v - , semiIndexBp :: !v - } deriving (Functor, Traversable, Foldable) - -buildSemiIndex :: BS.ByteString -> SemiIndex (DVS.Vector Word64) -buildSemiIndex bs = DVS.createT $ do - let len = (BS.length bs + 7) `div` 8 - mib <- W.newWriter len - mbp <- W.newWriter (len * 2) - buildFromByteString mib mbp bs 0 InJson -{-# INLINE buildSemiIndex #-} - -buildFromByteString :: W.Writer s -> W.Writer s -> BS.ByteString -> Int -> Context -> ST s (SemiIndex (DVS.MVector s Word64)) -buildFromByteString ib bp bs i context = if i < BS.length bs - then do - let c = BSU.unsafeIndex bs i - case context of - InJson -> if - | c == W8.openBracket || c == W8.openBrace -> do - W.unsafeWriteBit bp 1 - W.unsafeWriteBit bp 1 - W.unsafeWriteBit ib 1 - buildFromByteString ib bp bs (i + 1) InJson - | c == W8.closeBracket || c == W8.closeBrace -> do - W.unsafeWriteBit bp 0 - W.unsafeWriteBit bp 0 - W.unsafeWriteBit ib 1 - buildFromByteString ib bp bs (i + 1) InJson - | c == W8.comma || c == W8.colon -> do - W.unsafeWriteBit bp 0 - W.unsafeWriteBit bp 1 - W.unsafeWriteBit ib 1 - buildFromByteString ib bp bs (i + 1) InJson - | c == W8.doubleQuote -> do - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InString - | otherwise -> do - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InJson - InString -> do - W.unsafeWriteBit ib 0 - let newContext = if - | c == W8.doubleQuote -> InJson - | c == W8.backSlash -> InEscape - | otherwise -> InString - buildFromByteString ib bp bs (i + 1) newContext - InEscape -> do - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InString - else do - ibv <- W.written ib - bpv <- W.written bp - return (SemiIndex context ibv bpv) -{-# INLINE buildFromByteString #-} diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Json.Backend.Standard.Cursor - {-# DEPRECATED "Use HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic instead" #-} - ( module X - ) where - -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic as X diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Fast.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Fast.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Fast.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast - ( Cursor - ) where - -import Data.Word -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific -import HaskellWorks.Data.RankSelect.CsPoppy - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM - -data Fast - -instance SpecificCursor Fast where - type CursorOf Fast = Cursor - -type Cursor = GenericCursor BS.ByteString CsPoppy (RM.RangeMin (DVS.Vector Word64)) diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Generic.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Generic.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Generic.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} - -module HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic - ( GenericCursor(..) - , jsonCursorPos - ) where - -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.TreeCursor -import Prelude hiding (drop) - -import qualified HaskellWorks.Data.BalancedParens as BP - -data GenericCursor t v w = GenericCursor - { cursorText :: !t - , interests :: !v - , balancedParens :: !w - , cursorRank :: !Count - } - deriving (Eq, Show) - -instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (GenericCursor t v u) where - firstChild :: GenericCursor t v u -> Maybe (GenericCursor t v u) - firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq - - nextSibling :: GenericCursor t v u -> Maybe (GenericCursor t v u) - nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) - - parent :: GenericCursor t v u -> Maybe (GenericCursor t v u) - parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq - - depth :: GenericCursor t v u -> Maybe Count - depth k = BP.depth (balancedParens k) (cursorRank k) - - subtreeSize :: GenericCursor t v u -> Maybe Count - subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) - -jsonCursorPos :: (Rank1 w, Select1 v) => GenericCursor s v w -> Position -jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) - where ik = interests k - bpk = balancedParens k diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Slow.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Slow.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Slow.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow - ( Cursor - ) where - -import Data.Word -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.BalancedParens as BP - -data Slow - -instance SpecificCursor Slow where - type CursorOf Slow = Cursor - -type Cursor = GenericCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64)) diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Specific.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Specific.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Cursor/Specific.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific - ( SpecificCursor(..) - , jsonCursorPos - ) where - -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic - -class SpecificCursor w where - type CursorOf w diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Fast.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Fast.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Fast.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module HaskellWorks.Data.Json.Backend.Standard.Fast - ( fromByteString - , fromForeignRegion - , fromString - ) where - -import Foreign.ForeignPtr -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.RankSelect.CsPoppy - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Internal as BSI -import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM -import qualified HaskellWorks.Data.FromForeignRegion as F -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp as J - -fromByteString :: BS.ByteString -> Cursor -fromByteString bs = GenericCursor - { cursorText = bs - , interests = makeCsPoppy ib - , balancedParens = RM.mkRangeMin bp - , cursorRank = 1 - } - where J.IbBp ib bp = J.toIbBp bs - -fromForeignRegion :: F.ForeignRegion -> Cursor -fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) - -fromString :: String -> Cursor -fromString = fromByteString . BSC.pack diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Index.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Index.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Index.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module HaskellWorks.Data.Json.Backend.Standard.Index - ( indexJson - ) where - -import Data.Word -import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW - -indexJson :: String -> IO () -indexJson filename = do - bs <- BS.mmap filename - -- We use the SLOW reference implementation because we are writing to a file and will never query. - let GenericCursor _ !ib (SimpleBalancedParens !bp) _ = SLOW.fromByteString bs - let wib = DVS.unsafeCast ib :: DVS.Vector Word8 - let wbp = DVS.unsafeCast bp :: DVS.Vector Word8 - BS.writeFile (filename ++ ".ib.idx") (BS.toByteString wib) - BS.writeFile (filename ++ ".bp.idx") (BS.toByteString wbp) diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Load/Cursor.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module HaskellWorks.Data.Json.Backend.Standard.Load.Cursor - ( loadCursor - , loadCursorWithIndex - , loadCursorWithCsPoppyIndex - , loadCursorWithCsPoppyIndex2 - ) where - -import Data.Word -import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Backend.Standard.Load.Raw -import HaskellWorks.Data.RankSelect.CsPoppy - -import qualified Data.ByteString.Internal as BSI -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast as FAST -import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST - -loadCursor :: String -> IO FAST.Cursor -loadCursor path = do - bs <- BS.mmap path - let !cursor = FAST.fromByteString bs - return cursor - -loadCursorWithIndex :: String -> IO (GenericCursor BSI.ByteString (DVS.Vector Word64) (SimpleBalancedParens (DVS.Vector Word64))) -loadCursorWithIndex filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = GenericCursor jsonBS jsonIb (SimpleBalancedParens jsonBp) 1 - return cursor - -loadCursorWithCsPoppyIndex :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens (DVS.Vector Word64))) -loadCursorWithCsPoppyIndex filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 - return cursor - -loadCursorWithCsPoppyIndex2 :: String -> IO (GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy)) -loadCursorWithCsPoppyIndex2 filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens (makeCsPoppy jsonBp)) 1 - :: GenericCursor BSI.ByteString CsPoppy (SimpleBalancedParens CsPoppy) - return cursor diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Load/Raw.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Load/Raw.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Load/Raw.hs +++ /dev/null @@ -1,20 +0,0 @@ -module HaskellWorks.Data.Json.Backend.Standard.Load.Raw - ( loadRawWithIndex - ) where - -import Data.Word -import HaskellWorks.Data.FromForeignRegion -import System.IO.MMap - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS - -loadRawWithIndex :: String -> IO (BS.ByteString, DVS.Vector Word64, DVS.Vector Word64) -loadRawWithIndex filename = do - jsonFr <- mmapFileForeignPtr filename ReadOnly Nothing - jsonIbFr <- mmapFileForeignPtr (filename ++ ".ib.idx") ReadOnly Nothing - jsonBpFr <- mmapFileForeignPtr (filename ++ ".bp.idx") ReadOnly Nothing - let jsonBS = fromForeignRegion jsonFr :: BS.ByteString - let jsonIb = fromForeignRegion jsonIbFr :: DVS.Vector Word64 - let jsonBp = fromForeignRegion jsonBpFr :: DVS.Vector Word64 - return (jsonBS, jsonIb, jsonBp) diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/SemiIndex.hs +++ /dev/null @@ -1,269 +0,0 @@ -{-# LANGUAGE BinaryLiterals #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Json.Backend.Standard.SemiIndex - ( semiIndexBuilder - , SemiIndex(..) - , PreSiChunk(..) - , SiChunk(..) - , buildSemiIndex - , State(..) - , buildFromByteString2 - , buildFromByteString3 - , toIbBpBuilders - ) where - -import Control.Monad.ST -import Data.Bits.Pdep -import Data.Bits.Pext -import Data.Word -import Foreign.Storable (Storable (..)) -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Bits.PopCount.PopCount1 -import HaskellWorks.Data.Json.Internal.Backend.Standard.StateMachine (IntState (..), State (..)) -import HaskellWorks.Data.Vector.AsVector64 - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as B -import qualified Data.ByteString.Lazy as LBS -import qualified Data.ByteString.Unsafe as BSU -import qualified Data.Vector.Storable as DVS -import qualified Data.Vector.Storable.Mutable as DVSM -import qualified HaskellWorks.Data.Bits.Writer.Storable as W -import qualified HaskellWorks.Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.Blank as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.StateMachine as SM -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 as J -import qualified HaskellWorks.Data.Json.Internal.Word8 as W8 - -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} - -data PreSiChunk v = PreSiChunk - { preSiChunkIb :: !v -- interest bits - , preSiChunkBpOp :: !v -- balanced parens interest bits - , preSiChunkBpCl :: !v -- balanced parens open close - } deriving (Functor, Traversable, Foldable) - -data SiChunk v = SiChunk - { siChunkIb :: !v -- interest bits - , siChunkBp :: !v -- balanced parens open close - } deriving (Functor, Traversable, Foldable) - -data SemiIndex v = SemiIndex - { semiIndexIb :: !v - , semiIndexBp :: !v - } deriving (Functor, Traversable, Foldable) - -semiIndexBuilder :: LBS.ByteString -> SemiIndex B.Builder -semiIndexBuilder lbs = SemiIndex (B.lazyByteString ibs) (B.byteString (BS.toByteString bps)) - where blankedJson = J.blankJson (LBS.toChunks lbs) - ibs = LBS.fromChunks (J.blankedJsonToInterestBits blankedJson) - bps = J.toBalancedParens64 (J.BlankedJson blankedJson) -{-# INLINE semiIndexBuilder #-} - -buildSemiIndex :: BS.ByteString -> SemiIndex (DVS.Vector Word64) -buildSemiIndex bs = DVS.createT $ do - let len = (BS.length bs + 7) `div` 8 - mib <- W.newWriter len - mbp <- W.newWriter (len * 2) - buildFromByteString mib mbp bs 0 InJson -{-# INLINE buildSemiIndex #-} - -buildFromByteString :: W.Writer s -> W.Writer s -> BS.ByteString -> Int -> State -> ST s (SemiIndex (DVS.MVector s Word64)) -buildFromByteString ib bp bs i = go - where go state = if i < BS.length bs - then do - let c = BSU.unsafeIndex bs i - case state of - InJson -> if - | c == W8.openBracket || c == W8.openBrace -> do - W.unsafeWriteBit ib 1 - W.unsafeWriteBit bp 1 - buildFromByteString ib bp bs (i + 1) InJson - | c == W8.closeBracket || c == W8.closeBrace -> do - W.unsafeWriteBit bp 0 - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InJson - | c == W8.comma || c == W8.colon -> do - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InJson - | W8.isAlphabetic c || W8.isDigit c || W8.isPeriod c || W8.isMinus c || W8.isPlus c -> do - W.unsafeWriteBit ib 1 - W.unsafeWriteBit bp 1 - W.unsafeWriteBit bp 0 - buildFromByteString ib bp bs (i + 1) InValue - | c == W8.doubleQuote -> do - W.unsafeWriteBit ib 1 - W.unsafeWriteBit bp 1 - W.unsafeWriteBit bp 0 - buildFromByteString ib bp bs (i + 1) InString - | otherwise -> do - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InJson - InString -> do - W.unsafeWriteBit ib 0 - let newContext = if - | c == W8.doubleQuote -> InJson - | c == W8.backSlash -> InEscape - | otherwise -> InString - buildFromByteString ib bp bs (i + 1) newContext - InEscape -> do - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InString - InValue -> if - | W8.isAlphabetic c || W8.isDigit c || W8.isPeriod c || W8.isMinus c || W8.isPlus c -> do - W.unsafeWriteBit ib 0 - buildFromByteString ib bp bs (i + 1) InValue - | otherwise -> go InJson - else do - ibv <- W.written ib - bpv <- W.written bp - return (SemiIndex ibv bpv) -{-# INLINE buildFromByteString #-} - -constructSI :: forall a s. Storable a => Int -> (Int -> s -> (s, a)) -> s -> (s, DVS.Vector a) -constructSI n f state = DVS.createT $ do - mv <- DVSM.unsafeNew n - state' <- go 0 state mv - return (state', mv) - where go :: Int -> s -> DVSM.MVector t a -> ST t s - go i s mv = if i < DVSM.length mv - then do - let (s', a) = f i s - DVSM.unsafeWrite mv i a - go (i + 1) s' mv - else return s -{-# INLINE constructSI #-} - -buildFromByteString2 :: [BS.ByteString] -> [DVS.Vector Word64] -buildFromByteString2 = go (IntState (fromEnum InJson)) - where go :: IntState -> [BS.ByteString] -> [DVS.Vector Word64] - go s (bs:bss) = v:go s' bss - where (s', v) = constructSI (BS.length bs `div` 16) f s -- TODO adjust length - f :: Int -> IntState -> (IntState, Word64) - f i s'' = let j = i * 16 in transition16 s'' - (BSU.unsafeIndex bs j ) - (BSU.unsafeIndex bs (j + 1)) - (BSU.unsafeIndex bs (j + 2)) - (BSU.unsafeIndex bs (j + 3)) - (BSU.unsafeIndex bs (j + 4)) - (BSU.unsafeIndex bs (j + 5)) - (BSU.unsafeIndex bs (j + 6)) - (BSU.unsafeIndex bs (j + 7)) - (BSU.unsafeIndex bs (j + 8)) - (BSU.unsafeIndex bs (j + 9)) - (BSU.unsafeIndex bs (j + 10)) - (BSU.unsafeIndex bs (j + 11)) - (BSU.unsafeIndex bs (j + 12)) - (BSU.unsafeIndex bs (j + 13)) - (BSU.unsafeIndex bs (j + 14)) - (BSU.unsafeIndex bs (j + 15)) - go _ [] = [] -{-# INLINE buildFromByteString2 #-} - -transition16 :: IntState - -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 - -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 - -> (IntState, Word64) -transition16 s a b c d e f g h i j k l m n o p = (sp, w) - where (sa, wa) = transition1 s a - (sb, wb) = transition1 sa b - (sc, wc) = transition1 sb c - (sd, wd) = transition1 sc d - (se, we) = transition1 sd e - (sf, wf) = transition1 se f - (sg, wg) = transition1 sf g - (sh, wh) = transition1 sg h - (si, wi) = transition1 sh i - (sj, wj) = transition1 si j - (sk, wk) = transition1 sj k - (sl, wl) = transition1 sk l - (sm, wm) = transition1 sl m - (sn, wn) = transition1 sm n - (so, wo) = transition1 sn o - (sp, wp) = transition1 so p - w = (fromIntegral wa ) .|. - (fromIntegral wb .<. 4) .|. - (fromIntegral wc .<. 8) .|. - (fromIntegral wd .<. 12) .|. - (fromIntegral we .<. 16) .|. - (fromIntegral wf .<. 20) .|. - (fromIntegral wg .<. 24) .|. - (fromIntegral wh .<. 28) .|. - (fromIntegral wi .<. 32) .|. - (fromIntegral wj .<. 36) .|. - (fromIntegral wk .<. 40) .|. - (fromIntegral wl .<. 44) .|. - (fromIntegral wm .<. 48) .|. - (fromIntegral wn .<. 52) .|. - (fromIntegral wo .<. 56) .|. - (fromIntegral wp .<. 60) -{-# INLINE transition16 #-} - -transition1 :: IntState -> Word8 -> (IntState, Word64) -transition1 s a = (s', w) - where s' = SM.lookupTransitionTable s (fromIntegral a) - w = fromIntegral $ SM.lookupPhiTable s (fromIntegral a) -{-# INLINE transition1 #-} - -buildFromByteString3 :: [BS.ByteString] -> [PreSiChunk (DVS.Vector Word64)] -buildFromByteString3 bss = makePreSiChunk <$> buildFromByteString2 bss - where makePreSiChunk :: DVS.Vector Word64 -> PreSiChunk (DVS.Vector Word64) - makePreSiChunk v = PreSiChunk (makeIb v) (makeBpOp v) (makeBpCl v) - makeIb :: DVS.Vector Word64 -> DVS.Vector Word64 - makeIb v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go - where go :: DVS.Vector Word16 -> Word16 - go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x4444444444444444) - makeBpOp :: DVS.Vector Word64 -> DVS.Vector Word64 - makeBpOp v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go - where go :: DVS.Vector Word16 -> Word16 - go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x2222222222222222) - makeBpCl v = asVector64 $ BS.toByteString $ DVS.constructN (DVS.length v) go - where go :: DVS.Vector Word16 -> Word16 - go u = let ui = DVS.length u in fromIntegral (pext (DVS.unsafeIndex v ui) 0x1111111111111111) - -toIbBpBuilders :: [PreSiChunk (DVS.Vector Word64)] -> [SiChunk (DVS.Vector Word64)] -toIbBpBuilders = go 0 0 - where go :: Word64 -> Word64 -> [PreSiChunk (DVS.Vector Word64)] -> [SiChunk (DVS.Vector Word64)] - go b n (PreSiChunk ib bpOp bpCl:cs) = SiChunk ib bp: go b' n' cs - where ((b', n'), bp) = mkBp b n (DVS.unsafeCast bpOp) (DVS.unsafeCast bpCl) - go b _ [] = [SiChunk DVS.empty (DVS.singleton b)] - mkBp :: Word64 -> Word64 -> DVS.Vector Word32 -> DVS.Vector Word32 -> ((Word64, Word64), DVS.Vector Word64) - mkBp b n bpOp bpCl = DVS.createT $ do - mv <- DVSM.unsafeNew (DVS.length bpOp) - mkBpGo b n bpOp bpCl mv 0 0 - mkBpGo :: Word64 -> Word64 -> DVS.Vector Word32 -> DVS.Vector Word32 -> DVS.MVector s Word64 -> Int -> Int -> ST s ((Word64, Word64), DVS.MVector s Word64) - mkBpGo b n bpOp bpCl mv vi mvi = if vi < DVS.length bpOp - then do - let op = DVS.unsafeIndex bpOp vi - let cl = DVS.unsafeIndex bpCl vi - let (slo, mlo) = compress op cl -- slo: source lo, mlo: mask lo - let wb = pext slo mlo - let wn = popCount1 mlo - let tb = (wb .<. n) .|. b - let tn = n + wn - if tn < 64 - then do - mkBpGo tb tn bpOp bpCl mv (vi + 1) mvi - else do - DVSM.unsafeWrite mv mvi tb - let ub = wb .>. (64 - n) - let un = tn - 64 - mkBpGo ub un bpOp bpCl mv (vi + 1) (mvi + 1) - else return ((b, n), DVSM.take mvi mv) - compress :: Word32 -> Word32 -> (Word64, Word64) - compress op cl = (sw, mw) - where iop = pdep (fromIntegral op :: Word64) 0x5555555555555555 -- interleaved open - icl = pdep (fromIntegral cl :: Word64) 0xaaaaaaaaaaaaaaaa -- interleaved close - ioc = iop .|. icl -- interleaved open/close - sw = pext iop ioc - pc = popCount1 ioc - mw = (1 .<. pc) - 1 diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Slow.hs b/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Slow.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Backend/Standard/Slow.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module HaskellWorks.Data.Json.Backend.Standard.Slow - ( fromByteString - , fromForeignRegion - , fromString - ) where - -import Foreign.ForeignPtr -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow - -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import qualified Data.ByteString.Internal as BSI -import qualified HaskellWorks.Data.BalancedParens as BP -import qualified HaskellWorks.Data.FromForeignRegion as F -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp as J - -fromByteString :: BS.ByteString -> Cursor -fromByteString bs = GenericCursor - { cursorText = bs - , interests = ib - , balancedParens = BP.SimpleBalancedParens bp - , cursorRank = 1 - } - where J.IbBp ib bp = J.toIbBp bs - -fromForeignRegion :: F.ForeignRegion -> Cursor -fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) - -fromString :: String -> Cursor -fromString = fromByteString . BSC.pack diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Simple/IbBp.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Simple/IbBp.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Simple/IbBp.hs +++ /dev/null @@ -1,10 +0,0 @@ -module HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp where - -import Data.Word - -import qualified Data.Vector.Storable as DVS - -data IbBp = IbBp - { ib :: DVS.Vector Word64 - , bp :: DVS.Vector Word64 - } diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Simple/ToIbBp.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Simple/ToIbBp.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Simple/ToIbBp.hs +++ /dev/null @@ -1,12 +0,0 @@ -module HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp where - -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Simple.SemiIndex as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp as Z - -class ToIbBp a where - toIbBp :: a -> Z.IbBp - -instance ToIbBp BS.ByteString where - toIbBp bs = Z.IbBp ib bp - where J.SemiIndex _ ib bp = J.buildSemiIndex bs diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/Blank.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module HaskellWorks.Data.Json.Internal.Backend.Standard.Blank - ( blankJson - ) where - -import Data.ByteString as BS -import Data.Word -import Data.Word8 -import HaskellWorks.Data.Json.Internal.Word8 -import Prelude as P - -data BlankState - = Escaped - | InJson - | InString - | InNumber - | InIdent - -blankJson :: [BS.ByteString] -> [BS.ByteString] -blankJson = blankJson' InJson - -blankJson' :: BlankState -> [BS.ByteString] -> [BS.ByteString] -blankJson' lastState as = case as of - (bs:bss) -> - let (!cs, Just (!nextState, _)) = unfoldrN (BS.length bs) blankByteString (lastState, bs) in - cs:blankJson' nextState bss - [] -> [] - where - blankByteString :: (BlankState, ByteString) -> Maybe (Word8, (BlankState, ByteString)) - blankByteString (InJson, bs) = case BS.uncons bs of - Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs)) - Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs)) - Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs)) - Just (!c, !cs) -> Just (c , (InJson , cs)) - Nothing -> Nothing - blankByteString (InString, bs) = case BS.uncons bs of - Just (!c, !cs) | c == _backslash -> Just (_space , (Escaped , cs)) - Just (!c, !cs) | c == _quotedbl -> Just (_parenright , (InJson , cs)) - Just (_ , !cs) -> Just (_space , (InString , cs)) - Nothing -> Nothing - blankByteString (Escaped, bs) = case BS.uncons bs of - Just (_, !cs) -> Just (_space, (InString, cs)) - Nothing -> Nothing - blankByteString (InNumber, bs) = case BS.uncons bs of - Just (!c, !cs) | isTrailingDigit c -> Just (_0 , (InNumber , cs)) - Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs)) - Just (!c, !cs) | isAlphabetic c -> Just (c , (InIdent , cs)) - Just (!c, !cs) -> Just (c , (InJson , cs)) - Nothing -> Nothing - blankByteString (InIdent, bs) = case BS.uncons bs of - Just (!c, !cs) | isAlphabetic c -> Just (_underscore , (InIdent , cs)) - Just (!c, !cs) | isLeadingDigit c -> Just (_1 , (InNumber , cs)) - Just (!c, !cs) | c == _quotedbl -> Just (_parenleft , (InString , cs)) - Just (!c, !cs) -> Just (c , (InJson , cs)) - Nothing -> Nothing diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/BlankedJson.hs +++ /dev/null @@ -1,24 +0,0 @@ - -module HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson - ( BlankedJson(..) - , ToBlankedJson(..) - , toBlankedJsonTyped - ) where - -import HaskellWorks.Data.ByteString -import HaskellWorks.Data.Json.Internal.Backend.Standard.Blank - -import qualified Data.ByteString as BS - -newtype BlankedJson = BlankedJson - { unBlankedJson :: [BS.ByteString] - } deriving (Eq, Show) - -class ToBlankedJson a where - toBlankedJson :: a -> [BS.ByteString] - -instance ToBlankedJson BS.ByteString where - toBlankedJson bs = blankJson (chunkedBy 4096 bs) - -toBlankedJsonTyped :: ToBlankedJson a => a -> BlankedJson -toBlankedJsonTyped = BlankedJson . toBlankedJson diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/IbBp.hs +++ /dev/null @@ -1,24 +0,0 @@ -module HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp where - -import Data.Word - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 as J - -data IbBp = IbBp - { ib :: DVS.Vector Word64 - , bp :: DVS.Vector Word64 - } - -class ToIbBp a where - toIbBp :: a -> IbBp - -instance ToIbBp BS.ByteString where - toIbBp bs = IbBp - { ib = J.toInterestBits64 blankedJson - , bp = J.toBalancedParens64 blankedJson - } - where blankedJson = J.toBlankedJsonTyped bs diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/MakeIndex.hs +++ /dev/null @@ -1,134 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} - -module HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex - ( blankedJsonToInterestBits - , byteStringToBits - , blankedJsonToBalancedParens - , compressWordAsBit - , interestingWord8s - ) where - -import Control.Monad -import Data.Array.Unboxed ((!)) -import Data.ByteString (ByteString) -import Data.Int -import Data.Word -import Data.Word8 -import HaskellWorks.Data.Bits.BitWise -import Prelude as P - -import qualified Data.Array.Unboxed as A -import qualified Data.Bits as BITS -import qualified Data.ByteString as BS - -interestingWord8s :: A.UArray Word8 Word8 -interestingWord8s = A.array (0, 255) [ - (w, if w == _bracketleft || w == _braceleft || w == _parenleft || w == _t || w == _f || w == _n || w == _1 - then 1 - else 0) - | w <- [0 .. 255]] - -blankedJsonToInterestBits :: [BS.ByteString] -> [BS.ByteString] -blankedJsonToInterestBits = blankedJsonToInterestBits' "" - -padRight :: Word8 -> Int -> BS.ByteString -> BS.ByteString -padRight w n bs = if BS.length bs >= n then bs else fst (BS.unfoldrN n gen bs) - where gen :: ByteString -> Maybe (Word8, ByteString) - gen cs = case BS.uncons cs of - Just (c, ds) -> Just (c, ds) - Nothing -> Just (w, BS.empty) - -blankedJsonToInterestBits' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString] -blankedJsonToInterestBits' rs as = case as of - (bs:bss) -> - let cs = if BS.length rs /= 0 then BS.concat [rs, bs] else bs in - let lencs = BS.length cs in - let q = lencs + 7 `quot` 8 in - let (ds, es) = BS.splitAt (q * 8) cs in - let (fs, _) = BS.unfoldrN q gen ds in - fs:blankedJsonToInterestBits' es bss - [] -> [] - where gen :: ByteString -> Maybe (Word8, ByteString) - gen ds = if BS.length ds == 0 - then Nothing - else Just ( BS.foldr (\b m -> (interestingWord8s ! b) .|. (m .<. 1)) 0 (padRight 0 8 (BS.take 8 ds)) - , BS.drop 8 ds - ) - -repartitionMod8 :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString) -repartitionMod8 aBS bBS = (BS.take cLen abBS, BS.drop cLen abBS) - where abBS = BS.concat [aBS, bBS] - abLen = BS.length abBS - cLen = (abLen `div` 8) * 8 - -compressWordAsBit :: [BS.ByteString] -> [BS.ByteString] -compressWordAsBit = compressWordAsBit' BS.empty - -compressWordAsBit' :: BS.ByteString -> [BS.ByteString] -> [BS.ByteString] -compressWordAsBit' aBS as = case as of - (bBS:bBSs) -> - let (cBS, dBS) = repartitionMod8 aBS bBS in - let (cs, _) = BS.unfoldrN (BS.length cBS + 7 `div` 8) gen cBS in - cs:compressWordAsBit' dBS bBSs - [] -> do - let (cs, _) = BS.unfoldrN (BS.length aBS + 7 `div` 8) gen aBS - [cs] - where gen :: ByteString -> Maybe (Word8, ByteString) - gen xs = if BS.length xs == 0 - then Nothing - else Just ( BS.foldr (\b m -> ((b .&. 1) .|. (m .<. 1))) 0 (padRight 0 8 (BS.take 8 xs)) - , BS.drop 8 xs - ) - -blankedJsonToBalancedParens :: [BS.ByteString] -> [BS.ByteString] -blankedJsonToBalancedParens as = case as of - (bs:bss) -> - let (cs, _) = BS.unfoldrN (BS.length bs * 2) gen (Nothing, bs) in - cs:blankedJsonToBalancedParens bss - [] -> [] - where gen :: (Maybe Bool, ByteString) -> Maybe (Word8, (Maybe Bool, ByteString)) - gen (Just True , bs) = Just (0xFF, (Nothing, bs)) - gen (Just False , bs) = Just (0x00, (Nothing, bs)) - gen (Nothing , bs) = case BS.uncons bs of - Just (c, cs) -> case balancedParensOf c of - MiniN -> gen (Nothing , cs) - MiniT -> Just (0xFF, (Nothing , cs)) - MiniF -> Just (0x00, (Nothing , cs)) - MiniTF -> Just (0xFF, (Just False , cs)) - Nothing -> Nothing - -data MiniBP = MiniN | MiniT | MiniF | MiniTF - -balancedParensOf :: Word8 -> MiniBP -balancedParensOf c = case c of - d | d == _braceleft -> MiniT - d | d == _braceright -> MiniF - d | d == _bracketleft -> MiniT - d | d == _bracketright -> MiniF - d | d == _parenleft -> MiniT - d | d == _parenright -> MiniF - d | d == _t -> MiniTF - d | d == _f -> MiniTF - d | d == _1 -> MiniTF - d | d == _n -> MiniTF - _ -> MiniN - -yieldBitsOfWord8 :: Word8 -> [Bool] -> [Bool] -yieldBitsOfWord8 w = - (((w .&. BITS.bit 0) /= 0):) . - (((w .&. BITS.bit 1) /= 0):) . - (((w .&. BITS.bit 2) /= 0):) . - (((w .&. BITS.bit 3) /= 0):) . - (((w .&. BITS.bit 4) /= 0):) . - (((w .&. BITS.bit 5) /= 0):) . - (((w .&. BITS.bit 6) /= 0):) . - (((w .&. BITS.bit 7) /= 0):) - -yieldBitsofWord8s :: [Word8] -> [Bool] -> [Bool] -yieldBitsofWord8s = P.foldr ((>>) . yieldBitsOfWord8) id - -byteStringToBits :: [BS.ByteString] -> [Bool] -> [Bool] -byteStringToBits as = case as of - (bs:bss) -> yieldBitsofWord8s (BS.unpack bs) . byteStringToBits bss - [] -> id diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/StateMachine.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/StateMachine.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/StateMachine.hs +++ /dev/null @@ -1,109 +0,0 @@ -{-# LANGUAGE BinaryLiterals #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} - -module HaskellWorks.Data.Json.Internal.Backend.Standard.StateMachine - ( lookupPhiTable - , lookupTransitionTable - , phiTable - , phiTableSimd - , transitionTable - , transitionTableSimd - , IntState(..) - , State(..) - ) where - -import Data.Word -import HaskellWorks.Data.Bits.BitWise - -import qualified Data.Vector as DV -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Json.Internal.Word8 as W8 - -{-# ANN module ("HLint: ignore Redundant guard" :: String) #-} - -newtype IntState = IntState Int deriving (Eq, Ord, Show, Num) - -data State = InJson | InString | InEscape | InValue deriving (Eq, Enum, Bounded, Show) - -phiTable :: DV.Vector (DVS.Vector Word8) -phiTable = DV.constructN 5 gos - where gos :: DV.Vector (DVS.Vector Word8) -> DVS.Vector Word8 - gos v = DVS.constructN 256 go - where vi = DV.length v - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (snd (stateMachine (fromIntegral ui) (toEnum vi))) - where ui = DVS.length u -{-# NOINLINE phiTable #-} - -phiTable2 :: DVS.Vector Word8 -phiTable2 = DVS.constructN (4 * fromIntegral iLen) go - where iLen = 256 :: Int - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (snd (stateMachine (fromIntegral ui) (toEnum (fromIntegral uj)))) - where (uj, ui) = fromIntegral (DVS.length u) `divMod` iLen -{-# NOINLINE phiTable2 #-} - -lookupPhiTable :: IntState -> Word8 -> Word8 -lookupPhiTable (IntState s) w = DVS.unsafeIndex phiTable2 (s * 256 + fromIntegral w) -{-# INLINE lookupPhiTable #-} - -phiTableSimd :: DVS.Vector Word32 -phiTableSimd = DVS.constructN 256 go - where go :: DVS.Vector Word32 -> Word32 - go v = (snd (stateMachine vi InJson ) .<. 0) .|. - (snd (stateMachine vi InString) .<. 8) .|. - (snd (stateMachine vi InEscape) .<. 16) .|. - (snd (stateMachine vi InValue ) .<. 24) - where vi = fromIntegral (DVS.length v) -{-# NOINLINE phiTableSimd #-} - -transitionTable :: DV.Vector (DVS.Vector Word8) -transitionTable = DV.constructN 5 gos - where gos :: DV.Vector (DVS.Vector Word8) -> DVS.Vector Word8 - gos v = DVS.constructN 256 go - where vi = DV.length v - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (fromEnum (fst (stateMachine ui (toEnum vi)))) - where ui = fromIntegral (DVS.length u) -{-# NOINLINE transitionTable #-} - -transitionTable2 :: DVS.Vector Word8 -transitionTable2 = DVS.constructN (4 * fromIntegral iLen) go - where iLen = 256 :: Int - go :: DVS.Vector Word8 -> Word8 - go u = fromIntegral (fromEnum (fst (stateMachine (fromIntegral ui) (toEnum (fromIntegral uj))))) - where (uj, ui) = fromIntegral (DVS.length u) `divMod` iLen -{-# NOINLINE transitionTable2 #-} - -lookupTransitionTable :: IntState -> Word8 -> IntState -lookupTransitionTable (IntState s) w = fromIntegral (DVS.unsafeIndex transitionTable2 (s * 256 + fromIntegral w)) -{-# INLINE lookupTransitionTable #-} - -transitionTableSimd :: DVS.Vector Word64 -transitionTableSimd = DVS.constructN 256 go - where go :: DVS.Vector Word64 -> Word64 - go v = fromIntegral (fromEnum (fst (stateMachine vi InJson ))) .|. - fromIntegral (fromEnum (fst (stateMachine vi InString))) .|. - fromIntegral (fromEnum (fst (stateMachine vi InEscape))) .|. - fromIntegral (fromEnum (fst (stateMachine vi InValue ))) - where vi = fromIntegral (DVS.length v) -{-# NOINLINE transitionTableSimd #-} - -stateMachine :: Word8 -> State -> (State, Word32) -stateMachine c InJson | W8.isOpen c = (InJson , 0b110) -stateMachine c InJson | W8.isClose c = (InJson , 0b001) -stateMachine c InJson | W8.isDelim c = (InJson , 0b000) -stateMachine c InJson | W8.isValueChar c = (InValue , 0b111) -stateMachine c InJson | W8.isDoubleQuote c = (InString, 0b111) -stateMachine _ InJson | otherwise = (InJson , 0b000) -stateMachine c InString | W8.isDoubleQuote c = (InJson , 0b000) -stateMachine c InString | W8.isBackSlash c = (InEscape, 0b000) -stateMachine _ InString | otherwise = (InString, 0b000) -stateMachine _ InEscape | otherwise = (InString, 0b000) -stateMachine c InValue | W8.isOpen c = (InJson , 0b110) -stateMachine c InValue | W8.isClose c = (InJson , 0b001) -stateMachine c InValue | W8.isDelim c = (InJson , 0b000) -stateMachine c InValue | W8.isValueChar c = (InValue , 0b000) -stateMachine _ InValue | otherwise = (InJson , 0b000) -{-# INLINE stateMachine #-} diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/ToBalancedParens64.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 - ( ToBalancedParens64(..) - ) where - -import Control.Applicative -import Data.Word -import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex - -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J - -genBitWordsForever :: LBS.ByteString -> Maybe (Word8, LBS.ByteString) -genBitWordsForever bs = LBS.uncons bs <|> Just (0, bs) -{-# INLINE genBitWordsForever #-} - -class ToBalancedParens64 a where - toBalancedParens64 :: a -> DVS.Vector Word64 - -instance ToBalancedParens64 J.BlankedJson where - toBalancedParens64 (J.BlankedJson bj) = DVS.unsafeCast (DVS.unfoldrN newLen genBitWordsForever bpBS) - where bpBS = LBS.fromChunks (compressWordAsBit (blankedJsonToBalancedParens bj)) - newLen = fromIntegral ((LBS.length bpBS + 7) `div` 8 * 8) diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Backend/Standard/ToInterestBits64.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 - ( ToInterestBits64(..) - ) where - -import Control.Applicative -import Data.ByteString.Internal -import Data.Word -import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J - -class ToInterestBits64 a where - toInterestBits64 :: a -> DVS.Vector Word64 - -instance ToInterestBits64 J.BlankedJson where - toInterestBits64 bj = DVS.unsafeCast (DVS.unfoldrN newLen genInterestForever interestBS) - where interestBS = blankedJsonBssToInterestBitsBs (J.unBlankedJson bj) - newLen = (BS.length interestBS + 7) `div` 8 * 8 - -blankedJsonBssToInterestBitsBs :: [ByteString] -> ByteString -blankedJsonBssToInterestBitsBs bss = BS.concat $ blankedJsonToInterestBits bss - -genInterestForever :: ByteString -> Maybe (Word8, ByteString) -genInterestForever bs = BS.uncons bs <|> Just (0, bs) diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Word8.hs b/hw-json-cursor/HaskellWorks/Data/Json/Internal/Word8.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Internal/Word8.hs +++ /dev/null @@ -1,72 +0,0 @@ -module HaskellWorks.Data.Json.Internal.Word8 where - -import Data.Word -import Data.Word8 hiding (isDigit) - -import qualified Data.Char as C - -isLeadingDigit :: Word8 -> Bool -isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9) - -isTrailingDigit :: Word8 -> Bool -isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e - -isAlphabetic :: Word8 -> Bool -isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z) - -isDigit :: Word8 -> Bool -isDigit w = w >= _0 && w <= _9 - -wIsJsonNumberDigit :: Word8 -> Bool -wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen - -doubleQuote :: Word8 -doubleQuote = fromIntegral (C.ord '"') - -backSlash :: Word8 -backSlash = fromIntegral (C.ord '\\') - -openBrace :: Word8 -openBrace = fromIntegral (C.ord '{') - -closeBrace :: Word8 -closeBrace = fromIntegral (C.ord '}') - -openBracket :: Word8 -openBracket = fromIntegral (C.ord '[') - -closeBracket :: Word8 -closeBracket = fromIntegral (C.ord ']') - -comma :: Word8 -comma = fromIntegral (C.ord ',') - -colon :: Word8 -colon = fromIntegral (C.ord ':') - -isPeriod :: Word8 -> Bool -isPeriod w = w == 46 - -isMinus :: Word8 -> Bool -isMinus w = w == 45 - -isPlus :: Word8 -> Bool -isPlus w = w == 43 - -isValueChar :: Word8 -> Bool -isValueChar c = isAlphabetic c || isDigit c || isPeriod c || isMinus c || isPlus c - -isOpen :: Word8 -> Bool -isOpen c = c == openBracket || c == openBrace - -isClose :: Word8 -> Bool -isClose c = c == closeBracket || c == closeBrace - -isDelim :: Word8 -> Bool -isDelim c = c == comma || c == colon - -isDoubleQuote :: Word8 -> Bool -isDoubleQuote c = c == doubleQuote - -isBackSlash :: Word8 -> Bool -isBackSlash c = c == backSlash diff --git a/hw-json-cursor/HaskellWorks/Data/Json/Type.hs b/hw-json-cursor/HaskellWorks/Data/Json/Type.hs deleted file mode 100644 --- a/hw-json-cursor/HaskellWorks/Data/Json/Type.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE MultiParamTypeClasses #-} - -module HaskellWorks.Data.Json.Type - ( JsonType(..) - , JsonTypeAt(..) - ) where - -import Data.Char -import Data.String -import Data.Word8 -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Drop -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Internal.Word8 -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import Prelude hiding (drop) - -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.BalancedParens as BP - -{-# ANN module ("HLint: Reduce duplication" :: String) #-} - -data JsonType - = JsonTypeArray - | JsonTypeBool - | JsonTypeNull - | JsonTypeNumber - | JsonTypeObject - | JsonTypeString - deriving (Eq, Show) - -class JsonTypeAt a where - jsonTypeAtPosition :: Position -> a -> Maybe JsonType - jsonTypeAt :: a -> Maybe JsonType - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor String v w) where - jsonTypeAtPosition p k = case drop (toCount p) (cursorText k) of - c:_ | fromIntegral (ord c) == _bracketleft -> Just JsonTypeArray - c:_ | fromIntegral (ord c) == _f -> Just JsonTypeBool - c:_ | fromIntegral (ord c) == _t -> Just JsonTypeBool - c:_ | fromIntegral (ord c) == _n -> Just JsonTypeNull - c:_ | wIsJsonNumberDigit (fromIntegral (ord c)) -> Just JsonTypeNumber - c:_ | fromIntegral (ord c) == _braceleft -> Just JsonTypeObject - c:_ | fromIntegral (ord c) == _quotedbl -> Just JsonTypeString - _ -> Nothing - - jsonTypeAt k = jsonTypeAtPosition p k - where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) - ik = interests k - bpk = balancedParens k - -instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonTypeAt (GenericCursor BS.ByteString v w) where - jsonTypeAtPosition p k = case BS.uncons (drop (toCount p) (cursorText k)) of - Just (c, _) | c == _bracketleft -> Just JsonTypeArray - Just (c, _) | c == _f -> Just JsonTypeBool - Just (c, _) | c == _t -> Just JsonTypeBool - Just (c, _) | c == _n -> Just JsonTypeNull - Just (c, _) | wIsJsonNumberDigit c -> Just JsonTypeNumber - Just (c, _) | c == _braceleft -> Just JsonTypeObject - Just (c, _) | c == _quotedbl -> Just JsonTypeString - _ -> Nothing - - jsonTypeAt k = jsonTypeAtPosition p k - where p = lastPositionOf (select1 ik (rank1 bpk (cursorRank k))) - ik = interests k - bpk = balancedParens k diff --git a/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor.hs b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor.hs new file mode 100644 --- /dev/null +++ b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.Json.Simple.Cursor + ( JsonCursor(..) + , jsonCursorPos + ) where + +import Data.String +import Data.Word +import HaskellWorks.Data.FromByteString +import HaskellWorks.Data.FromForeignRegion +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.RankSelect.CsPoppy +import HaskellWorks.Data.TreeCursor +import Prelude hiding (drop) + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Internal as BSI +import qualified Data.Vector.Storable as DVS +import qualified Foreign.ForeignPtr as F +import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM +import qualified HaskellWorks.Data.Json.Simple.Cursor.SemiIndex as SI + +data JsonCursor t v w = JsonCursor + { cursorText :: !t + , interests :: !v + , balancedParens :: !w + , cursorRank :: !Count + } + deriving (Eq, Show) + +instance FromByteString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromByteString bs = JsonCursor + { cursorText = bs + , interests = ib + , balancedParens = BP.SimpleBalancedParens bp + , cursorRank = 1 + } + where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs + +instance FromByteString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where + fromByteString bs = JsonCursor + { cursorText = bs + , interests = makeCsPoppy ib + , balancedParens = RM.mkRangeMin (makeCsPoppy bp) + , cursorRank = 1 + } + where SI.SemiIndex _ ib bp = SI.buildSemiIndex bs + +instance FromForeignRegion (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) + +instance FromForeignRegion (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where + fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (F.castForeignPtr fptr) offset size) + +instance IsString (JsonCursor BS.ByteString (DVS.Vector Word64) (BP.SimpleBalancedParens (DVS.Vector Word64))) where + fromString = fromByteString . BSC.pack + +instance IsString (JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy)) where + fromString = fromByteString . BSC.pack + +instance (BP.BalancedParens u, Rank1 u, Rank0 u) => TreeCursor (JsonCursor t v u) where + firstChild :: JsonCursor t v u -> Maybe (JsonCursor t v u) + firstChild k = let mq = BP.firstChild (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + nextSibling :: JsonCursor t v u -> Maybe (JsonCursor t v u) + nextSibling k = (\q -> k { cursorRank = q }) <$> BP.nextSibling (balancedParens k) (cursorRank k) + + parent :: JsonCursor t v u -> Maybe (JsonCursor t v u) + parent k = let mq = BP.parent (balancedParens k) (cursorRank k) in (\q -> k { cursorRank = q }) <$> mq + + depth :: JsonCursor t v u -> Maybe Count + depth k = BP.depth (balancedParens k) (cursorRank k) + + subtreeSize :: JsonCursor t v u -> Maybe Count + subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k) + +jsonCursorPos :: (Rank1 w, Select1 v) => JsonCursor s v w -> Position +jsonCursorPos k = toPosition (select1 ik (rank1 bpk (cursorRank k)) - 1) + where ik = interests k + bpk = balancedParens k diff --git a/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Fast.hs b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Fast.hs new file mode 100644 --- /dev/null +++ b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Fast.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module HaskellWorks.Data.Json.Simple.Cursor.Fast + ( fromByteString + , fromForeignRegion + , fromString + ) where + +import Foreign.ForeignPtr +import HaskellWorks.Data.Json.Simple.Cursor +import HaskellWorks.Data.RankSelect.CsPoppy + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Internal as BSI +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM +import qualified HaskellWorks.Data.FromForeignRegion as F +import qualified HaskellWorks.Data.Json.Simple.Cursor.Internal.IbBp as J +import qualified HaskellWorks.Data.Json.Simple.Cursor.Internal.ToIbBp as J + +fromByteString :: BS.ByteString -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromByteString bs = JsonCursor + { cursorText = bs + , interests = makeCsPoppy ib + , balancedParens = RM.mkRangeMin (makeCsPoppy bp) + , cursorRank = 1 + } + where J.IbBp ib bp = J.toIbBp bs + +fromForeignRegion :: F.ForeignRegion -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromForeignRegion (fptr, offset, size) = fromByteString (BSI.fromForeignPtr (castForeignPtr fptr) offset size) + +fromString :: String -> JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) +fromString = fromByteString . BSC.pack diff --git a/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/IbBp.hs b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/IbBp.hs new file mode 100644 --- /dev/null +++ b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/IbBp.hs @@ -0,0 +1,10 @@ +module HaskellWorks.Data.Json.Simple.Cursor.Internal.IbBp where + +import Data.Word + +import qualified Data.Vector.Storable as DVS + +data IbBp = IbBp + { ib :: DVS.Vector Word64 + , bp :: DVS.Vector Word64 + } diff --git a/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/ToIbBp.hs b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/ToIbBp.hs new file mode 100644 --- /dev/null +++ b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/ToIbBp.hs @@ -0,0 +1,12 @@ +module HaskellWorks.Data.Json.Simple.Cursor.Internal.ToIbBp where + +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.Json.Simple.Cursor.Internal.IbBp as Z +import qualified HaskellWorks.Data.Json.Simple.Cursor.SemiIndex as J + +class ToIbBp a where + toIbBp :: a -> Z.IbBp + +instance ToIbBp BS.ByteString where + toIbBp bs = Z.IbBp ib bp + where J.SemiIndex _ ib bp = J.buildSemiIndex bs diff --git a/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/Word8.hs b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/Word8.hs new file mode 100644 --- /dev/null +++ b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/Internal/Word8.hs @@ -0,0 +1,72 @@ +module HaskellWorks.Data.Json.Simple.Cursor.Internal.Word8 where + +import Data.Word +import Data.Word8 hiding (isDigit) + +import qualified Data.Char as C + +isLeadingDigit :: Word8 -> Bool +isLeadingDigit w = w == _hyphen || (w >= _0 && w <= _9) + +isTrailingDigit :: Word8 -> Bool +isTrailingDigit w = w == _plus || w == _hyphen || (w >= _0 && w <= _9) || w == _period || w == _E || w == _e + +isAlphabetic :: Word8 -> Bool +isAlphabetic w = (w >= _A && w <= _Z) || (w >= _a && w <= _z) + +isDigit :: Word8 -> Bool +isDigit w = w >= _0 && w <= _9 + +wIsJsonNumberDigit :: Word8 -> Bool +wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen + +doubleQuote :: Word8 +doubleQuote = fromIntegral (C.ord '"') + +backSlash :: Word8 +backSlash = fromIntegral (C.ord '\\') + +openBrace :: Word8 +openBrace = fromIntegral (C.ord '{') + +closeBrace :: Word8 +closeBrace = fromIntegral (C.ord '}') + +openBracket :: Word8 +openBracket = fromIntegral (C.ord '[') + +closeBracket :: Word8 +closeBracket = fromIntegral (C.ord ']') + +comma :: Word8 +comma = fromIntegral (C.ord ',') + +colon :: Word8 +colon = fromIntegral (C.ord ':') + +isPeriod :: Word8 -> Bool +isPeriod w = w == 46 + +isMinus :: Word8 -> Bool +isMinus w = w == 45 + +isPlus :: Word8 -> Bool +isPlus w = w == 43 + +isValueChar :: Word8 -> Bool +isValueChar c = isAlphabetic c || isDigit c || isPeriod c || isMinus c || isPlus c + +isOpen :: Word8 -> Bool +isOpen c = c == openBracket || c == openBrace + +isClose :: Word8 -> Bool +isClose c = c == closeBracket || c == closeBrace + +isDelim :: Word8 -> Bool +isDelim c = c == comma || c == colon + +isDoubleQuote :: Word8 -> Bool +isDoubleQuote c = c == doubleQuote + +isBackSlash :: Word8 -> Bool +isBackSlash c = c == backSlash diff --git a/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/SemiIndex.hs b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/SemiIndex.hs new file mode 100644 --- /dev/null +++ b/hw-json-simple-cursor/HaskellWorks/Data/Json/Simple/Cursor/SemiIndex.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiWayIf #-} + +module HaskellWorks.Data.Json.Simple.Cursor.SemiIndex + ( buildSemiIndex + , SemiIndex(..) + ) where + +import Control.Monad.ST +import Data.Word + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.Bits.Writer.Storable as W +import qualified HaskellWorks.Data.Json.Simple.Cursor.Internal.Word8 as W8 + +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +data Context = InJson | InString | InEscape deriving (Eq, Show) + +data SemiIndex v = SemiIndex + { semiIndexContext :: !Context + , semiIndexIb :: !v + , semiIndexBp :: !v + } deriving (Functor, Traversable, Foldable) + +buildSemiIndex :: BS.ByteString -> SemiIndex (DVS.Vector Word64) +buildSemiIndex bs = DVS.createT $ do + let len = (BS.length bs + 7) `div` 8 + mib <- W.newWriter len + mbp <- W.newWriter (len * 2) + buildFromByteString mib mbp bs 0 InJson +{-# INLINE buildSemiIndex #-} + +buildFromByteString :: W.Writer s -> W.Writer s -> BS.ByteString -> Int -> Context -> ST s (SemiIndex (DVS.MVector s Word64)) +buildFromByteString ib bp bs i context = if i < BS.length bs + then do + let c = BSU.unsafeIndex bs i + case context of + InJson -> if + | c == W8.openBracket || c == W8.openBrace -> do + W.unsafeWriteBit bp 1 + W.unsafeWriteBit bp 1 + W.unsafeWriteBit ib 1 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.closeBracket || c == W8.closeBrace -> do + W.unsafeWriteBit bp 0 + W.unsafeWriteBit bp 0 + W.unsafeWriteBit ib 1 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.comma || c == W8.colon -> do + W.unsafeWriteBit bp 0 + W.unsafeWriteBit bp 1 + W.unsafeWriteBit ib 1 + buildFromByteString ib bp bs (i + 1) InJson + | c == W8.doubleQuote -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InString + | otherwise -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InJson + InString -> do + W.unsafeWriteBit ib 0 + let newContext = if + | c == W8.doubleQuote -> InJson + | c == W8.backSlash -> InEscape + | otherwise -> InString + buildFromByteString ib bp bs (i + 1) newContext + InEscape -> do + W.unsafeWriteBit ib 0 + buildFromByteString ib bp bs (i + 1) InString + else do + ibv <- W.written ib + bpv <- W.written bp + return (SemiIndex context ibv bpv) +{-# INLINE buildFromByteString #-} diff --git a/hw-json.cabal b/hw-json.cabal --- a/hw-json.cabal +++ b/hw-json.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: hw-json -version: 1.1.0.2 +version: 1.2.0.0 synopsis: Memory efficient JSON parser description: Memory efficient JSON parser. Please see README.md category: Data @@ -37,36 +37,37 @@ manual: False default: False -common base { build-depends: base >= 4 && < 5 } +common base { build-depends: base >= 4 && < 5 } -common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.8.2 && < 0.7 } -common array { build-depends: array >= 0.5 && < 0.6 } -common attoparsec { build-depends: attoparsec >= 0.13 && < 0.14 } -common bits-extra { build-depends: bits-extra >= 0.0.1.3 && < 0.1 } -common bytestring { build-depends: bytestring >= 0.10.6 && < 0.11 } -common criterion { build-depends: criterion >= 1.4 && < 1.6 } -common directory { build-depends: directory >= 1.3 && < 1.4 } -common dlist { build-depends: dlist >= 0.8 && < 0.9 } -common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 1.2 } -common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } -common hspec { build-depends: hspec >= 2.4 && < 3 } -common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.0 && < 0.4 } -common hw-bits { build-depends: hw-bits >= 0.7.0.5 && < 0.8 } -common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } -common hw-json-simd { build-depends: hw-json-simd >= 0.1.0.2 && < 0.2 } -common hw-mquery { build-depends: hw-mquery >= 0.2.0.0 && < 0.3 } -common hw-parser { build-depends: hw-parser >= 0.1 && < 0.2 } -common hw-prim { build-depends: hw-prim >= 0.6.2.28 && < 0.7 } -common hw-rankselect { build-depends: hw-rankselect >= 0.13 && < 0.14 } -common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } -common hw-simd { build-depends: hw-simd >= 0.1.1.2 && < 0.2 } -common lens { build-depends: lens >= 4 && < 5 } -common mmap { build-depends: mmap >= 0.5 && < 0.6 } -common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.15 } -common text { build-depends: text >= 1.2 && < 1.3 } -common transformers { build-depends: transformers >= 0.4 && < 0.6 } -common vector { build-depends: vector >= 0.12 && < 0.13 } -common word8 { build-depends: word8 >= 0.1 && < 0.2 } +common ansi-wl-pprint { build-depends: ansi-wl-pprint >= 0.6.8.2 && < 0.7 } +common array { build-depends: array >= 0.5 && < 0.6 } +common attoparsec { build-depends: attoparsec >= 0.13 && < 0.14 } +common bits-extra { build-depends: bits-extra >= 0.0.1.3 && < 0.1 } +common bytestring { build-depends: bytestring >= 0.10.6 && < 0.11 } +common criterion { build-depends: criterion >= 1.4 && < 1.6 } +common directory { build-depends: directory >= 1.3 && < 1.4 } +common dlist { build-depends: dlist >= 0.8 && < 0.9 } +common generic-lens { build-depends: generic-lens >= 1.1.0.0 && < 1.2 } +common hedgehog { build-depends: hedgehog >= 0.6 && < 1.1 } +common hspec { build-depends: hspec >= 2.4 && < 3 } +common hw-balancedparens { build-depends: hw-balancedparens >= 0.3.0.0 && < 0.4 } +common hw-bits { build-depends: hw-bits >= 0.7.0.5 && < 0.8 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } +common hw-json-simd { build-depends: hw-json-simd >= 0.1.0.2 && < 0.2 } +common hw-json-standard-cursor { build-depends: hw-json-standard-cursor >= 0.1.0.0 && < 0.2 } +common hw-mquery { build-depends: hw-mquery >= 0.2.0.0 && < 0.3 } +common hw-parser { build-depends: hw-parser >= 0.1 && < 0.2 } +common hw-prim { build-depends: hw-prim >= 0.6.2.28 && < 0.7 } +common hw-rankselect { build-depends: hw-rankselect >= 0.13 && < 0.14 } +common hw-rankselect-base { build-depends: hw-rankselect-base >= 0.3.2.1 && < 0.4 } +common hw-simd { build-depends: hw-simd >= 0.1.1.2 && < 0.2 } +common lens { build-depends: lens >= 4 && < 5 } +common mmap { build-depends: mmap >= 0.5 && < 0.6 } +common optparse-applicative { build-depends: optparse-applicative >= 0.14 && < 0.15 } +common text { build-depends: text >= 1.2 && < 1.3 } +common transformers { build-depends: transformers >= 0.4 && < 0.6 } +common vector { build-depends: vector >= 0.12 && < 0.13 } +common word8 { build-depends: word8 >= 0.1 && < 0.2 } common semigroups { if impl(ghc < 8 ) { build-depends: semigroups >= 0.16 && < 0.19 } } @@ -79,56 +80,34 @@ ghc-options: -mbmi2 -msse4.2 cpp-options: -DBMI2_ENABLED -library hw-json-cursor +library hw-json-simple-cursor import: base, config - , array - , bits-extra , bytestring , hw-balancedparens , hw-bits , hw-prim , hw-rankselect , hw-rankselect-base - , mmap , vector , word8 - hs-source-dirs: hw-json-cursor - exposed-modules: HaskellWorks.Data.Json.Backend.Simple.Cursor - HaskellWorks.Data.Json.Backend.Simple.Fast - HaskellWorks.Data.Json.Backend.Simple.SemiIndex - HaskellWorks.Data.Json.Backend.Standard.Cursor - HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast - HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic - HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow - HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific - HaskellWorks.Data.Json.Backend.Standard.Fast - HaskellWorks.Data.Json.Backend.Standard.Index - HaskellWorks.Data.Json.Backend.Standard.Load.Cursor - HaskellWorks.Data.Json.Backend.Standard.Load.Raw - HaskellWorks.Data.Json.Backend.Standard.SemiIndex - HaskellWorks.Data.Json.Backend.Standard.Slow - HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp - HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp - HaskellWorks.Data.Json.Internal.Backend.Standard.Blank - HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson - HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp - HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex - HaskellWorks.Data.Json.Internal.Backend.Standard.StateMachine - HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 - HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 - HaskellWorks.Data.Json.Internal.Word8 - HaskellWorks.Data.Json.Type + hs-source-dirs: hw-json-simple-cursor + exposed-modules: HaskellWorks.Data.Json.Simple.Cursor + HaskellWorks.Data.Json.Simple.Cursor.Fast + HaskellWorks.Data.Json.Simple.Cursor.SemiIndex + HaskellWorks.Data.Json.Simple.Cursor.Internal.IbBp + HaskellWorks.Data.Json.Simple.Cursor.Internal.ToIbBp + HaskellWorks.Data.Json.Simple.Cursor.Internal.Word8 library import: base, config , ansi-wl-pprint - , array , attoparsec , bits-extra , bytestring , dlist , hw-balancedparens , hw-bits + , hw-json-standard-cursor , hw-mquery , hw-parser , hw-prim @@ -143,15 +122,12 @@ hs-source-dirs: src other-modules: Paths_hw_json autogen-modules: Paths_hw_json - build-depends: hw-json-cursor + build-depends: hw-json-simple-cursor exposed-modules: - HaskellWorks.Data.Json - HaskellWorks.Data.Json.Backend.Simple.Value - HaskellWorks.Data.Json.Backend.Standard.Load.Partial HaskellWorks.Data.Json.DecodeError HaskellWorks.Data.Json.FromValue - HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token - HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize + HaskellWorks.Data.Json.Internal.Standard.Cursor.Token + HaskellWorks.Data.Json.Internal.Standard.Token.Tokenize HaskellWorks.Data.Json.Internal.CharLike HaskellWorks.Data.Json.Internal.Doc HaskellWorks.Data.Json.Internal.Index @@ -165,33 +141,15 @@ HaskellWorks.Data.Json.LightJson HaskellWorks.Data.Json.PartialValue HaskellWorks.Data.Json.Query + HaskellWorks.Data.Json.Simple.Value + HaskellWorks.Data.Json.Standard.Load.Partial HaskellWorks.Data.Json.Value reexported-modules: - HaskellWorks.Data.Json.Backend.Simple.Cursor - , HaskellWorks.Data.Json.Backend.Simple.Fast - , HaskellWorks.Data.Json.Backend.Simple.SemiIndex - , HaskellWorks.Data.Json.Backend.Standard.Cursor - , HaskellWorks.Data.Json.Backend.Standard.Cursor.Fast - , HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic - , HaskellWorks.Data.Json.Backend.Standard.Cursor.Slow - , HaskellWorks.Data.Json.Backend.Standard.Cursor.Specific - , HaskellWorks.Data.Json.Backend.Standard.Fast - , HaskellWorks.Data.Json.Backend.Standard.Index - , HaskellWorks.Data.Json.Backend.Standard.Load.Cursor - , HaskellWorks.Data.Json.Backend.Standard.Load.Raw - , HaskellWorks.Data.Json.Backend.Standard.SemiIndex - , HaskellWorks.Data.Json.Backend.Standard.Slow - , HaskellWorks.Data.Json.Internal.Backend.Simple.IbBp - , HaskellWorks.Data.Json.Internal.Backend.Simple.ToIbBp - , HaskellWorks.Data.Json.Internal.Backend.Standard.Blank - , HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson - , HaskellWorks.Data.Json.Internal.Backend.Standard.IbBp - , HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex - , HaskellWorks.Data.Json.Internal.Backend.Standard.StateMachine - , HaskellWorks.Data.Json.Internal.Backend.Standard.ToBalancedParens64 - , HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 - , HaskellWorks.Data.Json.Internal.Word8 - , HaskellWorks.Data.Json.Type + HaskellWorks.Data.Json.Simple.Cursor + , HaskellWorks.Data.Json.Simple.Cursor.Fast + , HaskellWorks.Data.Json.Simple.Cursor.SemiIndex + , HaskellWorks.Data.Json.Simple.Cursor.Internal.IbBp + , HaskellWorks.Data.Json.Simple.Cursor.Internal.ToIbBp executable hw-json import: base, config @@ -200,6 +158,7 @@ , generic-lens , hw-balancedparens , hw-json-simd + , hw-json-standard-cursor , hw-mquery , hw-prim , hw-rankselect @@ -230,6 +189,7 @@ , hw-balancedparens , hw-bits , hw-hspec-hedgehog + , hw-json-standard-cursor , hw-prim , hw-rankselect , hw-rankselect-base @@ -242,14 +202,9 @@ ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tools: hspec-discover other-modules: - HaskellWorks.Data.Json.Backend.Simple.CursorSpec - HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.BalancedParensSpec - HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.InterestBitsSpec - HaskellWorks.Data.Json.Backend.Standard.Succinct.CursorSpec - HaskellWorks.Data.Json.Backend.Standard.Succinct.GenCursorTest - HaskellWorks.Data.Json.CorpusSpec - HaskellWorks.Data.Json.Internal.BlankSpec - HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec + HaskellWorks.Data.Json.Simple.CursorSpec + HaskellWorks.Data.Json.Standard.CursorSpec + HaskellWorks.Data.Json.Standard.GenCursorTest HaskellWorks.Data.Json.Token.TokenizeSpec HaskellWorks.Data.Json.TypeSpec HaskellWorks.Data.Json.ValueSpec @@ -260,6 +215,7 @@ , bytestring , criterion , directory + , hw-json-standard-cursor , mmap , semigroups type: exitcode-stdio-1.0 diff --git a/src/HaskellWorks/Data/Json.hs b/src/HaskellWorks/Data/Json.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Json.hs +++ /dev/null @@ -1,6 +0,0 @@ -module HaskellWorks.Data.Json - ( module X - ) where - -import HaskellWorks.Data.Json.Type as X -import HaskellWorks.Data.Json.Value as X diff --git a/src/HaskellWorks/Data/Json/Backend/Simple/Value.hs b/src/HaskellWorks/Data/Json/Backend/Simple/Value.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Json/Backend/Simple/Value.hs +++ /dev/null @@ -1,42 +0,0 @@ -module HaskellWorks.Data.Json.Backend.Simple.Value where - -import Data.Maybe -import HaskellWorks.Data.Json.Backend.Simple.Cursor -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Data.RankSelect.CsPoppy - -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.BalancedParens as BP -import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM - -data JsonValue - = JsonValues JsonValues - | JsonNull - | JsonNumber Double - | JsonString String - | JsonBoolean Bool - deriving (Eq, Show) - -data JsonValues - = JsonArray [JsonValue] - | JsonObject [(String, JsonValue)] - deriving (Eq, Show) - -snippetPos :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> (Count, Count) -snippetPos k = (kpa, kpz) - where kpa = select1 kib kta + km - kpz = select1 kib ktz - km - kib = interests k - kbp = balancedParens k - kra = cursorRank k - krz = fromMaybe maxBound (BP.findClose kbp kra) - ksa = kra + 1 - ksz = krz + 1 - kta = ksa `div` 2 - ktz = ksz `div` 2 - km = ksa `mod` 2 - -snippet :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> BS.ByteString -snippet k = let (a, z) = snippetPos k in BS.take (fromIntegral (z - a + 1)) (BS.drop (fromIntegral (a - 1)) kt) - where kt = cursorText k diff --git a/src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs b/src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Json/Backend/Standard/Load/Partial.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module HaskellWorks.Data.Json.Backend.Standard.Load.Partial - ( loadPartial - , loadPartialWithCsPoppyIndex - , loadPartialWithIndex - ) where - -import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Backend.Standard.Load.Raw -import HaskellWorks.Data.Json.Internal.PartialIndex -import HaskellWorks.Data.Json.PartialValue -import HaskellWorks.Data.RankSelect.CsPoppy - -loadPartialWithIndex :: String -> IO JsonPartialValue -loadPartialWithIndex filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = GenericCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1 - let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) - return jsonResult - -loadPartialWithCsPoppyIndex :: String -> IO JsonPartialValue -loadPartialWithCsPoppyIndex filename = do - (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename - let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 - let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) - return jsonResult - -loadPartial :: String -> IO JsonPartialValue -loadPartial = loadPartialWithCsPoppyIndex diff --git a/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs b/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Cursor/Token.hs +++ /dev/null @@ -1,24 +0,0 @@ - -module HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token - ( jsonTokenAt - ) where - -import Data.ByteString.Internal as BSI -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Drop -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize -import HaskellWorks.Data.Positioning -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import Prelude hiding (drop) - -import qualified Data.Attoparsec.ByteString.Char8 as ABC - -jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => GenericCursor ByteString v w -> Maybe (JsonToken String Double) -jsonTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k) - then case ABC.parse parseJsonToken (drop (toCount (jsonCursorPos k)) (cursorText k)) of - ABC.Fail {} -> error "Failed to parse token in cursor" - ABC.Partial _ -> error "Failed to parse token in cursor" - ABC.Done _ r -> Just r - else Nothing diff --git a/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.hs b/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.hs deleted file mode 100644 --- a/src/HaskellWorks/Data/Json/Internal/Backend/Standard/Token/Tokenize.hs +++ /dev/null @@ -1,165 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize - ( IsChar(..) - , JsonToken(..) - , ParseJson(..) - ) where - -import Control.Applicative -import Data.Bits -import Data.Char -import Data.Word -import Data.Word8 -import HaskellWorks.Data.Char.IsChar -import HaskellWorks.Data.Json.Internal.Token.Types -import HaskellWorks.Data.Parser (()) - -import qualified Data.Attoparsec.ByteString.Char8 as BC -import qualified Data.Attoparsec.Combinator as AC -import qualified Data.Attoparsec.Types as T -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.Parser as P - -hexDigitNumeric :: P.Parser t u => T.Parser t Int -hexDigitNumeric = do - c <- P.satisfyChar (\c -> '0' <= c && c <= '9') - return $ ord c - ord '0' - -hexDigitAlphaLower :: P.Parser t u => T.Parser t Int -hexDigitAlphaLower = do - c <- P.satisfyChar (\c -> 'a' <= c && c <= 'z') - return $ ord c - ord 'a' + 10 - -hexDigitAlphaUpper :: P.Parser t u => T.Parser t Int -hexDigitAlphaUpper = do - c <- P.satisfyChar (\c -> 'A' <= c && c <= 'Z') - return $ ord c - ord 'A' + 10 - -hexDigit :: P.Parser t u => T.Parser t Int -hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper - -class ParseJson t s d where - parseJsonTokenString :: T.Parser t (JsonToken s d) - parseJsonToken :: T.Parser t (JsonToken s d) - parseJsonTokenBraceL :: T.Parser t (JsonToken s d) - parseJsonTokenBraceR :: T.Parser t (JsonToken s d) - parseJsonTokenBracketL :: T.Parser t (JsonToken s d) - parseJsonTokenBracketR :: T.Parser t (JsonToken s d) - parseJsonTokenComma :: T.Parser t (JsonToken s d) - parseJsonTokenColon :: T.Parser t (JsonToken s d) - parseJsonTokenWhitespace :: T.Parser t (JsonToken s d) - parseJsonTokenNull :: T.Parser t (JsonToken s d) - parseJsonTokenBoolean :: T.Parser t (JsonToken s d) - parseJsonTokenDouble :: T.Parser t (JsonToken s d) - - parseJsonToken = - parseJsonTokenString <|> - parseJsonTokenBraceL <|> - parseJsonTokenBraceR <|> - parseJsonTokenBracketL <|> - parseJsonTokenBracketR <|> - parseJsonTokenComma <|> - parseJsonTokenColon <|> - parseJsonTokenWhitespace <|> - parseJsonTokenNull <|> - parseJsonTokenBoolean <|> - parseJsonTokenDouble - -instance ParseJson BS.ByteString String Double where - parseJsonTokenBraceL = P.string "{" >> return JsonTokenBraceL - parseJsonTokenBraceR = P.string "}" >> return JsonTokenBraceR - parseJsonTokenBracketL = P.string "[" >> return JsonTokenBracketL - parseJsonTokenBracketR = P.string "]" >> return JsonTokenBracketR - parseJsonTokenComma = P.string "," >> return JsonTokenComma - parseJsonTokenColon = P.string ":" >> return JsonTokenColon - parseJsonTokenNull = P.string "null" >> return JsonTokenNull - parseJsonTokenDouble = JsonTokenNumber <$> P.rational - - parseJsonTokenString = do - _ <- P.string "\"" - value <- many (verbatimChar <|> escapedChar <|> escapedCode) - _ <- P.string "\"" - return $ JsonTokenString value - where - verbatimChar = P.satisfyChar (BC.notInClass "\"\\") "invalid string character" - escapedChar = do - _ <- P.string "\\" - ( P.char '"' >> return '"' ) <|> - ( P.char 'b' >> return '\b' ) <|> - ( P.char 'n' >> return '\n' ) <|> - ( P.char 'f' >> return '\f' ) <|> - ( P.char 'r' >> return '\r' ) <|> - ( P.char 't' >> return '\t' ) <|> - ( P.char '\\' >> return '\\' ) <|> - ( P.char '\'' >> return '\'' ) <|> - ( P.char '/' >> return '/' ) - escapedCode = do - _ <- P.string "\\u" - a <- hexDigit - b <- hexDigit - c <- hexDigit - d <- hexDigit - return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d - - parseJsonTokenWhitespace = do - _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"] - return JsonTokenWhitespace - - parseJsonTokenBoolean = true <|> false - where true = P.string "true" >> return (JsonTokenBoolean True) - false = P.string "false" >> return (JsonTokenBoolean False) - -instance ParseJson BS.ByteString BS.ByteString Double where - parseJsonTokenBraceL = P.string "{" >> return JsonTokenBraceL - parseJsonTokenBraceR = P.string "}" >> return JsonTokenBraceR - parseJsonTokenBracketL = P.string "[" >> return JsonTokenBracketL - parseJsonTokenBracketR = P.string "]" >> return JsonTokenBracketR - parseJsonTokenComma = P.string "," >> return JsonTokenComma - parseJsonTokenColon = P.string ":" >> return JsonTokenColon - parseJsonTokenNull = P.string "null" >> return JsonTokenNull - parseJsonTokenDouble = JsonTokenNumber <$> P.rational - - parseJsonTokenString = do - _ <- P.string "\"" - value <- many (verbatimChar <|> escapedChar <|> escapedCode) - _ <- P.string "\"" - return $ JsonTokenString $ BS.pack value - where - word :: Word8 -> T.Parser BS.ByteString Word8 - word w = P.satisfy (== w) - verbatimChar :: T.Parser BS.ByteString Word8 - verbatimChar = P.satisfy (\w -> w /= _quotedbl && w /= _backslash) -- "invalid string character" - escapedChar :: T.Parser BS.ByteString Word8 - escapedChar = do - _ <- P.string "\\" - ( word _quotedbl >> return _quotedbl ) <|> - ( word _b >> return 0x08 ) <|> - ( word _n >> return _lf ) <|> - ( word _f >> return _np ) <|> - ( word _r >> return _cr ) <|> - ( word _t >> return _tab ) <|> - ( word _backslash >> return _backslash ) <|> - ( word _quotesingle >> return _quotesingle ) <|> - ( word _slash >> return _slash ) - escapedCode :: T.Parser BS.ByteString Word8 - escapedCode = do - _ <- P.string "\\u" - a <- hexDigit - b <- hexDigit - c <- hexDigit - d <- hexDigit - return $ fromIntegral $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d - - parseJsonTokenWhitespace = do - _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"] - return JsonTokenWhitespace - - parseJsonTokenBoolean = true <|> false - where - true = P.string "true" >> return (JsonTokenBoolean True) - false = P.string "false" >> return (JsonTokenBoolean False) diff --git a/src/HaskellWorks/Data/Json/Internal/CharLike.hs b/src/HaskellWorks/Data/Json/Internal/CharLike.hs --- a/src/HaskellWorks/Data/Json/Internal/CharLike.hs +++ b/src/HaskellWorks/Data/Json/Internal/CharLike.hs @@ -2,7 +2,7 @@ import Data.Word import Data.Word8 -import HaskellWorks.Data.Json.Internal.Word8 +import HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8 class JsonCharLike c where isLeadingDigit2 :: c -> Bool diff --git a/src/HaskellWorks/Data/Json/Internal/Index.hs b/src/HaskellWorks/Data/Json/Internal/Index.hs --- a/src/HaskellWorks/Data/Json/Internal/Index.hs +++ b/src/HaskellWorks/Data/Json/Internal/Index.hs @@ -8,16 +8,16 @@ import Control.Monad import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Internal.CharLike +import HaskellWorks.Data.Json.Standard.Cursor.Generic import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Uncons -import Prelude hiding (drop) +import Prelude hiding (drop) import qualified Data.ByteString as BS import qualified Data.List as L diff --git a/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs b/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs --- a/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs +++ b/src/HaskellWorks/Data/Json/Internal/PartialIndex.hs @@ -14,15 +14,15 @@ import Data.String import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.CharLike +import HaskellWorks.Data.Json.Standard.Cursor.Generic import HaskellWorks.Data.Positioning import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Uncons -import Prelude hiding (drop) +import Prelude hiding (drop) import qualified Data.ByteString as BS import qualified Data.List as L diff --git a/src/HaskellWorks/Data/Json/Internal/Slurp.hs b/src/HaskellWorks/Data/Json/Internal/Slurp.hs --- a/src/HaskellWorks/Data/Json/Internal/Slurp.hs +++ b/src/HaskellWorks/Data/Json/Internal/Slurp.hs @@ -10,8 +10,8 @@ import Data.Text import Data.Word import Data.Word8 -import HaskellWorks.Data.Json.Internal.Word8 -import Prelude hiding (drop) +import HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8 +import Prelude hiding (drop) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC diff --git a/src/HaskellWorks/Data/Json/Internal/Standard/Cursor/Token.hs b/src/HaskellWorks/Data/Json/Internal/Standard/Cursor/Token.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Internal/Standard/Cursor/Token.hs @@ -0,0 +1,24 @@ + +module HaskellWorks.Data.Json.Internal.Standard.Cursor.Token + ( jsonTokenAt + ) where + +import Data.ByteString.Internal as BSI +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Drop +import HaskellWorks.Data.Json.Internal.Standard.Token.Tokenize +import HaskellWorks.Data.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import Prelude hiding (drop) + +import qualified Data.Attoparsec.ByteString.Char8 as ABC + +jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => GenericCursor ByteString v w -> Maybe (JsonToken String Double) +jsonTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k) + then case ABC.parse parseJsonToken (drop (toCount (jsonCursorPos k)) (cursorText k)) of + ABC.Fail {} -> error "Failed to parse token in cursor" + ABC.Partial _ -> error "Failed to parse token in cursor" + ABC.Done _ r -> Just r + else Nothing diff --git a/src/HaskellWorks/Data/Json/Internal/Standard/Token/Tokenize.hs b/src/HaskellWorks/Data/Json/Internal/Standard/Token/Tokenize.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Internal/Standard/Token/Tokenize.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module HaskellWorks.Data.Json.Internal.Standard.Token.Tokenize + ( IsChar(..) + , JsonToken(..) + , ParseJson(..) + ) where + +import Control.Applicative +import Data.Bits +import Data.Char +import Data.Word +import Data.Word8 +import HaskellWorks.Data.Char.IsChar +import HaskellWorks.Data.Json.Internal.Token.Types +import HaskellWorks.Data.Parser (()) + +import qualified Data.Attoparsec.ByteString.Char8 as BC +import qualified Data.Attoparsec.Combinator as AC +import qualified Data.Attoparsec.Types as T +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.Parser as P + +hexDigitNumeric :: P.Parser t u => T.Parser t Int +hexDigitNumeric = do + c <- P.satisfyChar (\c -> '0' <= c && c <= '9') + return $ ord c - ord '0' + +hexDigitAlphaLower :: P.Parser t u => T.Parser t Int +hexDigitAlphaLower = do + c <- P.satisfyChar (\c -> 'a' <= c && c <= 'z') + return $ ord c - ord 'a' + 10 + +hexDigitAlphaUpper :: P.Parser t u => T.Parser t Int +hexDigitAlphaUpper = do + c <- P.satisfyChar (\c -> 'A' <= c && c <= 'Z') + return $ ord c - ord 'A' + 10 + +hexDigit :: P.Parser t u => T.Parser t Int +hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper + +class ParseJson t s d where + parseJsonTokenString :: T.Parser t (JsonToken s d) + parseJsonToken :: T.Parser t (JsonToken s d) + parseJsonTokenBraceL :: T.Parser t (JsonToken s d) + parseJsonTokenBraceR :: T.Parser t (JsonToken s d) + parseJsonTokenBracketL :: T.Parser t (JsonToken s d) + parseJsonTokenBracketR :: T.Parser t (JsonToken s d) + parseJsonTokenComma :: T.Parser t (JsonToken s d) + parseJsonTokenColon :: T.Parser t (JsonToken s d) + parseJsonTokenWhitespace :: T.Parser t (JsonToken s d) + parseJsonTokenNull :: T.Parser t (JsonToken s d) + parseJsonTokenBoolean :: T.Parser t (JsonToken s d) + parseJsonTokenDouble :: T.Parser t (JsonToken s d) + + parseJsonToken = + parseJsonTokenString <|> + parseJsonTokenBraceL <|> + parseJsonTokenBraceR <|> + parseJsonTokenBracketL <|> + parseJsonTokenBracketR <|> + parseJsonTokenComma <|> + parseJsonTokenColon <|> + parseJsonTokenWhitespace <|> + parseJsonTokenNull <|> + parseJsonTokenBoolean <|> + parseJsonTokenDouble + +instance ParseJson BS.ByteString String Double where + parseJsonTokenBraceL = P.string "{" >> return JsonTokenBraceL + parseJsonTokenBraceR = P.string "}" >> return JsonTokenBraceR + parseJsonTokenBracketL = P.string "[" >> return JsonTokenBracketL + parseJsonTokenBracketR = P.string "]" >> return JsonTokenBracketR + parseJsonTokenComma = P.string "," >> return JsonTokenComma + parseJsonTokenColon = P.string ":" >> return JsonTokenColon + parseJsonTokenNull = P.string "null" >> return JsonTokenNull + parseJsonTokenDouble = JsonTokenNumber <$> P.rational + + parseJsonTokenString = do + _ <- P.string "\"" + value <- many (verbatimChar <|> escapedChar <|> escapedCode) + _ <- P.string "\"" + return $ JsonTokenString value + where + verbatimChar = P.satisfyChar (BC.notInClass "\"\\") "invalid string character" + escapedChar = do + _ <- P.string "\\" + ( P.char '"' >> return '"' ) <|> + ( P.char 'b' >> return '\b' ) <|> + ( P.char 'n' >> return '\n' ) <|> + ( P.char 'f' >> return '\f' ) <|> + ( P.char 'r' >> return '\r' ) <|> + ( P.char 't' >> return '\t' ) <|> + ( P.char '\\' >> return '\\' ) <|> + ( P.char '\'' >> return '\'' ) <|> + ( P.char '/' >> return '/' ) + escapedCode = do + _ <- P.string "\\u" + a <- hexDigit + b <- hexDigit + c <- hexDigit + d <- hexDigit + return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d + + parseJsonTokenWhitespace = do + _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"] + return JsonTokenWhitespace + + parseJsonTokenBoolean = true <|> false + where true = P.string "true" >> return (JsonTokenBoolean True) + false = P.string "false" >> return (JsonTokenBoolean False) + +instance ParseJson BS.ByteString BS.ByteString Double where + parseJsonTokenBraceL = P.string "{" >> return JsonTokenBraceL + parseJsonTokenBraceR = P.string "}" >> return JsonTokenBraceR + parseJsonTokenBracketL = P.string "[" >> return JsonTokenBracketL + parseJsonTokenBracketR = P.string "]" >> return JsonTokenBracketR + parseJsonTokenComma = P.string "," >> return JsonTokenComma + parseJsonTokenColon = P.string ":" >> return JsonTokenColon + parseJsonTokenNull = P.string "null" >> return JsonTokenNull + parseJsonTokenDouble = JsonTokenNumber <$> P.rational + + parseJsonTokenString = do + _ <- P.string "\"" + value <- many (verbatimChar <|> escapedChar <|> escapedCode) + _ <- P.string "\"" + return $ JsonTokenString $ BS.pack value + where + word :: Word8 -> T.Parser BS.ByteString Word8 + word w = P.satisfy (== w) + verbatimChar :: T.Parser BS.ByteString Word8 + verbatimChar = P.satisfy (\w -> w /= _quotedbl && w /= _backslash) -- "invalid string character" + escapedChar :: T.Parser BS.ByteString Word8 + escapedChar = do + _ <- P.string "\\" + ( word _quotedbl >> return _quotedbl ) <|> + ( word _b >> return 0x08 ) <|> + ( word _n >> return _lf ) <|> + ( word _f >> return _np ) <|> + ( word _r >> return _cr ) <|> + ( word _t >> return _tab ) <|> + ( word _backslash >> return _backslash ) <|> + ( word _quotesingle >> return _quotesingle ) <|> + ( word _slash >> return _slash ) + escapedCode :: T.Parser BS.ByteString Word8 + escapedCode = do + _ <- P.string "\\u" + a <- hexDigit + b <- hexDigit + c <- hexDigit + d <- hexDigit + return $ fromIntegral $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d + + parseJsonTokenWhitespace = do + _ <- AC.many1' $ BC.choice [P.string " ", P.string "\t", P.string "\n", P.string "\r"] + return JsonTokenWhitespace + + parseJsonTokenBoolean = true <|> false + where + true = P.string "true" >> return (JsonTokenBoolean True) + false = P.string "false" >> return (JsonTokenBoolean False) diff --git a/src/HaskellWorks/Data/Json/Internal/Token.hs b/src/HaskellWorks/Data/Json/Internal/Token.hs --- a/src/HaskellWorks/Data/Json/Internal/Token.hs +++ b/src/HaskellWorks/Data/Json/Internal/Token.hs @@ -2,4 +2,4 @@ ( module X ) where -import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize as X +import HaskellWorks.Data.Json.Internal.Standard.Token.Tokenize as X diff --git a/src/HaskellWorks/Data/Json/Internal/Word64.hs b/src/HaskellWorks/Data/Json/Internal/Word64.hs --- a/src/HaskellWorks/Data/Json/Internal/Word64.hs +++ b/src/HaskellWorks/Data/Json/Internal/Word64.hs @@ -2,7 +2,7 @@ import Data.Word -import qualified HaskellWorks.Data.Json.Internal.Word8 as W8 +import qualified HaskellWorks.Data.Json.Standard.Cursor.Internal.Word8 as W8 doubleQuote :: Word64 doubleQuote = 0x0101010101010101 * fromIntegral W8.doubleQuote diff --git a/src/HaskellWorks/Data/Json/LightJson.hs b/src/HaskellWorks/Data/Json/LightJson.hs --- a/src/HaskellWorks/Data/Json/LightJson.hs +++ b/src/HaskellWorks/Data/Json/LightJson.hs @@ -11,13 +11,13 @@ import Control.Arrow import Control.Monad import Data.String -import Data.Text (Text) +import Data.Text (Text) import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.CharLike import HaskellWorks.Data.Json.Internal.Doc import HaskellWorks.Data.Json.Internal.Slurp +import HaskellWorks.Data.Json.Standard.Cursor.Generic import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.AtLeastSize import HaskellWorks.Data.MQuery.Entry @@ -30,8 +30,8 @@ import HaskellWorks.Data.RankSelect.Base.Select1 import HaskellWorks.Data.TreeCursor import HaskellWorks.Data.Uncons -import Prelude hiding (drop) -import Prelude hiding (drop) +import Prelude hiding (drop) +import Prelude hiding (drop) import Text.PrettyPrint.ANSI.Leijen import qualified Data.ByteString as BS diff --git a/src/HaskellWorks/Data/Json/PartialValue.hs b/src/HaskellWorks/Data/Json/PartialValue.hs --- a/src/HaskellWorks/Data/Json/PartialValue.hs +++ b/src/HaskellWorks/Data/Json/PartialValue.hs @@ -23,13 +23,13 @@ import Control.Arrow import Data.String -import Data.Text (Text) +import Data.Text (Text) import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.Internal.Doc -import HaskellWorks.Data.Json.Internal.Orphans () +import HaskellWorks.Data.Json.Internal.Orphans () import HaskellWorks.Data.Json.Internal.PartialIndex import HaskellWorks.Data.Json.Internal.Value +import HaskellWorks.Data.Json.Standard.Cursor.Generic import HaskellWorks.Data.MQuery import HaskellWorks.Data.MQuery.AtLeastSize import HaskellWorks.Data.MQuery.Entry @@ -39,8 +39,8 @@ import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 -import Prelude hiding (drop) -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) +import Prelude hiding (drop) +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import qualified Data.Attoparsec.ByteString.Char8 as ABC import qualified Data.ByteString as BS diff --git a/src/HaskellWorks/Data/Json/Simple/Value.hs b/src/HaskellWorks/Data/Json/Simple/Value.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Simple/Value.hs @@ -0,0 +1,42 @@ +module HaskellWorks.Data.Json.Simple.Value where + +import Data.Maybe +import HaskellWorks.Data.Json.Simple.Cursor +import HaskellWorks.Data.Positioning +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Data.RankSelect.CsPoppy + +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.BalancedParens as BP +import qualified HaskellWorks.Data.BalancedParens.RangeMin as RM + +data JsonValue + = JsonValues JsonValues + | JsonNull + | JsonNumber Double + | JsonString String + | JsonBoolean Bool + deriving (Eq, Show) + +data JsonValues + = JsonArray [JsonValue] + | JsonObject [(String, JsonValue)] + deriving (Eq, Show) + +snippetPos :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> (Count, Count) +snippetPos k = (kpa, kpz) + where kpa = select1 kib kta + km + kpz = select1 kib ktz - km + kib = interests k + kbp = balancedParens k + kra = cursorRank k + krz = fromMaybe maxBound (BP.findClose kbp kra) + ksa = kra + 1 + ksz = krz + 1 + kta = ksa `div` 2 + ktz = ksz `div` 2 + km = ksa `mod` 2 + +snippet :: JsonCursor BS.ByteString CsPoppy (RM.RangeMin CsPoppy) -> BS.ByteString +snippet k = let (a, z) = snippetPos k in BS.take (fromIntegral (z - a + 1)) (BS.drop (fromIntegral (a - 1)) kt) + where kt = cursorText k diff --git a/src/HaskellWorks/Data/Json/Standard/Load/Partial.hs b/src/HaskellWorks/Data/Json/Standard/Load/Partial.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Json/Standard/Load/Partial.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.Json.Standard.Load.Partial + ( loadPartial + , loadPartialWithCsPoppyIndex + , loadPartialWithIndex + ) where + +import HaskellWorks.Data.BalancedParens.Simple +import HaskellWorks.Data.Bits.BitShown +import HaskellWorks.Data.Json.Internal.PartialIndex +import HaskellWorks.Data.Json.PartialValue +import HaskellWorks.Data.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Standard.Cursor.Load.Raw +import HaskellWorks.Data.RankSelect.CsPoppy + +loadPartialWithIndex :: String -> IO JsonPartialValue +loadPartialWithIndex filename = do + (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename + let cursor = GenericCursor jsonBS (BitShown jsonIb) (SimpleBalancedParens jsonBp) 1 + let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) + return jsonResult + +loadPartialWithCsPoppyIndex :: String -> IO JsonPartialValue +loadPartialWithCsPoppyIndex filename = do + (jsonBS, jsonIb, jsonBp) <- loadRawWithIndex filename + let cursor = GenericCursor jsonBS (makeCsPoppy jsonIb) (SimpleBalancedParens jsonBp) 1 + let !jsonResult = jsonPartialJsonValueAt (jsonPartialIndexAt cursor) + return jsonResult + +loadPartial :: String -> IO JsonPartialValue +loadPartial = loadPartialWithCsPoppyIndex diff --git a/test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs b/test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/Backend/Simple/CursorSpec.hs +++ /dev/null @@ -1,84 +0,0 @@ -{-# 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.Backend.Simple.CursorSpec - ( spec - ) where - -import Control.Monad -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -import qualified HaskellWorks.Data.Json.Backend.Simple.Cursor as Z -import qualified HaskellWorks.Data.Json.Backend.Simple.Fast as FAST -import qualified HaskellWorks.Data.Json.Backend.Simple.Value as V -import qualified HaskellWorks.Data.TreeCursor as TC - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} - -fc = TC.firstChild -ns = TC.nextSibling - -spec :: Spec -spec = describe "HaskellWorks.Data.Json.Backend.Simple.CursorSpec" $ do - describe "Json cursor" $ do - describe "For sample Json" $ do - let k = FAST.fromByteString "[[11],[22]]" - -- [ [ 1 1 ] , [ 2 2 ] ] - -- (( (( )) )( (( )) )) - it "can navigate" $ requireTest $ do - (Z.cursorRank <$> Just k) === Just 1 - (Z.cursorRank <$> ns k) === Nothing - (Z.cursorRank <$> fc k) === Just 2 - (Z.cursorRank <$> (fc >=> ns ) k) === Just 8 - (Z.cursorRank <$> (fc >=> ns >=> fc ) k) === Just 9 - (Z.cursorRank <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing - (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc ) k) === Just 10 - (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing - (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing - (Z.cursorRank <$> (fc >=> fc ) k) === Just 3 - (Z.cursorRank <$> (fc >=> fc >=> ns ) k) === Nothing - (Z.cursorRank <$> (fc >=> fc >=> fc ) k) === Just 4 - (Z.cursorRank <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing - (Z.cursorRank <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing - it "can snippet pos" $ requireTest $ do - (V.snippetPos <$> Just k) === Just (1, 11) - (V.snippetPos <$> ns k) === Nothing - (V.snippetPos <$> fc k) === Just (2, 5) - (V.snippetPos <$> (fc >=> ns ) k) === Just (7, 10) - (V.snippetPos <$> (fc >=> ns >=> fc ) k) === Just (7, 10) - (V.snippetPos <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing - (V.snippetPos <$> (fc >=> ns >=> fc >=> fc ) k) === Just (8, 9) - (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing - (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing - (V.snippetPos <$> (fc >=> fc ) k) === Just (2, 5) - (V.snippetPos <$> (fc >=> fc >=> ns ) k) === Nothing - (V.snippetPos <$> (fc >=> fc >=> fc ) k) === Just (3, 4) - (V.snippetPos <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing - (V.snippetPos <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing - it "can snippet" $ requireTest $ do - (V.snippet <$> Just k) === Just "[[11],[22]]" - (V.snippet <$> ns k) === Nothing - (V.snippet <$> fc k) === Just "[11]" - (V.snippet <$> (fc >=> ns ) k) === Just "[22]" - (V.snippet <$> (fc >=> ns >=> fc ) k) === Just "[22]" - (V.snippet <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing - (V.snippet <$> (fc >=> ns >=> fc >=> fc ) k) === Just "22" - (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing - (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing - (V.snippet <$> (fc >=> fc ) k) === Just "[11]" - (V.snippet <$> (fc >=> fc >=> ns ) k) === Nothing - (V.snippet <$> (fc >=> fc >=> fc ) k) === Just "11" - (V.snippet <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing - (V.snippet <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/BalancedParensSpec.hs +++ /dev/null @@ -1,43 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - - -module HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.BalancedParensSpec - ( spec - ) where - -import Data.Word -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Json.Backend.Standard.SemiIndex as SI - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} - -balancedParensOf2 :: BS.ByteString -> DVS.Vector Word64 -balancedParensOf2 bs = let SI.SemiIndex _ bp = SI.buildSemiIndex bs in bp - -spec :: Spec -spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec" $ do - it "Evaluating interest bits 2" $ requireTest $ do - bitShow (balancedParensOf2 "" ) === "" - bitShow (balancedParensOf2 " \n \r \t ") === "" - bitShow (balancedParensOf2 "1234 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "-1.1e-1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "false " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "true " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "\"\\\"\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "{ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "} " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "[ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 "] " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 ": " ) === "" - bitShow (balancedParensOf2 ", " ) === "" - bitShow (balancedParensOf2 "{{}}" ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (balancedParensOf2 " { { } } " ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/Cursor/InterestBitsSpec.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - - -module HaskellWorks.Data.Json.Backend.Standard.Succinct.Cursor.InterestBitsSpec(spec) where - -import Data.String -import Data.Word -import HaskellWorks.Data.Bits.BitShow -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -import qualified Data.ByteString as BS -import qualified Data.Vector.Storable as DVS -import qualified HaskellWorks.Data.Json.Backend.Standard.SemiIndex as SI -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.ToInterestBits64 as J - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} - -interestBitsOf :: BS.ByteString -> DVS.Vector Word64 -interestBitsOf bs = J.toInterestBits64 (J.toBlankedJsonTyped bs) - -interestBitsOf2 :: BS.ByteString -> DVS.Vector Word64 -interestBitsOf2 bs = let SI.SemiIndex ib _ = SI.buildSemiIndex bs in ib - -spec :: Spec -spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.InterestBitsSpec" $ do - it "Evaluating interest bits" $ requireTest $ do - BitShown (interestBitsOf "" ) === fromString "" - BitShown (interestBitsOf " \n \r \t ") === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "1234 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "1.1 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "-1.1e-2 " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "false " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "true " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "\"hello\" " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "\"\\\"\" " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "{ " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "} " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "[ " ) === fromString "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "] " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf ": " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf ", " ) === fromString "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf "{{}}" ) === fromString "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - BitShown (interestBitsOf " { { } } " ) === fromString "01010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - it "Evaluating interest bits 2" $ requireTest $ do - bitShow (interestBitsOf2 "" ) === "" - bitShow (interestBitsOf2 " \n \r \t ") === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "1234 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "-1.1 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "-1.1e-2 " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "false " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "true " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "\"hello\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "\"\\\"\" " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "{ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "} " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "[ " ) === "10000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "] " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 ": " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 ", " ) === "00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 "{{}}" ) === "11000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" - bitShow (interestBitsOf2 " { { } } " ) === "01010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000" diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/CursorSpec.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# 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.Backend.Standard.Succinct.CursorSpec(spec) where - -import HaskellWorks.Data.Json.Backend.Standard.Succinct.GenCursorTest -import Test.Hspec - -import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST -import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do - genTest "DVS.Vector Word64" SLOW.fromString - genTest "CsPoppy" FAST.fromString diff --git a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs b/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/Backend/Standard/Succinct/GenCursorTest.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# 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.Backend.Standard.Succinct.GenCursorTest(genTest) where - -import Control.Monad -import HaskellWorks.Data.BalancedParens.BalancedParens -import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Internal.Backend.Standard.Cursor.Token -import HaskellWorks.Data.Json.Internal.Index -import HaskellWorks.Data.Json.Internal.Token -import HaskellWorks.Data.RankSelect.Base.Rank0 -import HaskellWorks.Data.RankSelect.Base.Rank1 -import HaskellWorks.Data.RankSelect.Base.Select1 -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.TreeCursor as TC - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} - -fc = TC.firstChild -ns = TC.nextSibling -pn = TC.parent -ss = TC.subtreeSize - -genTest :: forall t u. - ( Eq t - , Show t - , Select1 t - , Eq u - , Show u - , Rank0 u - , Rank1 u - , BalancedParens u - , TestBit u) - => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () -genTest t mkCursor = do - describe ("Json cursor of type " ++ t) $ do - describe "For empty json array" $ do - let cursor = mkCursor "[null]" - it "can navigate down and forwards" $ requireTest $ do - jsonIndexAt cursor === Right (JsonIndexArray [JsonIndexNull]) - describe "For sample Json" $ do - let cursor = mkCursor "\ - \{ \ - \ \"widget\": { \ - \ \"debug\": \"on\", \ - \ \"window\": { \ - \ \"name\": \"main_window\", \ - \ \"dimensions\": [500, 600.01e-02, true, false, null] \ - \ } \ - \ } \ - \}" - it "can navigate up" $ requireTest $ do - ( pn) cursor === Nothing - (fc >=> pn) cursor === Just cursor - (fc >=> ns >=> pn) cursor === Just cursor - (fc >=> ns >=> fc >=> pn) cursor === (fc >=> ns ) cursor - (fc >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns ) cursor - (fc >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor - it "can get subtree size" $ requireTest $ do - ( ss) cursor === Just 16 - (fc >=> ss) cursor === Just 1 - (fc >=> ns >=> ss) cursor === Just 14 - (fc >=> ns >=> fc >=> ss) cursor === Just 1 - (fc >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 - (fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 10 - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor === Just 1 - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6 - it "can get token at cursor" $ requireTest $ do - (jsonTokenAt ) cursor === Just (JsonTokenBraceL ) - (fc >=> jsonTokenAt) cursor === Just (JsonTokenString "widget" ) - (fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBraceL ) - (fc >=> ns >=> fc >=> jsonTokenAt) cursor === Just (JsonTokenString "debug" ) - (fc >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "on" ) - (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "window" ) - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBraceL ) - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTokenAt) cursor === Just (JsonTokenString "name" ) - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "main_window" ) - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "dimensions" ) - (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBracketL ) diff --git a/test/HaskellWorks/Data/Json/CorpusSpec.hs b/test/HaskellWorks/Data/Json/CorpusSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/CorpusSpec.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# 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.CorpusSpec(spec) where - -import Control.Monad.IO.Class -import HaskellWorks.Data.BalancedParens.Simple -import HaskellWorks.Data.Bits.FromBitTextByteString -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.Json.Corpus" $ do - it "Corpus 5000B loads properly" $ requireTest $ do - inJsonBS <- liftIO $ BS.readFile "corpus/5000B.json" - inInterestBitsBS <- liftIO $ BS.readFile "corpus/5000B.json.ib.idx" - inInterestBalancedParensBS <- liftIO $ BS.readFile "corpus/5000B.json.bp.idx" - let inInterestBits = fromBitTextByteString inInterestBitsBS - let inInterestBalancedParens = fromBitTextByteString inInterestBalancedParensBS - let !cursor = SLOW.fromByteString inJsonBS - let text = cursorText cursor - let ib = interests cursor - let SimpleBalancedParens bp = balancedParens cursor - text === inJsonBS - ib === inInterestBits - bp === inInterestBalancedParens - it "issue-0001 loads properly" $ requireTest $ do - inJsonBS <- liftIO $ BS.readFile "corpus/issue-0001.json" - inInterestBitsBS <- liftIO $ BS.readFile "corpus/issue-0001.json.ib.idx" - inInterestBalancedParensBS <- liftIO $ BS.readFile "corpus/issue-0001.json.bp.idx" - let inInterestBits = fromBitTextByteString inInterestBitsBS - let inInterestBalancedParens = fromBitTextByteString inInterestBalancedParensBS - let !cursor = SLOW.fromByteString inJsonBS - let text = cursorText cursor - let ib = interests cursor - let SimpleBalancedParens bp = balancedParens cursor - text === inJsonBS - ib === inInterestBits - bp === inInterestBalancedParens diff --git a/test/HaskellWorks/Data/Json/Internal/BlankSpec.hs b/test/HaskellWorks/Data/Json/Internal/BlankSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/Internal/BlankSpec.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module HaskellWorks.Data.Json.Internal.BlankSpec (spec) where - -import HaskellWorks.Data.Json.Internal.Backend.Standard.Blank -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -import qualified Data.ByteString as BS - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} - -whenBlankedJsonShouldBe :: BS.ByteString -> BS.ByteString -> Spec -whenBlankedJsonShouldBe original expected = do - it (show original ++ " when blanked json should be " ++ show expected) $ requireTest $ do - BS.concat (blankJson [original]) === expected - -spec :: Spec -spec = describe "HaskellWorks.Data.Json.Internal.BlankSpec" $ do - describe "Can blank json" $ do - "\"\"" `whenBlankedJsonShouldBe` "()" - "\"\\\\\"" `whenBlankedJsonShouldBe` "( )" - "\"\\\\\\\"" `whenBlankedJsonShouldBe` "( " - "\" \\\\\\\"" `whenBlankedJsonShouldBe` "( " - "\" \\n\\\\\"" `whenBlankedJsonShouldBe` "( )" - "" `whenBlankedJsonShouldBe` "" - "\"\"" `whenBlankedJsonShouldBe` "()" - "\" \"" `whenBlankedJsonShouldBe` "( )" - "\" a \"" `whenBlankedJsonShouldBe` "( )" - " \"a \" x" `whenBlankedJsonShouldBe` " ( ) x" - " \"\"\"\" " `whenBlankedJsonShouldBe` " ()() " - " [][] " `whenBlankedJsonShouldBe` " [][] " - " {}{} " `whenBlankedJsonShouldBe` " {}{} " - " \"a\"b\"c\"d" `whenBlankedJsonShouldBe` " ( )b( )d" - "" `whenBlankedJsonShouldBe` "" - "1" `whenBlankedJsonShouldBe` "1" - "11" `whenBlankedJsonShouldBe` "10" - "00" `whenBlankedJsonShouldBe` "10" - "00" `whenBlankedJsonShouldBe` "10" - "-0.12e+34" `whenBlankedJsonShouldBe` "100000000" - "10.12E-34 " `whenBlankedJsonShouldBe` "100000000 " - "10.12E-34 12" `whenBlankedJsonShouldBe` "100000000 10" - " 10.12E-34 -1" `whenBlankedJsonShouldBe` " 100000000 10" - "" `whenBlankedJsonShouldBe` "" - "a" `whenBlankedJsonShouldBe` "a" - "z" `whenBlankedJsonShouldBe` "z" - " Aaa " `whenBlankedJsonShouldBe` " A__ " - " Za def " `whenBlankedJsonShouldBe` " Z_ d__ " - "" `whenBlankedJsonShouldBe` "" - " { \"ff\": 1.0, [\"\", true], null}" `whenBlankedJsonShouldBe` " { ( ): 100, [(), t___], n___}" diff --git a/test/HaskellWorks/Data/Json/Simple/CursorSpec.hs b/test/HaskellWorks/Data/Json/Simple/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Json/Simple/CursorSpec.hs @@ -0,0 +1,84 @@ +{-# 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.Simple.CursorSpec + ( spec + ) where + +import Control.Monad +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified HaskellWorks.Data.Json.Simple.Cursor as Z +import qualified HaskellWorks.Data.Json.Simple.Cursor.Fast as FAST +import qualified HaskellWorks.Data.Json.Simple.Value as V +import qualified HaskellWorks.Data.TreeCursor as TC + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} + +fc = TC.firstChild +ns = TC.nextSibling + +spec :: Spec +spec = describe "HaskellWorks.Data.Json.Backend.Simple.CursorSpec" $ do + describe "Json cursor" $ do + describe "For sample Json" $ do + let k = FAST.fromByteString "[[11],[22]]" + -- [ [ 1 1 ] , [ 2 2 ] ] + -- (( (( )) )( (( )) )) + it "can navigate" $ requireTest $ do + (Z.cursorRank <$> Just k) === Just 1 + (Z.cursorRank <$> ns k) === Nothing + (Z.cursorRank <$> fc k) === Just 2 + (Z.cursorRank <$> (fc >=> ns ) k) === Just 8 + (Z.cursorRank <$> (fc >=> ns >=> fc ) k) === Just 9 + (Z.cursorRank <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc ) k) === Just 10 + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (Z.cursorRank <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (Z.cursorRank <$> (fc >=> fc ) k) === Just 3 + (Z.cursorRank <$> (fc >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> fc >=> fc ) k) === Just 4 + (Z.cursorRank <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (Z.cursorRank <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can snippet pos" $ requireTest $ do + (V.snippetPos <$> Just k) === Just (1, 11) + (V.snippetPos <$> ns k) === Nothing + (V.snippetPos <$> fc k) === Just (2, 5) + (V.snippetPos <$> (fc >=> ns ) k) === Just (7, 10) + (V.snippetPos <$> (fc >=> ns >=> fc ) k) === Just (7, 10) + (V.snippetPos <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (V.snippetPos <$> (fc >=> ns >=> fc >=> fc ) k) === Just (8, 9) + (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (V.snippetPos <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (V.snippetPos <$> (fc >=> fc ) k) === Just (2, 5) + (V.snippetPos <$> (fc >=> fc >=> ns ) k) === Nothing + (V.snippetPos <$> (fc >=> fc >=> fc ) k) === Just (3, 4) + (V.snippetPos <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (V.snippetPos <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing + it "can snippet" $ requireTest $ do + (V.snippet <$> Just k) === Just "[[11],[22]]" + (V.snippet <$> ns k) === Nothing + (V.snippet <$> fc k) === Just "[11]" + (V.snippet <$> (fc >=> ns ) k) === Just "[22]" + (V.snippet <$> (fc >=> ns >=> fc ) k) === Just "[22]" + (V.snippet <$> (fc >=> ns >=> fc >=> ns ) k) === Nothing + (V.snippet <$> (fc >=> ns >=> fc >=> fc ) k) === Just "22" + (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> ns) k) === Nothing + (V.snippet <$> (fc >=> ns >=> fc >=> fc >=> fc) k) === Nothing + (V.snippet <$> (fc >=> fc ) k) === Just "[11]" + (V.snippet <$> (fc >=> fc >=> ns ) k) === Nothing + (V.snippet <$> (fc >=> fc >=> fc ) k) === Just "11" + (V.snippet <$> (fc >=> fc >=> fc >=> ns ) k) === Nothing + (V.snippet <$> (fc >=> fc >=> fc >=> fc ) k) === Nothing diff --git a/test/HaskellWorks/Data/Json/Standard/CursorSpec.hs b/test/HaskellWorks/Data/Json/Standard/CursorSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Json/Standard/CursorSpec.hs @@ -0,0 +1,27 @@ +{-# 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.Standard.CursorSpec(spec) where + +import HaskellWorks.Data.Json.Standard.GenCursorTest +import Test.Hspec + +import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST +import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} + +spec :: Spec +spec = describe "HaskellWorks.Data.Json.Succinct.CursorSpec" $ do + genTest "DVS.Vector Word64" SLOW.fromString + genTest "CsPoppy" FAST.fromString diff --git a/test/HaskellWorks/Data/Json/Standard/GenCursorTest.hs b/test/HaskellWorks/Data/Json/Standard/GenCursorTest.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Json/Standard/GenCursorTest.hs @@ -0,0 +1,103 @@ +{-# 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.Standard.GenCursorTest(genTest) where + +import Control.Monad +import HaskellWorks.Data.BalancedParens.BalancedParens +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Json.Internal.Index +import HaskellWorks.Data.Json.Internal.Standard.Cursor.Token +import HaskellWorks.Data.Json.Internal.Token +import HaskellWorks.Data.Json.Standard.Cursor.Generic +import HaskellWorks.Data.RankSelect.Base.Rank0 +import HaskellWorks.Data.RankSelect.Base.Rank1 +import HaskellWorks.Data.RankSelect.Base.Select1 +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.TreeCursor as TC + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{-# ANN module ("HLint: ignore Redundant bracket" :: String) #-} + +fc = TC.firstChild +ns = TC.nextSibling +pn = TC.parent +ss = TC.subtreeSize + +genTest :: forall t u. + ( Eq t + , Show t + , Select1 t + , Eq u + , Show u + , Rank0 u + , Rank1 u + , BalancedParens u + , TestBit u) + => String -> (String -> GenericCursor BS.ByteString t u) -> SpecWith () +genTest t mkCursor = do + describe ("Json cursor of type " ++ t) $ do + describe "For empty json array" $ do + let cursor = mkCursor "[null]" + it "can navigate down and forwards" $ requireTest $ do + jsonIndexAt cursor === Right (JsonIndexArray [JsonIndexNull]) + describe "For sample Json" $ do + let cursor = mkCursor "\ + \{ \ + \ \"widget\": { \ + \ \"debug\": \"on\", \ + \ \"window\": { \ + \ \"name\": \"main_window\", \ + \ \"dimensions\": [500, 600.01e-02, true, false, null] \ + \ } \ + \ } \ + \}" + it "can navigate up" $ requireTest $ do + ( pn) cursor === Nothing + (fc >=> pn) cursor === Just cursor + (fc >=> ns >=> pn) cursor === Just cursor + (fc >=> ns >=> fc >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns ) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> pn) cursor === (fc >=> ns >=> fc >=> ns >=> ns >=> ns) cursor + it "can get subtree size" $ requireTest $ do + ( ss) cursor === Just 16 + (fc >=> ss) cursor === Just 1 + (fc >=> ns >=> ss) cursor === Just 14 + (fc >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 10 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ss) cursor === Just 1 + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> ss) cursor === Just 6 + it "can get token at cursor" $ requireTest $ do + (jsonTokenAt ) cursor === Just (JsonTokenBraceL ) + (fc >=> jsonTokenAt) cursor === Just (JsonTokenString "widget" ) + (fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBraceL ) + (fc >=> ns >=> fc >=> jsonTokenAt) cursor === Just (JsonTokenString "debug" ) + (fc >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "on" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBraceL ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> jsonTokenAt) cursor === Just (JsonTokenString "name" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "main_window" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenString "dimensions" ) + (fc >=> ns >=> fc >=> ns >=> ns >=> ns >=> fc >=> ns >=> ns >=> ns >=> jsonTokenAt) cursor === Just (JsonTokenBracketL ) diff --git a/test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs b/test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs deleted file mode 100644 --- a/test/HaskellWorks/Data/Json/Succinct/Cursor/BalancedParensSpec.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - -module HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec(spec) where - -import Data.String -import HaskellWorks.Data.Bits.BitShown -import HaskellWorks.Data.Json.Internal.Backend.Standard.MakeIndex -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Internal.Backend.Standard.BlankedJson as J - -{-# ANN module ("HLint: Ignore Redundant do" :: String) #-} - -spec :: Spec -spec = describe "HaskellWorks.Data.Json.Succinct.Cursor.BalancedParensSpec" $ do - it "Blanking JSON should not contain strange characters 1" $ requireTest $ do - let blankedJson = J.BlankedJson ["[ [],", "[]]"] - let bp = BitShown $ BS.concat (blankedJsonToBalancedParens (J.unBlankedJson blankedJson)) - bp === fromString "11111111 11111111 00000000 11111111 00000000 00000000" - it "Blanking JSON should not contain strange characters 2" $ requireTest $ do - let blankedJson = J.BlankedJson ["[ [],", "[]]"] - let bp = BitShown $ BS.concat ((compressWordAsBit . blankedJsonToBalancedParens) (J.unBlankedJson blankedJson)) - bp === fromString "11010000" diff --git a/test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs b/test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs --- a/test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs +++ b/test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs @@ -2,8 +2,8 @@ module HaskellWorks.Data.Json.Token.TokenizeSpec (spec) where -import Data.ByteString (ByteString) -import HaskellWorks.Data.Json.Internal.Backend.Standard.Token.Tokenize +import Data.ByteString (ByteString) +import HaskellWorks.Data.Json.Internal.Standard.Token.Tokenize import HaskellWorks.Hspec.Hedgehog import Hedgehog import Test.Hspec diff --git a/test/HaskellWorks/Data/Json/TypeSpec.hs b/test/HaskellWorks/Data/Json/TypeSpec.hs --- a/test/HaskellWorks/Data/Json/TypeSpec.hs +++ b/test/HaskellWorks/Data/Json/TypeSpec.hs @@ -14,8 +14,8 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic -import HaskellWorks.Data.Json.Type +import HaskellWorks.Data.Json.Standard.Cursor.Generic +import HaskellWorks.Data.Json.Standard.Cursor.Type import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 import HaskellWorks.Data.RankSelect.Base.Select1 @@ -23,10 +23,10 @@ import Hedgehog import Test.Hspec -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST -import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW -import qualified HaskellWorks.Data.TreeCursor as TC +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST +import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW +import qualified HaskellWorks.Data.TreeCursor as TC {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} diff --git a/test/HaskellWorks/Data/Json/ValueSpec.hs b/test/HaskellWorks/Data/Json/ValueSpec.hs --- a/test/HaskellWorks/Data/Json/ValueSpec.hs +++ b/test/HaskellWorks/Data/Json/ValueSpec.hs @@ -14,9 +14,9 @@ import Control.Monad import HaskellWorks.Data.BalancedParens.BalancedParens import HaskellWorks.Data.Bits.BitWise -import HaskellWorks.Data.Json.Backend.Standard.Cursor.Generic import HaskellWorks.Data.Json.DecodeError import HaskellWorks.Data.Json.Internal.Index +import HaskellWorks.Data.Json.Standard.Cursor.Generic import HaskellWorks.Data.Json.Value import HaskellWorks.Data.RankSelect.Base.Rank0 import HaskellWorks.Data.RankSelect.Base.Rank1 @@ -25,10 +25,10 @@ import Hedgehog import Test.Hspec -import qualified Data.ByteString as BS -import qualified HaskellWorks.Data.Json.Backend.Standard.Fast as FAST -import qualified HaskellWorks.Data.Json.Backend.Standard.Slow as SLOW -import qualified HaskellWorks.Data.TreeCursor as TC +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as FAST +import qualified HaskellWorks.Data.Json.Standard.Cursor.Slow as SLOW +import qualified HaskellWorks.Data.TreeCursor as TC {-# ANN module ("HLint: ignore Redundant do" :: String) #-} {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}