{-# 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 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 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 forall v. Uncons v => v -> Maybe (Elem v, v) uncons ByteString remainder of Just (!Elem ByteString c, ByteString _) | forall c. JsonCharLike c => c -> Bool isLeadingDigit2 Elem ByteString c -> forall a b. b -> Either a b Right (ByteString -> JsonIndex JsonIndexNumber ByteString remainder) Just (!Elem ByteString c, ByteString _) | forall c. JsonCharLike c => c -> Bool isQuotDbl Elem ByteString c -> forall a b. b -> Either a b Right (ByteString -> JsonIndex JsonIndexString ByteString remainder) Just (!Elem ByteString c, ByteString _) | forall c. JsonCharLike c => c -> Bool isChar_t Elem ByteString c -> forall a b. b -> Either a b Right (Bool -> JsonIndex JsonIndexBool Bool True) Just (!Elem ByteString c, ByteString _) | forall c. JsonCharLike c => c -> Bool isChar_f Elem ByteString c -> forall a b. b -> Either a b Right (Bool -> JsonIndex JsonIndexBool Bool False) Just (!Elem ByteString c, ByteString _) | forall c. JsonCharLike c => c -> Bool isChar_n Elem ByteString c -> forall a b. b -> Either a b Right JsonIndex JsonIndexNull Just (!Elem ByteString c, ByteString _) | forall c. JsonCharLike c => c -> Bool isBraceLeft Elem ByteString c -> [(ByteString, JsonIndex)] -> JsonIndex JsonIndexObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {a}. (JsonIndexAt a, TreeCursor a) => Maybe a -> Either DecodeError [(ByteString, JsonIndex)] mapValuesFrom (forall k. TreeCursor k => k -> Maybe k firstChild GenericCursor ByteString v w k) Just (!Elem ByteString c, ByteString _) | forall c. JsonCharLike c => c -> Bool isBracketLeft Elem ByteString c -> [JsonIndex] -> JsonIndex JsonIndexArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {a}. (JsonIndexAt a, TreeCursor a) => Maybe a -> Either DecodeError [JsonIndex] arrayValuesFrom (forall k. TreeCursor k => k -> Maybe k firstChild GenericCursor ByteString v w k) Just (Elem ByteString, ByteString) _ -> forall a b. a -> Either a b Left (String -> DecodeError DecodeError String "Invalid Json Type") Maybe (Elem ByteString, ByteString) Nothing -> forall a b. a -> Either a b Left (String -> DecodeError DecodeError String "End of data" ) where ik :: v ik = forall t v w. GenericCursor t v w -> v interests GenericCursor ByteString v w k bpk :: w bpk = forall t v w. GenericCursor t v w -> w balancedParens GenericCursor ByteString v w k p :: Position p = Count -> Position lastPositionOf (forall v. Select1 v => v -> Count -> Count select1 v ik (forall v. Rank1 v => v -> Count -> Count rank1 w bpk (forall t v w. GenericCursor t v w -> Count cursorRank GenericCursor ByteString v w k))) remainder :: ByteString remainder = forall v. Drop v => Count -> v -> v drop (forall a. ToCount a => a -> Count toCount Position p) (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 = forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence (forall b a. (b -> Maybe (a, b)) -> b -> [a] L.unfoldr (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall a. JsonIndexAt a => a -> Either DecodeError JsonIndex jsonIndexAt forall (a :: * -> * -> *) b c c'. Arrow a => a b c -> a b c' -> a b (c, c') &&& forall k. TreeCursor k => k -> Maybe k nextSibling)) Maybe a j) mapValuesFrom :: Maybe a -> Either DecodeError [(ByteString, JsonIndex)] mapValuesFrom Maybe a j = (forall {b}. [b] -> [(b, b)] pairwise forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> forall {b}. (JsonIndex, b) -> [(ByteString, b)] asField) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> 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) 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 _ -> []