Skip to content

Instantly share code, notes, and snippets.

@hiratara
Last active August 29, 2015 14:14
Show Gist options
  • Save hiratara/bdfd1726c6258ee8b401 to your computer and use it in GitHub Desktop.
Save hiratara/bdfd1726c6258ee8b401 to your computer and use it in GitHub Desktop.
An implementation of lax monoidal functor with strength
module Main (main) where
import Control.Applicative
class Functor f => LaxMonoidalWithStrength f where
unit :: () -> f ()
phi :: (f a, f b) -> f (a, b)
st :: (a, f b) -> f (a, b)
{-
satisfy the following laws
1) fmap f . phi == phi . f
2) fmap fst . phi . (id >< unit) == fst
3) fmap snd . phi . (unit >< id) == snd
4) phi . (id >< phi) . alpha == fmap alpha . phi . (phi >< id)
5) fmap snd . st == snd
6) fmap alpha . st == st . (id >< st) . alpha
where
(f >< g) (x, y) = (f x, g y)
alpha ((x, y), z) = (x, (y, z))
-}
aUnit :: Applicative f => () -> f ()
aUnit = pure
aPhi :: Applicative f => (f a, f b) -> f (a, b)
aPhi (fx, fy) = (,) <$> fx <*> fy
aSt :: Applicative f => (a, f b) -> f (a, b)
aSt (x, fy) = aPhi (pure x, fy)
sPure :: LaxMonoidalWithStrength f => a -> f a
sPure x = fst `fmap` st (x, unit ())
sAp :: LaxMonoidalWithStrength f => f (a -> b) -> f a -> f b
sAp ff fx = uncurry ($) `fmap` phi (ff, fx)
instance LaxMonoidalWithStrength Maybe where
unit = aUnit
phi = aPhi
st = aSt
data SMaybe a = SJust a | SNothing deriving (Eq, Show)
instance Functor SMaybe where
fmap f (SJust x) = SJust (f x)
fmap _ SNothing = SNothing
instance LaxMonoidalWithStrength SMaybe where
unit () = SJust ()
phi (SJust x, SJust y) = SJust (x, y)
phi _ = SNothing
st (x, SJust y) = SJust (x, y)
st (_, SNothing) = SNothing
instance Applicative SMaybe where
pure = sPure
(<*>) = sAp
main :: IO ()
main = error "implement it"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment