{-# LANGUAGE GADTs            #-}
{-# LANGUAGE TypeOperators    #-}
{-# LANGUAGE FlexibleContexts #-}
module Generics.Simplistic.Derive.Functor where

import Generics.Simplistic

-- TODO: Abstract this away as a repMap1

-- |'SRep1' is a functor
gfmap' :: OnLeaves1 Trivial Functor f
      => (a -> b) -> SRep1 f a -> SRep1 f b
gfmap' :: (a -> b) -> SRep1 f a -> SRep1 f b
gfmap' _ S1_U1       = SRep1 f b
forall x. SRep1 U1 x
S1_U1
gfmap' f :: a -> b
f (S1_L1 x :: SRep1 f a
x)   = SRep1 f b -> SRep1 (f :+: g) b
forall (f :: * -> *) x (g :: * -> *).
SRep1 f x -> SRep1 (f :+: g) x
S1_L1 ((a -> b) -> SRep1 f a -> SRep1 f b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f SRep1 f a
x)
gfmap' f :: a -> b
f (S1_R1 x :: SRep1 g a
x)   = SRep1 g b -> SRep1 (f :+: g) b
forall (g :: * -> *) x (f :: * -> *).
SRep1 g x -> SRep1 (f :+: g) x
S1_R1 ((a -> b) -> SRep1 g a -> SRep1 g b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f SRep1 g a
x)
gfmap' f :: a -> b
f (x :: SRep1 f a
x :***: y :: SRep1 g a
y) = (a -> b) -> SRep1 f a -> SRep1 f b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f SRep1 f a
x SRep1 f b -> SRep1 g b -> SRep1 (f :*: g) b
forall (f :: * -> *) x (a :: * -> *).
SRep1 f x -> SRep1 a x -> SRep1 (f :*: a) x
:***: (a -> b) -> SRep1 g a -> SRep1 g b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f SRep1 g a
y
gfmap' _ (S1_K1 x :: a
x)   = a -> SRep1 (K1 i a) b
forall a i x. a -> SRep1 (K1 i a) x
S1_K1 a
x
gfmap' f :: a -> b
f (S1_M1 i :: SMeta i t
i x :: SRep1 f a
x) = SMeta i t -> SRep1 f b -> SRep1 (M1 i t f) b
forall i (t :: Meta) (c :: * -> *) x.
SMeta i t -> SRep1 c x -> SRep1 (M1 i t c) x
S1_M1 SMeta i t
i ((a -> b) -> SRep1 f a -> SRep1 f b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f SRep1 f a
x)
gfmap' f :: a -> b
f (S1_ST x :: SRep1 f a
x)   = SRep1 f b -> SRep1 (c :=>: f) b
forall (c :: Constraint) (f :: * -> *) x.
c =>
SRep1 f x -> SRep1 (c :=>: f) x
S1_ST ((a -> b) -> SRep1 f a -> SRep1 f b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f SRep1 f a
x)
gfmap' f :: a -> b
f (S1_Par  x :: a
x) = b -> SRep1 Par1 b
forall x. x -> SRep1 Par1 x
S1_Par (a -> b
f a
x)
gfmap' f :: a -> b
f (S1_Rec  x :: f a
x) = f b -> SRep1 (Rec1 f) b
forall (f :: * -> *) x. f x -> SRep1 (Rec1 f) x
S1_Rec ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
x)
gfmap' f :: a -> b
f (S1_Comp x :: f (SRep1 g a)
x) = f (SRep1 g b) -> SRep1 (f :.: g) b
forall (f :: * -> *) (g :: * -> *) x.
f (SRep1 g x) -> SRep1 (f :.: g) x
S1_Comp ((SRep1 g a -> SRep1 g b) -> f (SRep1 g a) -> f (SRep1 g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> SRep1 g a -> SRep1 g b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f) f (SRep1 g a)
x)

-- |The action of f over arrows can be obtained by translating
-- into the generic representation, using the generic
-- 'gfmap'' and translating back to regular representation.
gfmap :: (Simplistic1 f, OnLeaves1 Trivial Functor (Rep1 f))
      => (a -> b) -> f a -> f b
gfmap :: (a -> b) -> f a -> f b
gfmap f :: a -> b
f = SRep1 (Rep1 f) b -> f b
forall (f :: * -> *) x. Simplistic1 f => SRep1 (Rep1 f) x -> f x
toS1 (SRep1 (Rep1 f) b -> f b)
-> (f a -> SRep1 (Rep1 f) b) -> f a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> SRep1 (Rep1 f) a -> SRep1 (Rep1 f) b
forall (f :: * -> *) a b.
OnLeaves1 Trivial Functor f =>
(a -> b) -> SRep1 f a -> SRep1 f b
gfmap' a -> b
f (SRep1 (Rep1 f) a -> SRep1 (Rep1 f) b)
-> (f a -> SRep1 (Rep1 f) a) -> f a -> SRep1 (Rep1 f) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> SRep1 (Rep1 f) a
forall (f :: * -> *) x. Simplistic1 f => f x -> SRep1 (Rep1 f) x
fromS1