diff --git a/package.yaml b/package.yaml index 3bdac22..dc5deaf 100644 --- a/package.yaml +++ b/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 diff --git a/src/Strongweak/Strengthen.hs b/src/Strongweak/Strengthen.hs index 84bc951..b84e141 100644 --- a/src/Strongweak/Strengthen.hs +++ b/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 diff --git a/src/Strongweak/Weaken.hs b/src/Strongweak/Weaken.hs index bef9413..9b7fc33 100644 --- a/src/Strongweak/Weaken.hs +++ b/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 diff --git a/strongweak.cabal b/strongweak.cabal index 91043aa..8260d69 100644 --- a/strongweak.cabal +++ b/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