{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

-- | Minimal JSON / RFC 7159 support
--
-- The API is heavily inspired by @aeson@'s API but puts emphasis on
-- simplicity rather than performance. The 'ToJSON' instances are
-- intended to have an encoding compatible with @aeson@'s encoding.
module Haddock.Utils.Json
  ( Value (..)
  , Object
  , object
  , Pair
  , (.=)
  , encodeToString
  , encodeToBuilder
  , ToJSON (toJSON)
  , Parser (..)
  , Result (..)
  , FromJSON (parseJSON)
  , withObject
  , withArray
  , withString
  , withDouble
  , withBool
  , fromJSON
  , parse
  , parseEither
  , (.:)
  , (.:?)
  , decode
  , decodeWith
  , eitherDecode
  , eitherDecodeWith
  , decodeFile
  , eitherDecodeFile
  )
where

import Control.Applicative (Alternative (..))
import Control.Monad (MonadPlus (..), zipWithM, (>=>))
import qualified Control.Monad as Monad
import qualified Control.Monad.Fail as Fail
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BSL
import Data.Char
import Data.Int
import Data.List (intersperse)
import Data.Monoid
import Data.Word
import GHC.Natural
import qualified Text.Parsec.ByteString.Lazy as Parsec.Lazy
import qualified Text.ParserCombinators.Parsec as Parsec

import Haddock.Utils.Json.Parser
import Haddock.Utils.Json.Types

infixr 8 .=

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

-- | 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 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 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/UTF8-encoded 'Builder'
encodeToBuilder :: ToJSON a => a -> Builder
encodeToBuilder :: forall a. ToJSON a => 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 [Char]
s -> [Char] -> Builder
encodeStringBB [Char]
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 [] = Builder
"{}"
encodeObjectBB Object
jvs = Char -> Builder
BB.char8 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Object -> Builder
go Object
jvs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
'}'
  where
    go :: Object -> Builder
go = [Builder] -> Builder
forall a. Monoid a => [a] -> a
Data.Monoid.mconcat ([Builder] -> Builder)
-> (Object -> [Builder]) -> Object -> 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])
-> (Object -> [Builder]) -> Object -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Builder) -> Object -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Pair -> Builder
encPair
    encPair :: Pair -> Builder
encPair ([Char]
l, Value
x) = [Char] -> Builder
encodeStringBB [Char]
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 :: String -> Builder
encodeStringBB :: [Char] -> Builder
encodeStringBB [Char]
str = Char -> Builder
BB.char8 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
go [Char]
str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BB.char8 Char
'"'
  where
    go :: [Char] -> Builder
go = [Char] -> Builder
BB.stringUtf8 ([Char] -> Builder) -> ([Char] -> [Char]) -> [Char] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
escapeString

------------------------------------------------------------------------------
-- 'String'-based encoding

-- | Serialise value as JSON-encoded Unicode 'String'
encodeToString :: ToJSON a => a -> String
encodeToString :: forall a. ToJSON a => a -> [Char]
encodeToString a
jv = Value -> [Char] -> [Char]
encodeValue (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
jv) []

encodeValue :: Value -> ShowS
encodeValue :: Value -> [Char] -> [Char]
encodeValue Value
jv = case Value
jv of
  Bool Bool
b -> [Char] -> [Char] -> [Char]
showString (if Bool
b then [Char]
"true" else [Char]
"false")
  Value
Null -> [Char] -> [Char] -> [Char]
showString [Char]
"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 -> [Char] -> [Char]
encodeValue Value
Null
    | Just Int64
i <- Double -> Maybe Int64
doubleToInt64 Double
n -> Int64 -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows Int64
i
    | Bool
otherwise -> Double -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows Double
n
  Array [Value]
a -> [Value] -> [Char] -> [Char]
encodeArray [Value]
a
  String [Char]
s -> [Char] -> [Char] -> [Char]
encodeString [Char]
s
  Object Object
o -> Object -> [Char] -> [Char]
encodeObject Object
o

encodeArray :: [Value] -> ShowS
encodeArray :: [Value] -> [Char] -> [Char]
encodeArray [] = [Char] -> [Char] -> [Char]
showString [Char]
"[]"
encodeArray [Value]
jvs = (Char
'[' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> [Char] -> [Char]
go [Value]
jvs ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
']' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
  where
    go :: [Value] -> [Char] -> [Char]
go [] = [Char] -> [Char]
forall a. a -> a
id
    go [Value
x] = Value -> [Char] -> [Char]
encodeValue Value
x
    go (Value
x : [Value]
xs) = Value -> [Char] -> [Char]
encodeValue Value
x ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
',' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> [Char] -> [Char]
go [Value]
xs

encodeObject :: Object -> ShowS
encodeObject :: Object -> [Char] -> [Char]
encodeObject [] = [Char] -> [Char] -> [Char]
showString [Char]
"{}"
encodeObject Object
jvs = (Char
'{' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Char] -> [Char]
go Object
jvs ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'}' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
  where
    go :: Object -> [Char] -> [Char]
go [] = [Char] -> [Char]
forall a. a -> a
id
    go [([Char]
l, Value
x)] = [Char] -> [Char] -> [Char]
encodeString [Char]
l ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [Char] -> [Char]
encodeValue Value
x
    go (([Char]
l, Value
x) : Object
lxs) = [Char] -> [Char] -> [Char]
encodeString [Char]
l ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> [Char] -> [Char]
encodeValue Value
x ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
',' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [Char] -> [Char]
go Object
lxs

encodeString :: String -> ShowS
encodeString :: [Char] -> [Char] -> [Char]
encodeString [Char]
str = (Char
'"' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString ([Char] -> [Char]
escapeString [Char]
str) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'"' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)

------------------------------------------------------------------------------
-- 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 b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x

-- | Minimally escape a 'String' in accordance with RFC 7159, "7. Strings"
escapeString :: String -> String
escapeString :: [Char] -> [Char]
escapeString [Char]
s
  | Bool -> Bool
not ((Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any Char -> Bool
needsEscape [Char]
s) = [Char]
s
  | Bool
otherwise = [Char] -> [Char]
escape [Char]
s
  where
    escape :: [Char] -> [Char]
escape [] = []
    escape (Char
x : [Char]
xs) = case Char
x of
      Char
'\\' -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
      Char
'"' -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'"' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
      Char
'\b' -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'b' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
      Char
'\f' -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'f' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
      Char
'\n' -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
      Char
'\r' -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'r' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
      Char
'\t' -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
't' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
      Char
c
        | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10 -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> Char
intToDigit (Char -> Int
ord Char
c) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
        | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 -> Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'u' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'0' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'1' Char -> [Char] -> [Char]
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 -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
xs
        | Bool
otherwise -> Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
escape [Char]
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 -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [Char
'\\', Char
'"']

------------------------------------------------------------------------------
-- FromJSON

-- | Elements of a JSON path used to describe the location of an
-- error.
data JSONPathElement
  = -- | JSON path element of a key into an object,
    -- \"object.key\".
    Key String
  | -- | JSON path element of an index into an
    -- array, \"array[index]\".
    Index !Int
  deriving (JSONPathElement -> JSONPathElement -> Bool
(JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> Eq JSONPathElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JSONPathElement -> JSONPathElement -> Bool
== :: JSONPathElement -> JSONPathElement -> Bool
$c/= :: JSONPathElement -> JSONPathElement -> Bool
/= :: JSONPathElement -> JSONPathElement -> Bool
Eq, Int -> JSONPathElement -> [Char] -> [Char]
[JSONPathElement] -> [Char] -> [Char]
JSONPathElement -> [Char]
(Int -> JSONPathElement -> [Char] -> [Char])
-> (JSONPathElement -> [Char])
-> ([JSONPathElement] -> [Char] -> [Char])
-> Show JSONPathElement
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> JSONPathElement -> [Char] -> [Char]
showsPrec :: Int -> JSONPathElement -> [Char] -> [Char]
$cshow :: JSONPathElement -> [Char]
show :: JSONPathElement -> [Char]
$cshowList :: [JSONPathElement] -> [Char] -> [Char]
showList :: [JSONPathElement] -> [Char] -> [Char]
Show, Eq JSONPathElement
Eq JSONPathElement =>
(JSONPathElement -> JSONPathElement -> Ordering)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> Bool)
-> (JSONPathElement -> JSONPathElement -> JSONPathElement)
-> (JSONPathElement -> JSONPathElement -> JSONPathElement)
-> Ord JSONPathElement
JSONPathElement -> JSONPathElement -> Bool
JSONPathElement -> JSONPathElement -> Ordering
JSONPathElement -> JSONPathElement -> JSONPathElement
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JSONPathElement -> JSONPathElement -> Ordering
compare :: JSONPathElement -> JSONPathElement -> Ordering
$c< :: JSONPathElement -> JSONPathElement -> Bool
< :: JSONPathElement -> JSONPathElement -> Bool
$c<= :: JSONPathElement -> JSONPathElement -> Bool
<= :: JSONPathElement -> JSONPathElement -> Bool
$c> :: JSONPathElement -> JSONPathElement -> Bool
> :: JSONPathElement -> JSONPathElement -> Bool
$c>= :: JSONPathElement -> JSONPathElement -> Bool
>= :: JSONPathElement -> JSONPathElement -> Bool
$cmax :: JSONPathElement -> JSONPathElement -> JSONPathElement
max :: JSONPathElement -> JSONPathElement -> JSONPathElement
$cmin :: JSONPathElement -> JSONPathElement -> JSONPathElement
min :: JSONPathElement -> JSONPathElement -> JSONPathElement
Ord)

type JSONPath = [JSONPathElement]

-- | Failure continuation.
type Failure f r = JSONPath -> String -> f r

-- | Success continuation.
type Success a f r = a -> f r

newtype Parser a = Parser
  { forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser
      :: forall f r
       . JSONPath
      -> Failure f r
      -> Success a f r
      -> f r
  }

modifyFailure :: (String -> String) -> Parser a -> Parser a
modifyFailure :: forall a. ([Char] -> [Char]) -> Parser a -> Parser a
modifyFailure [Char] -> [Char]
f (Parser forall (f :: Type -> Type) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p) = (forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: Type -> Type) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: Type -> Type) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks ->
  [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall (f :: Type -> Type) r.
[JSONPathElement] -> Failure f r -> Success a f r -> f r
p [JSONPathElement]
path (\[JSONPathElement]
p' [Char]
m -> Failure f r
kf [JSONPathElement]
p' ([Char] -> [Char]
f [Char]
m)) Success a f r
ks

prependFailure :: String -> Parser a -> Parser a
prependFailure :: forall a. [Char] -> Parser a -> Parser a
prependFailure = ([Char] -> [Char]) -> Parser a -> Parser a
forall a. ([Char] -> [Char]) -> Parser a -> Parser a
modifyFailure (([Char] -> [Char]) -> Parser a -> Parser a)
-> ([Char] -> [Char] -> [Char]) -> [Char] -> Parser a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
(++)

prependContext :: String -> Parser a -> Parser a
prependContext :: forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
name = [Char] -> Parser a -> Parser a
forall a. [Char] -> Parser a -> Parser a
prependFailure ([Char]
"parsing " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" failed, ")

typeMismatch :: String -> Value -> Parser a
typeMismatch :: forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
expected Value
actual =
  [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser a) -> [Char] -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char]
"expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
expected [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", but encountered " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
typeOf Value
actual

instance Monad.Monad Parser where
  Parser a
m >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
g = (forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
forall a.
(forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: Type -> Type) r.
  [JSONPathElement] -> Failure f r -> Success b f r -> f r)
 -> Parser b)
-> (forall (f :: Type -> Type) r.
    [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success b f r
ks ->
    Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser
      Parser a
m
      [JSONPathElement]
path
      Failure f r
kf
      (\a
a -> Parser b
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
g a
a) [JSONPathElement]
path Failure f r
kf Success b f r
ks)
  return :: forall a. a -> Parser a
return = a -> Parser a
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure

instance Fail.MonadFail Parser where
  fail :: forall a. [Char] -> Parser a
fail [Char]
msg = (forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: Type -> Type) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: Type -> Type) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
_ks -> Failure f r
kf ([JSONPathElement] -> [JSONPathElement]
forall a. [a] -> [a]
reverse [JSONPathElement]
path) [Char]
msg

instance Functor Parser where
  fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f Parser a
m = (forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
forall a.
(forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: Type -> Type) r.
  [JSONPathElement] -> Failure f r -> Success b f r -> f r)
 -> Parser b)
-> (forall (f :: Type -> Type) r.
    [JSONPathElement] -> Failure f r -> Success b f r -> f r)
-> Parser b
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success b f r
ks ->
    let ks' :: a -> f r
ks' a
a = Success b f r
ks (a -> b
f a
a)
     in Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
m [JSONPathElement]
path Failure f r
kf a -> f r
ks'

instance Applicative Parser where
  pure :: forall a. a -> Parser a
pure a
a = (forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: Type -> Type) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: Type -> Type) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
_path Failure f r
_kf Success a f r
ks -> Success a f r
ks a
a
  <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = Parser (a -> b) -> Parser a -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
apP

instance Alternative Parser where
  empty :: forall a. Parser a
empty = [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"empty"
  <|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) = Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (m :: Type -> Type) a. MonadPlus m => m a -> m a -> m a
mplus

instance MonadPlus Parser where
  mzero :: forall a. Parser a
mzero = [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"mzero"
  mplus :: forall a. Parser a -> Parser a -> Parser a
mplus Parser a
a Parser a
b = (forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: Type -> Type) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: Type -> Type) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks ->
    Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
a [JSONPathElement]
path (\[JSONPathElement]
_ [Char]
_ -> Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
b [JSONPathElement]
path Failure f r
kf Success a f r
ks) Success a f r
ks

instance Semigroup (Parser a) where
  <> :: Parser a -> Parser a -> Parser a
(<>) = Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (m :: Type -> Type) a. MonadPlus m => m a -> m a -> m a
mplus

instance Monoid (Parser a) where
  mempty :: Parser a
mempty = [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"mempty"
  mappend :: Parser a -> Parser a -> Parser a
mappend = Parser a -> Parser a -> Parser a
forall a. Semigroup a => a -> a -> a
(<>)

apP :: Parser (a -> b) -> Parser a -> Parser b
apP :: forall a b. Parser (a -> b) -> Parser a -> Parser b
apP Parser (a -> b)
d Parser a
e = do
  b <- Parser (a -> b)
d
  b <$> e

(<?>) :: Parser a -> JSONPathElement -> Parser a
Parser a
p <?> :: forall a. Parser a -> JSONPathElement -> Parser a
<?> JSONPathElement
pathElem = (forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a.
(forall (f :: Type -> Type) r.
 [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
Parser ((forall (f :: Type -> Type) r.
  [JSONPathElement] -> Failure f r -> Success a f r -> f r)
 -> Parser a)
-> (forall (f :: Type -> Type) r.
    [JSONPathElement] -> Failure f r -> Success a f r -> f r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \[JSONPathElement]
path Failure f r
kf Success a f r
ks -> Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser Parser a
p (JSONPathElement
pathElem JSONPathElement -> [JSONPathElement] -> [JSONPathElement]
forall a. a -> [a] -> [a]
: [JSONPathElement]
path) Failure f r
kf Success a f r
ks

parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON :: forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
p Int
idx Value
value = Value -> Parser a
p Value
value Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> Int -> JSONPathElement
Index Int
idx

unexpected :: Value -> Parser a
unexpected :: forall a. Value -> Parser a
unexpected Value
actual = [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser a) -> [Char] -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Value -> [Char]
typeOf Value
actual

withObject :: String -> (Object -> Parser a) -> Value -> Parser a
withObject :: forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
_ Object -> Parser a
f (Object Object
obj) = Object -> Parser a
f Object
obj
withObject [Char]
name Object -> Parser a
_ Value
v = [Char] -> Parser a -> Parser a
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
name ([Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Object" Value
v)

withArray :: String -> ([Value] -> Parser a) -> Value -> Parser a
withArray :: forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withArray [Char]
_ [Value] -> Parser a
f (Array [Value]
arr) = [Value] -> Parser a
f [Value]
arr
withArray [Char]
name [Value] -> Parser a
_ Value
v = [Char] -> Parser a -> Parser a
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
name ([Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Array" Value
v)

withString :: String -> (String -> Parser a) -> Value -> Parser a
withString :: forall a. [Char] -> ([Char] -> Parser a) -> Value -> Parser a
withString [Char]
_ [Char] -> Parser a
f (String [Char]
txt) = [Char] -> Parser a
f [Char]
txt
withString [Char]
name [Char] -> Parser a
_ Value
v = [Char] -> Parser a -> Parser a
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
name ([Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"String" Value
v)

withDouble :: String -> (Double -> Parser a) -> Value -> Parser a
withDouble :: forall a. [Char] -> (Double -> Parser a) -> Value -> Parser a
withDouble [Char]
_ Double -> Parser a
f (Number Double
duble) = Double -> Parser a
f Double
duble
withDouble [Char]
name Double -> Parser a
_ Value
v = [Char] -> Parser a -> Parser a
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
name ([Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Number" Value
v)

withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
withBool :: forall a. [Char] -> (Bool -> Parser a) -> Value -> Parser a
withBool [Char]
_ Bool -> Parser a
f (Bool Bool
arr) = Bool -> Parser a
f Bool
arr
withBool [Char]
name Bool -> Parser a
_ Value
v = [Char] -> Parser a -> Parser a
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
name ([Char] -> Value -> Parser a
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Boolean" Value
v)

class FromJSON a where
  parseJSON :: Value -> Parser a

  parseJSONList :: Value -> Parser [a]
  parseJSONList = [Char] -> ([Value] -> Parser [a]) -> Value -> Parser [a]
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withArray [Char]
"[]" ((Int -> Value -> Parser a) -> [Int] -> [Value] -> Parser [a]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM ((Value -> Parser a) -> Int -> Value -> Parser a
forall a. (Value -> Parser a) -> Int -> Value -> Parser a
parseIndexedJSON Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON) [Int
0 ..])

instance FromJSON Bool where
  parseJSON :: Value -> Parser Bool
parseJSON (Bool Bool
b) = Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
b
  parseJSON Value
v = [Char] -> Value -> Parser Bool
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"Bool" Value
v

instance FromJSON () where
  parseJSON :: Value -> Parser ()
parseJSON =
    [Char] -> ([Value] -> Parser ()) -> Value -> Parser ()
forall a. [Char] -> ([Value] -> Parser a) -> Value -> Parser a
withArray [Char]
"()" (([Value] -> Parser ()) -> Value -> Parser ())
-> ([Value] -> Parser ()) -> Value -> Parser ()
forall a b. (a -> b) -> a -> b
$ \[Value]
v ->
      if [Value] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Value]
v
        then () -> Parser ()
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
        else [Char] -> Parser () -> Parser ()
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
"()" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser ()
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"expected an empty array"

instance FromJSON Char where
  parseJSON :: Value -> Parser Char
parseJSON = [Char] -> ([Char] -> Parser Char) -> Value -> Parser Char
forall a. [Char] -> ([Char] -> Parser a) -> Value -> Parser a
withString [Char]
"Char" [Char] -> Parser Char
parseChar

  parseJSONList :: Value -> Parser [Char]
parseJSONList (String [Char]
s) = [Char] -> Parser [Char]
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Char]
s
  parseJSONList Value
v = [Char] -> Value -> Parser [Char]
forall a. [Char] -> Value -> Parser a
typeMismatch [Char]
"String" Value
v

parseChar :: String -> Parser Char
parseChar :: [Char] -> Parser Char
parseChar [Char
c] = Char -> Parser Char
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Char
c
parseChar [] = [Char] -> Parser Char -> Parser Char
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
"Char" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser Char
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"expected a string of length 1, got an empty string"
parseChar (Char
_ : [Char]
_) = [Char] -> Parser Char -> Parser Char
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
"Char" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser Char
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"expected a string of length 1, got a longer string"

parseRealFloat :: RealFloat a => String -> Value -> Parser a
parseRealFloat :: forall a. RealFloat a => [Char] -> Value -> Parser a
parseRealFloat [Char]
_ (Number Double
s) = a -> Parser a
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> Parser a) -> a -> Parser a
forall a b. (a -> b) -> a -> b
$ Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
s
parseRealFloat [Char]
_ Value
Null = a -> Parser a
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a
0 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0)
parseRealFloat [Char]
name Value
v = [Char] -> Parser a -> Parser a
forall a. [Char] -> Parser a -> Parser a
prependContext [Char]
name (Value -> Parser a
forall a. Value -> Parser a
unexpected Value
v)

instance FromJSON Double where
  parseJSON :: Value -> Parser Double
parseJSON = [Char] -> Value -> Parser Double
forall a. RealFloat a => [Char] -> Value -> Parser a
parseRealFloat [Char]
"Double"

instance FromJSON Float where
  parseJSON :: Value -> Parser Float
parseJSON = [Char] -> Value -> Parser Float
forall a. RealFloat a => [Char] -> Value -> Parser a
parseRealFloat [Char]
"Float"

parseNatural :: Integer -> Parser Natural
parseNatural :: Integer -> Parser Natural
parseNatural Integer
integer =
  if Integer
integer Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
    then [Char] -> Parser Natural
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser Natural) -> [Char] -> Parser Natural
forall a b. (a -> b) -> a -> b
$ [Char]
"parsing Natural failed, unexpected negative number " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
integer
    else Natural -> Parser Natural
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Natural -> Parser Natural) -> Natural -> Parser Natural
forall a b. (a -> b) -> a -> b
$ Integer -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
integer

parseIntegralFromDouble :: Integral a => Double -> Parser a
parseIntegralFromDouble :: forall a. Integral a => Double -> Parser a
parseIntegralFromDouble Double
d =
  let r :: Rational
r = Double -> Rational
forall a. Real a => a -> Rational
toRational Double
d
      x :: a
x = Rational -> a
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Rational
r
   in if a -> Rational
forall a. Real a => a -> Rational
toRational a
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
r
        then a -> Parser a
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
x
        else [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser a) -> [Char] -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char]
"unexpected floating number " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Double -> [Char]
forall a. Show a => a -> [Char]
show Double
d

parseIntegral :: Integral a => String -> Value -> Parser a
parseIntegral :: forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
name = [Char] -> (Double -> Parser a) -> Value -> Parser a
forall a. [Char] -> (Double -> Parser a) -> Value -> Parser a
withDouble [Char]
name Double -> Parser a
forall a. Integral a => Double -> Parser a
parseIntegralFromDouble

instance FromJSON Integer where
  parseJSON :: Value -> Parser Integer
parseJSON = [Char] -> Value -> Parser Integer
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Integer"

instance FromJSON Natural where
  parseJSON :: Value -> Parser Natural
parseJSON =
    [Char] -> (Double -> Parser Natural) -> Value -> Parser Natural
forall a. [Char] -> (Double -> Parser a) -> Value -> Parser a
withDouble
      [Char]
"Natural"
      (Double -> Parser Integer
forall a. Integral a => Double -> Parser a
parseIntegralFromDouble (Double -> Parser Integer)
-> (Integer -> Parser Natural) -> Double -> Parser Natural
forall (m :: Type -> Type) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Integer -> Parser Natural
parseNatural)

instance FromJSON Int where
  parseJSON :: Value -> Parser Int
parseJSON = [Char] -> Value -> Parser Int
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Int"

instance FromJSON Int8 where
  parseJSON :: Value -> Parser Int8
parseJSON = [Char] -> Value -> Parser Int8
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Int8"

instance FromJSON Int16 where
  parseJSON :: Value -> Parser Int16
parseJSON = [Char] -> Value -> Parser Int16
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Int16"

instance FromJSON Int32 where
  parseJSON :: Value -> Parser Int32
parseJSON = [Char] -> Value -> Parser Int32
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Int32"

instance FromJSON Int64 where
  parseJSON :: Value -> Parser Int64
parseJSON = [Char] -> Value -> Parser Int64
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Int64"

instance FromJSON Word where
  parseJSON :: Value -> Parser Word
parseJSON = [Char] -> Value -> Parser Word
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Word"

instance FromJSON Word8 where
  parseJSON :: Value -> Parser Word8
parseJSON = [Char] -> Value -> Parser Word8
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Word8"

instance FromJSON Word16 where
  parseJSON :: Value -> Parser Word16
parseJSON = [Char] -> Value -> Parser Word16
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Word16"

instance FromJSON Word32 where
  parseJSON :: Value -> Parser Word32
parseJSON = [Char] -> Value -> Parser Word32
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Word32"

instance FromJSON Word64 where
  parseJSON :: Value -> Parser Word64
parseJSON = [Char] -> Value -> Parser Word64
forall a. Integral a => [Char] -> Value -> Parser a
parseIntegral [Char]
"Word64"

instance FromJSON a => FromJSON [a] where
  parseJSON :: Value -> Parser [a]
parseJSON = Value -> Parser [a]
forall a. FromJSON a => Value -> Parser [a]
parseJSONList

data Result a
  = Error String
  | Success a
  deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
/= :: Result a -> Result a -> Bool
Eq, Int -> Result a -> [Char] -> [Char]
[Result a] -> [Char] -> [Char]
Result a -> [Char]
(Int -> Result a -> [Char] -> [Char])
-> (Result a -> [Char])
-> ([Result a] -> [Char] -> [Char])
-> Show (Result a)
forall a. Show a => Int -> Result a -> [Char] -> [Char]
forall a. Show a => [Result a] -> [Char] -> [Char]
forall a. Show a => Result a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> [Char] -> [Char]
showsPrec :: Int -> Result a -> [Char] -> [Char]
$cshow :: forall a. Show a => Result a -> [Char]
show :: Result a -> [Char]
$cshowList :: forall a. Show a => [Result a] -> [Char] -> [Char]
showList :: [Result a] -> [Char] -> [Char]
Show)

fromJSON :: FromJSON a => Value -> Result a
fromJSON :: forall a. FromJSON a => Value -> Result a
fromJSON = (Value -> Parser a) -> Value -> Result a
forall a b. (a -> Parser b) -> a -> Result b
parse Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON

parse :: (a -> Parser b) -> a -> Result b
parse :: forall a b. (a -> Parser b) -> a -> Result b
parse a -> Parser b
m a
v = Parser b
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] (([Char] -> Result b) -> Failure Result b
forall a b. a -> b -> a
const [Char] -> Result b
forall a. [Char] -> Result a
Error) Success b Result b
forall a. a -> Result a
Success

