85 lines
2.1 KiB
Agda
85 lines
2.1 KiB
Agda
module TypeClass
|
|
|
|
data Monad : (U -> U) -> U where
|
|
MkMonad : { M : U -> U } ->
|
|
(bind : {A B : U} -> (M A) -> (A -> M B) -> M B) ->
|
|
(pure : {A : U} -> A -> M A) ->
|
|
Monad M
|
|
|
|
infixl 1 _>>=_ _>>_
|
|
_>>=_ : {a b : U} -> {m : U -> U} -> {{x : Monad m}} -> (m a) -> (a -> m b) -> m b
|
|
_>>=_ {a} {b} {m} {{MkMonad bind' _}} ma amb = bind' {a} {b} ma amb
|
|
|
|
_>>_ : {a b : U} -> {m : U -> U} -> {{x : Monad m}} -> m a -> m b -> m b
|
|
ma >> mb = mb
|
|
|
|
pure : {a : U} {m : U -> U} {{_ : Monad m}} -> a -> m a
|
|
pure {_} {_} {{MkMonad _ pure'}} a = pure' a
|
|
|
|
data Either : U -> U -> U where
|
|
Left : {A B : U} -> A -> Either A B
|
|
Right : {A B : U} -> B -> Either A B
|
|
|
|
bindEither : {A B C : U} -> (Either A B) -> (B -> Either A C) -> Either A C
|
|
bindEither (Left a) amb = Left a
|
|
bindEither (Right b) amb = amb b
|
|
|
|
EitherMonad : {A : U} -> Monad (Either A)
|
|
EitherMonad = MkMonad {Either A} bindEither Right
|
|
|
|
data Maybe : U -> U where
|
|
Just : {A : U} -> A -> Maybe A
|
|
Nothing : {A : U} -> Maybe A
|
|
|
|
bindMaybe : {A B : U} -> Maybe A -> (A -> Maybe B) -> Maybe B
|
|
bindMaybe Nothing amb = Nothing
|
|
bindMaybe (Just a) amb = amb a
|
|
|
|
MaybeMonad : Monad Maybe
|
|
MaybeMonad = MkMonad bindMaybe Just
|
|
|
|
infixr 7 _::_
|
|
data List : U -> U where
|
|
Nil : {A : U} -> List A
|
|
_::_ : {A : U} -> A -> List A -> List A
|
|
|
|
infixl 7 _++_
|
|
_++_ : {A : U} -> List A -> List A -> List A
|
|
Nil ++ ys = ys
|
|
(x :: xs) ++ ys = x :: (xs ++ ys)
|
|
|
|
bindList : {A B : U} -> List A -> (A -> List B) -> List B
|
|
bindList Nil f = Nil
|
|
bindList (x :: xs) f = f x ++ bindList xs f
|
|
|
|
singleton : {A : U} -> A -> List A
|
|
singleton a = a :: Nil
|
|
|
|
-- TODO need better error when the monad is not defined
|
|
ListMonad : Monad List
|
|
ListMonad = MkMonad bindList singleton
|
|
|
|
infixr 1 _,_
|
|
data Pair : U -> U -> U where
|
|
_,_ : {A B : U} -> A -> B -> Pair A B
|
|
|
|
ptype Int
|
|
|
|
test : Maybe Int
|
|
test = pure 10
|
|
|
|
foo : Int -> Maybe Int
|
|
foo x = Just 42 >> Just x >>= (\ x => pure {_} {Maybe} 10)
|
|
|
|
bar : Int -> Maybe Int
|
|
bar x = do
|
|
let y = x
|
|
z <- Just x
|
|
pure z
|
|
|
|
baz : {A B : U} -> List A -> List B -> List (Pair A B)
|
|
baz xs ys = do
|
|
x <- xs
|
|
y <- ys
|
|
pure (x , y)
|