Add support for deriving instances via Generically (#108)

* Add support for deriving instances via `Generically`

* Add more tests

* Add some documentation

source/library/Witch.hs

@@ -302,6 +302,7 @@ where
 
 import qualified Witch.Encoding
 import qualified Witch.From
+import Witch.Generic ()
 import Witch.Instances ()
 import qualified Witch.Lift
 import qualified Witch.TryFrom

source/library/Witch/Generic.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Witch.Generic where
+
+import qualified GHC.Generics as Generics
+import qualified Witch.From as From
+
+-- | This type class is used to implement generic conversions using the 'Generics.Generically' helper.
+-- This is an advanced use case.
+-- Most users will not need to know about this type class.
+-- And even for those that want to derive 'Generics.Generically', this type class should be an implementation detail.
+--
+-- This type class can convert between any two types as long as they have 'Generics.Generic' instances and they are structurally similar.
+-- For example, if you define your own empty type you could convert it to the typical 'Data.Void.Void' type:
+--
+-- > data Empty deriving Generic
+-- > deriving via Generically Void instance From Empty Void
+--
+-- Or your own unit type:
+--
+-- > data Unit = MkUnit deriving Generic
+-- > deriving via Generically () instance From Unit ()
+--
+-- Note that this looks superficially similar to @newtype Unit = MkUnit ()@ together with @instance From Unit ()@, but that goes through 'Data.Coerce.Coercible' and requires the types to be representationally equal.
+-- This approach (with 'Generics.Generically') only requires the types to be /structurally/ equal.
+-- In this case, @Unit@ is structurally equal to @()@ since they both have a single constructor with no arguments.
+--
+-- This also works with arbitrary sum types, like a custom pair type:
+--
+-- > data Pair a b = MkPair a b deriving Generic
+-- > deriving via Generically (Pair c d)
+-- >   instance (From a c, From b d) => From (a, b) (Pair c d)
+--
+-- Note that this can also convert the type variables as long as they have 'From.From' instances as well.
+-- This allows converting from @(Int, Int)@ to @Pair Integer Integer@ in one step, for example.
+--
+-- And this works with arbitrary product types as well:
+--
+-- > data Result a b = Failure a | Success b deriving Generic
+-- > deriving via Generically (Result c d)
+-- >   instance (From a c, From b d) => From (Either a b) (Result c d)
+--
+-- Note that these conversions are all /structural/ not semantic.
+-- That means if you had defined @Result@ as @Success b | Failure a@, then converting from 'Either' would be "wrong".
+-- 'Left' would convert into @Success@ and 'Right' would convert into @Failure@.
+class GFrom s t where
+  gFrom :: s x -> t x
+
+instance GFrom Generics.V1 Generics.V1 where
+  gFrom = id
+
+instance GFrom Generics.U1 Generics.U1 where
+  gFrom = id
+
+instance (From.From s t) => GFrom (Generics.K1 a s) (Generics.K1 b t) where
+  gFrom = Generics.K1 . From.from . Generics.unK1
+
+instance (GFrom s t) => GFrom (Generics.M1 a b s) (Generics.M1 c d t) where
+  gFrom = Generics.M1 . gFrom . Generics.unM1
+
+instance (GFrom s1 t1, GFrom s2 t2) => GFrom (s1 Generics.:+: s2) (t1 Generics.:+: t2) where
+  gFrom x = case x of
+    Generics.L1 l -> Generics.L1 $ gFrom l
+    Generics.R1 r -> Generics.R1 $ gFrom r
+
+instance (GFrom s1 t1, GFrom s2 t2) => GFrom (s1 Generics.:*: s2) (t1 Generics.:*: t2) where
+  gFrom (l Generics.:*: r) = gFrom l Generics.:*: gFrom r
+
+-- | See the 'GFrom' type class for an explanation of this instance.
+instance
+  ( Generics.Generic s,
+    Generics.Generic t,
+    GFrom (Generics.Rep s) (Generics.Rep t)
+  ) =>
+  From.From s (Generics.Generically t)
+  where
+  from = Generics.Generically . Generics.to . gFrom . Generics.from

source/test-suite/Main.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-error=overflowed-literals #-}
@@ -28,7 +31,10 @@ import qualified Data.Time as Time
 import qualified Data.Time.Clock.POSIX as Time
 import qualified Data.Time.Clock.System as Time
 import qualified Data.Time.Clock.TAI as Time
+import qualified Data.Tuple as Tuple
+import qualified Data.Void as Void
 import qualified Data.Word as Word
+import qualified GHC.Generics as Generics
 import qualified GHC.Stack as Stack
 import qualified Numeric.Natural as Natural
 import qualified Test.HUnit as HUnit
@@ -64,7 +70,7 @@ spec = describe "Witch" $ do
 
     describe "over" $ do
       it "works" $ do
-        Utility.over @Int.Int8 (+ 1) (Age 1) `shouldBe` Age 2
+        Utility.over @Int.Int8 (+ 1) (MkAge 1) `shouldBe` MkAge 2
 
     describe "via" $ do
       it "works" $ do
@@ -2439,8 +2445,86 @@ spec = describe "Witch" $ do
       it "works" $ do
         f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x00, 0x00, 0x00, 0x61])
 
+  describe "Generically" $ do
+    it "converts into empty" $ do
+      -- This only needs to type check.
+      let _ = Witch.from @Void.Void @Empty
+      pure ()
+
+    it "converts into unit" $ do
+      let f = Witch.from @() @Unit
+      f () `shouldBe` MkUnit
+
+    it "converts into only" $ do
+      let f = Witch.from @(Tuple.Solo Int) @(Only Integer)
+      f (Tuple.MkSolo 1) `shouldBe` MkOnly 1
+
+    it "converts into pair" $ do
+      let f = Witch.from @(Int, Int.Int8) @(Pair Integer Age)
+      f (1, 2) `shouldBe` MkPair 1 (MkAge 2)
+
+    it "converts into result" $ do
+      let f = Witch.from @(Either Int Int.Int8) @(Result Integer Age)
+      f (Left 1) `shouldBe` Failure 1
+      f (Right 2) `shouldBe` Success (MkAge 2)
+
+    it "converts into list" $ do
+      let f = Witch.from @[Int] @(List Integer)
+      f [] `shouldBe` Nil
+      f [1] `shouldBe` Cons 1 Nil
+      f [1, 2] `shouldBe` Cons 1 (Cons 2 Nil)
+
+data Empty
+  deriving (Generics.Generic)
+
+deriving via Generics.Generically Empty instance Witch.From Void.Void Empty
+
+data Unit
+  = MkUnit
+  deriving (Eq, Generics.Generic, Show)
+
+deriving via Generics.Generically Unit instance Witch.From () Unit
+
+newtype Only a
+  = MkOnly a
+  deriving (Eq, Generics.Generic, Show)
+
+deriving via
+  Generics.Generically (Only b)
+  instance
+    (Witch.From a b) => Witch.From (Tuple.Solo a) (Only b)
+
+data Pair a b
+  = MkPair a b
+  deriving (Eq, Generics.Generic, Show)
+
+deriving via
+  Generics.Generically (Pair c d)
+  instance
+    (Witch.From a c, Witch.From b d) => Witch.From (a, b) (Pair c d)
+
+data Result a b
+  = Failure a
+  | Success b
+  deriving (Eq, Generics.Generic, Show)
+
+deriving via
+  Generics.Generically (Result c d)
+  instance
+    (Witch.From a c, Witch.From b d) => Witch.From (Either a b) (Result c d)
+
+data List a
+  = Nil
+  | Cons a (List a)
+  deriving (Eq, Generics.Generic, Show)
+
+deriving via
+  Generics.Generically (List b)
+  instance
+    (Witch.From a b) => Witch.From [a] (List b)
+
 newtype Age
-  = Age Int.Int8
+  = MkAge Int.Int8
   deriving (Eq, Show)
 
 instance Witch.From Age Int.Int8

witch.cabal

@@ -70,6 +70,7 @@ library
     Witch
     Witch.Encoding
     Witch.From
+    Witch.Generic
     Witch.Instances
     Witch.Lift
     Witch.TryFrom