Attempt to fix Template Haskell problems

src/ghc-8.10/Witch/Lift.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Witch.Lift where
+
+import qualified Control.Exception as Exception
+import qualified Control.Monad.IO.Class as IO
+import qualified Data.Typeable as Typeable
+import qualified Language.Haskell.TH.Syntax as TH
+import qualified Witch.Identity as Identity
+import qualified Witch.TryCast as TryCast
+
+liftedCast
+  :: ( TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  ) => source
+  -> TH.Q (TH.TExp target)
+liftedCast = either (IO.liftIO . Exception.throwIO) TH.liftTyped . TryCast.tryCast
+
+liftedFrom
+  :: forall s source target
+  . ( Identity.Identity s ~ source
+  , TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  ) => source
+  -> TH.Q (TH.TExp target)
+liftedFrom = liftedCast
+
+liftedInto
+  :: forall t source target
+  . ( Identity.Identity t ~ target
+  , TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  ) => source
+  -> TH.Q (TH.TExp target)
+liftedInto = liftedCast

src/ghc-8.8/Witch/Lift.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Witch.Lift where
+
+import qualified Control.Exception as Exception
+import qualified Control.Monad.IO.Class as IO
+import qualified Data.Typeable as Typeable
+import qualified Language.Haskell.TH.Syntax as TH
+import qualified Witch.Identity as Identity
+import qualified Witch.TryCast as TryCast
+
+liftedCast
+  :: forall source target
+  . ( TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  ) => source
+  -> TH.Q TH.Exp
+liftedCast s = case TryCast.tryCast s of
+  Left e -> IO.liftIO $ Exception.throwIO e
+  Right t -> TH.lift (t :: target)
+
+liftedFrom
+  :: forall s source target
+  . ( Identity.Identity s ~ source
+  , TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  ) => source
+  -> TH.Q TH.Exp
+liftedFrom = liftedCast @source @target
+
+liftedInto
+  :: forall t source target
+  . ( Identity.Identity t ~ target
+  , TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  ) => source
+  -> TH.Q TH.Exp
+liftedInto = liftedCast @source @target

src/ghc-9.0/Witch/Lift.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Witch.Lift where
+
+import qualified Control.Exception as Exception
+import qualified Control.Monad.IO.Class as IO
+import qualified Data.Typeable as Typeable
+import qualified Language.Haskell.TH.Syntax as TH
+import qualified Witch.Identity as Identity
+import qualified Witch.TryCast as TryCast
+
+liftedCast
+  :: ( TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  , TH.Quote m
+  ) => source
+  -> TH.Code m target
+liftedCast = either (TH.liftCode . IO.liftIO . Exception.throwIO) TH.liftTyped . TryCast.tryCast
+
+liftedFrom
+  :: forall s source target
+  . ( Identity.Identity s ~ source
+  , TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  , TH.Quote m
+  ) => source
+  -> TH.Code m target
+liftedFrom = liftedCast
+
+liftedInto
+  :: forall t source target
+  . ( Identity.Identity t ~ target
+  , TryCast.TryCast source target
+  , TH.Lift target
+  , Show source
+  , Typeable.Typeable source
+  , Typeable.Typeable target
+  , TH.Quote m
+  ) => source
+  -> TH.Code m target
+liftedInto = liftedCast

src/lib/Witch.hs

@@ -12,12 +12,13 @@ module Witch
   , Witch.Utility.unsafeCast
   , Witch.Utility.unsafeFrom
   , Witch.Utility.unsafeInto
-  , Witch.Utility.liftedCast
+  , Witch.Lift.liftedCast
-  , Witch.Utility.liftedFrom
+  , Witch.Lift.liftedFrom
-  , Witch.Utility.liftedInto
+  , Witch.Lift.liftedInto
   ) where
 
 import qualified Witch.Cast
+import qualified Witch.Lift
 import qualified Witch.Utility
 import qualified Witch.TryCast
 import qualified Witch.TryCastException

src/lib/Witch/Utility.hs

@@ -5,10 +5,8 @@
 module Witch.Utility where
 
 import qualified Control.Exception as Exception
-import qualified Control.Monad.IO.Class as IO
 import qualified Data.Typeable as Typeable
 import qualified GHC.Stack as Stack
-import qualified Language.Haskell.TH.Syntax as TH
 import qualified Witch.Cast as Cast
 import qualified Witch.Identity as Identity
 import qualified Witch.TryCast as TryCast
@@ -97,37 +95,3 @@ unsafeInto
   ) => source
   -> target
 unsafeInto = unsafeCast
-
-liftedCast
-  :: ( TryCast.TryCast source target
-  , TH.Lift target
-  , Show source
-  , Typeable.Typeable source
-  , Typeable.Typeable target
-  ) => source
-  -> TH.Q (TH.TExp target)
-liftedCast = either (IO.liftIO . Exception.throwIO) TH.liftTyped . TryCast.tryCast
-
-liftedFrom
-  :: forall s source target
-  . ( Identity.Identity s ~ source
-  , TryCast.TryCast source target
-  , TH.Lift target
-  , Show source
-  , Typeable.Typeable source
-  , Typeable.Typeable target
-  ) => source
-  -> TH.Q (TH.TExp target)
-liftedFrom = liftedCast
-
-liftedInto
-  :: forall t source target
-  . ( Identity.Identity t ~ target
-  , TryCast.TryCast source target
-  , TH.Lift target
-  , Show source
-  , Typeable.Typeable source
-  , Typeable.Typeable target
-  ) => source
-  -> TH.Q (TH.TExp target)
-liftedInto = liftedCast

witch.cabal

@@ -25,6 +25,7 @@ library
     Witch
     Witch.Cast
     Witch.Identity
+    Witch.Lift
     Witch.TryCast
     Witch.TryCastException
     Witch.Utility
@@ -41,6 +42,14 @@ library
     -Wno-unsafe
   hs-source-dirs: src/lib
 
+  if impl(ghc >= 9.0)
+    hs-source-dirs: src/ghc-9.0
+  else
+    if impl(ghc >= 8.10)
+      hs-source-dirs: src/ghc-8.10
+    else
+      hs-source-dirs: src/ghc-8.8
+
 test-suite test
   build-depends:
     base