Skip to content

Instantly share code, notes, and snippets.

@Icelandjack
Created May 17, 2017 13:46
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Icelandjack/f5247a4d7d29e76a364f2073efe9928c to your computer and use it in GitHub Desktop.
Save Icelandjack/f5247a4d7d29e76a364f2073efe9928c to your computer and use it in GitHub Desktop.
GHC Trac #11439 (case signatures?)

Good example from Eisenberg:

type Effect = Type -> Type -> Type -> Type

class Handler (e :: Effect) (m :: Type -> Type) where
  handle :: e res res' t -> res -> (res' -> t -> m a) -> m a  

For Random

data Random :: Effect where
  GetRandom :: Random Nat Nat Nat
  SetSeed   :: Nat -> Random Nat Nat ()
  
instance Handler Random m where
  handle :: Random res res' t -> res -> (res' -> t -> m a) -> m a 
  handle GetRandom   seed k = ...
  handle (SetSeed n) _    k = k n ()

With case-signatures:

data Random :: Effect where
  GetRandom :: Random Nat Nat Nat
  SetSeed   :: Nat -> Random Nat Nat ()
  
instance Handler Random m where
  handle :: Random res res' t -> res -> (res' -> t -> m a) -> m a 
  
--handle :: Random Nat Nat Nat -> Nat -> (Nat -> Nat -> m a) -> m a 
  handle GetRandom   seed k = ...
  
--handle :: Random Nat Nat () -> Nat -> (Nat -> () -> m a) -> m a 
  handle (SetSeed n) _    k = k n ()

And Select

data Selection :: Effect where
  Select :: [a] -> Selection () () a

instance Handler Selection Maybe where
  handle :: forall res res' t a. Selection res res' t -> res -> (res' -> t -> Maybe a) -> Maybe a
--handle :: Selection ()  ()   t -> ()  -> (()   -> t -> Maybe a) -> Maybe a
  handle (Select xs) _ k = tryAll xs where
    tryAll :: [t] -> Maybe a
    tryAll []     = Nothing
    tryAll (x:xs) = case k () x of
                      Nothing -> tryAll xs
                      Just v  -> Just v
                      
instance Handler Selection [] where
  handle :: Selection res res' t -> res -> (res' -> t -> [a]) -> [a]
--handle :: Selection ()  ()   t -> ()  -> (()   -> t -> [a]) -> [a]
  handle (Select xs) r k = concatMap (k r) xs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment