From 1e2cf97bcb72b9a9d0326be6476015615c0f3527 Mon Sep 17 00:00:00 2001
From: Ben Orchard <thefirstmuffinman@gmail.com>
Date: Wed, 22 Feb 2023 16:52:11 +0000
Subject: [PATCH] add derivingvia wrapper

---
 src/Strongweak.hs             |  1 +
 src/Strongweak/Generic.hs     |  4 +++
 src/Strongweak/Generic/Via.hs | 47 +++++++++++++++++++++++++++++++++++
 strongweak.cabal              |  1 +
 4 files changed, 53 insertions(+)
 create mode 100644 src/Strongweak/Generic/Via.hs

diff --git a/src/Strongweak.hs b/src/Strongweak.hs
index 2688f5e..13475b9 100644
--- a/src/Strongweak.hs
+++ b/src/Strongweak.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UndecidableInstances #-}
 module Strongweak
   (
   -- * Instance design
diff --git a/src/Strongweak/Generic.hs b/src/Strongweak/Generic.hs
index 17274f0..9c067b9 100644
--- a/src/Strongweak/Generic.hs
+++ b/src/Strongweak/Generic.hs
@@ -8,10 +8,14 @@ module Strongweak.Generic
   -- * Generic derivers
     weakenGeneric
   , strengthenGeneric
+
+  -- * Generic wrapper
+  , GenericallySW(..)
   ) where
 
 import Strongweak.Generic.Weaken
 import Strongweak.Generic.Strengthen
+import Strongweak.Generic.Via
 
 {- $generic-derivation-compatibility
 
diff --git a/src/Strongweak/Generic/Via.hs b/src/Strongweak/Generic/Via.hs
new file mode 100644
index 0000000..403df9d
--- /dev/null
+++ b/src/Strongweak/Generic/Via.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE UndecidableInstances #-} -- required due to nested constraints
+
+module Strongweak.Generic.Via where
+
+import Strongweak.Generic.Weaken
+import Strongweak.Generic.Strengthen
+import Strongweak
+import GHC.Generics
+import Data.Kind
+
+{- | @DerivingVia@ wrapper for strongweak instances.
+
+We can't use 'Generically' conveniently because we need to talk about two data
+types, not one -- we would have to do something like @'Generically' ('Tagged' w
+s)@, which is ugly. So we instead define our own adorable little "via type"
+here!
+
+Use like so:
+
+@
+data XYZ (s :: Strength) = XYZ
+  { xyz1 :: SW s Word8
+  , xyz2 :: Word8
+  , xyz3 :: ()
+  } deriving stock Generic
+deriving via (GenericallySW (XYZ 'Strong) (XYZ 'Weak)) instance Weaken (XYZ 'Strong)
+deriving via (GenericallySW (XYZ 'Strong) (XYZ 'Weak)) instance Strengthen (XYZ 'Strong)
+@
+
+TODO can't figure out a way around multiple standalone deriving declarations :(
+-}
+
+newtype GenericallySW s (w :: Type) = GenericallySW { unGenericallySW :: s }
+
+instance
+  ( Generic s, Generic w
+  , GWeaken (Rep s) (Rep w)
+  ) => Weaken (GenericallySW s w) where
+    type Weak (GenericallySW s w) = w
+    weaken = weakenGeneric . unGenericallySW
+
+instance
+  ( Generic s, Generic w
+  , GStrengthenD (Rep w) (Rep s)
+  , Weaken (GenericallySW s w)
+  ) => Strengthen (GenericallySW s w) where
+    strengthen = fmap GenericallySW . strengthenGeneric
diff --git a/strongweak.cabal b/strongweak.cabal
index 46a5dc1..f74a06d 100644
--- a/strongweak.cabal
+++ b/strongweak.cabal
@@ -31,6 +31,7 @@ library
       Strongweak
       Strongweak.Generic
       Strongweak.Generic.Strengthen
+      Strongweak.Generic.Via
       Strongweak.Generic.Weaken
       Strongweak.Strengthen
       Strongweak.Strengthen.Unsafe