Strict.hs

{-# LANGUAGE GADTs #-}
-- | Strict weaves are the naive implementation of the idea "what if we generalized @zip@ to free monads?"
--
-- The resulting breadth-first unfold take quadratic time, which is slow.
--
-- The main reason for making this available is to compare it with the other variants.
module Weave.Strict
  ( Weave(..)
  , weft
  , mesh
  ) where

-- | Strict weaves.
--
-- The 'Applicative' operation @('liftA2')@ combines weaves level-wise.
data Weave m a where
  Pure :: a -> Weave m a
  Weft :: m (Weave m a) -> Weave m a

instance Functor m => Functor (Weave m) where
  fmap f (Pure x) = Pure (f x)
  fmap f (Weft u) = Weft ((fmap . fmap) f u)

instance Applicative m => Applicative (Weave m) where
  pure = Pure
  liftA2 f (Pure x) u = fmap (f x) u
  liftA2 f (Weft u) (Pure y) = Weft ((fmap . fmap) (\x -> f x y) u)
  liftA2 f (Weft u) (Weft v) = Weft ((liftA2 . liftA2) f u v)

-- | A weft is one level of 'Weave'. It is a computation which returns the remaining levels.
weft :: m (Weave m a) -> Weave m a
weft = Weft

-- | Run all the wefts in a 'Weave' sequentially.
mesh :: Monad m => Weave m a -> m a
mesh (Pure x) = pure x
mesh (Weft u) = u >>= mesh