{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} module HaskellWorks.Data.Json.Succinct.Index where import Control.Arrow import Control.Monad import qualified Data.ByteString as BS import qualified Data.List as L import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Decode 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 JsonIndex = JsonIndexString BS.ByteString | JsonIndexNumber BS.ByteString | JsonIndexObject [(BS.ByteString, JsonIndex)] | JsonIndexArray [JsonIndex] | JsonIndexBool Bool | JsonIndexNull deriving (JsonIndex -> JsonIndex -> Bool (JsonIndex -> JsonIndex -> Bool) -> (JsonIndex -> JsonIndex -> Bool) -> Eq JsonIndex forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: JsonIndex -> JsonIndex -> Bool $c/= :: JsonIndex -> JsonIndex -> Bool == :: JsonIndex -> JsonIndex -> Bool $c== :: JsonIndex -> JsonIndex -> Bool Eq, Int -> JsonIndex -> ShowS [JsonIndex] -> ShowS JsonIndex -> String (Int -> JsonIndex -> ShowS) -> (JsonIndex -> String) -> ([JsonIndex] -> ShowS) -> Show JsonIndex forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [JsonIndex] -> ShowS $cshowList :: [JsonIndex] -> ShowS show :: JsonIndex -> String $cshow :: JsonIndex -> String showsPrec :: Int -> JsonIndex -> ShowS $cshowsPrec :: Int -> JsonIndex -> ShowS Show) class JsonIndexAt a where jsonIndexAt :: a -> Either DecodeError JsonIndex instance (BP.BalancedParens w, Rank0 w, Rank1 w, Select1 v, TestBit w) => JsonIndexAt (JsonCursor BS.ByteString v w) where jsonIndexAt :: JsonCursor ByteString v w -> Either DecodeError JsonIndex jsonIndexAt JsonCursor ByteString v w k = case ByteString -> Maybe (Elem ByteString, ByteString) forall v. Seq v => v -> Maybe (Elem v, v) vUncons ByteString remainder of Just (!Elem ByteString c, ByteString _) | Word8 -> Bool forall c. JsonCharLike c => c -> Bool isLeadingDigit2 Word8 Elem ByteString c -> JsonIndex -> Either DecodeError JsonIndex forall a b. b -> Either a b Right (ByteString -> JsonIndex JsonIndexNumber ByteString remainder) Just (!Elem ByteString c, ByteString _) | Word8 -> Bool forall c. JsonCharLike c => c -> Bool isQuotDbl Word8 Elem ByteString c -> JsonIndex -> Either DecodeError JsonIndex forall a b. b -> Either a b Right (ByteString -> JsonIndex JsonIndexString ByteString remainder) Just (!Elem ByteString c, ByteString _) | Word8 -> Bool forall c. JsonCharLike c => c -> Bool isChar_t Word8 Elem ByteString c -> JsonIndex -> Either DecodeError JsonIndex forall a b. b -> Either a b Right (Bool -> JsonIndex JsonIndexBool Bool True) Just (!Elem ByteString c, ByteString _) | Word8 -> Bool forall c. JsonCharLike c => c -> Bool isChar_f Word8 Elem ByteString c -> JsonIndex -> Either DecodeError JsonIndex forall a b. b -> Either a b Right (Bool -> JsonIndex JsonIndexBool Bool False) Just (!Elem ByteString c, ByteString _) | Word8 -> Bool forall c. JsonCharLike c => c -> Bool isChar_n Word8 Elem ByteString c -> JsonIndex -> Either DecodeError JsonIndex forall a b. b -> Either a b Right JsonIndex JsonIndexNull Just (!Elem ByteString c, ByteString _) | Word8 -> Bool forall c. JsonCharLike c => c -> Bool isBraceLeft Word8 Elem ByteString c -> [(ByteString, JsonIndex)] -> JsonIndex JsonIndexObject ([(ByteString, JsonIndex)] -> JsonIndex) -> Either DecodeError [(ByteString, JsonIndex)] -> Either DecodeError JsonIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (JsonCursor ByteString v w) -> Either DecodeError [(ByteString, JsonIndex)] forall a. (JsonIndexAt a, TreeCursor a) => Maybe a -> Either DecodeError [(ByteString, JsonIndex)] mapValuesFrom (JsonCursor ByteString v w -> Maybe (JsonCursor ByteString v w) forall k. TreeCursor k => k -> Maybe k firstChild JsonCursor ByteString v w k) Just (!Elem ByteString c, ByteString _) | Word8 -> Bool forall c. JsonCharLike c => c -> Bool isBracketLeft Word8 Elem ByteString c -> [JsonIndex] -> JsonIndex JsonIndexArray ([JsonIndex] -> JsonIndex) -> Either DecodeError [JsonIndex] -> Either DecodeError JsonIndex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (JsonCursor ByteString v w) -> Either DecodeError [JsonIndex] forall a. (JsonIndexAt a, TreeCursor a) => Maybe a -> Either DecodeError [JsonIndex] arrayValuesFrom (JsonCursor ByteString v w -> Maybe (JsonCursor ByteString v w) forall k. TreeCursor k => k -> Maybe k firstChild JsonCursor ByteString v w k) Just (Elem ByteString, ByteString) _ -> DecodeError -> Either DecodeError JsonIndex forall a b. a -> Either a b Left (String -> DecodeError DecodeError String "Invalid Json Type") Maybe (Elem ByteString, ByteString) Nothing -> DecodeError -> Either DecodeError JsonIndex forall a b. a -> Either a b Left (String -> DecodeError DecodeError String "End of data" ) where ik :: v ik = JsonCursor ByteString v w -> v forall t v w. JsonCursor t v w -> v interests JsonCursor ByteString v w k bpk :: w bpk = JsonCursor ByteString v w -> w forall t v w. JsonCursor t v w -> w balancedParens JsonCursor ByteString v w k p :: Position p = Count -> Position lastPositionOf (v -> Count -> Count forall v. Select1 v => v -> Count -> Count select1 v ik (w -> Count -> Count forall v. Rank1 v => v -> Count -> Count rank1 w bpk (JsonCursor ByteString v w -> Count forall t v w. JsonCursor t v w -> Count cursorRank JsonCursor ByteString v w k))) remainder :: ByteString remainder = Count -> ByteString -> ByteString forall v. Seq v => Count -> v -> v vDrop (Position -> Count toCount Position p) (JsonCursor ByteString v w -> ByteString forall t v w. JsonCursor t v w -> t cursorText JsonCursor ByteString v w k) arrayValuesFrom :: Maybe a -> Either DecodeError [JsonIndex] arrayValuesFrom Maybe a j = [Either DecodeError JsonIndex] -> Either DecodeError [JsonIndex] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence ((Maybe a -> Maybe (Either DecodeError JsonIndex, Maybe a)) -> Maybe a -> [Either DecodeError JsonIndex] forall b a. (b -> Maybe (a, b)) -> b -> [a] L.unfoldr ((a -> (Either DecodeError JsonIndex, Maybe a)) -> Maybe a -> Maybe (Either DecodeError JsonIndex, Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (a -> Either DecodeError JsonIndex forall a. JsonIndexAt a => a -> Either DecodeError JsonIndex jsonIndexAt (a -> Either DecodeError JsonIndex) -> (a -> Maybe a) -> a -> (Either DecodeError JsonIndex, Maybe a) forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& a -> Maybe a forall k. TreeCursor k => k -> Maybe k nextSibling)) Maybe a j) mapValuesFrom :: Maybe a -> Either DecodeError [(ByteString, JsonIndex)] mapValuesFrom Maybe a j = ([JsonIndex] -> [(JsonIndex, JsonIndex)] forall b. [b] -> [(b, b)] pairwise ([JsonIndex] -> [(JsonIndex, JsonIndex)]) -> ((JsonIndex, JsonIndex) -> [(ByteString, JsonIndex)]) -> [JsonIndex] -> [(ByteString, JsonIndex)] forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> (JsonIndex, JsonIndex) -> [(ByteString, JsonIndex)] forall b. (JsonIndex, b) -> [(ByteString, b)] asField) ([JsonIndex] -> [(ByteString, JsonIndex)]) -> Either DecodeError [JsonIndex] -> Either DecodeError [(ByteString, JsonIndex)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe a -> Either DecodeError [JsonIndex] forall a. (JsonIndexAt a, TreeCursor a) => Maybe a -> Either DecodeError [JsonIndex] arrayValuesFrom Maybe a j pairwise :: [b] -> [(b, b)] pairwise (b a:b b:[b] rs) = (b a, b b) (b, b) -> [(b, b)] -> [(b, b)] forall a. a -> [a] -> [a] : [b] -> [(b, b)] pairwise [b] rs pairwise [b] _ = [] asField :: (JsonIndex, b) -> [(ByteString, b)] asField (JsonIndex a, b b) = case JsonIndex a of JsonIndexString ByteString s -> [(ByteString s, b b)] JsonIndex _ -> []