gistfile1.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE IncoherentInstances #-}

module X where

data P a = P

flattenMaybe :: P (Maybe (Maybe a)) -> P (Maybe a)
flattenMaybe P = P

class ProjectableMaybe a b where
  flatten :: P a -> P b

instance ProjectableMaybe (Maybe a) b => ProjectableMaybe (Maybe (Maybe a)) b where
  flatten = flatten . flattenMaybe

instance ProjectableMaybe (Maybe a) (Maybe a) where
  flatten = id

f :: P (Maybe (Maybe (Maybe (Maybe a)))) -> P (Maybe a)
f =  flatten

v :: P (Maybe (Maybe (Maybe (Maybe Int))))
v =  P

foo :: P (Maybe Int)
foo =  flatten v

-- error
-- bar :: P Int
-- bar =  flatten foo