{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}

#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE DefaultSignatures #-}
#endif

#if __GLASGOW_HASKELL__ >= 705
{-# LANGUAGE PolyKinds #-}
#endif

#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE EmptyCase #-}
#endif

#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif

module Generics.Deriving.Functor (
  -- * Generic Functor class
    GFunctor(..)

  -- * Default method
  , gmapdefault

  -- * Internal Functor class
  , GFunctor'(..)

  ) where

import           Control.Applicative (Const, ZipList)

import qualified Data.Monoid as Monoid (First, Last, Product, Sum)
import           Data.Monoid (Dual)

import           Generics.Deriving.Base

#if MIN_VERSION_base(4,4,0)
import           Data.Complex (Complex)
#endif

#if MIN_VERSION_base(4,6,0)
import           Data.Ord (Down)
#else
import           GHC.Exts (Down)
#endif

#if MIN_VERSION_base(4,7,0)
import           Data.Proxy (Proxy)
#endif

#if MIN_VERSION_base(4,8,0)
import           Data.Functor.Identity (Identity)
import           Data.Monoid (Alt)
#endif

#if MIN_VERSION_base(4,9,0)
import qualified Data.Functor.Product as Functor (Product)
import qualified Data.Functor.Sum as Functor (Sum)
import           Data.List.NonEmpty (NonEmpty)
import qualified Data.Semigroup as Semigroup (First, Last)
import           Data.Semigroup (Arg, Max, Min, WrappedMonoid)
#endif

--------------------------------------------------------------------------------
-- Generic fmap
--------------------------------------------------------------------------------

class GFunctor' f where
  gmap' :: (a -> b) -> f a -> f b

instance GFunctor' V1 where
  gmap' :: (a -> b) -> V1 a -> V1 b
gmap' a -> b
_ V1 a
x = case V1 a
x of
#if __GLASGOW_HASKELL__ >= 708
                {}
#else
                !_ -> error "Void gmap"
#endif

instance GFunctor' U1 where
  gmap' :: (a -> b) -> U1 a -> U1 b
gmap' a -> b
_ U1 a
U1 = U1 b
forall k (p :: k). U1 p
U1

instance GFunctor' Par1 where
  gmap' :: (a -> b) -> Par1 a -> Par1 b
gmap' a -> b
f (Par1 a
a) = b -> Par1 b
forall p. p -> Par1 p
Par1 (a -> b
f a
a)

instance GFunctor' (K1 i c) where
  gmap' :: (a -> b) -> K1 i c a -> K1 i c b
gmap' a -> b
_ (K1 c
a) = c -> K1 i c b
forall k i c (p :: k). c -> K1 i c p
K1 c
a

instance (GFunctor f) => GFunctor' (Rec1 f) where
  gmap' :: (a -> b) -> Rec1 f a -> Rec1 f b
gmap' a -> b
f (Rec1 f a
a) = f b -> Rec1 f b
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. GFunctor f => (a -> b) -> f a -> f b
gmap a -> b
f f a
a)

instance (GFunctor' f) => GFunctor' (M1 i c f) where
  gmap' :: (a -> b) -> M1 i c f a -> M1 i c f b
gmap' a -> b
f (M1 f a
a) = f b -> M1 i c f b
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. GFunctor' f => (a -> b) -> f a -> f b
gmap' a -> b
f f a
a)

instance (GFunctor' f, GFunctor' g) => GFunctor' (f :+: g) where
  gmap' :: (a -> b) -> (:+:) f g a -> (:+:) f g b
gmap' a -> b
f (L1 f a
a) = f b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. GFunctor' f => (a -> b) -> f a -> f b
gmap' a -> b
f f a
a)
  gmap' a -> b
f (R1 g a
a) = g b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. GFunctor' f => (a -> b) -> f a -> f b
gmap' a -> b
f g a
a)

instance (GFunctor' f, GFunctor' g) => GFunctor' (f :*: g) where
  gmap' :: (a -> b) -> (:*:) f g a -> (:*:) f g b
