{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

-- | Minimal JavaScript Object Notation (JSON) support as per <https://tools.ietf.org/html/rfc8259 RFC 8259>.
--
-- This API provides a subset (with a couple of divergences; see below) of
-- [aeson API](https://hackage.haskell.org/package/aeson/docs/Data-Aeson.html)
-- but puts the emphasis on simplicity rather than performance and features.
--
-- The 'ToJSON' and 'FromJSON' instances are intended to have an encoding
-- compatible with @aeson@'s encoding.
--
-- == Limitations and divergences from @aeson@'s API
--
-- In order to reduce the dependency footprint and keep the code
-- simpler, the following divergences from the @aeson@ API have to be
-- made:
--
-- * There are no `FromJSON`/`ToJSON` instances for `Char` & `String`.
-- * The type synonym (& the constructor of the same name) 'Object' uses @containers@'s 'Map.Map' rather than a 'HashMap' @unordered-containers@.
-- * 'Array' is represented by an ordinary list rather than a 'Vector' from the @vector@ package.
-- * 'Number' uses 'Double' instead of 'Scientific'
--
module Data.Aeson.Micro
    ( -- * Core JSON types
      Value(..)
    , Object
    , Pair

      -- ** Constructors
    , (.=)
    , object
    , emptyArray
    , emptyObject

      -- ** Accessors
    , (.:)
    , (.:?)
    , (.:!)
    , (.!=)

      -- * Encoding and decoding
    , encode
    , encodeStrict
    , encodeToBuilder

    , decodeStrict
    , decode

    , decodeStrictN

      -- * Prism-style parsers
    , withObject
    , withText
    , withArray
    , withNumber
    , withBool

      -- * Type conversion
    , FromJSON(parseJSON)
    , Parser, parseMaybe
    , ToJSON(toJSON)

    ) where

import           Control.Monad
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail
#endif
import           Data.Char
import           Data.Data                (Data)
import           Data.Int
import           Data.List                (intersperse)
import           Data.Monoid
import           Data.String
import           Data.Typeable            (Typeable)
import           Data.Word
import           GHC.Generics             (Generic)

import           Control.DeepSeq
import qualified Data.ByteString          as BS
import           Data.ByteString.Builder  (Builder)
import qualified Data.ByteString.Builder  as BB
import qualified Data.ByteString.Lazy     as BS.Lazy
import qualified Data.Map.Strict          as Map
import           Data.Text                (Text)
import qualified Data.Text                as T
import qualified Data.Text.Encoding       as T
import qualified Data.Text.Lazy           as TL

import           Data.Aeson.Micro.Parser
import           Data.Aeson.Micro.Scanner (Lexeme (..), scanLexemes)

-- TODO: We may want to replace 'String' with 'Text' or 'ByteString'

-- | A JSON value represented as a Haskell value.
data Value = Object !Object
           | Array  [Value]
           | String !Text
           | Number !Double
           | Bool   !Bool
           | Null
           deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
(Int -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read Value
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Value]
$creadListPrec :: ReadPrec [Value]
readPrec :: ReadPrec Value
$creadPrec :: ReadPrec Value
readList :: ReadS [Value]
$creadList :: ReadS [Value]
readsPrec :: Int -> ReadS Value
$creadsPrec :: Int -> ReadS Value
Read, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic, Typeable Value
DataType
Constr
Typeable Value
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Value -> c Value)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Value)
-> (Value -> Constr)
-> (Value -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Value))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value))
-> ((forall b. Data b => b -> b) -> Value -> Value)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall u. (forall d. Data d => d -> u) -> Value -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Value -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Value -> m Value)
-> Data Value
Value -> DataType
Value -> Constr
(forall b. Data b => b -> b) -> Value -> Value
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
forall u. (forall d. Data d => d -> u) -> Value -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cNull :: Constr
$cBool :: Constr
$cNumber :: Constr
$cString :: Constr
$cArray :: Constr
$cObject :: Constr
$tValue :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMp :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapM :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapQi :: Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQ :: (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapT :: (forall b. Data b => b -> b) -> Value -> Value
$cgmapT :: (forall b. Data b => b -> b) -> Value -> Value
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Value)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
dataTypeOf :: Value -> DataType
$cdataTypeOf :: Value -> DataType
toConstr :: Value -> Constr
$ctoConstr :: Value -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cp1Data :: Typeable Value
Data, Typeable)

instance NFData Value

instance IsString Value where
  fromString :: String -> Value
fromString = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | A key\/value pair for an 'Object'
type Pair = (Text, Value)

-- | A JSON \"object\" (key/value map).
type Object = Map.Map Text Value

infixr 8 .=

-- | A key-value pair for encoding a JSON object.
(.=) :: ToJSON v => Text -> v -> Pair
Text
k .= :: Text -> v -> Pair
.= v
v  = (Text
k, v -> Value
forall a. ToJSON a => a -> Value
toJSON v
v)

-- | Create a 'Value' from a list of name\/value 'Pair's.
object :: [Pair] -> Value
object :: [Pair] -> Value
object = Object -> Value
Object (Object -> Value) -> ([Pair] -> Object) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Object
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

-- | The empty JSON 'Object' (i.e. @{}@).
emptyObject :: Value
emptyObject :: Value
emptyObject = Object -> Value
Object Object
forall a. Monoid a => a
mempty

