mirror of
https://github.com/tfausak/witch.git
synced 2024-11-26 09:43:03 +03:00
Attempt to fix Template Haskell problems
This commit is contained in:
Taylor Fausak
parent
5484556515
commit
4657c5bf49
46
src/ghc-8.10/Witch/Lift.hs
Normal file
46
src/ghc-8.10/Witch/Lift.hs
Normal file
@ -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
|
||||
50
src/ghc-8.8/Witch/Lift.hs
Normal file
50
src/ghc-8.8/Witch/Lift.hs
Normal file
@ -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
|
||||
49
src/ghc-9.0/Witch/Lift.hs
Normal file
49
src/ghc-9.0/Witch/Lift.hs
Normal file
@ -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
|
||||
@ -12,12 +12,13 @@ module Witch
|
||||
, Witch.Utility.unsafeCast
|
||||
, Witch.Utility.unsafeFrom
|
||||
, Witch.Utility.unsafeInto
|
||||
, Witch.Utility.liftedCast
|
||||
, Witch.Utility.liftedFrom
|
||||
, Witch.Utility.liftedInto
|
||||
, Witch.Lift.liftedCast
|
||||
, Witch.Lift.liftedFrom
|
||||
, Witch.Lift.liftedInto
|
||||
) where
|
||||
|
||||
import qualified Witch.Cast
|
||||
import qualified Witch.Lift
|
||||
import qualified Witch.Utility
|
||||
import qualified Witch.TryCast
|
||||
import qualified Witch.TryCastException
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user