Files
newt/tests/black/TypeClass.newt
2024-12-26 18:51:46 -08:00

85 lines
1.9 KiB
Agda

module TypeClass
data Monad : (U -> U) -> U where
MkMonad : { M : U -> U } ->
(bind : A B. (M A) -> (A -> M B) -> M B) ->
(pure : A. A -> M A) ->
Monad M
infixl 1 _>>=_ _>>_
_>>=_ : m a b. {{Monad m}} -> (m a) -> (a -> m b) -> m b
_>>=_ {{MkMonad bind' _}} ma amb = bind' ma amb
_>>_ : m a b. {{Monad m}} -> m a -> m b -> m b
ma >> mb = mb
pure : m a. {{Monad m}} -> a -> m a
pure {{MkMonad _ pure'}} a = pure' a
data Either : U -> U -> U where
Left : A B. A -> Either A B
Right : A B. B -> Either A B
bindEither : A B C. (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. A -> Maybe A
Nothing : A. Maybe A
bindMaybe : A B. 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. List A
_::_ : A. A -> List A -> List A
infixl 7 _++_
_++_ : A. List A -> List A -> List A
Nil ++ ys = ys
(x :: xs) ++ ys = x :: (xs ++ ys)
bindList : A B. List A -> (A -> List B) -> List B
bindList Nil f = Nil
bindList (x :: xs) f = f x ++ bindList xs f
singleton : A. 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. A -> B -> Pair A B
test : Maybe Int
test = pure 10
foo : Int -> Maybe Int
foo x = Just 42 >> Just x >>= (\ x => pure 10)
bar : Int -> Maybe Int
bar x = do
let y = x
z <- Just x
pure z
baz : A B. List A -> List B -> List (Pair A B)
baz xs ys = do
x <- xs
y <- ys
pure (x , y)