{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Newtypes with special instances for deriving.
--
-- === Warning
--
-- This is an internal module: it is not subject to any versioning policy,
-- breaking changes can happen at any time.
--
-- If something here seems useful, please report it or create a pull request to
-- export it from an external module.

module Generic.Data.Internal.Resolvers where

import Data.Bifunctor (first)
import Data.Functor.Classes
import Data.Function (on)
import Text.Read (Read(..))

import Generic.Data.Internal.Compat(readPrec1)

-- | A newtype whose instances for simple classes ('Eq', 'Ord', 'Read', 'Show')
-- use higher-kinded class instances for @f@ (`Eq1`, `Ord1`, `Read1`, `Show1`).
newtype Id1 f a = Id1 { Id1 f a -> f a
unId1 :: f a }
  deriving ((a -> b -> Bool) -> Id1 f a -> Id1 f b -> Bool
(forall a b. (a -> b -> Bool) -> Id1 f a -> Id1 f b -> Bool)
-> Eq1 (Id1 f)
forall a b. (a -> b -> Bool) -> Id1 f a -> Id1 f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> Id1 f a -> Id1 f b -> Bool
forall (f :: * -> *).
(forall a b. (a -> b -> Bool) -> f a -> f b -> Bool) -> Eq1 f
liftEq :: (a -> b -> Bool) -> Id1 f a -> Id1 f b -> Bool
$cliftEq :: forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> Id1 f a -> Id1 f b -> Bool
Eq1, Eq1 (Id1 f)
Eq1 (Id1 f)
-> (forall a b.
    (a -> b -> Ordering) -> Id1 f a -> Id1 f b -> Ordering)
-> Ord1 (Id1 f)
(a -> b -> Ordering) -> Id1 f a -> Id1 f b -> Ordering
forall a b. (a -> b -> Ordering) -> Id1 f a -> Id1 f b -> Ordering
forall (f :: * -> *).
Eq1 f
-> (forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering)
-> Ord1 f
forall (f :: * -> *). Ord1 f => Eq1 (Id1 f)
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> Id1 f a -> Id1 f b -> Ordering
liftCompare :: (a -> b -> Ordering) -> Id1 f a -> Id1 f b -> Ordering
$cliftCompare :: forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> Id1 f a -> Id1 f b -> Ordering
$cp1Ord1 :: forall (f :: * -> *). Ord1 f => Eq1 (Id1 f)
Ord1, ReadPrec a -> ReadPrec [a] -> ReadPrec (Id1 f a)
ReadPrec a -> ReadPrec [a] -> ReadPrec [Id1 f a]
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Id1 f a)
(Int -> ReadS a) -> ReadS [a] -> ReadS [Id1 f a]
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Id1 f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Id1 f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Id1 f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Id1 f a])
-> Read1 (Id1 f)
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [Id1 f a]
forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (Id1 f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Id1 f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [Id1 f a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [Id1 f a]
forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (Id1 f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Id1 f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [Id1 f a]
forall (f :: * -> *).
(forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a))
-> (forall a. (Int -> ReadS a) -> ReadS [a] -> ReadS [f a])
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (f a))
-> (forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec [f a])
-> Read1 f
liftReadListPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec [Id1 f a]
$cliftReadListPrec :: forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec [Id1 f a]
liftReadPrec :: ReadPrec a -> ReadPrec [a] -> ReadPrec (Id1 f a)
$cliftReadPrec :: forall (f :: * -> *) a.
Read1 f =>
ReadPrec a -> ReadPrec [a] -> ReadPrec (Id1 f a)
liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [Id1 f a]
$cliftReadList :: forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [Id1 f a]
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Id1 f a)
$cliftReadsPrec :: forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Id1 f a)
Read1, (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Id1 f a -> ShowS
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Id1 f a] -> ShowS
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Id1 f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Id1 f a] -> ShowS)
-> Show1 (Id1 f)
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Id1 f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Id1 f a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Id1 f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Id1 f a] -> ShowS
forall (f :: * -> *).
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [Id1 f a] -> ShowS
$cliftShowList :: forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [Id1 f a] -> ShowS
liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Id1 f a -> ShowS
$cliftShowsPrec :: forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Id1 f a -> ShowS
Show1)

instance (Eq1 f, Eq a) => Eq (Id1 f a) where
  == :: Id1 f a -> Id1 f a -> Bool
(==) = f a -> f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1 (f a -> f a -> Bool)
-> (Id1 f a -> f a) -> Id1 f a -> Id1 f a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Id1 f a -> f a
forall (f :: * -> *) a. Id1 f a -> f a
unId1

instance (Ord1 f, Ord a) => Ord (Id1 f a) where
  compare :: Id1 f a -> Id1 f a -> Ordering
compare = f a -> f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1 (f a -> f a -> Ordering)
-> (Id1 f a -> f a) -> Id1 f a -> Id1 f a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Id1 f a -> f a
forall (f :: * -> *) a. Id1 f a -> f a
unId1

instance (Read1 f, Read a) => Read (Id1 f a) where
  readsPrec :: Int -> ReadS (Id1 f a)
readsPrec = (((String -> [(f a, String)]) -> ReadS (Id1 f a))
-> (Int -> String -> [(f a, String)]) -> Int -> ReadS (Id1 f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String -> [(f a, String)]) -> ReadS (Id1 f a))
 -> (Int -> String -> [(f a, String)]) -> Int -> ReadS (Id1 f a))
-> ((f a -> Id1 f a)
    -> (String -> [(f a, String)]) -> ReadS (Id1 f a))
-> (f a -> Id1 f a)
-> (Int -> String -> [(f a, String)])
-> Int
-> ReadS (Id1 f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(f a, String)] -> [(Id1 f a, String)])
-> (String -> [(f a, String)]) -> ReadS (Id1 f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(f a, String)] -> [(Id1 f a, String)])
 -> (String -> [(f a, String)]) -> ReadS (Id1 f a))
-> ((f a -> Id1 f a) -> [(f a, String)] -> [(Id1 f a, String)])
-> (f a -> Id1 f a)
-> (String -> [(f a, String)])
-> ReadS (Id1 f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((f a, String) -> (Id1 f a, String))
-> [(f a, String)] -> [(Id1 f a, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((f a, String) -> (Id1 f a, String))
 -> [(f a, String)] -> [(Id1 f a, String)])
-> ((f a -> Id1 f a) -> (f a, String) -> (Id1 f a, String))
-> (f a -> Id1 f a)
-> [(f a, String)]
-> [(Id1 f a, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> Id1 f a) -> (f a, String) -> (Id1 f a, String)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) f a -> Id1 f a
forall (f :: * -> *) a. f a -> Id1 f a
Id1 Int -> String -> [(f a, String)]
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1
  readPrec :: ReadPrec (Id1 f a)
readPrec = (f a -> Id1 f a) -> ReadPrec (f a) -> ReadPrec (Id1 f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> Id1 f a
forall (f :: * -> *) a. f a -> Id1 f a
Id1 ReadPrec (f a)
forall (f :: * -> *) a. (Read1 f, Read a) => ReadPrec (f a)
readPrec1

instance (Show1 f, Show a) => Show (Id1 f a) where
  showsPrec :: Int -> Id1 f a -> ShowS
showsPrec Int
d = Int -> f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1 Int
d (f a -> ShowS) -> (Id1 f a -> f a) -> Id1 f a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id1 f a -> f a
forall (f :: * -> *) a. Id1 f a -> f a
unId1

-- | A newtype with trivial instances, that considers
-- every value equivalent to every other one,
-- and shows as just @"_"@.
newtype Opaque a = Opaque { Opaque a -> a
unOpaque :: a }

-- | All equal.
instance Eq (Opaque a) where
  == :: Opaque a -> Opaque a -> Bool
(==) Opaque a
_ Opaque a
_ = Bool
True

-- | All equal.
instance Ord (Opaque a) where
  compare :: Opaque a -> Opaque a -> Ordering
compare Opaque a
_ Opaque a
_ = Ordering
EQ

-- | Shown as @"_"@.
instance Show (Opaque a) where
  showsPrec :: Int -> Opaque a -> ShowS
showsPrec Int
_ Opaque a
_ = String -> ShowS
showString String
"_"

-- | All equal.
instance Eq1 Opaque where
  liftEq :: (a -> b -> Bool) -> Opaque a -> Opaque b -> Bool
liftEq a -> b -> Bool
_ Opaque a
_ Opaque b
_ = Bool
True

-- | All equal.
instance Ord1 Opaque where
  liftCompare :: (a -> b -> Ordering) -> Opaque a -> Opaque b -> Ordering
liftCompare a -> b -> Ordering
_ Opaque a
_ Opaque b
_ = Ordering
EQ

-- | Shown as @"_"@.
instance Show1 Opaque where
  liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Opaque a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ Opaque a
_ = String -> ShowS
showString String
"_"

-- | A higher-kinded version of 'Opaque'.
newtype Opaque1 f a = Opaque1 { Opaque1 f a -> f a
unOpaque1 :: f a }

-- | All equal.
instance Eq (Opaque1 f a) where
  == :: Opaque1 f a -> Opaque1 f a -> Bool
(==) Opaque1 f a
_ Opaque1 f a
_ = Bool
True

-- | All equal.
instance Ord (Opaque1 f a) where
  compare :: Opaque1 f a -> Opaque1 f a -> Ordering
compare Opaque1 f a
_ Opaque1 f a
_ = Ordering
EQ

-- | Shown as @"_"@.
instance Show (Opaque1 f a) where
  showsPrec :: Int -> Opaque1 f a -> ShowS
showsPrec Int
_ Opaque1 f a
_ = String -> ShowS
showString String
"_"

-- | All equal.
instance Eq1 (Opaque1 f) where
  liftEq :: (a -> b -> Bool) -> Opaque1 f a -> Opaque1 f b -> Bool
liftEq a -> b -> Bool
_ Opaque1 f a
_ Opaque1 f b
_ = Bool
True

-- | All equal.
instance Ord1 (Opaque1 f) where
  liftCompare :: (a -> b -> Ordering) -> Opaque1 f a -> Opaque1 f b -> Ordering
liftCompare a -> b -> Ordering
_ Opaque1 f a
_ Opaque1 f b
_ = Ordering
EQ

-- | Shown as @"_"@.
instance Show1 (Opaque1 f) where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Opaque1 f a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
_ Int
_ Opaque1 f a
_ = String -> ShowS
showString String
"_"