Skip to content

Commit

Permalink
Add a newtype Unit
Browse files Browse the repository at this point in the history
Unit is a newtype over () with handy Semigroup+Monoid instances,
where (<>) = seq. This allows reducing structures to normal form
using foldMap-like functions.
  • Loading branch information
meooow25 committed Aug 25, 2024
1 parent 1e00020 commit 27e223c
Showing 1 changed file with 40 additions and 0 deletions.
40 changes: 40 additions & 0 deletions Control/DeepSeq.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,6 +78,7 @@ module Control.DeepSeq (
($!!),
(<$!!>),
rwhnf,
Unit(..),

-- * Liftings of the 'NFData' class

Expand Down Expand Up @@ -397,6 +398,45 @@ class (forall a. NFData a => NFData1 (p a)) => NFData2 p where
rnf2 :: (NFData2 p, NFData a, NFData b) => p a b -> ()
rnf2 = liftRnf2 rnf rnf

-- | A monoid with @(<>) = seq@.
--
-- Its purpose is to allow reducing structures to normal form using
-- 'foldMap'-like functions.
--
-- ==== __Examples__
--
-- @
-- data Three a = Three a a a
--
-- instance Foldable Three where
-- foldMap f (Three x1 x2 x3) = f x1 <> f x2 <> f x3
--
-- instance NFData a => NFData (Three a) where
-- rnf = runUnit . foldMap (Unit . rnf)
-- @
--
-- @
-- data Tree a b
-- = NodeA a [Tree a b]
-- | NodeB b [Tree a b]
--
-- foldMapTree :: Monoid m => (a -> m) -> (b -> m) -> Tree a b -> m
-- foldMapTree f g = go
-- where
-- go (NodeA x ts) = f x <> foldMap go ts
-- go (NodeB y ts) = g y <> foldMap go ts
--
-- instance NFData2 Tree where
-- liftRnf2 r r' = runUnit . foldMapTree (Unit . r) (Unit . r')
-- @
newtype Unit = Unit { runUnit :: () }

instance Semigroup Unit where
(<>) = seq

instance Monoid Unit where
mempty = Unit ()

instance NFData Int where rnf = rwhnf

instance NFData Word where rnf = rwhnf
Expand Down

0 comments on commit 27e223c

Please sign in to comment.