-- | The empty JSON 'Array' (i.e. @[]@).
emptyArray :: Value
emptyArray :: Value
emptyArray = [Value] -> Value
Array [Value]
forall a. Monoid a => a
mempty

----------------------------------------------------------------------------

(.:) :: FromJSON a => Object -> Text -> Parser a
Object
m .: :: Object -> Text -> Parser a
.: Text
k = Parser a -> (Value -> Parser a) -> Maybe Value -> Parser a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser a
forall a. String -> Parser a
pfail String
"key not found") Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Object -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Object
m)

(.:?) :: FromJSON a => Object -> Text -> Parser (Maybe a)
Object
m .:? :: Object -> Text -> Parser (Maybe a)
.:? Text
k = Parser (Maybe a)
-> (Value -> Parser (Maybe a)) -> Maybe Value -> Parser (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) Value -> Parser (Maybe a)
forall a. FromJSON a => Value -> Parser a
parseJSON (Text -> Object -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Object
m)

(.:!) :: FromJSON a => Object -> Text -> Parser (Maybe a)
Object
m .:! :: Object -> Text -> Parser (Maybe a)
.:! Text
k = Parser (Maybe a)
-> (Value -> Parser (Maybe a)) -> Maybe Value -> Parser (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Parser a -> Parser (Maybe a))
-> (Value -> Parser a) -> Value -> Parser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON) (Text -> Object -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
k Object
m)

(.!=) :: Parser (Maybe a) -> a -> Parser a
Parser (Maybe a)
mv .!= :: Parser (Maybe a) -> a -> Parser a
.!= a
def = (Maybe a -> a) -> Parser (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
def a -> a
forall a. a -> a
id) Parser (Maybe a)
mv

----------------------------------------------------------------------------

-- | A type that can be converted to JSON.
class ToJSON a where
  -- | Convert a Haskell value to a JSON-friendly intermediate type.
  toJSON :: a -> Value

instance ToJSON () where
  toJSON :: () -> Value
toJSON () = [Value] -> Value
Array []

instance ToJSON Value where
  toJSON :: Value -> Value
toJSON = Value -> Value
forall a. a -> a
id

instance ToJSON Bool where
  toJSON :: Bool -> Value
toJSON = Bool -> Value
Bool

instance ToJSON a => ToJSON [a] where
  toJSON :: [a] -> Value
toJSON = [Value] -> Value
Array ([Value] -> Value) -> ([a] -> [Value]) -> [a] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map a -> Value
forall a. ToJSON a => a -> Value
toJSON

instance ToJSON v => ToJSON (Map.Map Text v) where
  toJSON :: Map Text v -> Value
toJSON = Object -> Value
Object (Object -> Value) -> (Map Text v -> Object) -> Map Text v -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Value) -> Map Text v -> Object
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map v -> Value
forall a. ToJSON a => a -> Value
toJSON

instance ToJSON a => ToJSON (Maybe a) where
  toJSON :: Maybe a -> Value
toJSON Maybe a
Nothing  = Value
Null
  toJSON (Just a
a) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a

instance (ToJSON a,ToJSON b) => ToJSON (a,b) where
  toJSON :: (a, b) -> Value
toJSON (a
a,b
b) = [Value] -> Value
Array [a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b]

instance (ToJSON a,ToJSON b,ToJSON c) => ToJSON (a,b,c) where
  toJSON :: (a, b, c) -> Value
toJSON (a
a,b
b,c
c) = [Value] -> Value
Array [a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b, c -> Value
forall a. ToJSON a => a -> Value
toJSON c
c]

instance (ToJSON a,ToJSON b,ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where
  toJSON :: (a, b, c, d) -> Value
toJSON (a
a,b
b,c
c,d
d) = [Value] -> Value
Array [a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a, b -> Value
forall a. ToJSON a => a -> Value
toJSON b
b, c -> Value
forall a. ToJSON a => a -> Value
toJSON c
c, d -> Value
forall a. ToJSON a => a -> Value
toJSON d
d]

instance ToJSON Text where
  toJSON :: Text -> Value
toJSON = Text -> Value
String

instance ToJSON TL.Text where
  toJSON :: Text -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Text -> Text) -> Text -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict

instance ToJSON Float where
  toJSON :: Float -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Float -> Double) -> Float -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance ToJSON Double where
  toJSON :: Double -> Value
toJSON = Double -> Value
Number

instance ToJSON Int    where  toJSON :: Int -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int -> Double) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Int8   where  toJSON :: Int8 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int8 -> Double) -> Int8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Int16  where  toJSON :: Int16 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int16 -> Double) -> Int16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Int32  where  toJSON :: Int32 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int32 -> Double) -> Int32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance ToJSON Word   where  toJSON :: Word -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word -> Double) -> Word -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Word8  where  toJSON :: Word8 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word8 -> Double) -> Word8 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Word16 where  toJSON :: Word16 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word16 -> Double) -> Word16 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
instance ToJSON Word32 where  toJSON :: Word32 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word32 -> Double) -> Word32 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Possibly lossy due to conversion to 'Double'
instance ToJSON Int64  where  toJSON :: Int64 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Int64 -> Double) -> Int64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Possibly lossy due to conversion to 'Double'
instance ToJSON Word64 where  toJSON :: Word64 -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Word64 -> Double) -> Word64 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Possibly lossy due to conversion to 'Double'
instance ToJSON Integer where toJSON :: Integer -> Value
toJSON = Double -> Value
Number (Double -> Value) -> (Integer -> Double) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger

