Verified Commit ec7a8e20 authored by Camil Staps's avatar Camil Staps 🚀

Split Applicative in pure, <*> and ApplicativeExtra

parent 0abdc23b
Pipeline #16001 passed with stage
in 1 minute and 15 seconds
......@@ -12,7 +12,7 @@ import StdString
import StdTuple
import Control.Applicative
from Control.Monad import mapM, class Monad
from Control.Monad import mapM, class Monad(..), >>=
import Data.Either
import Data.Error
from Data.Func import $
......
......@@ -12,15 +12,17 @@ import Data.Either
import Data.GenEq
import Data.Maybe
from Data.Func import $
from Data.List import instance Functor [], instance Applicative [], instance Alternative []
from Data.List import instance Functor [], instance pure [], instance <*> [],
instance Alternative []
from Text import class Text(concat), instance Text String
import Data.Functor
import Control.Applicative
import Control.Monad
from Text.Parsers.Simple.Core import :: Parser, :: Error,
instance Functor (Parser t), instance Applicative (Parser t),
instance Alternative (Parser t), instance Monad (Parser t),
parse, pToken, pSepBy, pSepBy1, pList, pSatisfy, pPeek
instance Functor (Parser t), instance pure (Parser t),
instance <*> (Parser t), instance Alternative (Parser t),
instance Monad (Parser t), parse, pToken, pSepBy, pSepBy1, pList, pSatisfy,
pPeek
(|<<) infixl 1 :: !(m a) !(m b) -> m a | Monad m
(|<<) ma mb = ma >>= \a -> mb >>= \_ -> pure a
......
......@@ -8,7 +8,7 @@ from StdFunc import flip
from StdOverloaded import class toString (toString)
import Clean.Types
from Control.Monad import class Applicative, class Monad, foldM
from Control.Monad import class pure, class <*>, class Applicative, class Monad, foldM
from Data.Functor import class Functor
from Data.Map import :: Map
from Data.Maybe import :: Maybe
......
......@@ -12,15 +12,17 @@ unwrapMonad :: !(WrappedMonad m a) -> m a
getConst :: !(Const a b) -> a
class Applicative f | Functor f
where
pure :: a -> f a
(<*>) infixl 4 :: !(f (a -> b)) (f a) -> f b
class pure f :: a -> f a
class (<*>) infixl 4 f :: !(f (a -> b)) (f a) -> f b
class Applicative f | Functor, pure, <*> f
(<*) infixl 4 :: !(f a) (f b) -> f a
class ApplicativeExtra f | Applicative f
where
(<*) infixl 4 :: !(f a) (f b) -> f a
(<*) fa fb = pure (\x _->x) <*> fa <*> fb
(*>) infixl 4 :: !(f a) (f b) -> f b
(*>) infixl 4 :: !(f a) (f b) -> f b
(*>) fa fb = pure (\_ x->x) <*> fa <*> fb
class Alternative f | Applicative f
......@@ -30,8 +32,10 @@ where
instance Functor (Const m)
instance Functor (WrappedMonad m) | Monad m
instance Applicative (Const m) | Monoid m
instance Applicative (WrappedMonad m) | Monad m
instance pure (Const m) | Monoid m
instance pure (WrappedMonad m) | pure m
instance <*> (Const m) | Monoid m
instance <*> (WrappedMonad m) | Monad m
instance Monad (WrappedMonad m) | Monad m
instance Alternative (WrappedMonad m) | MonadPlus m
......@@ -45,7 +49,7 @@ many :: (f a) -> f [a] | Alternative f
(<**>) infixl 4 :: (f a) (f (a -> b)) -> f b | Applicative f
lift :: a -> f a | Applicative f
lift :: a -> f a | pure f
liftA :: (a -> b) (f a) -> f b | Applicative f
......
......@@ -5,17 +5,6 @@ import Data.Func, Data.Functor, System.IO, Data.List, Data.Maybe
import Data.Monoid
from StdFunc import id, o, flip, const
class Applicative f | Functor f
where
pure :: a -> f a
(<*>) infixl 4 :: !(f (a -> b)) (f a) -> f b
(<*) infixl 4 :: !(f a) (f b) -> f a
(<*) fa fb = pure (\x _->x) <*> fa <*> fb
(*>) infixl 4 :: !(f a) (f b) -> f b
(*>) fa fb = pure (\_ x->x) <*> fa <*> fb
getConst :: !(Const a b) -> a
getConst (Const x) = x
......@@ -28,9 +17,13 @@ instance Semigroup (Const a b) | Semigroup a where
instance Monoid (Const a b) | Monoid a where
mempty = Const mempty
instance Applicative (Const m) | Monoid m where
pure _ = Const mempty
(<*>) (Const f) (Const v) = Const (mappend f v)
instance pure (Const m) | Monoid m
where
pure _ = Const mempty
instance <*> (Const m) | Monoid m
where
(<*>) (Const f) (Const v) = Const (mappend f v)
unwrapMonad :: !(WrappedMonad m a) -> m a
unwrapMonad (WrapMonad x) = x
......@@ -38,9 +31,13 @@ unwrapMonad (WrapMonad x) = x
instance Functor (WrappedMonad m) | Monad m where
fmap f (WrapMonad v) = WrapMonad (liftM f v)
instance Applicative (WrappedMonad m) | Monad m where
pure x = WrapMonad (pure x)
(<*>) (WrapMonad f) (WrapMonad v) = WrapMonad (ap f v)
instance pure (WrappedMonad m) | pure m
where
pure x = WrapMonad (pure x)
instance <*> (WrappedMonad m) | Monad m
where
(<*>) (WrapMonad f) (WrapMonad v) = WrapMonad (ap f v)
instance Monad (WrappedMonad m) | Monad m where
bind a f = WrapMonad (unwrapMonad a >>= unwrapMonad o f)
......@@ -62,7 +59,7 @@ many v = many_v
(<**>) infixl 4 :: (f a) (f (a -> b)) -> f b | Applicative f
(<**>) fa fab = liftA2 (flip ($)) fa fab
lift :: a -> f a | Applicative f
lift :: a -> f a | pure f
lift x = pure x
liftA :: (a -> b) (f a) -> f b | Applicative f
......
......@@ -2,7 +2,7 @@ definition module Control.Arrow
import Control.Category
from Control.Monad import class Monad
from Control.Applicative import class Applicative, class Alternative
from Control.Applicative import class pure, class <*>, class Applicative, class Alternative
from Data.Functor import class Functor
from Data.Either import :: Either
......@@ -180,7 +180,8 @@ instance ArrowApply (Kleisli m) | Monad m
instance Functor (ArrowMonad a) | Arrow a
instance Applicative (ArrowMonad a) | Arrow a
instance pure (ArrowMonad a) | Arrow a
instance <*> (ArrowMonad a) | Arrow a
instance Monad (ArrowMonad a) | ArrowApply a
......
......@@ -108,8 +108,12 @@ instance ArrowApply (Kleisli m) | Monad m where
instance Functor (ArrowMonad a) | Arrow a where
fmap f (ArrowMonad m) = ArrowMonad (m >>> arr f)
instance Applicative (ArrowMonad a) | Arrow a where
pure x = ArrowMonad (arr (const x))
instance pure (ArrowMonad a) | Arrow a
where
pure x = ArrowMonad (arr (const x))
instance <*> (ArrowMonad a) | Arrow a
where
(<*>) (ArrowMonad f) (ArrowMonad x) = ArrowMonad (f &&& x >>> arr (uncurry cid))
instance Monad (ArrowMonad a) | ArrowApply a where
......
definition module Control.Monad
from Control.Applicative import class Applicative(pure)
from Control.Applicative import class pure(pure), class <*>, class Applicative
from Data.Functor import class Functor
class Monad m | Applicative m
......@@ -19,7 +19,7 @@ where
(=<<) infixr 1 :: (a -> m b) (m a) -> m b | Monad m
(=<<) f x :== x >>= f
return :: a -> m a | Applicative m
return :: a -> m a | pure m
return x :== pure x
class MonadPlus m | Monad m
......
implementation module Control.Monad
from Control.Applicative import class Applicative (..), lift
from Data.Functor import class Functor (..)
from Data.List import map, zipWith, replicate
from StdList import foldr
from StdFunc import flip, id, o, const
from StdInt import class +, instance + Int
import Control.Applicative
from Data.Functor import class Functor (..)
from Data.List import map, zipWith, replicate
from StdList import foldr
from StdFunc import flip, id, o, const
from StdInt import class +, instance + Int
sequence :: !.[a b] -> a [b] | Monad a
sequence ms = foldr k (lift []) ms
......
definition module Control.Monad.Fix
from Control.Monad import class Monad
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Data.Functor import class Functor
from Data.Maybe import :: Maybe
......
definition module Control.Monad.Identity
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Control.Monad import class Monad
from Control.Monad.Fix import class MonadFix
from Data.Functor import class Functor
from Data.Functor.Identity import :: Identity, instance Functor Identity, instance Applicative Identity, instance Monad Identity
from Data.Functor.Identity import :: Identity, instance Functor Identity,
instance pure Identity, instance <*> Identity, instance Monad Identity
instance MonadFix Identity
definition module Control.Monad.RWST
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Control.Monad import class Monad
from Control.Monad.Trans import class MonadTrans
from Data.Functor import class Functor
......@@ -14,7 +14,8 @@ from Data.Monoid import class Monoid, class Semigroup
:: RWST r w s m a = RWST (r s -> m (a, s, w))
instance Functor (RWST r w s m) | Monad m & Monoid w
instance Applicative (RWST r w s m) | Monad m & Monoid w
instance pure (RWST r w s m) | pure m & Monoid w
instance <*> (RWST r w s m) | Monad m & Monoid w
instance Monad (RWST r w s m) | Monad m & Monoid w
instance MonadTrans (RWST r w s) | Monoid w
......
......@@ -14,9 +14,13 @@ import Control.Applicative
instance Functor (RWST r w s m) | Monad m & Monoid w where
fmap f m = liftM f m
instance Applicative (RWST r w s m) | Monad m & Monoid w where
pure a = RWST (\_ s -> pure (a, s, mempty))
(<*>) mf mx = ap mf mx
instance pure (RWST r w s m) | pure m & Monoid w
where
pure a = RWST \_ s -> pure (a,s,mempty)
instance <*> (RWST r w s m) | Monad m & Monoid w
where
(<*>) mf mx = ap mf mx
instance Monad (RWST r w s m) | Monad m & Monoid w where
bind m k
......
definition module Control.Monad.Reader
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Control.Monad import class Monad
from Control.Monad.Trans import class MonadTrans
from Data.Functor import class Functor
......@@ -23,7 +23,8 @@ local :: u:((.a -> .b) -> v:(.(ReaderT .b .c .d) -> .(ReaderT .a .c .d)))
asks :: (a -> b) -> ReaderT a c b | Monad c
instance Functor (ReaderT r m) | Monad m
instance Applicative (ReaderT r m) | Monad m
instance pure (ReaderT r m) | Monad m
instance <*> (ReaderT r m) | Monad m
instance Monad (ReaderT r m) | Monad m
instance MonadTrans (ReaderT r)
......@@ -13,9 +13,13 @@ import Control.Monad.Trans
instance Functor (ReaderT r m) | Monad m where
fmap f m = liftM f m
instance Applicative (ReaderT r m) | Monad m where
pure x = (liftT o pure) x
<*> mf mx = ap mf mx
instance pure (ReaderT r m) | Monad m
where
pure x = (liftT o pure) x
instance <*> (ReaderT r m) | Monad m
where
<*> mf mx = ap mf mx
instance Monad (ReaderT r m) | Monad m where
bind m k = ReaderT (\r -> runReaderT m r >>= \a -> runReaderT (k a) r)
......
definition module Control.Monad.State
from Control.Monad import class Monad
from Control.Applicative import class Applicative, class Alternative
from Control.Applicative import class pure, class <*>, class Applicative, class ApplicativeExtra, class Alternative
from Data.Functor import class Functor
from Data.Functor.Identity import :: Identity
from Control.Monad.Trans import class MonadTrans
......@@ -10,7 +10,7 @@ from Control.Monad.Trans import class MonadTrans
:: State s a :== StateT s Identity a
state :: (s -> .(a, s)) -> StateT s m a | Monad m
state :: (s -> .(a, s)) -> StateT s m a | pure m
getState :: StateT s m s | Monad m
put :: s -> StateT s m () | Monad m
modify :: (s -> s) -> StateT s m () | Monad m
......@@ -29,7 +29,9 @@ withStateT :: (s -> s) .(StateT s m c) -> StateT s m c
transformStateT :: (s2 -> s1) (a s1 -> (a, s2)) (StateT s1 m a) -> (StateT s2 m a) | Functor m
instance Functor (StateT s m) | Monad m
instance Applicative (StateT s m) | Monad m
instance pure (StateT s m) | pure m
instance <*> (StateT s m) | Monad m
instance ApplicativeExtra (StateT s m) | Monad m
instance Alternative (StateT s m) | Alternative m
instance Monad (StateT s m) | Monad m
instance MonadTrans (StateT s)
......@@ -14,9 +14,15 @@ from StdTuple import fst, snd
instance Functor (StateT s m) | Monad m where
fmap f m = StateT (\s -> fmap (\(a, s`) -> (f a, s`)) (runStateT m s))
instance Applicative (StateT s m) | Monad m where
pure a = state (\s -> (a, s))
(<*>) sf sa = ap sf sa
instance pure (StateT s m) | pure m
where
pure a = state \s -> (a, s)
instance <*> (StateT s m) | Monad m
where
(<*>) sf sa = ap sf sa
instance ApplicativeExtra (StateT s m) | Monad m
instance Alternative (StateT s m) | Alternative m where
empty = StateT (const empty)
......@@ -28,7 +34,7 @@ instance Monad (StateT s m) | Monad m where
instance MonadTrans (StateT s) where
liftT m = StateT (\s -> m >>= \a -> pure (a, s))
state :: (s -> .(a, s)) -> StateT s m a | Monad m
state :: (s -> .(a, s)) -> StateT s m a | pure m
state f = StateT (\s -> pure (f s))
getState :: StateT s m s | Monad m
......
definition module Control.Monad.Trans
from Control.Monad import class Monad
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Data.Functor import class Functor
class MonadTrans t where
......
implementation module Control.Monad.Trans
from Data.Functor import class Functor
from Control.Applicative import class Applicative
import Control.Applicative
from Control.Monad import class Monad
class MonadTrans t where
......
definition module Control.Monad.Writer
from Control.Monad import class Monad
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Data.Monoid import class Monoid, class Semigroup
from Control.Monad.Trans import class MonadTrans
from Data.Functor import class Functor
......@@ -12,7 +12,8 @@ from Data.Functor.Identity import :: Identity
:: Writer w a :== WriterT w Identity a
instance Functor (WriterT w m) | Monad m & Monoid w
instance Applicative (WriterT w m) | Monad m & Monoid w
instance pure (WriterT w m) | pure m & Monoid w
instance <*> (WriterT w m) | Monad m & Monoid w
instance Monad (WriterT w m) | Monad m & Monoid w
instance MonadTrans (WriterT w) | Monoid w
......
......@@ -15,9 +15,13 @@ from StdTuple import fst, snd
instance Functor (WriterT w m) | Monad m & Monoid w where
fmap f m = liftM f m
instance Applicative (WriterT w m) | Monad m & Monoid w where
pure x = WriterT (pure (x, mempty))
<*> mf mx = ap mf mx
instance pure (WriterT w m) | pure m & Monoid w
where
pure x = WriterT (pure (x, mempty))
instance <*> (WriterT w m) | Monad m & Monoid w
where
<*> mf mx = ap mf mx
instance Monad (WriterT w m) | Monad m & Monoid w where
bind m k = WriterT (runWriterT m >>= \(a, w) ->
......
......@@ -3,7 +3,7 @@ definition module Data.Array
from StdArray import class Array
from StdOverloaded import class +++
from Data.Functor import class Functor
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Control.Monad import class Monad
mapArrSt :: !(.a -> .(*st -> *(!.a, !*st))) !*(arr .a) !*st -> *(!*(arr .a), !*st) | Array arr a
......@@ -33,7 +33,8 @@ appendArr :: !(arr a) !(arr a) -> arr a | Array arr a
instance +++ (arr a) | Array arr a
instance Functor {}, {!}
instance Applicative {}, {!}
instance pure {}, {!}
instance <*> {}, {!}
instance Monad {}, {!}
reduceArray :: ((.a -> u:(b -> b)) -> .(b -> .(c -> .a))) (.a -> u:(b -> b)) b .(d c) -> b | Array d c
......@@ -118,16 +118,22 @@ instance +++ (arr a) | Array arr a where
instance Functor {} where fmap f arr = {f a\\a<-:arr}
instance Functor {!} where fmap f arr = {f a\\a<-:arr}
instance Applicative {}
instance pure {}
where
pure x = {x}
(<*>) fs xs = {f x\\f<-:fs, x<-:xs}
instance Applicative {!}
instance <*> {}
where
pure x = {x}
(<*>) fs xs = {f x\\f<-:fs, x<-:xs}
instance pure {!}
where
pure x = {!x}
instance <*> {!}
where
(<*>) fs xs = {!f x\\f<-:fs, x<-:xs}
instance Monad {} where bind m k = foldrArr ((+++) o k) {} m
instance Monad {!} where bind m k = foldrArr ((+++) o k) {} m
......
......@@ -5,7 +5,7 @@ definition module Data.Either
* used inside generic functions, since most generic functions treat this
* type in a special way which may lead to strange behavior.
*/
from Control.Applicative import class Applicative, class Alternative
from Control.Applicative import class pure, class <*>, class Applicative, class ApplicativeExtra, class Alternative
from Control.Monad import class Monad
from Data.Functor import class Functor
from Data.Monoid import class Monoid, class Semigroup
......@@ -17,7 +17,9 @@ from Data.GenEq import generic gEq
:: Either a b = Left a | Right b
instance Functor (Either a)
instance Applicative (Either e)
instance pure (Either e)
instance <*> (Either e)
instance ApplicativeExtra (Either e)
instance Monad (Either e)
instance Foldable (Either a)
......
......@@ -16,12 +16,17 @@ instance Functor (Either a) where
fmap f (Left l) = Left l
fmap f (Right r) = Right (f r)
instance Applicative (Either e) where
pure x = Right x
instance pure (Either e)
where
pure x = Right x
instance <*> (Either e)
where
(<*>) (Left e) _ = Left e
(<*>) (Right f) r = fmap f r
instance ApplicativeExtra (Either e)
where
(*>) (Right _) e = e
(*>) (Left l) _ = Left l
......
......@@ -2,7 +2,7 @@ definition module Data.Error
from Data.Functor import class Functor
from Control.Monad import class Monad
from Control.Applicative import class Applicative
from Control.Applicative import class pure, class <*>, class Applicative
from Data.Maybe import :: Maybe
from Data.GenEq import generic gEq
......@@ -20,7 +20,8 @@ from Data.GenEq import generic gEq
:: MaybeErrorString a :== MaybeError String a
instance Functor (MaybeError a)
instance Applicative (MaybeError a)
instance pure (MaybeError a)
instance <*> (MaybeError a)
instance Monad (MaybeError a)
derive gEq MaybeError
......
......@@ -10,8 +10,12 @@ where
fmap f (Ok x) = Ok (f x)
fmap f (Error x) = Error x
instance Applicative (MaybeError e) where
pure x = Ok x
instance pure (MaybeError a)
where
pure x = Ok x
instance <*> (MaybeError a)
where
(<*>) (Error e) _ = Error e
(<*>) (Ok f) r = fmap f r
......