{-# 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' _ S1_U1       = S1_U1
gfmap' f (S1_L1 x)   = S1_L1 (gfmap' f x)
gfmap' f (S1_R1 x)   = S1_R1 (gfmap' f x)
gfmap' f (x :***: y) = gfmap' f x :***: gfmap' f y
gfmap' _ (S1_K1 x)   = S1_K1 x
gfmap' f (S1_M1 i x) = S1_M1 i (gfmap' f x)
gfmap' f (S1_ST x)   = S1_ST (gfmap' f x)
gfmap' f (S1_Par  x) = S1_Par (f x)
gfmap' f (S1_Rec  x) = S1_Rec (fmap f x)
gfmap' f (S1_Comp x) = S1_Comp (fmap (gfmap' f) 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 f = toS1 . gfmap' f . fromS1