{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, TypeOperators #-}
{-# LANGUAGE DataKinds, PolyKinds, FlexibleContexts, FlexibleInstances #-}
module WhyNot
( type (?)
, Handles (..)
, Result
, Return
, handle
, whynot
) where
import Data.Kind (Type)
import CPS (CPS(..))
type family Result (h :: Type) :: Type
type h ? a = CPS (Result h) ((->) h) a
type family Return (opApp :: Type) :: Type
class Handles (h :: Type) (op :: j -> k -> Type) where
type Ex h op :: j
clause
:: (e ~ Ex h op)
=> op e u
-> ( Return (op e u) -> ( h -> Result h ) )
-> ( h -> Result h )
handle :: (h ? a) -> (a -> (h -> Result h)) -> (h -> Result h)
handle :: forall h a. (h ? a) -> (a -> h -> Result h) -> h -> Result h
handle = forall k (result :: k) (m :: k -> *) answer.
CPS result m answer -> (answer -> m result) -> m result
(#)
whynot
:: (h `Handles` op, e ~ Ex h op)
=> op e u
-> h ? Return (op e u)
whynot :: forall {k} {k} h (op :: k -> k -> *) (e :: k) (u :: k).
(Handles h op, e ~ Ex h op) =>
op e u -> h ? Return (op e u)
whynot op e u
op = forall k (result :: k) (m :: k -> *) answer.
((answer -> m result) -> m result) -> CPS result m answer
CPS (\Return (op e u) -> h -> Result h
k h
h -> forall j k h (op :: j -> k -> *) (e :: j) (u :: k).
(Handles h op, e ~ Ex h op) =>
op e u -> (Return (op e u) -> h -> Result h) -> h -> Result h
clause op e u
op Return (op e u) -> h -> Result h
k h
h)