lift1 fix

src/Misc/Lift1.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 module Misc.Lift1
-    ( Lift1(..)
+    ( Lift1(..), lift1
     , liftCon, liftCon2, liftCon3
     , Lift(..)
     )
@@ -13,11 +13,17 @@ import Language.Haskell.TH.Quote
 import Data.Kind                        qualified
 import GHC.Generics
 
+-- instances
 import Data.Fix
+import Data.Functor.Sum
 --------------------------------------------------------------------------------
 
 class Lift1 (f :: Data.Kind.Type -> Data.Kind.Type) where
-    lift1 :: (Quote m, Lift t) => f t -> m Exp
+    -- lift1 :: (Quote m, Lift t) => f t -> m Exp
+    liftLift :: (Quote m) => (a -> m Exp) -> f a -> m Exp
+
+lift1 :: (Lift1 f, Lift a, Quote m) => f a -> m Exp
+lift1 = liftLift lift
 
 liftCon :: Quote m => TH.Name -> m Exp -> m Exp
 liftCon n = fmap (AppE (ConE n))
@@ -38,4 +44,11 @@ liftCon3 n a b c = do
 instance Lift1 f => Lift (Fix f) where
     lift (Fix f) = AppE (ConE 'Fix) <$> lift1 f
 
+instance Lift1 [] where
+    liftLift lf []     = pure $ ConE '[]
+    liftLift lf (a:as) = liftCon2 '(:) (lf a) (liftLift lf as)
+
+instance (Lift1 f, Lift1 g) => Lift1 (Sum f g) where
+    liftLift lf (InL fa) = liftCon 'InL $ liftLift lf fa
+    liftLift lf (InR ga) = liftCon 'InR $ liftLift lf ga