hw-succinct 0.0.0.12 → 0.0.0.13

raw patch · 10 files changed

+237/−114 lines, 10 filesdep +containersdep +word8PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers, word8

API changes (from Hackage documentation)

Files

• hw-succinct.cabal +6/−1
• src/HaskellWorks/Data/Json/Succinct/Cursor/FromJsonCursor.hs +33/−0
• src/HaskellWorks/Data/Json/Succinct/Cursor/Internal.hs +37/−0
• src/HaskellWorks/Data/Json/Succinct/Cursor/Token.hs +1/−1
• src/HaskellWorks/Data/Json/Token.hs +2/−2
• src/HaskellWorks/Data/Json/Token/Tokenize.hs +122/−79
• src/HaskellWorks/Data/Json/Token/Types.hs +4/−30
• src/HaskellWorks/Data/Json/Type.hs +15/−0
• src/HaskellWorks/Data/Json/Value.hs +16/−0
• test/HaskellWorks/Data/Json/Token/TokenizeSpec.hs +1/−1

@@ -1,5 +1,5 @@ name:                   hw-succinct-version:                0.0.0.12+version:                0.0.0.13 synopsis:               Conduits for tokenizing streams. description:            Please see README.md homepage:               http://github.com/haskell-works/hw-succinct#readme@@ -41,17 +41,21 @@                       , HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens                       , HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson                       , HaskellWorks.Data.Json.Succinct.Cursor.CursorType+                      , HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor                       , HaskellWorks.Data.Json.Succinct.Cursor.InterestBits                       , HaskellWorks.Data.Json.Succinct.Cursor.Internal                       , HaskellWorks.Data.Json.Succinct.Cursor.Token                       , HaskellWorks.Data.Json.Token.Tokenize                       , HaskellWorks.Data.Json.Token.Types                       , HaskellWorks.Data.Json.Token+                      , HaskellWorks.Data.Json.Type+                      , HaskellWorks.Data.Json.Value                       , HaskellWorks.Data.Succinct   build-depends:        base                            >= 4.7  && < 5                       , attoparsec                       , bytestring                       , conduit+                      , containers                       , hw-bits                       , hw-conduit                       , hw-parser@@ -60,6 +64,7 @@                       , mono-traversable                       , text                       , vector+                      , word8    default-language:     Haskell2010   ghc-options:          -rtsopts -with-rtsopts=-N -Wall -O2 -Wall -msse4.2

@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE MultiParamTypeClasses  #-}++module HaskellWorks.Data.Json.Succinct.Cursor.FromJsonCursor where++import qualified Data.ByteString as BS+import           HaskellWorks.Data.Bits.BitWise+import           HaskellWorks.Data.Json.Succinct.Cursor.Internal+import           HaskellWorks.Data.Json.Succinct.Cursor.Token+import           HaskellWorks.Data.Json.Value+import           HaskellWorks.Data.Json.Token.Types+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1+import           HaskellWorks.Data.TreeCursor++class FromJsonCursor t v w a where+  fromJsonCursor :: JsonCursor t v w -> a++instance (TreeCursor (JsonCursor BS.ByteString v w), Rank1 w, Select1 v, TestBit w) => FromJsonCursor BS.ByteString v w (JsonValue BS.ByteString BS.ByteString) where+  fromJsonCursor k = case jsonTokenAt k of+    Just JsonTokenBraceL          -> undefined+    Just JsonTokenBraceR          -> undefined+    Just JsonTokenBracketL        -> undefined+    Just JsonTokenBracketR        -> undefined+    Just JsonTokenComma           -> undefined+    Just JsonTokenColon           -> undefined+    Just JsonTokenWhitespace      -> undefined+    Just (JsonTokenString _)      -> undefined+    Just (JsonTokenBoolean value) -> JsonBool value+    Just (JsonTokenNumber _)      -> undefined+    Just JsonTokenNull            -> undefined+    Nothing                       -> undefined

