Oleg's gists — Archive

Squash the irrelevant bits

Posted on 2018-05-28 by Oleg Grenrus notes

Squashed c x let a library writer provide x in "c-irrelevant" way to a library user.

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
module Squash where
import Control.Applicative (liftA2)
import Control.Monad (void, liftM, liftM2)
import Data.Monoid (Sum (..))
import Data.Semigroup (Semigroup (..))
import Data.Tree (Tree (..))
import Data.Set (Set)
import qualified Data.Set as Set

The definition is simple:

newtype Squashed c x = Squash
    { getSquashed :: forall r. c r => (x -> r) -> r }

Squashed is almost like Cont ¹ or Codensity ², so Squashed is a Monad:

instance Monad (Squashed c) where
    return x  = Squash ($ x)
  
    m >>= k   = Squash $ \bx ->
        getSquashed m $ \a ->
        getSquashed (k a) bx

instance Applicative (Squashed c) where
    pure    = return
    liftA2  = liftM2
instance Functor (Squashed c) where
    fmap    = liftM

Monad-instance allows to work on the wrapped value, for example

squashedTree' :: Squashed Monoid (Tree String)
squashedTree' = pure $ Node "x" [ pure "yz", pure "foo" ]

squashedTree :: Squashed Monoid (Tree Int)
squashedTree = do
    x <- squashedTree'
    return (fmap length x)

However, we cannot extract the original value, only as much as the constraint let us:

-- 6
example_1 :: Int
example_1 = getSum (getSquashed squashedTree (foldMap Sum))

-- [1,2,3]
example_2 :: [Int]
example_2 = getSquashed squashedTree (foldMap pure)

This restriction maybe be useful to enforce correctness, without relying on the module system!

Squash c x is a generalised notion of "free c over x", e.g. Monoid as described in Free Monoids in Haskell ³. It should be possible to write c (Squashed c x) instances for all (reasonable) c. Or actually (forall x. c' x => c x) => c (Squashed c' a) after Quantified Constraints -proposal ⁴ is implemented. (TODO: amend when we have the extension in released GHC).

instance Semigroup (Squashed Semigroup x) where
    a <> b = Squash $ \k -> getSquashed a k <> getSquashed b k

instance Monoid (Squashed Monoid x) where
  mempty       = Squash $ \ _  -> mempty
  mappend a b  = Squash $ \k   -> getSquashed a k `mappend` getSquashed b k

As with Singleton containers ⁵, tell me if you have seen this construction in the wild!

Addendum: As Iceland_jack pointed on Twitter ⁶ ⁷ there is a free-functors ⁸ package on Hackage, and more is written about Squash:

Note, that Squash doesn’t let us turn a thing into something it isn’t...

newtype Squashed1 c f x = Squash1
    { getSquashed1 :: forall g. c g => (forall y. f y -> g y) -> g x }
squash1 :: f x -> Squashed1 c f x
squash1 fx = Squash1 ($ fx)

instance Monad (Squashed1 Monad f) where
    return x  = Squash1 $ \ _ -> return x
    m >>= k   = Squash1 $ \f ->
        getSquashed1 m f >>= \y ->
        getSquashed1 (k y) f

instance Applicative (Squashed1 Monad f) where
    pure    = return
    liftA2  = liftM2
instance Functor (Squashed1 Monad f) where
    fmap    = liftM

... though we can foolishly think so:

intSet' :: Squashed1 Monad Set Int
intSet' = squash1 $ Set.fromList [1, 2, 3]

intSet :: Squashed1 Monad Set Int
intSet = intSet' >>= \ _ -> return 5

-- [5,5,5]
intList :: [Int]
intList = getSquashed1 intSet Set.toList

So Squash let’s only forget, not to "remember" anything new.

By the way, this post is genuine Literate Haskell file, using LaTeX, not Markdown. If interested on how, check the gists repository ⁹. I’m weird, as after some point of markup complexity, I actually prefer LaTeX.

2024-04-12 – Core Inspection
2024-04-01 – Implicit arguments
2024-03-17 – ST with an early exit
2024-02-27 – More QualifiedDo examples
2023-10-17 – More traversals and more Cabal SAT

This work is licensed under a “CC BY SA 4.0” license.

Oleg's gists — Archive

twitter github email linkedin stackoverflow

Site proudly generated by Hakyll