Pav based Haskell typeclasses

Pav.hs

module Main where

import Data.Monoid

data Pav a = Pav a | EmptyPav deriving (Show)

instance Semigroup Int where
  a <> b = a + b
instance Monoid Int where
  mappend a b = a + b
  mempty = 0

instance Semigroup a => Semigroup (Pav a) where
  -- combine Pav to make a bigger Pav
  Pav a <> Pav b = Pav (a <> b)
  EmptyPav <> Pav b = Pav b
  Pav a <> EmptyPav = Pav a
  EmptyPav <> EmptyPav = EmptyPav
instance (Semigroup a, Monoid a) => Monoid (Pav a) where
  -- combine Pav to make a bigger Pav
  mappend (Pav a) (Pav b) = Pav (a <> b)
  -- omg an empty Pav?!
  mempty = Pav mempty

instance Functor Pav where
  fmap f (Pav s) = Pav (f s)

instance Applicative Pav where
  pure = Pav
  Pav a <*> Pav b = Pav (a b)

instance Monad Pav where
  return = Pav
  m >>= g = case m of
              EmptyPav -> EmptyPav
              Pav x    -> g x

pav :: Semigroup a => Pav a -> Pav a -> Pav a
pav a b = do
  x <- a
  y <- b
  a <> b

main :: IO ()
main = do
  let u1 = mempty :: Pav Int
      u2 = Pav 999 :: Pav Int
      u3 = Pav 1000 :: Pav Int
  print u1
  print u2
  print u3
  print (u1 <> u2)
  print (u2 <> u1)
  print (u3 <> u2)
  print $ fmap (*20) u3
  print $ (-) <$> u2 <*> u3
  print $ pav u2 u3
  print $ pav EmptyPav u3