@@ -13,19 +13,24 @@ import           Data.String import qualified Data.Vector.Storable                                  as DVS import           Data.Word+import           Data.Word8 import           Foreign.ForeignPtr import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Bits.BitWise import           HaskellWorks.Data.FromByteString import           HaskellWorks.Data.FromForeignRegion import           HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens import           HaskellWorks.Data.Json.Succinct.Cursor.BlankedJson import           HaskellWorks.Data.Json.Succinct.Cursor.InterestBits+import           HaskellWorks.Data.Json.Type+import           HaskellWorks.Data.Json.Value import           HaskellWorks.Data.Positioning import           HaskellWorks.Data.Succinct.BalancedParens             as BP import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0 import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1 import           HaskellWorks.Data.Succinct.RankSelect.Binary.Poppy512 import           HaskellWorks.Data.TreeCursor+import           HaskellWorks.Data.Vector.VectorLike  data JsonCursor t v w = JsonCursor   { cursorText     :: !t@@ -102,3 +107,35 @@    subtreeSize :: JsonCursor t v u -> Count   subtreeSize k = BP.subtreeSize (balancedParens k) (cursorRank k)++wIsJsonNumberDigit :: Word8 -> Bool+wIsJsonNumberDigit w = (w >= _0 && w <= _9) || w == _hyphen++instance TestBit w => JsonTypeAt (JsonCursor BS.ByteString v w) where+  jsonTypeAtPosition p k = if balancedParens k .?. p+    then case cursorText k !!! p of+      c | c == _bracketleft     -> Just JsonTypeArray+      c | c == _t               -> Just JsonTypeBool+      c | c == _n               -> Just JsonTypeNull+      c | wIsJsonNumberDigit c  -> Just JsonTypeNumber+      c | c == _braceleft       -> Just JsonTypeObject+      c | c == _quotedbl        -> Just JsonTypeString+      _                         -> Nothing+    else Nothing++  jsonTypeAt k = jsonTypeAtPosition (lastPositionOf (cursorRank k)) k++instance TestBit w => JsonValueAt BS.ByteString BS.ByteString (JsonCursor BS.ByteString v w) where+  jsonValueAt :: JsonCursor BS.ByteString v w -> Maybe (JsonValue BS.ByteString BS.ByteString)+  jsonValueAt k = case jsonTypeAtPosition p k of+    Just JsonTypeArray  -> error "Not Implemented"+    Just JsonTypeBool   -> case cursorText k !!! p of+      c | c == _t -> Just $ JsonBool True+      c | c == _t -> Just $ JsonBool False+      _           -> Nothing+    Just JsonTypeNull   -> Just JsonNull+    Just JsonTypeNumber -> error "Not Implemented"+    Just JsonTypeObject -> error "Not Implemented"+    Just JsonTypeString -> error "Not Implemented"+    Nothing             -> Nothing+    where p = lastPositionOf (cursorRank k)

@@ -14,7 +14,7 @@ import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1 import           HaskellWorks.Data.Vector.VectorLike -jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => JsonCursor ByteString v w -> Maybe JsonToken+jsonTokenAt :: (Rank1 w, Select1 v, TestBit w) => JsonCursor ByteString v w -> Maybe (JsonToken String Double) jsonTokenAt k = if balancedParens k .?. lastPositionOf (cursorRank k)   then case ABC.parse parseJsonToken (vDrop (toCount (jsonCursorPos k)) (cursorText k)) of     ABC.Fail    {}  -> error "Failed to parse token in cursor"

@@ -2,5 +2,5 @@   ( module X   ) where -  import           HaskellWorks.Data.Json.Token.Types as X-  import           HaskellWorks.Data.Json.Token.Tokenize as X+import           HaskellWorks.Data.Json.Token.Types     as X+import           HaskellWorks.Data.Json.Token.Tokenize  as X

@@ -1,25 +1,27 @@-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverloadedStrings      #-}+{-# LANGUAGE TypeSynonymInstances   #-}  module HaskellWorks.Data.Json.Token.Tokenize     ( IsChar(..)     , JsonToken(..)-    , parseJsonToken-    , parseJsonTokenString-    , escapedChar+    , ParseJson(..)     ) where  import           Control.Applicative-import           Control.Monad 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           Data.Bits import           Data.Char-import           Data.String-import           HaskellWorks.Data.Parser           as P+import           Data.Word+import           Data.Word8 import           HaskellWorks.Data.Char.IsChar import           HaskellWorks.Data.Json.Token.Types+import           HaskellWorks.Data.Parser           as P  hexDigitNumeric :: P.Parser t => T.Parser t Int hexDigitNumeric = do@@ -39,83 +41,124 @@ hexDigit :: P.Parser t => T.Parser t Int hexDigit = hexDigitNumeric <|> hexDigitAlphaLower <|> hexDigitAlphaUpper -verbatimChar :: P.Parser t => T.Parser t Char-verbatimChar  = satisfyChar (BC.notInClass "\"\\") <?> "invalid string character"--escapedChar :: (IsString t, P.Parser t) => T.Parser t Char-escapedChar   = do-  _ <- string "\\"-  (   char '"'  >> return '"'  ) <|>-    ( char 'b'  >> return '\b' ) <|>-    ( char 'n'  >> return '\n' ) <|>-    ( char 'f'  >> return '\f' ) <|>-    ( char 'r'  >> return '\r' ) <|>-    ( char 't'  >> return '\t' ) <|>-    ( char '\\' >> return '\\' ) <|>-    ( char '\'' >> return '\'' ) <|>-    ( char '/'  >> return '/'  )--escapedCode :: (IsString t, P.Parser t) => T.Parser t Char-escapedCode   = do-  _ <- string "\\u"-  a <- hexDigit-  b <- hexDigit-  c <- hexDigit-  d <- hexDigit-  return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d--parseJsonTokenString :: (JsonTokenLike j, P.Parser t, Alternative (T.Parser t), IsString t) => T.Parser t j-parseJsonTokenString = do-  _ <- string "\""-  value <- many (verbatimChar <|> escapedChar <|> escapedCode)-  _ <- string "\""-  return $ jsonTokenString value--parseJsonTokenBraceL :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenBraceL = string "{" >> return jsonTokenBraceL--parseJsonTokenBraceR :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenBraceR = string "}" >> return jsonTokenBraceR+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) -parseJsonTokenBracketL :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenBracketL = string "[" >> return jsonTokenBracketL+  parseJsonToken =+    parseJsonTokenString     <|>+    parseJsonTokenBraceL     <|>+    parseJsonTokenBraceR     <|>+    parseJsonTokenBracketL   <|>+    parseJsonTokenBracketR   <|>+    parseJsonTokenComma      <|>+    parseJsonTokenColon      <|>+    parseJsonTokenWhitespace <|>+    parseJsonTokenNull       <|>+    parseJsonTokenBoolean    <|>+    parseJsonTokenDouble -parseJsonTokenBracketR :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenBracketR = string "]" >> return jsonTokenBracketR+instance ParseJson BS.ByteString String Double where+  parseJsonTokenBraceL = string "{" >> return JsonTokenBraceL+  parseJsonTokenBraceR = string "}" >> return JsonTokenBraceR+  parseJsonTokenBracketL = string "[" >> return JsonTokenBracketL+  parseJsonTokenBracketR = string "]" >> return JsonTokenBracketR+  parseJsonTokenComma = string "," >> return JsonTokenComma+  parseJsonTokenColon = string ":" >> return JsonTokenColon+  parseJsonTokenNull = string "null" >> return JsonTokenNull+  parseJsonTokenDouble = JsonTokenNumber <$> rational -parseJsonTokenComma :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenComma = string "," >> return jsonTokenComma+  parseJsonTokenString = do+    _ <- string "\""+    value <- many (verbatimChar <|> escapedChar <|> escapedCode)+    _ <- string "\""+    return $ JsonTokenString value+    where+      verbatimChar  = satisfyChar (BC.notInClass "\"\\") <?> "invalid string character"+      escapedChar   = do+        _ <- string "\\"+        (   char '"'  >> return '"'  ) <|>+          ( char 'b'  >> return '\b' ) <|>+          ( char 'n'  >> return '\n' ) <|>+          ( char 'f'  >> return '\f' ) <|>+          ( char 'r'  >> return '\r' ) <|>+          ( char 't'  >> return '\t' ) <|>+          ( char '\\' >> return '\\' ) <|>+          ( char '\'' >> return '\'' ) <|>+          ( char '/'  >> return '/'  )+      escapedCode   = do+        _ <- string "\\u"+        a <- hexDigit+        b <- hexDigit+        c <- hexDigit+        d <- hexDigit+        return $ chr $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d -parseJsonTokenColon :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenColon = string ":" >> return jsonTokenColon+  parseJsonTokenWhitespace = do+    _ <- AC.many1' $ BC.choice [string " ", string "\t", string "\n", string "\r"]+    return JsonTokenWhitespace -parseJsonTokenWhitespace :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenWhitespace = do-  _ <- AC.many1' $ BC.choice [string " ", string "\t", string "\n", string "\r"]-  return jsonTokenWhitespace+  parseJsonTokenBoolean = true <|> false+    where+      true  = string "true"   >> return (JsonTokenBoolean True)+      false = string "false"  >> return (JsonTokenBoolean False) -parseJsonTokenNull :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenNull = string "null" >> return jsonTokenNull+instance ParseJson BS.ByteString BS.ByteString Double where+  parseJsonTokenBraceL = string "{" >> return JsonTokenBraceL+  parseJsonTokenBraceR = string "}" >> return JsonTokenBraceR+  parseJsonTokenBracketL = string "[" >> return JsonTokenBracketL+  parseJsonTokenBracketR = string "]" >> return JsonTokenBracketR+  parseJsonTokenComma = string "," >> return JsonTokenComma+  parseJsonTokenColon = string ":" >> return JsonTokenColon+  parseJsonTokenNull = string "null" >> return JsonTokenNull+  parseJsonTokenDouble = JsonTokenNumber <$> rational -parseJsonTokenBoolean :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenBoolean = true <|> false-  where-    true  = string "true"   >> return (jsonTokenBoolean True)-    false = string "false"  >> return (jsonTokenBoolean False)+  parseJsonTokenString = do+    _ <- string "\""+    value <- many (verbatimChar <|> escapedChar <|> escapedCode)+    _ <- string "\""+    return $ JsonTokenString $ BS.pack value+    where+      word :: Word8 -> T.Parser BS.ByteString Word8+      word w = satisfy (== w)+      verbatimChar :: T.Parser BS.ByteString Word8+      verbatimChar  = satisfy (\w -> w /= _quotedbl && w /= _backslash) -- <?> "invalid string character"+      escapedChar :: T.Parser BS.ByteString Word8+      escapedChar   = do+        _ <- 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+        _ <- string "\\u"+        a <- hexDigit+        b <- hexDigit+        c <- hexDigit+        d <- hexDigit+        return $ fromIntegral $ a `shift` 24 .|. b `shift` 16 .|. c `shift` 8 .|. d -parseJsonTokenDouble :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonTokenDouble = liftM jsonTokenNumber rational+  parseJsonTokenWhitespace = do+    _ <- AC.many1' $ BC.choice [string " ", string "\t", string "\n", string "\r"]+    return JsonTokenWhitespace -parseJsonToken :: (JsonTokenLike j, P.Parser t, IsString t) => T.Parser t j-parseJsonToken =-  parseJsonTokenString     <|>-  parseJsonTokenBraceL     <|>-  parseJsonTokenBraceR     <|>-  parseJsonTokenBracketL   <|>-  parseJsonTokenBracketR   <|>-  parseJsonTokenComma      <|>-  parseJsonTokenColon      <|>-  parseJsonTokenWhitespace <|>-  parseJsonTokenNull       <|>-  parseJsonTokenBoolean    <|>-  parseJsonTokenDouble+  parseJsonTokenBoolean = true <|> false+    where+      true  = string "true"   >> return (JsonTokenBoolean True)+      false = string "false"  >> return (JsonTokenBoolean False)

@@ -1,19 +1,6 @@-module HaskellWorks.Data.Json.Token.Types (JsonToken(..), JsonTokenLike(..)) where--class JsonTokenLike j where-  jsonTokenBraceL     :: j-  jsonTokenBraceR     :: j-  jsonTokenBracketL   :: j-  jsonTokenBracketR   :: j-  jsonTokenComma      :: j-  jsonTokenColon      :: j-  jsonTokenWhitespace :: j-  jsonTokenString     :: String -> j-  jsonTokenBoolean    :: Bool -> j-  jsonTokenNumber     :: Double -> j-  jsonTokenNull       :: j+module HaskellWorks.Data.Json.Token.Types (JsonToken(..)) where -data JsonToken+data JsonToken s d   = JsonTokenBraceL   | JsonTokenBraceR   | JsonTokenBracketL@@ -21,21 +8,8 @@   | JsonTokenComma   | JsonTokenColon   | JsonTokenWhitespace-  | JsonTokenString String+  | JsonTokenString s   | JsonTokenBoolean Bool-  | JsonTokenNumber Double+  | JsonTokenNumber d   | JsonTokenNull   deriving (Eq, Show)--instance JsonTokenLike JsonToken where-  jsonTokenBraceL     = JsonTokenBraceL-  jsonTokenBraceR     = JsonTokenBraceR-  jsonTokenBracketL   = JsonTokenBracketL-  jsonTokenBracketR   = JsonTokenBracketR-  jsonTokenComma      = JsonTokenComma-  jsonTokenColon      = JsonTokenColon-  jsonTokenWhitespace = JsonTokenWhitespace-  jsonTokenString     = JsonTokenString-  jsonTokenBoolean    = JsonTokenBoolean-  jsonTokenNumber     = JsonTokenNumber-  jsonTokenNull       = JsonTokenNull

@@ -0,0 +1,15 @@+module HaskellWorks.Data.Json.Type where++import HaskellWorks.Data.Positioning++data JsonType+  = JsonTypeArray+  | JsonTypeBool+  | JsonTypeNull+  | JsonTypeNumber+  | JsonTypeObject+  | JsonTypeString++class JsonTypeAt a where+  jsonTypeAtPosition :: Position -> a -> Maybe JsonType+  jsonTypeAt :: a -> Maybe JsonType

@@ -0,0 +1,16 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Json.Value where++import Data.Map++data JsonValue s n+  = JsonString s+  | JsonNumber n+  | JsonObject (Map s (JsonValue s n))+  | JsonArray [JsonValue s n]+  | JsonBool Bool+  | JsonNull++class JsonValueAt s n a where+  jsonValueAt :: a -> Maybe (JsonValue s n)

@@ -9,7 +9,7 @@  {-# ANN module ("HLint: ignore Redundant do"        :: String) #-} -parseJsonToken' :: ByteString -> Either String JsonToken+parseJsonToken' :: ByteString -> Either String (JsonToken String Double) parseJsonToken' = BC.parseOnly parseJsonToken  spec :: Spec