parseEither :: (a -> Parser b) -> a -> Either String b
parseEither :: forall a b. (a -> Parser b) -> a -> Either [Char] b
parseEither a -> Parser b
m a
v = Parser b
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success b f r -> f r
forall a.
Parser a
-> forall (f :: Type -> Type) r.
   [JSONPathElement] -> Failure f r -> Success a f r -> f r
runParser (a -> Parser b
m a
v) [] Failure (Either [Char]) b
forall {b}. [JSONPathElement] -> [Char] -> Either [Char] b
onError Success b (Either [Char]) b
forall a b. b -> Either a b
Right
  where
    onError :: [JSONPathElement] -> [Char] -> Either [Char] b
onError [JSONPathElement]
path [Char]
msg = [Char] -> Either [Char] b
forall a b. a -> Either a b
Left ([JSONPathElement] -> [Char] -> [Char]
formatError [JSONPathElement]
path [Char]
msg)

formatError :: JSONPath -> String -> String
formatError :: [JSONPathElement] -> [Char] -> [Char]
formatError [JSONPathElement]
path [Char]
msg = [Char]
"Error in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> [Char]
formatPath [JSONPathElement]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg

formatPath :: JSONPath -> String
formatPath :: [JSONPathElement] -> [Char]
formatPath [JSONPathElement]
path = [Char]
"$" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [JSONPathElement] -> [Char]
formatRelativePath [JSONPathElement]
path

