{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} module HaskellWorks.Data.Json.Internal.Index where import Control.Arrow import Control.Monad import HaskellWorks.Data.Bits.BitWise import HaskellWorks.Data.Drop 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 qualified Data.ByteString as BS import qualified Data.List as L import qualified HaskellWorks.Data.BalancedParens as BP 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 (GenericCursor BS.ByteString v w) where jsonIndexAt :: GenericCursor ByteString v w -> Either DecodeError JsonIndex jsonIndexAt GenericCursor ByteString v w k = case ByteString -> Maybe (Elem ByteString, ByteString) forall v. Uncons v => v -> Maybe (Elem v, v) uncons 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 (GenericCursor ByteString v w) -> Either DecodeError [(ByteString, JsonIndex)] forall a. (JsonIndexAt a, TreeCursor a) => Maybe a -> Either DecodeError [(ByteString, JsonIndex)] mapValuesFrom (GenericCursor ByteString v w -> Maybe (GenericCursor ByteString v w) forall k. TreeCursor k => k -> Maybe k firstChild GenericCursor 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 (GenericCursor ByteString v w) -> Either DecodeError [JsonIndex] forall a. (JsonIndexAt a, TreeCursor a) => Maybe a -> Either DecodeError [JsonIndex] arrayValuesFrom (GenericCursor ByteString v w -> Maybe (GenericCursor ByteString v w) forall k. TreeCursor k => k -> Maybe k firstChild GenericCursor 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 = GenericCursor ByteString v w -> v forall t v w. GenericCursor t v w -> v interests GenericCursor ByteString v w k bpk :: w bpk = GenericCursor ByteString v w -> w forall t v w. GenericCursor t v w -> w balancedParens GenericCursor 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 (GenericCursor ByteString v w -> Count forall t v w. GenericCursor t v w -> Count cursorRank GenericCursor ByteString v w k))) remainder :: ByteString remainder = Count -> ByteString -> ByteString forall v. Drop v => Count -> v -> v drop (Position -> Count forall a. ToCount a => a -> Count toCount Position p) (GenericCursor ByteString v w -> ByteString forall t v w. GenericCursor t v w -> t cursorText GenericCursor 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 _ -> []