FFunctor-generics-sop.hs

{-# LANGUAGE DeriveGeneric, TypeOperators, RankNTypes, ScopedTypeVariables, DataKinds #-}
import Generics.SOP
import qualified GHC.Generics as GHC

type Text = String
type Day = String
data CardType = Visa | AmEx | Mastercard

data FormTemplate f = FormTemplate
    { _email :: f Text
    , _cardType :: f CardType
    , _cardNumber :: f Text
    , _cardExpiry :: f Day
    }
    deriving (GHC.Generic)

instance Generic (FormTemplate f)

type Record t = t I
type Partial t = t Maybe

type Form = Record FormTemplate
type DraftForm = Partial FormTemplate

-- natural transformations between functors f and g
type f ~> g = forall x. f x -> g x

class FFunctor f where
    ffmap :: (Functor g, Functor h) => (g ~> h) -> f g -> f h

instance FFunctor FormTemplate where
    ffmap = mapFormTemplate

mapFormTemplate :: forall f g. (f ~> g) -> FormTemplate f -> FormTemplate g
mapFormTemplate eta x = to (htoI sopG)
  where
    -- unfortunately we need the type annotation here.
    sopF = hfromI (from x) :: SOP f '[ '[Text, CardType, Text, Day] ]
    sopG = hmap eta sopF