formatRelativePath :: JSONPath -> String
formatRelativePath :: [JSONPathElement] -> [Char]
formatRelativePath [JSONPathElement]
path = [Char] -> [JSONPathElement] -> [Char]
format [Char]
"" [JSONPathElement]
path
  where
    format :: String -> JSONPath -> String
    format :: [Char] -> [JSONPathElement] -> [Char]
format [Char]
pfx [] = [Char]
pfx
    format [Char]
pfx (Index Int
idx : [JSONPathElement]
parts) = [Char] -> [JSONPathElement] -> [Char]
format ([Char]
pfx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]") [JSONPathElement]
parts
    format [Char]
pfx (Key [Char]
key : [JSONPathElement]
parts) = [Char] -> [JSONPathElement] -> [Char]
format ([Char]
pfx [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
formatKey [Char]
key) [JSONPathElement]
parts

    formatKey :: String -> String
    formatKey :: [Char] -> [Char]
formatKey [Char]
key
      | [Char] -> Bool
isIdentifierKey [Char]
key = [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
key
      | Bool
otherwise = [Char]
"['" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
escapeKey [Char]
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"']"

    isIdentifierKey :: String -> Bool
    isIdentifierKey :: [Char] -> Bool
isIdentifierKey [] = Bool
False
    isIdentifierKey (Char
x : [Char]
xs) = Char -> Bool
isAlpha Char
x Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isAlphaNum [Char]
xs

    escapeKey :: String -> String
    escapeKey :: [Char] -> [Char]
escapeKey = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escapeChar

    escapeChar :: Char -> String
    escapeChar :: Char -> [Char]
escapeChar Char
'\'' = [Char]
"\\'"
    escapeChar Char
'\\' = [Char]
"\\\\"
    escapeChar Char
c = [Char
c]

explicitParseField :: (Value -> Parser a) -> Object -> String -> Parser a
explicitParseField :: forall a. (Value -> Parser a) -> Object -> [Char] -> Parser a
explicitParseField Value -> Parser a
p Object
obj [Char]
key =
  case [Char]
key [Char] -> Object -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` Object
obj of
    Maybe Value
Nothing -> [Char] -> Parser a
forall a. [Char] -> Parser a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser a) -> [Char] -> Parser a
forall a b. (a -> b) -> a -> b
$ [Char]
"key " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"
    Just Value
v -> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> [Char] -> JSONPathElement
Key [Char]
key

(.:) :: FromJSON a => Object -> String -> Parser a
.: :: forall a. FromJSON a => Object -> [Char] -> Parser a
(.:) = (Value -> Parser a) -> Object -> [Char] -> Parser a
forall a. (Value -> Parser a) -> Object -> [Char] -> Parser a
explicitParseField Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON

explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> String -> Parser (Maybe a)
explicitParseFieldMaybe :: forall a.
(Value -> Parser a) -> Object -> [Char] -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser a
p Object
obj [Char]
key =
  case [Char]
key [Char] -> Object -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` Object
obj of
    Maybe Value
Nothing -> Maybe a -> Parser (Maybe a)
forall a. a -> Parser a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Just Value
v -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser a -> Parser (Maybe a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
p Value
v Parser a -> JSONPathElement -> Parser a
forall a. Parser a -> JSONPathElement -> Parser a
<?> [Char] -> JSONPathElement
Key [Char]
key

(.:?) :: FromJSON a => Object -> String -> Parser (Maybe a)
.:? :: forall a. FromJSON a => Object -> [Char] -> Parser (Maybe a)
(.:?) = (Value -> Parser a) -> Object -> [Char] -> Parser (Maybe a)
forall a.
(Value -> Parser a) -> Object -> [Char] -> Parser (Maybe a)
explicitParseFieldMaybe Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON

decodeWith :: (Value -> Result a) -> BSL.ByteString -> Maybe a
decodeWith :: forall a. (Value -> Result a) -> ByteString -> Maybe a
decodeWith Value -> Result a
decoder ByteString
bsl =
  case Parsec ByteString () Value
-> [Char] -> ByteString -> Either ParseError Value
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
Parsec.parse Parsec ByteString () Value
parseJSONValue [Char]
"<input>" ByteString
bsl of
    Left ParseError
_ -> Maybe a
forall a. Maybe a
Nothing
    Right Value
json ->
      case Value -> Result a
decoder Value
json of
        Success a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
        Error [Char]
_ -> Maybe a
forall a. Maybe a
Nothing

decode :: FromJSON a => BSL.ByteString -> Maybe a
decode :: forall a. FromJSON a => ByteString -> Maybe a
decode = (Value -> Result a) -> ByteString -> Maybe a
forall a. (Value -> Result a) -> ByteString -> Maybe a
decodeWith Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON

eitherDecodeWith :: (Value -> Result a) -> BSL.ByteString -> Either String a
eitherDecodeWith :: forall a. (Value -> Result a) -> ByteString -> Either [Char] a
eitherDecodeWith Value -> Result a
decoder ByteString
bsl =
  case Parsec ByteString () Value
-> [Char] -> ByteString -> Either ParseError Value
forall s t a.
Stream s Identity t =>
Parsec s () a -> [Char] -> s -> Either ParseError a
Parsec.parse Parsec ByteString () Value
parseJSONValue [Char]
"<input>" ByteString
bsl of
    Left ParseError
parsecError -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left (ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
parsecError)
    Right Value
json ->
      case Value -> Result a
decoder Value
json of
        Success a
a -> a -> Either [Char] a
forall a b. b -> Either a b
Right a
a
        Error [Char]
err -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
err

eitherDecode :: FromJSON a => BSL.ByteString -> Either String a
eitherDecode :: forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode = (Value -> Result a) -> ByteString -> Either [Char] a
forall a. (Value -> Result a) -> ByteString -> Either [Char] a
eitherDecodeWith Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON

decodeFile :: FromJSON a => FilePath -> IO (Maybe a)
decodeFile :: forall a. FromJSON a => [Char] -> IO (Maybe a)
decodeFile [Char]
filePath = do
  parsecResult <- Parsec ByteString () Value
-> [Char] -> IO (Either ParseError Value)
forall a. Parser a -> [Char] -> IO (Either ParseError a)
Parsec.Lazy.parseFromFile Parsec ByteString () Value
parseJSONValue [Char]
filePath
  case parsecResult of
    Right Value
r ->
      case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
r of
        Success a
a -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
        Error [Char]
_ -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Left ParseError
_ -> Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

eitherDecodeFile :: FromJSON a => FilePath -> IO (Either String a)
eitherDecodeFile :: forall a. FromJSON a => [Char] -> IO (Either [Char] a)
eitherDecodeFile [Char]
filePath = do
  parsecResult <- Parsec ByteString () Value
-> [Char] -> IO (Either ParseError Value)
forall a. Parser a -> [Char] -> IO (Either ParseError a)
Parsec.Lazy.parseFromFile Parsec ByteString () Value
parseJSONValue [Char]
filePath
  case parsecResult of
    Right Value
r ->
      case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
r of
        Success a
a -> Either [Char] a -> IO (Either [Char] a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (a -> Either [Char] a
forall a b. b -> Either a b
Right a
a)
        Error [Char]
err -> Either [Char] a -> IO (Either [Char] a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
err)
    Left ParseError
err -> Either [Char] a -> IO (Either [Char] a)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either [Char] a -> IO (Either [Char] a))
-> Either [Char] a -> IO (Either [Char] a)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] a
forall a b. a -> Either a b
Left (ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err)