    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE OverloadedStrings  #-}

    #if MIN_VERSION_base(4,9,0)
    #define LIFTED_FUNCTOR_CLASSES 1
    #else
    #if MIN_VERSION_transformers(0,5,0)
    #define LIFTED_FUNCTOR_CLASSES 1
    #else
    #if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)
    #define LIFTED_FUNCTOR_CLASSES 1
    #endif
    #endif
    #endif

    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveFoldable     #-}
    {-# LANGUAGE DeriveFunctor      #-}
    {-# LANGUAGE DeriveGeneric      #-}
    {-# LANGUAGE DeriveTraversable  #-}
    module Data.Functor.These (
        These1 (..),
        ) where

    import Prelude ()
    import Prelude.Compat

    import Data.Aeson
           (FromJSON (..), FromJSON1 (..), ToJSON (..), ToJSON1 (..), (.=))
    import Data.Data            (Data)
    import Data.Functor.Classes
           (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..), compare1, eq1, readsPrec1,
           showsPrec1)
    import Data.Typeable        (Typeable)
    import GHC.Generics         (Generic, Generic1)
    import Test.QuickCheck
           (Arbitrary (..), Arbitrary1 (..), arbitrary1, liftShrink2, oneof,
           shrink1)

    #if MIN_VERSION_deepseq(1,4,3)
    import Control.DeepSeq (NFData (..), NFData1 (..), rnf1)
    #endif

    import qualified Data.Aeson          as Aeson
    import qualified Data.Aeson.Encoding as Aeson (pair)
    import qualified Data.HashMap.Strict as HM

    data These1 f g a
        = This1 (f a)
        | That1 (g a)
        | These1 (f a) (g a)
      deriving (Functor, Foldable, Traversable, Generic
    #if __GLASGOW_HASKELL__ >= 706
        , Generic1
    #endif
    #if __GLASGOW_HASKELL__ >= 708
        , Typeable, Data
    #endif
        )

    -------------------------------------------------------------------------------
    -- Eq1
    -------------------------------------------------------------------------------

    instance (Eq1 f, Eq1 g) => Eq1 (These1 f g) where
    #ifdef LIFTED_FUNCTOR_CLASSES
        liftEq eq (This1 f)    (This1 f')     = liftEq eq f f'
        liftEq eq (That1 g)    (That1 g')     = liftEq eq g g'
        liftEq eq (These1 f g) (These1 f' g') = liftEq eq f f' && liftEq eq g g'

        liftEq _ This1  {} _ = False
        liftEq _ That1  {} _ = False
        liftEq _ These1 {} _ = False
    #else
        eq1 (This1 f)    (This1 f')     = eq1 f f'
        eq1 (That1 g)    (That1 g')     = eq1 g g'
        eq1 (These1 f g) (These1 f' g') = eq1 f f' && eq1 g g'

        eq1 This1  {} _ = False
        eq1 That1  {} _ = False
        eq1 These1 {} _ = False
    #endif

    -------------------------------------------------------------------------------
    -- Ord1
    -------------------------------------------------------------------------------

    instance (Ord1 f, Ord1 g) => Ord1 (These1 f g) where
    #ifdef LIFTED_FUNCTOR_CLASSES
        liftCompare  cmp (This1 f) (This1 f') = liftCompare cmp f f'
        liftCompare _cmp (This1 _) _          = LT
        liftCompare _cmp _         (This1 _)  = GT

        liftCompare  cmp (That1 g) (That1 g') = liftCompare cmp g g'
        liftCompare _cmp (That1 _) _          = LT
        liftCompare _cmp _         (That1 _)  = GT

        liftCompare  cmp (These1 f g) (These1 f' g') =
            liftCompare cmp f f' `mappend` liftCompare cmp g g'
    #else
        compare1 (This1 f) (This1 f') = compare1 f f'
        compare1 (This1 _) _          = LT
        compare1 _         (This1 _)  = GT

        compare1 (That1 g) (That1 g') = compare1 g g'
        compare1 (That1 _) _          = LT
        compare1 _         (That1 _)  = GT

        compare1  (These1 f g) (These1 f' g') =
            compare1 f f' `mappend` compare1 g g'
    #endif

    -------------------------------------------------------------------------------
    -- Show1
    -------------------------------------------------------------------------------

    instance (Show1 f, Show1 g) => Show1 (These1 f g) where
    #ifdef LIFTED_FUNCTOR_CLASSES
        liftShowsPrec sp sl d (This1 f) = showParen (d > 10)
            $ showString "This1 "
            . liftShowsPrec sp sl 11 f
        liftShowsPrec sp sl d (That1 g) = showParen (d > 10)
            $ showString "That1 "
            . liftShowsPrec sp sl 11 g
        liftShowsPrec sp sl d (These1 f g) = showParen (d > 10)
            $ showString "These1 "
            . liftShowsPrec sp sl 11 f
            . showChar ' '
            . liftShowsPrec sp sl 11 g
    #else
        showsPrec1 d (This1 f) = showParen (d > 10)
            $ showString "This1 "
            . showsPrec1 11 f
        showsPrec1 d (That1 g) = showParen (d > 10)
            $ showString "That1 "
            . showsPrec1 11 g
        showsPrec1 d (These1 f g) = showParen (d > 10)
            $ showString "These1 "
            . showsPrec1 11 f
            . showChar ' '
            . showsPrec1 11 g
    #endif

    -------------------------------------------------------------------------------
    -- Read1
    -------------------------------------------------------------------------------

    instance (Read1 f, Read1 g) => Read1 (These1 f g) where
    #ifdef LIFTED_FUNCTOR_CLASSES
        liftReadsPrec rp rl d = readParen (d > 10) $ \s0 -> do
            (t, s1) <- lex s0
            case t of
                "This1" -> do
                    (x, s2) <- liftReadsPrec rp rl 11 s1
                    return (This1 x, s2)
                "That1" -> do
                    (y, s2) <- liftReadsPrec rp rl 11 s1
                    return (That1 y, s2)
                "These1" -> do
                    (x, s2) <- liftReadsPrec rp rl 11 s1
                    (y, s3) <- liftReadsPrec rp rl 11 s2
                    return (These1 x y, s3)
                _ -> []
    #else
        readsPrec1 d = readParen (d > 10) $ \s0 -> do
            (t, s1) <- lex s0
            case t of
                "This1" -> do
                    (x, s2) <- readsPrec1 11 s1
                    return (This1 x, s2)
                "That1" -> do
                    (y, s2) <- readsPrec1 11 s1
                    return (That1 y, s2)
                "These1" -> do
                    (x, s2) <- readsPrec1 11 s1
                    (y, s3) <- readsPrec1 11 s2
                    return (These1 x y, s3)
                _ -> []
    #endif

    -------------------------------------------------------------------------------
    -- Eq, Ord, Show, Read
    -------------------------------------------------------------------------------

    instance (Eq1 f, Eq1 g, Eq a) => Eq (These1 f g a) where (==) = eq1
    instance (Ord1 f, Ord1 g, Ord a) => Ord (These1 f g a) where compare = compare1
    instance (Show1 f, Show1 g, Show a) => Show (These1 f g a) where showsPrec = showsPrec1
    instance (Read1 f, Read1 g, Read a) => Read (These1 f g a) where readsPrec = readsPrec1

    -------------------------------------------------------------------------------
    -- deepseq
    -------------------------------------------------------------------------------

    #if MIN_VERSION_deepseq(1,4,3)
    -- | This instance is available only with @deepseq >= 1.4.3.0@
    instance (NFData1 f, NFData1 g) => NFData1 (These1 f g) where
        liftRnf r (This1 x)    = liftRnf r x
        liftRnf r (That1 y)    = liftRnf r y
        liftRnf r (These1 x y) = liftRnf r x `seq` liftRnf r y

    -- | This instance is available only with @deepseq >= 1.4.3.0@
    instance (NFData1 f, NFData1 g, NFData a) => NFData (These1 f g a) where
        rnf = rnf1
    #endif

    -------------------------------------------------------------------------------
    -- aeson
    -------------------------------------------------------------------------------

    instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (These1 f g) where
        liftToJSON tx tl (This1 a)    = Aeson.object [ "This" .= liftToJSON tx tl a ]
        liftToJSON tx tl (That1 b)    = Aeson.object [ "That" .= liftToJSON tx tl b ]
        liftToJSON tx tl (These1 a b) = Aeson.object [ "This" .= liftToJSON tx tl a, "That" .= liftToJSON tx tl b ]

        liftToEncoding tx tl (This1 a)    = Aeson.pairs $ Aeson.pair "This" (liftToEncoding tx tl a)
        liftToEncoding tx tl (That1 b)    = Aeson.pairs $ Aeson.pair "That" (liftToEncoding tx tl b)
        liftToEncoding tx tl (These1 a b) = Aeson.pairs $
            Aeson.pair "This" (liftToEncoding tx tl a) `mappend`
            Aeson.pair "That" (liftToEncoding tx tl b)

    instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (These1 f g) where
        liftParseJSON px pl = Aeson.withObject "These1" (p . HM.toList)
          where
            p [("This", a), ("That", b)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b
            p [("That", b), ("This", a)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b
            p [("This", a)] = This1 <$> liftParseJSON px pl a
            p [("That", b)] = That1 <$> liftParseJSON px pl b
            p _  = fail "Expected object with 'This' and 'That' keys only"

    instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (These1 f g a) where
        toJSON = Aeson.toJSON1
        toEncoding = Aeson.toEncoding1

    instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (These1 f g a) where
        parseJSON = Aeson.parseJSON1

    -------------------------------------------------------------------------------
    -- QuickCheck
    -------------------------------------------------------------------------------

    instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (These1 f g) where
        liftArbitrary arb = oneof
            [ This1 <$> liftArbitrary arb
            , That1 <$> liftArbitrary arb
            , These1 <$> liftArbitrary arb <*> liftArbitrary arb
            ]

        liftShrink shr (This1 x) = This1 <$> liftShrink shr x
        liftShrink shr (That1 y) = That1 <$> liftShrink shr y
        liftShrink shr (These1 x y) =
            [ This1 x, That1 y ] ++
            [ These1 x' y'
            | (x', y') <- liftShrink2 (liftShrink shr) (liftShrink shr) (x, y)
            ]

    instance (Arbitrary1 f, Arbitrary1 g, Arbitrary a) => Arbitrary (These1 f g a) where
        arbitrary = arbitrary1
        shrink    = shrink1