Commit f10d3f08 authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'default-control-applicative' into 'master'

Make <* and *> default instances

See merge request !211
parents 4978e569 33754024
Pipeline #15145 passed with stage
in 1 minute and 11 seconds
......@@ -17,6 +17,12 @@ 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
class Alternative f | Applicative f
where
empty :: f a
......@@ -37,29 +43,6 @@ some :: (f a) -> f [a] | Alternative f
many :: (f a) -> f [a] | Alternative f
/**
* Sequence actions and take the value of the right argument.
* Previously, this was a normal function with the type context Applicative f
* and an implementation similar to the instance for f now. However, for some
* types there are more efficient possibilities. Making this a class with a
* default implementation allows overriding the instance in such cases, like
* for Maybe here.
* Be aware that the execution order has to be correct: the left hand side must
* be evaluated before the right hand side.
*/
class (*>) infixl 4 f :: !(f a) (f b) -> f b | Applicative f
instance *> f
/**
* Sequence actions and take the value of the left argument.
* For the reason behind making this a class rather than a normal function, see
* the documentation on *>.
* Be aware that the execution order has to be correct: the left hand side must
* be evaluated before the right hand side.
*/
class (<*) infixl 4 f :: !(f a) (f b) -> f a | Applicative f
instance <* f
(<**>) infixl 4 :: (f a) (f (a -> b)) -> f b | Applicative f
lift :: a -> f a | Applicative f
......
......@@ -6,6 +6,17 @@ from Data.Monoid import class Monoid, class Semigroup
import qualified Data.Monoid as DM
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
......@@ -49,10 +60,6 @@ many v = many_v
where many_v = some_v <|> lift []
some_v = (\x xs -> [x:xs]) <$> v <*> many_v
instance *> f where *> fa fb = id <$ fa <*> fb
instance <* f where <* fa fb = liftA2 const fa fb
(<**>) infixl 4 :: (f a) (f (a -> b)) -> f b | Applicative f
(<**>) fa fab = liftA2 (flip ($)) fa fab
......
......@@ -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 *>, class <*, class Alternative
from Control.Applicative import class Applicative, class Alternative
from Control.Monad import class Monad
from Data.Functor import class Functor
from Data.Monoid import class Monoid, class Semigroup
......@@ -17,14 +17,7 @@ from Data.GenEq import generic gEq
:: Either a b = Left a | Right b
instance Functor (Either a)
instance Applicative (Either e)
// Making use of the type information allows for faster sequencing operators.
// See the documentation on *> in Control.Applicative.
instance *> (Either e)
instance <* (Either e)
instance Monad (Either e)
instance Foldable (Either a)
......
......@@ -15,24 +15,21 @@ import Data.Bifunctor
import Data.GenEq
instance Functor (Either a) where
fmap f (Left l) = Left l
fmap f (Right r) = Right (f r)
fmap f (Left l) = Left l
fmap f (Right r) = Right (f r)
instance Applicative (Either e) where
pure x = Right x
(<*>) (Left e) _ = Left e
(<*>) (Right f) r = fmap f r
pure x = Right x
instance *> (Either e)
where
*> (Right _) e = e
*> (Left l) _ = Left l
(<*>) (Left e) _ = Left e
(<*>) (Right f) r = fmap f r
instance <* (Either e)
where
<* (Left l) _ = Left l
<* _ (Left l) = Left l
<* x _ = x
(*>) (Right _) e = e
(*>) (Left l) _ = Left l
(<*) (Left l) _ = Left l
(<*) _ (Left l) = Left l
(<*) x _ = x
instance Monad (Either e)
where
......
definition module Data.Foldable
from Control.Applicative import class Applicative (..), :: Const, class Alternative (..), class *>
from Control.Applicative import class Applicative (..), :: Const, class Alternative (..)
from Control.Monad import class Monad (..), >>=, class MonadPlus (..)
from Data.Functor import class Functor (..)
from Data.Monoid import class Monoid (..), class Semigroup (..)
......@@ -105,7 +105,7 @@ foldlM :: (b a -> m b) b (t a) -> m b | Foldable t & Monad m
* Map each element of a structure to an action, evaluate these actions from
* left to right, and ignore the results.
*/
traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative, *> f
traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative f
/**
* `for_` is {{`traverse_`}} with its arguments flipped.
......@@ -129,7 +129,7 @@ forM_ :== flip mapM_
* Evaluate each action in the structure from left to right, and ignore the
* results.
*/
sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative, *> f
sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative f
/**
* Evaluate each monadic action in the structure from left to right, and ignore
......
......@@ -47,13 +47,13 @@ foldlM :: (b a -> m b) b (t a) -> m b | Foldable t & Monad m
foldlM f z0 xs = foldr f` pure xs z0
where f` x k z = f z x >>= k
traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative, *> f
traverse_ :: (a -> f b) (t a) -> f () | Foldable t & Applicative f
traverse_ f x = foldr ((*>) o f) (pure ()) x
mapM_ :: (a -> m b) (t a) -> m () | Foldable t & Monad m
mapM_ f x = foldr ((\ma mb -> ma >>= \_ -> mb) o f) (pure ()) x
sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative, *> f
sequenceA_ :: (t (f a)) -> f () | Foldable t & Applicative f
sequenceA_ x = foldr (*>) (pure ()) x
concat :: (t [a]) -> [a] | Foldable t
......
implementation module Data.Functor.Identity
from Data.Functor import class Functor
from Control.Applicative import class Applicative
from Control.Monad import class Monad
import Data.Functor
import Control.Applicative
import Control.Monad
:: Identity a = Identity a
......
......@@ -2,16 +2,17 @@ implementation module Data.GenFDomain
import StdChar, StdEnum, StdInt, StdList
import StdGeneric
import Data.List
import Control.GenBimap
generic gFDomain a :: [a]
gFDomain{|Bool|} = [False,True]
gFDomain{|Char|} = map toChar [0..255]
gFDomain{|UNIT|} = [UNIT]
gFDomain{|PAIR|} dx dy = [PAIR x y \\ x <- dx, y <- dy]
gFDomain{|PAIR|} dx dy = [PAIR x y\\x <- dx, y <- dy]
gFDomain{|EITHER|} dx dy = map LEFT dx ++ map RIGHT dy
gFDomain{|CONS|} dx = map CONS dx
gFDomain{|FIELD|} dx = map FIELD dx
gFDomain{|OBJECT|} dx = map OBJECT dx
derive bimap []
derive gFDomain (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
......@@ -7,7 +7,7 @@ import StdMaybe
from StdOverloaded import class ==(..)
from Data.Functor import class Functor
from Control.Applicative import class Applicative, class *>, class <*, class Alternative
from Control.Applicative import class Applicative, class Alternative
from Control.Monad import class Monad, class MonadPlus
from Control.Monad.Trans import class MonadTrans
from Data.Monoid import class Semigroup, class Monoid
......@@ -17,8 +17,6 @@ from Data.GenEq import generic gEq
instance Functor Maybe
instance Applicative Maybe
instance *> Maybe
instance <* Maybe
instance Alternative Maybe
instance Monad Maybe
instance MonadPlus Maybe
......
......@@ -21,17 +21,11 @@ where
pure x = Just x
(<*>) Nothing _ = Nothing
(<*>) (Just f) ma = fmap f ma
instance *> Maybe
where
*> (Just _) m = m
*> _ _ = Nothing
instance <* Maybe
where
<* Nothing _ = Nothing
<* m (Just _) = m
<* _ _ = Nothing
(*>) (Just _) m = m
(*>) _ _ = Nothing
(<*) Nothing _ = Nothing
(<*) m (Just _) = m
(<*) _ _ = Nothing
instance Alternative Maybe
where
......@@ -118,7 +112,7 @@ instance Functor (MaybeT m) | Functor m where
instance Applicative (MaybeT m) | Monad m where
pure x = MaybeT $ pure $ Just x
<*> mf mx = MaybeT $
(<*>) mf mx = MaybeT $
runMaybeT mf >>= \mb_f ->
case mb_f of
Nothing = pure Nothing
......
implementation module Text.Parsers.Simple.Core
import StdEnv
import Control.Applicative
import Control.Monad
import Data.Either
import Data.Func
import Data.Functor
import Data.List
from StdFunc import o, const
:: PCont t a :== [t] -> ([(a, [t])], [Error])
:: Parser t a = Parser (PCont t a)
......
......@@ -2,7 +2,7 @@ definition module Text.Parsers.ZParsers.ParsersKernel
from StdEnv import class Eq, class toString, class ==
from Data.Maybe import :: Maybe(..)
from Control.Applicative import class Applicative, class Alternative, class *>
from Control.Applicative import class Applicative, class Alternative
from Control.Monad import class Monad
from Data.Functor import class Functor
......@@ -58,9 +58,9 @@ instance Monad (Gram f) | Functor f
mkP :: !(Gram f a) -> f a | Monad f & Applicative f & Alternative f
sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative, *> f
sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative f
insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative, *> f
insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative f
gmList :: !(Gram f a) -> Gram f [a] | Functor f
......
......@@ -188,18 +188,18 @@ mkP (Gram l_a m_a) = foldr (<|>) (maybe empty pure m_a)
where mkP_Alt (Seq f_b2a g_b) = f_b2a <*> mkP g_b
mkP_Alt (Bind f_b b2g_a) = f_b >>= (mkP o b2g_a)
sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative, *> f
sepBy :: !(Gram f a) (f b) -> f a | Monad, Applicative, Alternative f
sepBy g sep = mkP (insertSep sep g)
insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative, *> f
insertSep :: (f b) !(Gram f a) -> Gram f a | Monad, Applicative, Alternative f
insertSep sep (Gram na ea) = Gram (map insertSepInAlt na) ea
where insertSepInAlt (Seq fb2a gb) = Seq fb2a (prefixSepInGram sep gb)
insertSepInAlt (Bind fc c2ga) = Bind fc (insertSep sep o c2ga)
prefixSepInGram :: (f b) (Gram f a) -> Gram f a | Monad, Applicative, Alternative, *> f
prefixSepInGram :: (f b) (Gram f a) -> Gram f a | Monad, Applicative, Alternative f
prefixSepInGram sep (Gram na ne) = Gram (map (prefixSepInAlt sep) na) ne
prefixSepInAlt :: (f a) (PAlt f b) -> PAlt f b | Monad, Applicative, Alternative, *> f
prefixSepInAlt :: (f a) (PAlt f b) -> PAlt f b | Monad, Applicative, Alternative f
prefixSepInAlt sep (Seq fb2a gb) = Seq (sep *> fb2a) (prefixSepInGram sep gb)
gmList :: !(Gram f a) -> Gram f [a] | Functor f
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment