covariance-contravariance.hs

-- Kudos to Dominic Orchard

{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- P is contravariant in a
-- P is covariant in b

data P a b = P (a -> b)

fmap' :: (a -> a') -> P a' b -> P a b
fmap' f (P g) = P $ g . f

fmap'' :: (b' -> b) -> P a b' -> P a b
fmap'' f (P g) = P $ f . g

coercion :: Int -> Float
coercion = fromInteger . toInteger

fun :: Float -> Float
fun x = x*2

{-
       Int <: Float
--------------------------------
Float -> Float <: Int -> Float

-}

subTypeFun :: Int -> Float
subTypeFun = fun . coercion

-- Invariant
data Q a = Q (a -> Int) (Int -> a)

fmapQ :: (a -> b) -> (b -> a) -> Q a -> Q b
fmapQ f g (Q x y) = Q (x . g) (f . y)

------------------------------------
data R a = R (a -> Int)

{-
instance Functor R where
instance Applicative R where
instance Monad R where
  return x = R (\_ -> 0)
  (R x) >>= f = _
-}

-- m a -> (a -> m b) -> m b

newtype Arr a b = Arr { unArr :: a -> b } deriving Functor

instance Applicative (Arr a) where
instance Monad (Arr a) where
  return x = Arr $ const x
  (>>=) :: Arr a x -> (x -> Arr a y) -> Arr a y
  (Arr x) >>= f = Arr $ join (fmap' (unArr . f) x) where
    -- fmap :: (x -> y) -> f x -> f y
    fmap' :: (x -> y) -> (a -> x) -> (a -> y)
    fmap' f g = f . g
    join :: (a -> (a -> y)) -> (a -> y)
    join = undefined

---
data Stream a = Stream (Int -> a)

coreturn :: Stream a -> a
coreturn (Stream f) = f 0