An implementation of lax monoidal functor with strength

Main.hs

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"