------------------------------------------------------------------------------
-- 'BB.Builder'-based encoding

-- | Serialise value as JSON/UTF-8-encoded strict 'BS.ByteString'
encodeStrict :: ToJSON a => a -> BS.ByteString
encodeStrict :: a -> ByteString
encodeStrict = ByteString -> ByteString
BS.Lazy.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode

-- | Serialise value as JSON/UTF-8-encoded lazy 'BS.Lazy.ByteString'
encode :: ToJSON a => a -> BS.Lazy.ByteString
encode :: a -> ByteString
encode = Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> (a -> Builder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. ToJSON a => a -> Builder
encodeToBuilder

-- | Serialise value as JSON/UTF8-encoded 'Builder'
encodeToBuilder :: ToJSON a => a -> Builder
encodeToBuilder :: a -> Builder
encodeToBuilder = Value -> Builder
encodeValueBB (Value -> Builder) -> (a -> Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON

encodeValueBB :: Value -> Builder
encodeValueBB :: Value -> Builder
encodeValueBB Value
jv = case Value
jv of
  Bool Bool
True  -> Builder
"true"
  Bool Bool
False -> Builder
"false"
  Value
Null       -> Builder
"null"
  Number Double
n
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
n Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
n   -> Value -> Builder
encodeValueBB Value
Null
    | Just Int64
i <- Double -> Maybe Int64
doubleToInt64 Double
n -> Int64 -> Builder
BB.int64Dec Int64
i
    | Bool
otherwise                 -> Double -> Builder
BB.doubleDec Double
n
  Array [Value]
a  -> [Value] -> Builder
encodeArrayBB [Value]
a
  String Text
s -> Text -> Builder
encodeStringBB Text
s
  Object Object
o -> Object -> Builder
encodeObjectBB Object
o

encodeArrayBB :: [Value] -> Builder
encodeArrayBB :: [Value] -> Builder
encodeArrayBB [] = Builder
"[]"
encodeArrayBB [Value]
jvs = Char -> Builder
BB.char8 Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Value] -> Builder
go [Value]
jvs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
']'
  where
    go :: [Value] -> Builder
go = [Builder] -> Builder
forall a. Monoid a => [a] -> a
Data.Monoid.mconcat ([Builder] -> Builder)
-> ([Value] -> [Builder]) -> [Value] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BB.char8 Char
',') ([Builder] -> [Builder])
-> ([Value] -> [Builder]) -> [Value] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Builder) -> [Value] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Builder
encodeValueBB

encodeObjectBB :: Object -> Builder
encodeObjectBB :: Object -> Builder
encodeObjectBB Object
m
  | Object -> Bool
forall k a. Map k a -> Bool
Map.null Object
m  = Builder
"{}"
  | Bool
otherwise = Char -> Builder
BB.char8 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Pair] -> Builder
go [Pair]
jvs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
'}'
  where
    jvs :: [Pair]
jvs = Object -> [Pair]
forall k a. Map k a -> [(k, a)]
Map.toList Object
m
    go :: [Pair] -> Builder
go = [Builder] -> Builder
forall a. Monoid a => [a] -> a
Data.Monoid.mconcat ([Builder] -> Builder)
-> ([Pair] -> [Builder]) -> [Pair] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
BB.char8 Char
',') ([Builder] -> [Builder])
-> ([Pair] -> [Builder]) -> [Pair] -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Builder) -> [Pair] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Pair -> Builder
encPair
    encPair :: Pair -> Builder
encPair (Text
l,Value
x) = Text -> Builder
encodeStringBB Text
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Value -> Builder
encodeValueBB Value
x

encodeStringBB :: Text -> Builder
encodeStringBB :: Text -> Builder
encodeStringBB Text
str = Char -> Builder
BB.char8 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
go Text
str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
'"'
  where
    go :: Text -> Builder
go = Text -> Builder
T.encodeUtf8Builder (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeText

------------------------------------------------------------------------------
-- helpers

-- | Try to convert 'Double' into 'Int64', return 'Nothing' if not
-- representable loss-free as integral 'Int64' value.
doubleToInt64 :: Double -> Maybe Int64
doubleToInt64 :: Double -> Maybe Int64
doubleToInt64 Double
x
  | Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
x' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
x
  , Integer
x' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
maxBound :: Int64)
  , Integer
x' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64
forall a. Bounded a => a
minBound :: Int64)
    = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x')
  | Bool
otherwise = Maybe Int64
forall a. Maybe a
Nothing
  where
    x' :: Integer
x' = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x

-- | Minimally escape a 'String' in accordance with [RFC 8259, "7. Strings"](https://tools.ietf.org/html/rfc8259#section-7)
escapeText :: Text -> Text
escapeText :: Text -> Text
escapeText Text
s
  | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
needsEscape Text
s) = Text
s
  | Bool
otherwise                 = (String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
escape ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Text
s
  where
    escape :: ShowS
escape [] = []
    escape (Char
x:String
xs) = case Char
x of
      Char
'\\' -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
      Char
'"'  -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'"'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
      Char
'\b' -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'b'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
      Char
'\f' -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'f'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
      Char
'\n' -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'n'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
      Char
'\r' -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'r'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
      Char
'\t' -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
't'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
      Char
c | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10 -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'u'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char
intToDigit (Char -> Int
ord Char
c)Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
        | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 -> Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'u'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'1'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Char
intToDigit (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10)Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escape String
xs
        | Bool
otherwise    -> Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escape String
xs

    -- unescaped = %x20-21 / %x23-5B / %x5D-10FFFF
    needsEscape :: Char -> Bool
needsEscape Char
c = Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\\',Char
'"']

----------------------------------------------------------------------------
----------------------------------------------------------------------------

-- | JSON Parser 'Monad' used by 'FromJSON'
newtype Parser a = P { Parser a -> Maybe a
unP :: Maybe a }
                 deriving (a -> Parser b -> Parser a
(a -> b) -> Parser a -> Parser b
(forall a b. (a -> b) -> Parser a -> Parser b)
-> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
forall a b. a -> Parser b -> Parser a
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Parser b -> Parser a
$c<$ :: forall a b. a -> Parser b -> Parser a
fmap :: (a -> b) -> Parser a -> Parser b
$cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
Functor,Functor Parser
a -> Parser a
Functor Parser
-> (forall a. a -> Parser a)
-> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
-> (forall a b c.
    (a -> b -> c) -> Parser a -> Parser b -> Parser c)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser a)
-> Applicative Parser
Parser a -> Parser b -> Parser b
Parser a -> Parser b -> Parser a
Parser (a -> b) -> Parser a -> Parser b
(a -> b -> c) -> Parser a -> Parser b -> Parser c
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Parser a -> Parser b -> Parser a
$c<* :: forall a b. Parser a -> Parser b -> Parser a
*> :: Parser a -> Parser b -> Parser b
$c*> :: forall a b. Parser a -> Parser b -> Parser b
liftA2 :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
$cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
<*> :: Parser (a -> b) -> Parser a -> Parser b
$c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
pure :: a -> Parser a
$cpure :: forall a. a -> Parser a
$cp1Applicative :: Functor Parser
Applicative,Applicative Parser
a -> Parser a
Applicative Parser
-> (forall a b. Parser a -> (a -> Parser b) -> Parser b)
-> (forall a b. Parser a -> Parser b -> Parser b)
-> (forall a. a -> Parser a)
-> Monad Parser
Parser a -> (a -> Parser b) -> Parser b
Parser a -> Parser b -> Parser b
forall a. a -> Parser a
forall a b. Parser a -> Parser b -> Parser b
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Parser a
$creturn :: forall a. a -> Parser a
>> :: Parser a -> Parser b -> Parser b
$c>> :: forall a b. Parser a -> Parser b -> Parser b
>>= :: Parser a -> (a -> Parser b) -> Parser b
$c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
$cp1Monad :: Applicative Parser
Monad,Monad Parser
Monad Parser -> (forall a. String -> Parser a) -> MonadFail Parser
String -> Parser a
forall a. String -> Parser a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Parser a
$cfail :: forall a. String -> Parser a
$cp1MonadFail :: Monad Parser
MonadFail)

-- | Run 'Parser'.
--
-- A common use-case is @'parseMaybe' 'parseJSON'@.
parseMaybe :: (a -> Parser b) -> a -> Maybe b
parseMaybe :: (a -> Parser b) -> a -> Maybe b
parseMaybe a -> Parser b
m a
v = Parser b -> Maybe b
forall a. Parser a -> Maybe a
unP (a -> Parser b
m a
v)

pfail :: String -> Parser a
pfail :: String -> Parser a
pfail String
_ = Maybe a -> Parser a
forall a. Maybe a -> Parser a
P Maybe a
forall a. Maybe a
Nothing

-- | A type that JSON can be deserialised into
class FromJSON a where
  -- | Decode a JSON value into a native Haskell type
  parseJSON :: Value -> Parser a

instance FromJSON Value where
  parseJSON :: Value -> Parser Value
parseJSON = Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromJSON Bool where
  parseJSON :: Value -> Parser Bool
parseJSON = String -> (Bool -> Parser Bool) -> Value -> Parser Bool
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
"Bool" Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromJSON Text where
  parseJSON :: Value -> Parser Text
parseJSON = String -> (Text -> Parser Text) -> Value -> Parser Text
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Text" Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromJSON TL.Text where
  parseJSON :: Value -> Parser Text
parseJSON = String -> (Text -> Parser Text) -> Value -> Parser Text
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Text" (Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> (Text -> Text) -> Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict)

instance FromJSON a => FromJSON [a] where
  parseJSON :: Value -> Parser [a]
parseJSON = String -> ([Value] -> Parser [a]) -> Value -> Parser [a]
forall a. String -> ([Value] -> Parser a) -> Value -> Parser a
withArray String
"[a]" ((Value -> Parser a) -> [Value] -> Parser [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON)

instance FromJSON Double where
  parseJSON :: Value -> Parser Double
parseJSON Value
Null = Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
  parseJSON Value
j    = String -> (Double -> Parser Double) -> Value -> Parser Double
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Double" Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
j

instance FromJSON Float where
  parseJSON :: Value -> Parser Float
parseJSON Value
Null = Float -> Parser Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
  parseJSON Value
j    = String -> (Double -> Parser Float) -> Value -> Parser Float
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Float" (Float -> Parser Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Parser Float)
-> (Double -> Float) -> Double -> Parser Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac) Value
j

-- FIXME: lossy conversions

instance FromJSON Integer where
  parseJSON :: Value -> Parser Integer
parseJSON = String -> (Double -> Parser Integer) -> Value -> Parser Integer
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Int" (Integer -> Parser Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Parser Integer)
-> (Double -> Integer) -> Double -> Parser Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Int where
  parseJSON :: Value -> Parser Int
parseJSON = String -> (Double -> Parser Int) -> Value -> Parser Int
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Int" (Int -> Parser Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Parser Int) -> (Double -> Int) -> Double -> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Double -> Integer) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Int8 where
  parseJSON :: Value -> Parser Int8
parseJSON = String -> (Double -> Parser Int8) -> Value -> Parser Int8
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Int8" (Int8 -> Parser Int8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int8 -> Parser Int8) -> (Double -> Int8) -> Double -> Parser Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int8
forall a. Num a => Integer -> a
fromInteger (Integer -> Int8) -> (Double -> Integer) -> Double -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Int16 where
  parseJSON :: Value -> Parser Int16
parseJSON = String -> (Double -> Parser Int16) -> Value -> Parser Int16
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Int16" (Int16 -> Parser Int16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int16 -> Parser Int16)
-> (Double -> Int16) -> Double -> Parser Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int16
forall a. Num a => Integer -> a
fromInteger (Integer -> Int16) -> (Double -> Integer) -> Double -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Int32 where
  parseJSON :: Value -> Parser Int32
parseJSON = String -> (Double -> Parser Int32) -> Value -> Parser Int32
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Int32" (Int32 -> Parser Int32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> Parser Int32)
-> (Double -> Int32) -> Double -> Parser Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int32
forall a. Num a => Integer -> a
fromInteger (Integer -> Int32) -> (Double -> Integer) -> Double -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Int64 where
  parseJSON :: Value -> Parser Int64
parseJSON = String -> (Double -> Parser Int64) -> Value -> Parser Int64
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Int64" (Int64 -> Parser Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int64 -> Parser Int64)
-> (Double -> Int64) -> Double -> Parser Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int64
forall a. Num a => Integer -> a
fromInteger (Integer -> Int64) -> (Double -> Integer) -> Double -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Word where
  parseJSON :: Value -> Parser Word
parseJSON = String -> (Double -> Parser Word) -> Value -> Parser Word
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Word" (Word -> Parser Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Parser Word) -> (Double -> Word) -> Double -> Parser Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word
forall a. Num a => Integer -> a
fromInteger (Integer -> Word) -> (Double -> Integer) -> Double -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Word8 where
  parseJSON :: Value -> Parser Word8
parseJSON = String -> (Double -> Parser Word8) -> Value -> Parser Word8
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Word8" (Word8 -> Parser Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Parser Word8)
-> (Double -> Word8) -> Double -> Parser Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> (Double -> Integer) -> Double -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Word16 where
  parseJSON :: Value -> Parser Word16
parseJSON = String -> (Double -> Parser Word16) -> Value -> Parser Word16
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Word16" (Word16 -> Parser Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> Parser Word16)
-> (Double -> Word16) -> Double -> Parser Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word16
forall a. Num a => Integer -> a
fromInteger (Integer -> Word16) -> (Double -> Integer) -> Double -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Word32 where
  parseJSON :: Value -> Parser Word32
parseJSON = String -> (Double -> Parser Word32) -> Value -> Parser Word32
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Word32" (Word32 -> Parser Word32
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> Parser Word32)
-> (Double -> Word32) -> Double -> Parser Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a. Num a => Integer -> a
fromInteger (Integer -> Word32) -> (Double -> Integer) -> Double -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)

instance FromJSON Word64 where
  parseJSON :: Value -> Parser Word64
parseJSON = String -> (Double -> Parser Word64) -> Value -> Parser Word64
forall a. String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
"Word64" (Word64 -> Parser Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Parser Word64)
-> (Double -> Word64) -> Double -> Parser Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> (Double -> Integer) -> Double -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round)


instance FromJSON () where
  parseJSON :: Value -> Parser ()
parseJSON = String -> ([Value] -> Parser ()) -> Value -> Parser ()
forall a. String -> ([Value] -> Parser a) -> Value -> Parser a
withArray String
"()" (([Value] -> Parser ()) -> Value -> Parser ())
-> ([Value] -> Parser ()) -> Value -> Parser ()
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [] -> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      [Value]
_  -> String -> Parser ()
forall a. String -> Parser a
pfail String
"expected ()"

instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
  parseJSON :: Value -> Parser (a, b)
parseJSON = String -> ([Value] -> Parser (a, b)) -> Value -> Parser (a, b)
forall a. String -> ([Value] -> Parser a) -> Value -> Parser a
withArray String
"(a,b)" (([Value] -> Parser (a, b)) -> Value -> Parser (a, b))
-> ([Value] -> Parser (a, b)) -> Value -> Parser (a, b)
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [Value
a,Value
b] -> (a -> b -> (a, b)) -> Parser a -> Parser b -> Parser (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a) (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b)
      [Value]
