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