From 99d601b22283092b8735891d36f6a4ec5af16cf7 Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Mon, 10 May 2021 19:12:06 -0400 Subject: [PATCH] Remove identity type family --- src/ghc-8.10/Witch/Lift.hs | 13 ++++------- src/ghc-8.8/Witch/Lift.hs | 13 ++++------- src/ghc-9.0/Witch/Lift.hs | 13 ++++------- src/lib/Witch.hs | 28 ------------------------ src/lib/Witch/Identity.hs | 14 ------------ src/lib/Witch/Instances.hs | 2 -- src/lib/Witch/Utility.hs | 45 ++++++++++++++++---------------------- src/test/Main.hs | 2 -- witch.cabal | 1 - 9 files changed, 31 insertions(+), 100 deletions(-) delete mode 100644 src/lib/Witch/Identity.hs diff --git a/src/ghc-8.10/Witch/Lift.hs b/src/ghc-8.10/Witch/Lift.hs index 7b3424f..45bdade 100644 --- a/src/ghc-8.10/Witch/Lift.hs +++ b/src/ghc-8.10/Witch/Lift.hs @@ -1,12 +1,9 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE TypeFamilies #-} module Witch.Lift where 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 import qualified Witch.Utility as Utility @@ -39,9 +36,8 @@ liftedCast = TH.liftTyped . Utility.unsafeCast -- > -- Prefer this: -- > $$(liftedFrom @s "some literal") liftedFrom - :: forall s target source - . ( Identity.Identity s ~ source - , TryCast.TryCast source target + :: forall source target + . ( TryCast.TryCast source target , TH.Lift target , Show source , Typeable.Typeable source @@ -60,9 +56,8 @@ liftedFrom = liftedCast -- > -- Prefer this: -- > $$(liftedInto @t "some literal") liftedInto - :: forall t source target - . ( Identity.Identity t ~ target - , TryCast.TryCast source target + :: forall target source + . ( TryCast.TryCast source target , TH.Lift target , Show source , Typeable.Typeable source diff --git a/src/ghc-8.8/Witch/Lift.hs b/src/ghc-8.8/Witch/Lift.hs index ed057fe..b767ed1 100644 --- a/src/ghc-8.8/Witch/Lift.hs +++ b/src/ghc-8.8/Witch/Lift.hs @@ -1,12 +1,9 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} module Witch.Lift where 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 import qualified Witch.Utility as Utility @@ -39,9 +36,8 @@ liftedCast s = TH.unsafeTExpCoerce $ TH.lift (Utility.unsafeCast s :: target) -- > -- Prefer this: -- > $$(liftedFrom @s "some literal") liftedFrom - :: forall s target source - . ( Identity.Identity s ~ source - , TryCast.TryCast source target + :: forall source target + . ( TryCast.TryCast source target , TH.Lift target , Show source , Typeable.Typeable source @@ -60,9 +56,8 @@ liftedFrom = liftedCast -- > -- Prefer this: -- > $$(liftedInto @t "some literal") liftedInto - :: forall t source target - . ( Identity.Identity t ~ target - , TryCast.TryCast source target + :: forall target source + . ( TryCast.TryCast source target , TH.Lift target , Show source , Typeable.Typeable source diff --git a/src/ghc-9.0/Witch/Lift.hs b/src/ghc-9.0/Witch/Lift.hs index cbde4ba..ec65abb 100644 --- a/src/ghc-9.0/Witch/Lift.hs +++ b/src/ghc-9.0/Witch/Lift.hs @@ -1,12 +1,9 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ExplicitForAll #-} -{-# LANGUAGE TypeFamilies #-} module Witch.Lift where 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 import qualified Witch.Utility as Utility @@ -40,9 +37,8 @@ liftedCast = TH.liftTyped . Utility.unsafeCast -- > -- Prefer this: -- > $$(liftedFrom @s "some literal") liftedFrom - :: forall s target m source - . ( Identity.Identity s ~ source - , TryCast.TryCast source target + :: forall source target m + . ( TryCast.TryCast source target , TH.Lift target , Show source , Typeable.Typeable source @@ -62,9 +58,8 @@ liftedFrom = liftedCast -- > -- Prefer this: -- > $$(liftedInto @t "some literal") liftedInto - :: forall t source m target - . ( Identity.Identity t ~ target - , TryCast.TryCast source target + :: forall target source m + . ( TryCast.TryCast source target , TH.Lift target , Show source , Typeable.Typeable source diff --git a/src/lib/Witch.hs b/src/lib/Witch.hs index 94a1d3e..f440d89 100644 --- a/src/lib/Witch.hs +++ b/src/lib/Witch.hs @@ -159,34 +159,6 @@ module Witch -- 'Witch.TryCast.TryCast' instance for it. And if it is technically -- possible to convert from @s@ to @t@ but there are a lot of caveats, you -- probably should not write any instances at all. - - -- ** Type applications - -- | This library is designed to be used with the [@TypeApplications@](https://downloads.haskell.org/~ghc/9.0.1/docs/html/users_guide/exts/type_applications.html) - -- language extension. Although it is not required for basic functionality, - -- it is strongly encouraged. You can use 'Witch.Cast.cast', - -- 'Witch.TryCast.tryCast', 'Witch.Utility.unsafeCast', and - -- 'Witch.Lift.liftedCast' without type applications. Everything else - -- requires a type application. - - -- ** Ambiguous types - -- | You may see @Identity@ show up in some type signatures. Anywhere you see - -- @Identity a@, you can mentally replace it with @a@. It is a type family - -- used to trick GHC into requiring type applications for certain functions. - -- If you forget to give a type application, you will see an error like - -- this: - -- - -- >>> from (1 :: Int8) :: Int16 - -- :1:1: error: - -- * Couldn't match type `Identity s0' with `Int8' - -- arising from a use of `from' - -- The type variable `s0' is ambiguous - -- * In the expression: from (1 :: Int8) :: Int16 - -- In an equation for `it': it = from (1 :: Int8) :: Int16 - -- - -- You can fix the problem by giving a type application: - -- - -- >>> from @Int8 1 :: Int16 - -- 1 ) where import qualified Witch.Cast diff --git a/src/lib/Witch/Identity.hs b/src/lib/Witch/Identity.hs deleted file mode 100644 index d94c6a7..0000000 --- a/src/lib/Witch/Identity.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE TypeFamilies #-} - -module Witch.Identity where - --- | This is an ugly hack used to make GHC require type applications for --- certain functions. See this Twitter thread for a discussion: --- . -type family Identity a where - Identity Never = () - Identity a = a - --- | Never use this type for anything! It only exists to make the 'Identity' --- type family non-trivial. -data Never diff --git a/src/lib/Witch/Instances.hs b/src/lib/Witch/Instances.hs index 5734624..876a5ea 100644 --- a/src/lib/Witch/Instances.hs +++ b/src/lib/Witch/Instances.hs @@ -1,8 +1,6 @@ {-# OPTIONS_GHC -Wno-orphans #-} -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Witch.Instances where diff --git a/src/lib/Witch/Utility.hs b/src/lib/Witch/Utility.hs index e65c4ce..baff218 100644 --- a/src/lib/Witch/Utility.hs +++ b/src/lib/Witch/Utility.hs @@ -1,6 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} module Witch.Utility where @@ -8,7 +7,6 @@ import qualified Control.Exception as Exception import qualified Data.Typeable as Typeable import qualified GHC.Stack as Stack import qualified Witch.Cast as Cast -import qualified Witch.Identity as Identity import qualified Witch.TryCast as TryCast import qualified Witch.TryCastException as TryCastException @@ -21,7 +19,7 @@ import qualified Witch.TryCastException as TryCastException -- > -- > -- Prefer this: -- > f . as @Int . g -as :: forall s source . Identity.Identity s ~ source => source -> source +as :: forall source . source -> source as = id -- | This is the same as 'Cast.cast' except that it requires a type @@ -33,8 +31,8 @@ as = id -- > -- Prefer this: -- > from @s x from - :: forall s target source - . (Identity.Identity s ~ source, Cast.Cast source target) + :: forall source target + . Cast.Cast source target => source -> target from = Cast.cast @@ -48,8 +46,8 @@ from = Cast.cast -- > -- Prefer this: -- > into @t x into - :: forall t source target - . (Identity.Identity t ~ target, Cast.Cast source target) + :: forall target source + . Cast.Cast source target => source -> target into = Cast.cast @@ -65,9 +63,8 @@ into = Cast.cast -- > -- Prefer this: -- > over @t f over - :: forall t source target - . ( Identity.Identity t ~ target - , Cast.Cast source target + :: forall target source + . ( Cast.Cast source target , Cast.Cast target source ) => (target -> target) @@ -86,9 +83,8 @@ over f = Cast.cast . f . Cast.cast -- > -- Prefer this: -- > via @u via - :: forall u source target through - . ( Identity.Identity u ~ through - , Cast.Cast source through + :: forall through source target + . ( Cast.Cast source through , Cast.Cast through target ) => source @@ -104,8 +100,8 @@ via = Cast.cast . (\x -> x :: through) . Cast.cast -- > -- Prefer this: -- > tryFrom @s x tryFrom - :: forall s target source - . (Identity.Identity s ~ source, TryCast.TryCast source target) + :: forall source target + . TryCast.TryCast source target => source -> Either (TryCastException.TryCastException source target) target tryFrom = TryCast.tryCast @@ -119,8 +115,8 @@ tryFrom = TryCast.tryCast -- > -- Prefer this: -- > tryInto @t x tryInto - :: forall t source target - . (Identity.Identity t ~ target, TryCast.TryCast source target) + :: forall target source + . TryCast.TryCast source target => source -> Either (TryCastException.TryCastException source target) target tryInto = TryCast.tryCast @@ -139,9 +135,8 @@ tryInto = TryCast.tryCast -- > -- Prefer this: -- > tryVia @u tryVia - :: forall u source target through - . ( Identity.Identity u ~ through - , TryCast.TryCast source through + :: forall through source target + . ( TryCast.TryCast source through , TryCast.TryCast through target ) => source @@ -221,9 +216,8 @@ unsafeCast = either Exception.throw id . TryCast.tryCast -- > -- Prefer this: -- > unsafeFrom @s unsafeFrom - :: forall s target source - . ( Identity.Identity s ~ source - , Stack.HasCallStack + :: forall source target + . ( Stack.HasCallStack , TryCast.TryCast source target , Show source , Typeable.Typeable source @@ -242,9 +236,8 @@ unsafeFrom = unsafeCast -- > -- Prefer this: -- > unsafeInto @t unsafeInto - :: forall t source target - . ( Identity.Identity t ~ target - , Stack.HasCallStack + :: forall target source + . ( Stack.HasCallStack , TryCast.TryCast source target , Show source , Typeable.Typeable source diff --git a/src/test/Main.hs b/src/test/Main.hs index 0d92955..0e4c2bf 100644 --- a/src/test/Main.hs +++ b/src/test/Main.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} diff --git a/witch.cabal b/witch.cabal index 48fcc4a..4def916 100644 --- a/witch.cabal +++ b/witch.cabal @@ -47,7 +47,6 @@ library exposed-modules: Witch Witch.Cast - Witch.Identity Witch.Instances Witch.Lift Witch.TryCast