Skip to content

Instantly share code, notes, and snippets.

@ekmett
Created Jun 17, 2021
Embed
What would you like to do?
When functional dependencies don't
{-# Language FlexibleInstances #-}
{-# Language MultiParamTypeClasses #-}
{-# Language FlexibleContexts #-}
{-# Language UndecidableInstances #-}
{-# Language DeriveTraversable #-}
{-# Language NoStarIsType #-}
{-# Language StandaloneKindSignatures #-}
{-# Language RoleAnnotations #-}
-- | Dysfunctional dependencies
--
-- ghci> put () >> put ((),()) :: ProxyT m ()
-- ProxyT
module ProxyT where
import Control.Applicative
import Control.Monad (MonadPlus(..))
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Monad.Cont.Class
import Control.Monad.Writer.Class
import Control.Monad.Error.Class
import Control.Monad.RWS.Class
import Control.Monad.Fix
import Control.Monad.Zip
import Control.Monad.Fail
import Data.Kind
import Data.Traversable
import GHC.Ix
type ProxyT :: (Type -> Type) -> Type -> Type
type role ProxyT phantom phantom
data ProxyT m a = ProxyT
deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded,Functor,Foldable,Traversable)
instance Applicative (ProxyT m) where
pure _ = ProxyT
_ <*> _ = ProxyT
instance Alternative (ProxyT m) where
empty = ProxyT
_ <|> _ = ProxyT
instance Monad (ProxyT m) where
_ >>= _ = ProxyT
instance MonadPlus (ProxyT m)
instance MonadFail (ProxyT m) where
fail _ = ProxyT
instance MonadTrans ProxyT where
lift _ = ProxyT
instance MonadCont (ProxyT m) where
callCC _ = ProxyT
instance MonadFix (ProxyT m) where
mfix _ = ProxyT
instance MonadZip (ProxyT m) where
mzipWith _ _ _ = ProxyT
munzip _ = (ProxyT, ProxyT)
instance MonadIO (ProxyT m) where
liftIO _ = ProxyT
-- Now we go off the deepend. The terminal monad transformer should be a MonadState for
-- all possible choices of state s. So we er.. just make that happen by circularity in
-- the instance. This typechecks and actually works. Code still terminates. YMMV.
instance MonadState s (ProxyT m) => MonadState s (ProxyT m) where
get = ProxyT
put _ = ProxyT
state _ = ProxyT
instance MonadReader e (ProxyT m) => MonadReader e (ProxyT m) where
ask = ProxyT
local _ _ = ProxyT
reader _ = ProxyT
instance (Monoid w, MonadWriter w (ProxyT m)) => MonadWriter w (ProxyT m) where
tell _ = ProxyT
listen _ = ProxyT
pass _ = ProxyT
instance MonadError e (ProxyT m) => MonadError e (ProxyT m) where
throwError _ = ProxyT
catchError _ _ = ProxyT
instance (Monoid w, MonadRWS r w s (ProxyT m)) => MonadRWS r w s (ProxyT m)
@ekmett
Copy link
Author

ekmett commented Jun 17, 2021

This uses stock mtl, not some weird fork with the fundeps removed.

@ekmett
Copy link
Author

ekmett commented Jun 18, 2021

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment