## Strict Applicative Transformer

Posted on March 21, 2018

Tags: Haskell

Adapted from this post on reddit. It’s possible to take a lazy traversal and make it strict.

```
{-# LANGUAGE BangPatterns #-}
module Seq (fmap',traverse') where
import Data.Coerce
import Control.Applicative (liftA2)
newtype Seq a = Seq { unSeq :: a }
instance Functor Seq where
fmap f x = let !vx = unSeq x in Seq (f vx)
{-# INLINE fmap #-}
<$ xs = let !_ = unSeq xs in Seq x
x {-# INLINE (<$) #-}
instance Applicative Seq where
pure = Seq
{-# INLINE pure #-}
<*> xs = let !vx = unSeq xs in Seq (unSeq fs vx)
fs {-# INLINE (<*>) #-}
*> ys = let !_ = unSeq xs in ys
xs {-# INLINE (*>) #-}
<* ys = let !_ = unSeq ys in xs
xs {-# INLINE (<*) #-}
fmap' :: Traversable f => (a -> b) -> f a -> f b
= (coerce :: ((a -> Seq b) -> f a -> Seq (f b)) -> (a -> b) -> f a -> f b) traverse
fmap' {-# INLINE fmap' #-}
newtype SeqT f a = SeqT { unSeqT :: f a }
instance Functor f => Functor (SeqT f) where
fmap f = SeqT #. fmap (\ !vx -> f vx) .# unSeqT
{-# INLINE fmap #-}
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
#.) _ = coerce
({-# INLINE (#.) #-}
(.#) :: Coercible a b => (b -> c) -> (a -> b) -> a -> c
.#) f _ = coerce f
({-# INLINE (.#) #-}
instance Applicative f => Applicative (SeqT f) where
pure = SeqT #. pure
{-# INLINE pure #-}
<*>) = (coerce :: (f (a -> b) -> f a -> f b) -> (SeqT f (a -> b) -> SeqT f a -> SeqT f b)) (liftA2 (\fs !vx -> fs vx))
({-# INLINE (<*>) #-}
= (coerce :: (f a -> f b -> f c) -> (SeqT f a -> SeqT f b -> SeqT f c)) (liftA2 (\ !x !y -> f x y))
liftA2 f {-# INLINE liftA2 #-}
traverse' :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
= (coerce :: ((a -> SeqT f b) -> t a -> SeqT f (t b)) -> (a -> f b) -> t a -> f (t b)) traverse
traverse' {-# INLINE traverse' #-}
```

You need traversable in order to get the strictness: there’s a similar way to get a stricter fmap with monad instead:

```
(<$!>) :: Monad m => (a -> b) -> m a -> m b
{-# INLINE (<$!>) #-}
<$!> m = do
f <- m
x let z = f x
`seq` return z z
```