_     -> String -> Parser (a, b)
forall a. String -> Parser a
pfail String
"expected (a,b)"

instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
  parseJSON :: Value -> Parser (a, b, c)
parseJSON = String
-> ([Value] -> Parser (a, b, c)) -> Value -> Parser (a, b, c)
forall a. String -> ([Value] -> Parser a) -> Value -> Parser a
withArray String
"(a,b,c)" (([Value] -> Parser (a, b, c)) -> Value -> Parser (a, b, c))
-> ([Value] -> Parser (a, b, c)) -> Value -> Parser (a, b, c)
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [Value
a,Value
b,Value
c] -> (a -> b -> c -> (a, b, c))
-> Parser a -> Parser b -> Parser c -> Parser (a, b, c)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a) (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b) (Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c)
      [Value]
_       -> String -> Parser (a, b, c)
forall a. String -> Parser a
pfail String
"expected (a,b,c)"

instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where
  parseJSON :: Value -> Parser (a, b, c, d)
parseJSON = String
-> ([Value] -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d)
forall a. String -> ([Value] -> Parser a) -> Value -> Parser a
withArray String
"(a,b,c,d)" (([Value] -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d))
-> ([Value] -> Parser (a, b, c, d)) -> Value -> Parser (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \[Value]
lst ->
    case [Value]
lst of
      [Value
a,Value
b,Value
c,Value
d] -> (a -> b -> c -> d -> (a, b, c, d))
-> Parser a
-> Parser b
-> Parser c
-> Parser d
-> Parser (a, b, c, d)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a) (Value -> Parser b
forall a. FromJSON a => Value -> Parser a
parseJSON Value
b) (Value -> Parser c
forall a. FromJSON a => Value -> Parser a
parseJSON Value
c) (Value -> Parser d
forall a. FromJSON a => Value -> Parser a
parseJSON Value
d)
      [Value]
_         -> String -> Parser (a, b, c, d)
forall a. String -> Parser a
pfail String
"expected (a,b,c,d)"

instance FromJSON a => FromJSON (Maybe a) where
  parseJSON :: Value -> Parser (Maybe a)
parseJSON Value
Null = Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  parseJSON Value
j    = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
j

instance FromJSON Ordering where
  parseJSON :: Value -> Parser Ordering
parseJSON = String -> (Text -> Parser Ordering) -> Value -> Parser Ordering
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"{'LT','EQ','GT'}" ((Text -> Parser Ordering) -> Value -> Parser Ordering)
-> (Text -> Parser Ordering) -> Value -> Parser Ordering
forall a b. (a -> b) -> a -> b
$ \Text
s ->
    case Text
s of
      Text
"LT" -> Ordering -> Parser Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT
      Text
"EQ" -> Ordering -> Parser Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ
      Text
"GT" -> Ordering -> Parser Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT
      Text
_    -> String -> Parser Ordering
forall a. String -> Parser a
pfail String
"expected {'LT','EQ','GT'}"

instance FromJSON v => FromJSON (Map.Map Text v) where
  parseJSON :: Value -> Parser (Map Text v)
parseJSON = String
-> (Object -> Parser (Map Text v)) -> Value -> Parser (Map Text v)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Map Text v" ((Object -> Parser (Map Text v)) -> Value -> Parser (Map Text v))
-> (Object -> Parser (Map Text v)) -> Value -> Parser (Map Text v)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser v) -> Object -> Parser (Map Text v)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser v
forall a. FromJSON a => Value -> Parser a
parseJSON

-- "prisms"

withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
withBool String
_        Bool -> Parser a
f (Bool Bool
arr) = Bool -> Parser a
f Bool
arr
withBool String
expected Bool -> Parser a
_ Value
v          = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
expected Value
v

withText :: String -> (Text -> Parser a) -> Value -> Parser a
withText :: String -> (Text -> Parser a) -> Value -> Parser a
withText String
_        Text -> Parser a
f (String Text
txt) = Text -> Parser a
f Text
txt
withText String
expected Text -> Parser a
_ Value
v            = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
expected Value
v

withArray :: String -> ([Value] -> Parser a) -> Value -> Parser a
withArray :: String -> ([Value] -> Parser a) -> Value -> Parser a
withArray String
_        [Value] -> Parser a
f (Array [Value]
lst) = [Value] -> Parser a
f [Value]
lst
withArray String
expected [Value] -> Parser a
_ Value
v           = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
expected Value
v

withObject :: String -> (Object -> Parser a) -> Value -> Parser a
withObject :: String -> (Object -> Parser a) -> Value -> Parser a
withObject String
_        Object -> Parser a
f (Object Object
obj) = Object -> Parser a
f Object
obj
withObject String
expected Object -> Parser a
_ Value
v            = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
expected Value
v

withNumber :: String -> (Double -> Parser a) -> Value -> Parser a
withNumber :: String -> (Double -> Parser a) -> Value -> Parser a
withNumber String
_        Double -> Parser a
f (Number Double
n) = Double -> Parser a
f Double
n
withNumber String
expected Double -> Parser a
_ Value
v          = String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
expected Value
v

typeMismatch :: String -> Value -> Parser a
typeMismatch :: String -> Value -> Parser a
typeMismatch String
expected Value
_ = String -> Parser a
forall a. String -> Parser a
pfail (String
"expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
expected)

----------------------------------------------------------------------------

-- | Decode a single JSON document
decode :: FromJSON a => BS.Lazy.ByteString -> Maybe a
decode :: ByteString -> Maybe a
decode = ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict (ByteString -> Maybe a)
-> (ByteString -> ByteString) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.Lazy.toStrict

-- | Decode a single JSON document
decodeStrict :: FromJSON a => BS.ByteString -> Maybe a
decodeStrict :: ByteString -> Maybe a
decodeStrict ByteString
bs = do
  Value
v <- ByteString -> Maybe Value
decodeValue ByteString
bs
  Parser a -> Maybe a
forall a. Parser a -> Maybe a
unP (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

-- | Decode multiple concatenated JSON documents
decodeStrictN :: FromJSON a => BS.ByteString -> Maybe [a]
decodeStrictN :: ByteString -> Maybe [a]
decodeStrictN = [a] -> LexStream -> Maybe [a]
forall a. FromJSON a => [a] -> LexStream -> Maybe [a]
go [] (LexStream -> Maybe [a])
-> (ByteString -> LexStream) -> ByteString -> Maybe [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LexStream
scanLexemes
  where
    go :: [a] -> LexStream -> Maybe [a]
go [a]
acc [] = [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$! [a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc
    go [a]
acc LexStream
ls = do
      (LexStream
ls', Value
v) <- LexStream -> Maybe (LexStream, Value)
parseValue LexStream
ls
      a
a <- Parser a -> Maybe a
forall a. Parser a -> Maybe a
unP (Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)
      [a] -> LexStream -> Maybe [a]
go (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) LexStream
ls'

----

type LexStream = [(Lexeme,BS.ByteString)]

decodeValue :: BS.ByteString -> Maybe Value
decodeValue :: ByteString -> Maybe Value
decodeValue ByteString
bs = case LexStream -> Maybe (LexStream, Value)
parseValue (ByteString -> LexStream
scanLexemes ByteString
bs) of
                Just ([], Value
v) -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
                Maybe (LexStream, Value)
_            -> Maybe Value
forall a. Maybe a
Nothing

parseValue :: LexStream -> Maybe (LexStream, Value)
parseValue :: LexStream -> Maybe (LexStream, Value)
parseValue = LexStream -> Maybe (LexStream, Value)
goValue
  where
    goValue :: LexStream -> Maybe (LexStream, Value)
    goValue :: LexStream -> Maybe (LexStream, Value)
goValue ((Lexeme
L_True,ByteString
_):LexStream
xs)     = (LexStream, Value) -> Maybe (LexStream, Value)
forall a. a -> Maybe a
Just (LexStream
xs,Bool -> Value
Bool Bool
True)
    goValue ((Lexeme
L_False,ByteString
_):LexStream
xs)    = (LexStream, Value) -> Maybe (LexStream, Value)
forall a. a -> Maybe a
Just (LexStream
xs,Bool -> Value
Bool Bool
False)
    goValue ((Lexeme
L_Null,ByteString
_):LexStream
xs)     = (LexStream, Value) -> Maybe (LexStream, Value)
forall a. a -> Maybe a
Just (LexStream
xs,Value
Null)
    goValue ((Lexeme
L_Number,ByteString
bs):LexStream
xs)  = (\Double
n->(LexStream
xs,Double -> Value
Number Double
n)) (Double -> (LexStream, Value))
-> Maybe Double -> Maybe (LexStream, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Double
decodeNumber ByteString
bs
    goValue ((Lexeme
L_StrStart,ByteString
_):LexStream
xs) = LexStream -> Maybe (LexStream, Value)
goString LexStream
xs
    goValue ((Lexeme
L_ArrStart,ByteString
_):LexStream
xs) = LexStream -> Maybe (LexStream, Value)
goArray LexStream
xs
    goValue ((Lexeme
L_ObjStart,ByteString
_):LexStream
xs) = LexStream -> Maybe (LexStream, Value)
goObject LexStream
xs
    goValue LexStream
_                   = Maybe (LexStream, Value)
forall a. Maybe a
Nothing

    goArray :: LexStream -> Maybe (LexStream, Value)
    goArray :: LexStream -> Maybe (LexStream, Value)
goArray LexStream
xs0 = ([Value] -> Value
Array ([Value] -> Value) -> (LexStream, [Value]) -> (LexStream, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((LexStream, [Value]) -> (LexStream, Value))
-> Maybe (LexStream, [Value]) -> Maybe (LexStream, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LexStream -> Maybe (LexStream, [Value])
go0 LexStream
xs0
      where
        go0 :: LexStream -> Maybe (LexStream, [Value])
go0 ((Lexeme
L_ArrEnd,ByteString
_):LexStream
xs) = (LexStream, [Value]) -> Maybe (LexStream, [Value])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexStream
xs, [])
        go0 LexStream
xs                = do
          (LexStream
xs', Value
v) <- LexStream -> Maybe (LexStream, Value)
goValue LexStream
xs
          [Value] -> LexStream -> Maybe (LexStream, [Value])
go1 [Value
v] LexStream
xs'

        go1 :: [Value] -> LexStream -> Maybe (LexStream, [Value])
go1 [Value]
acc ((Lexeme
L_ArrEnd,ByteString
_):LexStream
xs) = (LexStream, [Value]) -> Maybe (LexStream, [Value])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexStream
xs, [Value] -> [Value]
forall a. [a] -> [a]
reverse [Value]
acc)
        go1 [Value]
acc ((Lexeme
L_Comma, ByteString
_):LexStream
xs) = do
          (LexStream
xs', Value
v) <- LexStream -> Maybe (LexStream, Value)
goValue LexStream
xs
          [Value] -> LexStream -> Maybe (LexStream, [Value])
go1 (Value
vValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
acc) LexStream
xs'
        go1 [Value]
_ LexStream
_ = Maybe (LexStream, [Value])
forall a. Maybe a
Nothing

    goObject :: LexStream -> Maybe (LexStream, Value)
    goObject :: LexStream -> Maybe (LexStream, Value)
goObject LexStream
xs0 = ((Object -> Value
Object (Object -> Value) -> ([Pair] -> Object) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Object
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList) ([Pair] -> Value) -> (LexStream, [Pair]) -> (LexStream, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((LexStream, [Pair]) -> (LexStream, Value))
-> Maybe (LexStream, [Pair]) -> Maybe (LexStream, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LexStream -> Maybe (LexStream, [Pair])
go0 LexStream
xs0
      where
        go0 :: LexStream -> Maybe (LexStream, [Pair])
go0 ((Lexeme
L_ObjEnd,ByteString
_):LexStream
xs) = (LexStream, [Pair]) -> Maybe (LexStream, [Pair])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexStream
xs, [])
        go0 LexStream
xs                = do
          ((Lexeme
L_Colon,ByteString
_):LexStream
xs', String Text
k) <- LexStream -> Maybe (LexStream, Value)
goValue LexStream
xs
          (LexStream
xs'',Value
v) <- LexStream -> Maybe (LexStream, Value)
goValue LexStream
xs'
          [Pair] -> LexStream -> Maybe (LexStream, [Pair])
go1 [(Text
k,Value
v)] LexStream
xs''

        go1 :: [Pair] -> LexStream -> Maybe (LexStream, [Pair])
go1 [Pair]
acc ((Lexeme
L_ObjEnd,ByteString
_):LexStream
xs) = (LexStream, [Pair]) -> Maybe (LexStream, [Pair])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexStream
xs, [Pair] -> [Pair]
forall a. [a] -> [a]
reverse [Pair]
acc)
        go1 [Pair]
acc ((Lexeme
L_Comma, ByteString
_):LexStream
xs) = do
          ((Lexeme
L_Colon,ByteString
_):LexStream
xs', String Text
k) <- LexStream -> Maybe (LexStream, Value)
goValue LexStream
xs
          (LexStream
xs'',Value
v) <- LexStream -> Maybe (LexStream, Value)
goValue LexStream
xs'
          [Pair] -> LexStream -> Maybe (LexStream, [Pair])
go1 ((Text
k,Value
v)Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
:[Pair]
acc) LexStream
xs''
        go1 [Pair]
_ LexStream
_ = Maybe (LexStream, [Pair])
forall a. Maybe a
Nothing

    goString :: LexStream -> Maybe (LexStream, Value)
    goString :: LexStream -> Maybe (LexStream, Value)
goString LexStream
xs0 = ((Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (String -> Value) -> (LexStream, String) -> (LexStream, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((LexStream, String) -> (LexStream, Value))
-> Maybe (LexStream, String) -> Maybe (LexStream, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> LexStream -> Maybe (LexStream, String)
go [] LexStream
xs0
      where
        go :: [String] -> LexStream -> Maybe (LexStream, String)
go [String]
_   []              = Maybe (LexStream, String)
forall a. Maybe a
Nothing
        go [String]
acc ((Lexeme
lx,ByteString
chunk):LexStream
xs) = case Lexeme
lx of
          Lexeme
L_StrEnd -> (LexStream, String) -> Maybe (LexStream, String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LexStream
xs, [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
acc))

          Lexeme
L_StrUnescaped -> do
            String
s <- ByteString -> Maybe String
decodeUnescaped ByteString
chunk
            [String] -> LexStream -> Maybe (LexStream, String)
go (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) LexStream
xs

          Lexeme
L_StrEscaped -> do
            Char
c <- ByteString -> Maybe Char
decodeEscaped ByteString
chunk
            [String] -> LexStream -> Maybe (LexStream, String)
go ([Char
c]String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) LexStream
xs

          Lexeme
L_StrEscapedHex -> do
            Char
c <- ByteString -> Maybe Char
decodeEscapedHex ByteString
chunk
            [String] -> LexStream -> Maybe (LexStream, String)
go ([Char
c]String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) LexStream
xs

          Lexeme
L_StrEscapedHexSurr -> do
            Char
c <- ByteString -> Maybe Char
decodeEscapedHexSurr ByteString
chunk
            [String] -> LexStream -> Maybe (LexStream, String)
go ([Char
c]String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) LexStream
xs

          Lexeme
_ -> Maybe (LexStream, String)
forall a. Maybe a
Nothing