{-# LANGUAGE CPP #-}

module Data.Aeson.Compat
#if MIN_VERSION_aeson(2, 0, 0)
  ( module Data.Aeson
  , parseEither
  ) where

import Data.Aeson

#if MIN_VERSION_aeson(2, 1, 0)
import Prelude
import Data.Aeson.Types (Parser, IResult(..), iparse)

parseEither :: (a -> Parser b) -> a -> Either String b
parseEither :: forall a b. (a -> Parser b) -> a -> Either String b
parseEither a -> Parser b
f a
a = case (a -> Parser b) -> a -> IResult b
forall a b. (a -> Parser b) -> a -> IResult b
iparse a -> Parser b
f a
a of
  IError JSONPath
_ String
x -> String -> Either String b
forall a b. a -> Either a b
Left String
x
  ISuccess b
b -> b -> Either String b
forall a b. b -> Either a b
Right b
b
#else
import Data.Aeson.Types (parseEither)
#endif

#else
  ( Key
  , module Data.Aeson
  , parseEither
  ) where

import Data.Aeson
import Data.Text (Text)
import Data.Aeson.Types (parseEither)

type Key = Text
#endif