WeirdFish.hs

-- Inspired by <https://duplode.github.io/posts/traversable-a-remix.html>.

module WeirdFish where

import Control.Monad
import Control.Monad.Free
import Data.Functor.Classes

type Nice functor = (Functor functor, Show1 functor)

data WeirdFish α = ∀ functor. Nice functor ⇒ WeirdFish {weirdFish ∷ functor α}

instance Show1 WeirdFish where
  liftShowsPrec showsPrec showList precedence WeirdFish {..}
    = liftShowsPrec showsPrec showList precedence weirdFish

instance Functor WeirdFish where
  fmap function WeirdFish {..} = WeirdFish { weirdFish = fmap function weirdFish}

irradiate ∷ ∀ α β functor. Nice functor ⇒ (α → functor β) → α → Free WeirdFish β
irradiate action x = liftF WeirdFish {weirdFish = action x}

-- Examples.

f ∷ α → [α]
f x = [x, x]

g ∷ (Integral α, Num β) ⇒ α → Maybe β
g x = Just (fromIntegral x + 1)

h ∷ (Integral α, Num β) ⇒ α → Free WeirdFish β
h = irradiate f >=> irradiate g

-- h 1 ≡ Free [ Free (Just (Pure 2)) , Free (Just (Pure 2)) ]