{-# LANGUAGE TemplateHaskell, FlexibleContexts, UndecidableInstances, TypeFamilies, DeriveDataTypeable, RankNTypes, RecordWildCards, OverloadedStrings, ScopedTypeVariables, NoMonomorphismRestriction, LiberalTypeSynonyms #-}


import Data.Fieldwise
import Data.Typeable
import Data.Monoid
import Control.Applicative
import Control.Monad

data Test1 = Test1 Int String
           | Test2 { test2Char :: Char, test2IntList :: [Int], test2Func :: (Int -> Int) }
  deriving (Typeable)

$(deriveFieldwise ''Test1  (++ "_f"))

liftR :: Test1_f ((->) Test1)
liftR = Test2_f test2Char test2IntList test2Func

-- (c t) is partial below, we do not like this, so we need special
-- thing to take care of this.
--
-- Problem stems from the fact that if Test1 has more than one
-- constructor then Test1_f ((->) Test1) might not be applicable to
-- Test1.
hoistR2 :: (Applicative m) => Test1_f ((->) Test1) -> Test1 -> Test1_f m
hoistR2 f t = hoistR (\c -> pure (c t)) f

liftWithR :: (forall a . (Test1 -> a) -> g a) -> Test1 -> Test1_f g
liftWithR x (Test2 {}) = Test2_f (x test2Char) (x test2IntList) (x test2Func)

main = return ()