Skip to content

Commit

Permalink
add Tagged instance for weakened "through"
Browse files Browse the repository at this point in the history
  • Loading branch information
raehik committed Oct 15, 2024
1 parent 4d8cf90 commit 0b59ab1
Show file tree
Hide file tree
Showing 4 changed files with 22 additions and 0 deletions.
1 change: 1 addition & 0 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
7 changes: 7 additions & 0 deletions src/Strongweak/Strengthen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
12 changes: 12 additions & 0 deletions src/Strongweak/Weaken.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
2 changes: 2 additions & 0 deletions strongweak.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 0b59ab1

Please sign in to comment.