Fetching contributors…
Cannot retrieve contributors at this time
518 lines (383 sloc) 16.8 KB
{-
Copyright © 2011 - 2015, Ingo Wechsung
All rights reserved.
Redistribution and use in source and binary forms, with or
without modification, are permitted provided that the following
conditions are met:
- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution. Neither the name of the copyright holder
nor the names of its contributors may be used to endorse or
promote products derived from this software without specific
prior written permission.
*THIS SOFTWARE IS PROVIDED BY THE
COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
THE POSSIBILITY OF SUCH DAMAGE.*
-}
{--
This package provides the 'Monad' class and related classes and functions.
The class hierarchy is derived from the (Haskell) proposal *The Other Prelude*
but the traditional method names have been kept.
The functions in this library use the following naming conventions:
- A postfix "M"" always stands for a function in the Kleisli category: The monad type constructor _m_ is
added to function results (modulo currying) and nowhere else. So, for example,
> filter :: (a -> Bool) -> [a] -> [a]
> filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
- A postfix "_" changes the result type from (_m a_) to (_m ()_). Thus, for example:
> sequence :: Monad m => [m a] -> m [a]
> sequence_ :: Monad m => [m a] -> m ()
- A prefix "m" generalizes an existing function to a monadic form. Thus, for example:
> sum :: Num a => [a] -> a
> msum :: MonadPlus m => [m a] -> m a
This package is _implementation specific_ insofar as the compiler may
assume that certain items are defined here in a certain way.
Changes may thus lead to compiler crashes or java code that
will be rejected by the java compiler.
In particular, desugared *@do@* expressions will reference 'Monad', '>>=' and '>>'.
This package is implicitly imported and besides the additional stuff covers most of what
one would get by importing _Control.Monad_ and _Control.Applicative_ in Haskell.
-}
protected package frege.prelude.PreludeMonad
inline (ST.fmap, ST.>>,
Reader.fmap, Reader.pure, Reader.<*>, Reader.>>=, Reader.>>,
when, unless)
where
import frege.prelude.PreludeBase
import frege.prelude.PreludeList(ListSource, ++,
reverse, map, concat, unzip, zipWith,
chunked, fold, foldr, replicate)
import frege.control.Semigroupoid
import frege.control.Category
infixr 2 `=<<`
infixr 3 `<=<` `>=>`
infixl 3 `>>` `>>=` `<|>`
infixl 4 `<$>` `<*>` `<*` `*>` fmap
infixr 13 mplus `<+>`
{--
The 'Functor' class is used for types that can be mapped over.
Instances of 'Functor' should satisfy the following laws:
> fmap id == id
> fmap (f . g) == fmap f . fmap g
-}
class Functor f where
--- Map a function over a 'Functor'
--- An infix operator that is aliased to 'Functor.fmap' is @<$>@
fmap :: (a -> b) -> f a -> f b
class (Functor f) => Apply f where
(<*>) :: f (a -> b) -> f a -> f b
--- An infix synonym for 'fmap'. Left associative with precedence 4.
-- (<$>) :: Functor f => (a -> b) -> f a -> f b
(<$>) = fmap
{--
A functor with application, providing operations to
- embed pure expressions ('pure'), and
- sequence computations and combine their results ('<*>').
A minimal complete definition must include implementations of these
functions satisfying the following laws:
[_identity_]
@pure id <*> v = v@
[_composition_]
@pure (•) <*> u <*> v <*> w = u <*> (v <*> w)@
[_homomorphism_]
@pure f <*> pure x = pure (f x)@
[_interchange_]
@u <*> pure y = pure ($ y) <*> u@
The other methods have the following default definitions, which may
be overridden with equivalent specialized implementations:
> u *> v = pure (const id) <*> u <*> v
> u <* v = pure const <*> u <*> v
As a consequence of these laws, the 'Functor' instance for @f@ will satisfy
> fmap f x = pure f <*> x
If @f@ is also a 'Monad', it should satisfy
> (<*>) = ap
(which implies that 'pure' and '<*>' satisfy the
applicative functor laws).
Minimal complete definition: 'pure' and '<*>'.
-}
class (Apply p) => Applicative p where
--- Lift a value
pure :: a -> p a
--- Sequence actions, discarding the value of the first argument.
(*>) :: p a -> p b -> p b
--- Sequence actions, discarding the value of the second argument.
(<*) :: p a -> p b -> p a
-- default implementations
pa *> pb = pure (const id) <*> pa <*> pb
pa <* pb = pure const <*> pa <*> pb
apply :: (Apply p) => p (a -> b) -> p a -> p b
apply = (<*>)
{-
Issue 39 (http://code.google.com/p/frege/issues/detail?id=39)
Requested by Daniel
-}
liftA :: Applicative f => (a -> b) -> f a -> f b
liftA f a = pure f <*> a
liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
liftA2 f a b = f <$> a <*> b
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 f a b c = f <$> a <*> b <*> c
liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
liftA4 f a b c d = f <$> a <*> b <*> c <*> d
liftA5 :: Applicative f => (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g
liftA5 f a b c d e = f <$> a <*> b <*> c <*> d <*> e
class (Apply f) => Bind f where
--- Sequentially compose two actions, passing any value produced by the first as an argument to the second.
(>>=) :: f a -> (a -> f b) -> f b
class (Functor f) => Alt f where
(<|>) :: f a -> f a -> f a
class (Alt f) => Plus f where
pzero :: f a
class (Plus f, Monad f) => MonadAlt f where
(<+>) :: f a -> f a -> f a
{--
The 'Monad' class defines the basic operations over a _monad_,
a concept from a branch of mathematics known as _category theory_.
From the perspective of a Frege programmer, however, it is best to think
of a monad as an _abstract datatype_ of actions.
Frege’s *@do@* expressions provide a convenient syntax for writing monadic expressions.
Instances of Monad should satisfy the following laws:
> pure a >>= k == k a
> m >>= pure == m
> m >>= (\x -> k x >>= h) == (m >>= k) >>= h
Since instances of 'Monad' are also instances of 'Functor',
they additionally shall satisfy the law:
> fmap f xs == xs >>= pure • f
which is also the default implementation of 'fmap'.
The instances of 'Monad' for lists, 'Maybe' and 'ST' defined in the Prelude
satisfy these laws.
Minimal complete definition: '>>=' and 'pure'
-}
class (Applicative m, Bind m) => Monad m where
{--
Sequentially compose two actions, discarding any value produced by the first,
this works like sequencing operators (such as the semicolon) in imperative languages.
-}
(>>) :: m a -> m b -> m b
{--
The 'join' function is the conventional monad *join* operator.
It is used to remove one level of monadic structure, projecting its bound argument into the outer level.
-}
join :: m (m a) -> m a
-- the second operand should be lazy in order to make forever and such like work.
(ma >> ?mb)= ma >>= const mb
(<*>) = ap
fmap f mx = mx >>= pure f
join mma = mma >>= id
-- according to AMP
-- return ∷ Monad m ⇒ a → m a
return = pure
{--
The 'MonadFail' class augments 'Monad' by adding the 'fail' operation.
This operation is not part of the mathematical definition of a monad.
-}
class (Monad m) => MonadFail m where
--- Fail with a message.
fail :: String -> m a
fail s = error s
{--
A 'Monad' with a left identity.
-}
class (Monad mz) => MonadZero mz where
--- This value should satisfy _left zero_:
--- > mzero >>= f = mzero
mzero :: mz a
{--
A 'Monad' that also supports choice and failure
and observes the following laws:
> mzero `mplus` v = v
> v `mplus` mzero = v
> (a `mplus` b) `mplus` c = a `mplus` (b `mplus` c)
> (a `mplus` b) >>= f = (a >>= f) `mplus` (b >>= f)
-}
class (MonadZero mp) => MonadPlus mp where
--- an associative operation
mplus :: mp a -> mp a -> mp a
class (MonadZero mo) => MonadOr mo where
-- Should satisfy 'monoid':
-- zero `orElse` b = b; b `orElse` zero = b
-- (a `orElse` b) `orElse` c = a `orElse` (b `orElse` c)
-- and 'left catch':
-- (pure a) `orElse` b = a
orElse :: mo a -> mo a -> mo a
--- '=<<' is the same as '>>=' with the arguments flipped
f =<< mv = mv >>= f
--- left to right Kleisli composition of monads
f >=> g = \x -> f x >>= g
--- Right-to-left Kleisli composition of monads. ('>=>'), with the arguments flipped
f <=< g = g >=> f
--- nowarn: deep recursion possible
--- repeat action forever
forever a = node where node = a >> node
--- discard or ignore result of evaluation, such as the return value of an 'IO' action.
void = fmap (const ())
--- 'msum' generalizes the list-based 'concat' function.
-- msum :: MonadPlus m => [m a] -> m a
msum = foldr mplus mzero
--- 'filterM' generalizes the list-based 'filter' function.
filterM mp = fold (liftM2 (++)) (pure []) . map (shortFilterM mp) . chunked 512
--- Version of 'filterM' that works on small lists with length < 1000 only.
--- Beware of stack overflow, and use 'filterM', when in doubt.
shortFilterM !p [] = pure []
shortFilterM !p (x:xs) = do
flg <- p x
ys <- shortFilterM p xs
pure (if flg then x:ys else ys)
--- @replicateM n act@ performs the action @n@ times, gathering the results.
replicateM :: (Monad m) => Int -> m a -> m [a]
replicateM n x = sequence (replicate n x)
--- Like 'replicateM', but discards the result.
replicateM_ :: (Monad m) => Int -> m a -> m ()
replicateM_ n x = sequence_ (replicate n x)
{--
In many situations, the 'liftM' operations can be replaced by uses of
'ap', which promotes function application.
> pure f `ap` x1 `ap` ... `ap` xn
is equivalent to
> liftMn f x1 x2 ... xn
-}
ap :: Monad α => α (γ->β) -> α γ -> α β
ap mf ma = mf >>= (\f -> ma >>= (\a -> pure (f a)))
--- Promote a function to a monad.
liftM :: Monad m => (a -> b) -> m a -> m b
liftM f ma = ma >>= (\a -> pure (f a))
--- Promote a function to a monad, scanning the monadic arguments from left to right. For example,
--- > liftM2 (+) [0,1] [0,2] = [0,2,1,3]
--- > liftM2 (+) (Just 1) Nothing = Nothing
liftM2 f ma mb = ma >>= (\a -> mb >>= (\b -> pure (f a b)))
--- Promote a function to a monad, scanning the monadic arguments from left to right (cf. 'liftM2').
liftM3 f ma mb mc = ma >>= (\a -> mb >>= (\b -> mc >>= (\c -> pure (f a b c))))
--- Promote a function to a monad, scanning the monadic arguments from left to right (cf. 'liftM2').
liftM4 f ma mb mc md = ma >>= (\a -> mb >>= (\b -> mc >>= (\c -> md >>= (\d -> pure (f a b c d)))))
--- Promote a function to a monad, scanning the monadic arguments from left to right (cf. 'liftM2').
liftM5 f ma mb mc md me = ma >>= (\a -> mb >>= (\b -> mc >>= (\c -> md >>= (\d -> me >>= (\e -> pure (f a b c d e))))))
-- ---------------------------------------------------------------------
-- -------------------- monadic list(source) functions -----------------
-- ---------------------------------------------------------------------
{--
The 'mapAndUnzipM' function maps its first argument over a list, returning
the result as a pair of lists. This function is mainly used with complicated
data structures or a state-transforming monad.
-}
--mapAndUnzipM :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
mapAndUnzipM f xs = sequence (map f xs) >>= pure unzip
--- The 'zipWithM' function generalizes 'zipWith' to arbitrary monads.
-- zipWithM :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM f xs ys = sequence (zipWith f xs ys)
--- 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.
-- zipWithM_ :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ f xs ys = sequence_ (zipWith f xs ys)
{--
Turn a list of monadic values @[m a]@ into a monadic value with a list @m [a]@
> sequence [Just 1, Just 3, Just 2] = Just [1,2,3]
This version of 'sequence' runs in constant stack space,
but needs heap space proportional to the size of the input list.
-}
sequence = fold (liftM2 (++)) (pure []) . map shortSequence . chunked 512
{--
A version of 'sequence' that uses the stack and may overflow
with longer lists.
A length of about 500 should be ok in most cases.
-}
shortSequence = foldr (liftM2 (:)) (pure [])
{-- fold ('>>') over a list of monadic values for side effects -}
sequence_ [] = pure ()
sequence_ (x:xs) = x >> sequence_ xs
--- @mapM f@ is equivalent to @sequence • map f@
-- mapM :: (ListSource list, Monad m) => (a -> m b) -> list a -> m [b]
mapM f = sequence map f -- • toList
--- @mapM_ f@ is equivalent to @sequence_ • map f@
-- mapM_ :: (ListSource list, Monad m) => (a -> m b) -> list a -> m ()
mapM_ f = sequence_ map f -- • toList
--- @forM xs f@ = @mapM_ f xs@
forM xs f = (sequence map f) xs
forM_ xs f = (sequence_ map f) xs
--- @for listSource f@ is a Java-friendly alias for @forM_@ that works on any list source
for :: (Monad m, ListSource listSource) => listSource e -> (e -> m a) -> m ()
for listSource = forM_ (toList listSource)
--- @foldM f a xs@ folds a monadic function _f_ over the list _xs_.
foldM p z = fold (\acc\as -> acc >>= flip (shortFoldM p) as) (pure z) . chunked 512
--- 'shortFoldM' is suitable only for lists with a length way below 1000.
--- Beware of stack overflow and use 'foldM' instead.
shortFoldM f a bs = fm f bs a
where
fm f (b:bs) a = a `f` b >>= fm f bs
fm f [] a = pure a
--- @foldM_@ is the same as 'foldM', but discards the result
foldM_ f a bs = foldM f a bs >> pure ()
--- @guard b@ is @pure ()@ if @b@ is *@true@*, and 'mzero' otherwise.
guard b = if b then pure () else mzero
{--
@when condition monadic@ returns /action/ of type @Monad m => m ()@
if /condition/ is true, otherwise 'pure' '()'.
-}
when c ioa = if c then ioa else pure ()
{-- opposite of 'when' -}
unless c ios = when (not c) ios
{-
instance Monad (Either a) where
pure a = Right a
Left x >>= _ = Left x
Right x >>= k = k x
fmap f (Left e) = Left e
fmap f (Right v) = Right (f v)
-}
private type L = []
protected type Reader = (->)
instance Functor [] where
fmap = map
instance Monad [] where
pure x = [x]
xs >>= f = concat ( map f xs )
instance MonadPlus [] where
mzero = []
mplus = (L.++)
instance MonadFail [] where
fail = const []
instance Monad (Either a) where
fmap f (Left x) = Left x
fmap f (Right x) = Right (f x)
pure = Right
Right x >>= f = f x
Left s >>= _ = Left s
instance MonadFail (Either String) where
fail x = Left x
-- instance Monad (State s)
instance Monad (ST s) where
fmap f st = st >>= pure . f
pure = ST.return
sta >> ?stb = sta >>= \_ -> stb
instance MonadFail (ST s) where
fail = error
-- Tuples
-- for higher arities and Monad instances see frege.data.Tuples
instance Functor ((,) a) where
fmap fn (a, x) = (a, fn x)
instance Functor ((,,) a b) where
fmap fn (a, b, x) = (a, b, fn x)
instance Applicative ((->) a) where
fmap = (.)
pure = const
(<*>) f g x = f x (g x)
instance Monad ((->) a) where
pure = const
f >>= k = \r -> k (f r) r
f >> k = f >>= const k
runReader :: Reader r a -> r -> a
runReader = ($)
mapReader :: (a -> b) -> Reader r a -> Reader r b
mapReader f r = f . runReader r
withReader :: (e -> r) -> Reader r a -> Reader e a
withReader f m = m . f