add Tagged instance for weakened "through"

Author: raehik

package.yaml

@@ -66,6 +66,7 @@ dependencies:
 - rerefined ^>= 0.8.0
 - vector-sized >= 1.5.0 && < 1.7
 - vector >= 0.12.3.1 && < 0.14
+- tagged ^>= 0.8.8
 
 library:
   source-dirs: src

src/Strongweak/Strengthen.hs

@@ -41,6 +41,8 @@ import Data.Bits ( FiniteBits )
 
 import Data.Typeable ( Typeable, TypeRep, typeRep, Proxy(Proxy) )
 
+import Data.Tagged ( Tagged(..) )
+
 {- | Attempt to strengthen some @'Weakened' a@, asserting certain invariants.
 
 We take 'Weaken' as a superclass in order to maintain strong/weak type pair
@@ -244,3 +246,8 @@ f .> g = g . f
 
 typeRep' :: forall a. Typeable a => TypeRep
 typeRep' = typeRep (Proxy @a)
+
+-- | SPECIAL: Strengthen through a 'Tagged'. That is, strengthen @a@ then tag it
+--   with @x@.
+instance Strengthen a => Strengthen (Tagged x a) where
+    strengthen = fmap Tagged <$> strengthen

src/Strongweak/Weaken.hs

@@ -23,6 +23,7 @@ import Data.Functor.Const
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.List.NonEmpty ( NonEmpty )
 import GHC.TypeNats
+import Data.Tagged ( Tagged(..) )
 
 {- | Weaken some @a@, relaxing certain invariants.
 
@@ -149,3 +150,14 @@ instance (Weaken a, Weaken b) => Weaken (Either a b) where
     type Weakened (Either a b) = Either (Weakened a) (Weakened b)
     weaken = \case Left  a -> Left  $ weaken a
                    Right b -> Right $ weaken b
+
+-- | SPECIAL: Weaken through a 'Tagged'. That is, strip the 'Tagged' and weaken
+--   the inner @a@.
+--
+-- This appears to contribute a useful role: we want to plug some newtype into
+-- the strongweak ecosystem, but it would result in orphan instances. With this,
+-- we can go through 'Tagged', and the phantom type helps us handle
+-- parameterized newtypes (like @newtype 'ByteOrdered' (end :: 'ByteOrder') a@).
+instance Weaken a => Weaken (Tagged x a) where
+    type Weakened (Tagged x a) = Weakened a
+    weaken = weaken . unTagged

strongweak.cabal

@@ -56,6 +56,7 @@ library
   build-depends:
       base >=4.18 && <5
     , rerefined >=0.8.0 && <0.9
+    , tagged >=0.8.8 && <0.9
     , text >=2.0 && <2.2
     , text-builder-linear >=0.1.3 && <0.2
     , vector >=0.12.3.1 && <0.14
@@ -93,6 +94,7 @@ test-suite spec
     , quickcheck-instances >=0.3.26 && <0.4
     , rerefined >=0.8.0 && <0.9
     , strongweak
+    , tagged >=0.8.8 && <0.9
     , text >=2.0 && <2.2
     , text-builder-linear >=0.1.3 && <0.2
     , vector >=0.12.3.1 && <0.14