Partial JSON support

hw-json.cabal

@@ -44,6 +44,7 @@ library
                       , HaskellWorks.Data.Json.Conduit.Blank
                       , HaskellWorks.Data.Json.Conduit.Words
                       , HaskellWorks.Data.Json.FromValue
+                      , HaskellWorks.Data.Json.PartialValue
                       , HaskellWorks.Data.Json.Succinct
                       , HaskellWorks.Data.Json.Succinct.Cursor
                       , HaskellWorks.Data.Json.Succinct.Cursor.BalancedParens
@@ -52,6 +53,7 @@ library
                       , HaskellWorks.Data.Json.Succinct.Cursor.Internal
                       , HaskellWorks.Data.Json.Succinct.Cursor.Token
                       , HaskellWorks.Data.Json.Succinct.Index
+                      , HaskellWorks.Data.Json.Succinct.PartialIndex
                       , HaskellWorks.Data.Json.Token.Tokenize
                       , HaskellWorks.Data.Json.Token.Types
                       , HaskellWorks.Data.Json.Token

src/HaskellWorks/Data/Json/PartialValue.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE InstanceSigs          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TupleSections         #-}
+
+module HaskellWorks.Data.Json.PartialValue
+  ( JsonPartialValue(..)
+  , JsonPartialValueAt(..)
+  ) where
+
+import           Control.Arrow
+import qualified Data.Attoparsec.ByteString.Char8             as ABC
+import qualified Data.ByteString                              as BS
+import           HaskellWorks.Data.Json.Succinct.PartialIndex
+import           HaskellWorks.Data.Json.Value.Internal
+
+data JsonPartialValue
+  = JsonPartialString String
+  | JsonPartialNumber Double
+  | JsonPartialObject [(String, JsonPartialValue)]
+  | JsonPartialArray [JsonPartialValue]
+  | JsonPartialBool Bool
+  | JsonPartialNull
+  | JsonPartialError String
+  deriving (Eq, Show)
+
+class JsonPartialValueAt a where
+  jsonPartialJsonValueAt :: a -> JsonPartialValue
+
+asString :: JsonPartialValue -> String
+asString pjv = case pjv of
+  JsonPartialString s -> s
+  _                   -> ""
+
+instance JsonPartialValueAt JsonPartialIndex where
+  jsonPartialJsonValueAt i = case i of
+    JsonPartialIndexString s  -> case ABC.parse parseJsonString s of
+      ABC.Fail    {}          -> JsonPartialError ("Invalid string: '" ++ show (BS.take 20 s) ++ "...'")
+      ABC.Partial _           -> JsonPartialError "Unexpected end of string"
+      ABC.Done    _ r         -> JsonPartialString r
+    JsonPartialIndexNumber s  -> case ABC.parse ABC.rational s of
+      ABC.Fail    {}    -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")
+      ABC.Partial f     -> case f " " of
+        ABC.Fail    {}    -> JsonPartialError ("Invalid number: '" ++ show (BS.take 20 s) ++ "...'")
+        ABC.Partial _     -> JsonPartialError "Unexpected end of number"
+        ABC.Done    _ r   -> JsonPartialNumber r
+      ABC.Done    _ r   -> JsonPartialNumber r
+    JsonPartialIndexObject  fs -> JsonPartialObject (map ((asString . parseString) *** jsonPartialJsonValueAt) fs)
+    JsonPartialIndexArray   es -> JsonPartialArray (map jsonPartialJsonValueAt es)
+    JsonPartialIndexBool    v  -> JsonPartialBool v
+    JsonPartialIndexNull       -> JsonPartialNull
+    JsonPartialIndexError s    -> JsonPartialError s
+    where parseString bs = case ABC.parse parseJsonString bs of
+            ABC.Fail    {}  -> JsonPartialError ("Invalid field: '" ++ show (BS.take 20 bs) ++ "...'")
+            ABC.Partial _   -> JsonPartialError "Unexpected end of field"
+            ABC.Done    _ s -> JsonPartialString s

src/HaskellWorks/Data/Json/Succinct/PartialIndex.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE BangPatterns           #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE InstanceSigs           #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+
+module HaskellWorks.Data.Json.Succinct.PartialIndex where
+
+import           Control.Arrow
+import qualified Data.ByteString                                            as BS
+import qualified Data.List                                                  as L
+import           HaskellWorks.Data.Bits.BitWise
+import           HaskellWorks.Data.Json.CharLike
+import           HaskellWorks.Data.Json.Succinct
+import           HaskellWorks.Data.Positioning
+import qualified HaskellWorks.Data.Succinct.BalancedParens                  as BP
+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank0
+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Rank1
+import           HaskellWorks.Data.Succinct.RankSelect.Binary.Basic.Select1
+import           HaskellWorks.Data.TreeCursor
+import           HaskellWorks.Data.Vector.VectorLike
+
+data JsonPartialIndex
+  = JsonPartialIndexString BS.ByteString
+  | JsonPartialIndexNumber BS.ByteString
+  | JsonPartialIndexObject [(BS.ByteString, JsonPartialIndex)]
+  | JsonPartialIndexArray [JsonPartialIndex]
+  | JsonPartialIndexBool Bool
+  | JsonPartialIndexNull
+  | JsonPartialIndexError String
+  deriving (Eq, Show)
+
+class JsonPartialIndexAt a where
+  jsonPartialIndexAt :: a -> JsonPartialIndex
+
+instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonPartialIndexAt (JsonCursor BS.ByteString v w) where
+  jsonPartialIndexAt k = case vUncons remainder of
+    Just (!c, _) | isLeadingDigit2 c  -> JsonPartialIndexNumber  remainder
+    Just (!c, _) | isQuotDbl c        -> JsonPartialIndexString  remainder
+    Just (!c, _) | isChar_t c         -> JsonPartialIndexBool    True
+    Just (!c, _) | isChar_f c         -> JsonPartialIndexBool    False
+    Just (!c, _) | isChar_n c         -> JsonPartialIndexNull
+    Just (!c, _) | isBraceLeft c      -> JsonPartialIndexObject (mapValuesFrom   (firstChild k))
+    Just (!c, _) | isBracketLeft c    -> JsonPartialIndexArray  (arrayValuesFrom (firstChild k))
+    Just _                            -> JsonPartialIndexError "Invalid Json Type"
+    Nothing                           -> JsonPartialIndexError "End of data"
+    where ik                = interests k
+          bpk               = balancedParens k
+          p                 = lastPositionOf (select1 ik (rank1 bpk (cursorRank k)))
+          remainder         = vDrop (toCount p) (cursorText k)
+          arrayValuesFrom :: Maybe (JsonCursor BS.ByteString v w) -> [JsonPartialIndex]
+          arrayValuesFrom = L.unfoldr (fmap (jsonPartialIndexAt &&& nextSibling))
+          mapValuesFrom j   = pairwise (arrayValuesFrom j) >>= asField
+          pairwise (a:b:rs) = (a, b) : pairwise rs
+          pairwise _        = []
+          asField (a, b)    = case a of
+                                JsonPartialIndexString s -> [(s, b)]
+                                _                 -> []