{-# LANGUAGE BangPatterns #-}
module Saison.Decoding.Value (
toResultValue,
toEitherValue,
toValue,
fromValue,
skipValue,
) where
import Data.Text (Text)
import Data.Void (Void, absurd)
import qualified Data.Aeson as A
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
import Saison.Decoding.Tokens
import Saison.Decoding.Result
toValue :: Tokens b Void -> A.Value
toValue = either absurd fst . toEitherValue
fromValue :: A.Value -> Tokens () a
fromValue = go () where
go :: k -> A.Value -> Tokens k a
go k A.Null = TkLit LitNull k
go k (A.Bool True) = TkLit LitTrue k
go k (A.Bool False) = TkLit LitFalse k
go k (A.String t) = TkText t k
go k (A.Number n) = TkNumber n k
go k (A.Array xs) = TkArrayOpen (V.foldr (\v ys -> TkItem (go ys v)) (TkArrayEnd k) xs)
go k (A.Object xs) = TkRecordOpen (HM.foldrWithKey (\i v ys -> TkPair i (go ys v)) (TkRecordEnd k) xs)
toEitherValue
:: Tokens k e
-> Either e (A.Value, k)
toEitherValue t = unResult (toResultValue t) Left $ \v k -> Right (v, k)
toResultValue
:: Tokens k e
-> Result e k A.Value
toResultValue t0 = Result (go t0) where
go :: Tokens k e -> (e -> r) -> (A.Value -> k -> r) -> r
go (TkLit LitNull k) _ f = f A.Null k
go (TkLit LitTrue k) _ f = f (A.Bool True) k
go (TkLit LitFalse k) _ f = f (A.Bool False) k
go (TkText t k) _ f = f (A.String t) k
go (TkNumber n k) _ f = f (A.Number n) k
go (TkArrayOpen arr) g f = goA 0 id arr g $ \n xs k -> f (A.Array (V.fromListN n xs)) k
go (TkRecordOpen rec) g f = goR id rec g $ \xs k -> f (A.Object (HM.fromList xs)) k
go (TkErr e) g _ = g e
goA :: Int
-> ([A.Value] -> [A.Value])
-> TkArray k e
-> (e -> r)
-> (Int -> [A.Value] -> k -> r)
-> r
goA !n !acc (TkItem toks) g f = go toks g $ \v k -> goA (succ n) (acc . (v :)) k g f
goA !n !acc (TkArrayEnd k) _ f = f n (acc []) k
goA !_ !_ (TkArrayErr e) g _ = g e
goR :: ([(Text, A.Value)] -> [(Text, A.Value)])
-> TkRecord k e
-> (e -> r)
-> ([(Text, A.Value)] -> k -> r)
-> r
goR !acc (TkPair t toks) g f = go toks g $ \v k -> goR (acc . ((t, v) :)) k g f
goR !acc (TkRecordEnd k) _ f = f (acc []) k
goR !_ (TkRecordErr e) g _ = g e
skipValue
:: Tokens k e
-> Result e k ()
skipValue t0 = Result $ \g f -> go t0 g $ \k -> f () k where
go :: Tokens k e -> (e -> r) -> (k -> r) -> r
go (TkLit _ k) _ f = f k
go (TkText _ k) _ f = f k
go (TkNumber _ k) _ f = f k
go (TkArrayOpen arr) g f = goA arr g f
go (TkRecordOpen rec) g f = goR rec g f
go (TkErr e) g _ = g e
goA :: TkArray k e
-> (e -> r)
-> (k -> r)
-> r
goA (TkItem toks) g f = go toks g $ \k -> goA k g f
goA (TkArrayEnd k) _ f = f k
goA (TkArrayErr e) g _ = g e
goR :: TkRecord k e
-> (e -> r)
-> (k -> r)
-> r
goR (TkPair _ toks) g f = go toks g $ \k -> goR k g f
goR (TkRecordEnd k) _ f = f k
goR (TkRecordErr e) g _ = g e