{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}

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

  -- * Default method
  , gmapdefault

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

  ) where

import           Control.Applicative (Const, ZipList)

import           Data.Complex (Complex)
import           Data.Functor.Identity (Identity)
import qualified Data.Functor.Product as Functor (Product)
import qualified Data.Functor.Sum as Functor (Sum)
import           Data.List.NonEmpty (NonEmpty)
import qualified Data.Monoid as Monoid (First, Last, Product, Sum)
import           Data.Monoid (Alt, Dual)
import           Data.Ord (Down)
import           Data.Proxy (Proxy)
import qualified Data.Semigroup as Semigroup (First, Last)
import           Data.Semigroup (Arg, Max, Min, WrappedMonoid)

import           Generics.Deriving.Base

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

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

instance GFunctor' V1 where
  gmap' :: forall a b. (a -> b) -> V1 a -> V1 b
gmap' a -> b
_ V1 a
x = case V1 a
x of {}

instance GFunctor' U1 where
  gmap' :: forall a b. (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' :: forall a b. (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' :: forall a b. (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' :: forall a b. (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 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)

instance (GFunctor' f) => GFunctor' (M1 i c f) where
  gmap' :: forall a b. (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 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)

instance (GFunctor' f, GFunctor' g) => GFunctor' (f :+: g) where
  gmap' :: forall a b. (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 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)
  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 a b. (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' :: forall a b. (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 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 a b. (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' :: forall a b. (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 a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. GFunctor f => (a -> b) -> f a -> f b
gmap ((a -> b) -> g a -> g b
forall a b. (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' :: forall a b. (a -> b) -> UAddr a -> UAddr b
gmap' a -> b
_ (UAddr Addr#
a) = Addr# -> URec (Ptr ()) b
forall k (p :: k). Addr# -> URec (Ptr ()) p
UAddr Addr#
a

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

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

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

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

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

class GFunctor f where
  gmap :: (a -> b) -> f a -> f b
  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

gmapdefault :: (Generic1 f, GFunctor' (Rep1 f))
            => (a -> b) -> f a -> f b
gmapdefault :: forall (f :: * -> *) a b.
(Generic1 f, GFunctor' (Rep1 f)) =>
(a -> b) -> f a -> f b
gmapdefault a -> b
f = Rep1 f b -> f b
forall a. Rep1 f a -> f a
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 a b. (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 a. 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 :: forall a b. (a -> b) -> (r -> a) -> r -> b
gmap = (a -> b) -> (r -> a) -> r -> b
forall a b. (a -> b) -> (r -> a) -> r -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance GFunctor ((,) a) where
  gmap :: forall a b. (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 :: forall a b. (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

instance GFunctor f => GFunctor (Alt f) where
  gmap :: forall a b. (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

instance GFunctor (Arg a) where
  gmap :: forall a b. (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

instance GFunctor Complex where
  gmap :: forall a b. (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

instance GFunctor (Const m) where
  gmap :: forall a b. (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 :: forall a b. (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 :: forall a b. (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 :: forall a b. (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 :: forall a b. (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

instance GFunctor (Semigroup.First) where
  gmap :: forall a b. (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

instance GFunctor Identity where
  gmap :: forall a b. (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

instance GFunctor IO where
  gmap :: forall a b. (a -> b) -> IO a -> IO b
gmap = (a -> b) -> IO a -> IO b
forall a b. (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 :: forall a b. (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 Semigroup.Last where
  gmap :: forall a b. (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 :: forall a b. (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

instance GFunctor Maybe where
  gmap :: forall a b. (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

instance GFunctor Min where
  gmap :: forall a b. (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 :: forall a b. (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

instance GFunctor Monoid.Product where
  gmap :: forall a b. (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

instance (GFunctor f, GFunctor g) => GFunctor (Functor.Product f g) where
  gmap :: forall a b. (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

instance GFunctor Proxy where
  gmap :: forall a b. (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

instance GFunctor Monoid.Sum where
  gmap :: forall a b. (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

instance (GFunctor f, GFunctor g) => GFunctor (Functor.Sum f g) where
  gmap :: forall a b. (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 :: forall a b. (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

instance GFunctor ZipList where
  gmap :: forall a b. (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