gmap' a -> b
f (f a
a :*: g a
b) = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. GFunctor' f => (a -> b) -> f a -> f b
gmap' a -> b
f f a
a f b -> g b -> (:*:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (a -> b) -> g a -> g b
forall (f :: * -> *) a b. GFunctor' f => (a -> b) -> f a -> f b
gmap' a -> b
f g a
b

instance (GFunctor f, GFunctor' g) => GFunctor' (f :.: g) where
  gmap' :: (a -> b) -> (:.:) f g a -> (:.:) f g b
gmap' a -> b
f (Comp1 f (g a)
x) = f (g b) -> (:.:) f g b
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 ((g a -> g b) -> f (g a) -> f (g b)
forall (f :: * -> *) a b. GFunctor f => (a -> b) -> f a -> f b
gmap ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. GFunctor' f => (a -> b) -> f a -> f b
gmap' a -> b
f) f (g a)
x)

instance GFunctor' UAddr where
  gmap' :: (a -> b) -> UAddr a -> UAddr b
gmap' a -> b
_ (UAddr a) = Addr# -> UAddr b
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
a

instance GFunctor' UChar where
  gmap' :: (a -> b) -> UChar a -> UChar b
gmap' a -> b
_ (UChar c) = Char# -> UChar b
forall k (p :: k). Char# -> URec Char p
UChar Char#
c

instance GFunctor' UDouble where
  gmap' :: (a -> b) -> UDouble a -> UDouble b
gmap' a -> b
_ (UDouble d) = Double# -> UDouble b
forall k (p :: k). Double# -> URec Double p
UDouble Double#
d

instance GFunctor' UFloat where
  gmap' :: (a -> b) -> UFloat a -> UFloat b
gmap' a -> b
_ (UFloat f) = Float# -> UFloat b
forall k (p :: k). Float# -> URec Float p
UFloat Float#
f

instance GFunctor' UInt where
  gmap' :: (a -> b) -> UInt a -> UInt b
gmap' a -> b
_ (UInt i) = Int# -> UInt b
forall k (p :: k). Int# -> URec Int p
UInt Int#
i

instance GFunctor' UWord where
  gmap' :: (a -> b) -> UWord a -> UWord b
gmap' a -> b
_ (UWord w) = Word# -> UWord b
forall k (p :: k). Word# -> URec Word p
UWord Word#
w

class GFunctor f where
  gmap :: (a -> b) -> f a -> f b
#if __GLASGOW_HASKELL__ >= 701
  default gmap :: (Generic1 f, GFunctor' (Rep1 f))
               => (a -> b) -> f a -> f b
  gmap = (a -> b) -> f a -> f b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

gmapdefault :: (Generic1 f, GFunctor' (Rep1 f))
            => (a -> b) -> f a -> f b
gmapdefault :: (a -> b) -> f a -> f b
gmapdefault a -> b
f = Rep1 f b -> f b
forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 (Rep1 f b -> f b) -> (f a -> Rep1 f b) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Rep1 f a -> Rep1 f b
forall (f :: * -> *) a b. GFunctor' f => (a -> b) -> f a -> f b
gmap' a -> b
f (Rep1 f a -> Rep1 f b) -> (f a -> Rep1 f a) -> f a -> Rep1 f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Rep1 f a
forall k (f :: k -> *) (a :: k). Generic1 f => f a -> Rep1 f a
from1

-- Base types instances
instance GFunctor ((->) r) where
  gmap :: (a -> b) -> (r -> a) -> r -> b
gmap = (a -> b) -> (r -> a) -> r -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance GFunctor ((,) a) where
  gmap :: (a -> b) -> (a, a) -> (a, b)
gmap = (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor [] where
  gmap :: (a -> b) -> [a] -> [b]
gmap = (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

#if MIN_VERSION_base(4,8,0)
instance GFunctor f => GFunctor (Alt f) where
  gmap :: (a -> b) -> Alt f a -> Alt f b
gmap = (a -> b) -> Alt f a -> Alt f b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

#if MIN_VERSION_base(4,9,0)
instance GFunctor (Arg a) where
  gmap :: (a -> b) -> Arg a a -> Arg a b
gmap = (a -> b) -> Arg a a -> Arg a b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

#if MIN_VERSION_base(4,4,0)
instance GFunctor Complex where
  gmap :: (a -> b) -> Complex a -> Complex b
gmap = (a -> b) -> Complex a -> Complex b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

instance GFunctor (Const m) where
  gmap :: (a -> b) -> Const m a -> Const m b
gmap = (a -> b) -> Const m a -> Const m b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor Down where
  gmap :: (a -> b) -> Down a -> Down b
gmap = (a -> b) -> Down a -> Down b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor Dual where
  gmap :: (a -> b) -> Dual a -> Dual b
gmap = (a -> b) -> Dual a -> Dual b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor (Either a) where
  gmap :: (a -> b) -> Either a a -> Either a b
gmap = (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor Monoid.First where
  gmap :: (a -> b) -> First a -> First b
gmap = (a -> b) -> First a -> First b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

#if MIN_VERSION_base(4,9,0)
instance GFunctor (Semigroup.First) where
  gmap :: (a -> b) -> First a -> First b
gmap = (a -> b) -> First a -> First b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

#if MIN_VERSION_base(4,8,0)
instance GFunctor Identity where
  gmap :: (a -> b) -> Identity a -> Identity b
gmap = (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

instance GFunctor IO where
  gmap :: (a -> b) -> IO a -> IO b
gmap = (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance GFunctor Monoid.Last where
  gmap :: (a -> b) -> Last a -> Last b
gmap = (a -> b) -> Last a -> Last b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

#if MIN_VERSION_base(4,9,0)
instance GFunctor Semigroup.Last where
  gmap :: (a -> b) -> Last a -> Last b
gmap = (a -> b) -> Last a -> Last b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor Max where
  gmap :: (a -> b) -> Max a -> Max b
gmap = (a -> b) -> Max a -> Max b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

instance GFunctor Maybe where
  gmap :: (a -> b) -> Maybe a -> Maybe b
gmap = (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

#if MIN_VERSION_base(4,9,0)
instance GFunctor Min where
  gmap :: (a -> b) -> Min a -> Min b
gmap = (a -> b) -> Min a -> Min b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor NonEmpty where
  gmap :: (a -> b) -> NonEmpty a -> NonEmpty b
gmap = (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

instance GFunctor Monoid.Product where
  gmap :: (a -> b) -> Product a -> Product b
gmap = (a -> b) -> Product a -> Product b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

#if MIN_VERSION_base(4,9,0)
instance (GFunctor f, GFunctor g) => GFunctor (Functor.Product f g) where
  gmap :: (a -> b) -> Product f g a -> Product f g b
gmap = (a -> b) -> Product f g a -> Product f g b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

#if MIN_VERSION_base(4,7,0)
instance GFunctor Proxy where
  gmap :: (a -> b) -> Proxy a -> Proxy b
gmap = (a -> b) -> Proxy a -> Proxy b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

instance GFunctor Monoid.Sum where
  gmap :: (a -> b) -> Sum a -> Sum b
gmap = (a -> b) -> Sum a -> Sum b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

#if MIN_VERSION_base(4,9,0)
instance (GFunctor f, GFunctor g) => GFunctor (Functor.Sum f g) where
  gmap :: (a -> b) -> Sum f g a -> Sum f g b
gmap = (a -> b) -> Sum f g a -> Sum f g b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault

instance GFunctor WrappedMonoid where
  gmap :: (a -> b) -> WrappedMonoid a -> WrappedMonoid b
gmap = (a -> b) -> WrappedMonoid a -> WrappedMonoid b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault
#endif

instance GFunctor ZipList where
  gmap :: (a -> b) -> ZipList a -> ZipList b
gmap = (a -> b) -> ZipList a -> ZipList b
forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault