{-
Copyright © 2011, 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, except for 'Applicative'._*pure*_
which is replaced by 'return'. This is because *@pure@* cannot be a function name in Frege
due to being a keyword.
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_ in Hasekll.
-}
{-
* $Author: Ingo.Wechsung@googlemail.com $
* $Revision: 494 $
* $Id: $
* $Date: 2012-01-31 21:43:16 +0100 (Tue, 31 Jan 2012) $
-}
protected package frege.prelude.PreludeMonad
inline candidates (ST.>>)
where
import frege.prelude.PreludeBase
import frege.prelude.PreludeList(ListSource, ListLike.++,
reverse, map, concat, unzip, zipWith, foldr, replicate)
-- The infixes must live in PreludeBase, because this module is
-- most likely not imported explicitly.
-- infixr 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'
fmap :: (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 ('return'), and
- sequence computations and combine their results ('<*>').
A minimal complete definition must include implementations of these
functions satisfying the following laws:
[/identity/]
@return id <*> v = v@
[/composition/]
@return (•) <*> u <*> v <*> w = u <*> (v <*> w)@
[/homomorphism/]
@return f <*> return x = return (f x)@
[/interchange/]
@u <*> return y = return ($ y) <*> u@
The other methods have the following default definitions, which may
be overridden with equivalent specialized implementations:
> u *> v = return (const id) <*> u <*> v
> u <* v = return const <*> u <*> v
As a consequence of these laws, the 'Functor' instance for @f@ will satisfy
> fmap f x = return f <*> x
If @f@ is also a 'Monad', it should satisfy
@(<*>) = ap@ (which implies that 'return' and '<*>' satisfy the
applicative functor laws).
Minimal complete definition: 'return' and '<*>'.
-}
class Applicative (Functor p) => p where
--- Lift a value
return :: a -> p a
--- Sequential application.
(<*>) :: p (a -> b) -> p a -> p b
--- 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 = return (const id) <*> pa <*> pb
pa <* pb = return const <*> pa <*> pb
apply :: (Applicative 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 = return 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
{--
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.
Minimal complete definition: '>>=' and 'return'.
Instances of Monad should satisfy the following laws:
> return a >>= k == k a
> m >>= return == 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 >>= return • 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.
-}
class Monad (Applicative m) => m where
--- Sequentially compose two actions, passing any value produced by the first as an argument to the second.
(>>=) :: m a -> (a -> m b) -> m b
{--
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
(ma >> mb) = ma >>= const mb
(<*>) = ap
fmap f mx = mx >>= return • f
join mma = mma >>= id
{--
The 'MonadFail' class augments 'Monad' by adding the 'fail' operation.
This operation is not part of the mathematical definition of a monad.
-}
class MonadFail (Monad m) => m where
--- Fail with a message.
fail :: String -> m a
fail s = error s
{--
A 'Monad' with a left identity.
-}
class MonadZero (Monad mz) => 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 MonadPlus (MonadZero mp) => mp where
--- an associative operation
mplus :: mp a -> mp a -> mp a
class MonadOr (MonadZero mo) => 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':
-- (return 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
--- repeat action forever
forever a = a >> forever a
--- 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 :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
filterM p xs = filterM xs.toList where
filterM [] = return []
filterM (x:xs) = do
flg <- p x
ys <- filterM xs
return (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.
> return f `ap` x1 `ap` ... `ap` xn
is equivalent to
> liftMn f x1 x2 ... xn
-}
ap mf ma = mf >>= (\f -> ma >>= (\a -> return (f a)))
--- Promote a function to a monad.
liftM :: Monad m => (a -> b) -> m a -> m b
liftM f ma = ma >>= (\a -> return (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 -> return (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 -> return (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 -> return (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 -> return (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) >>= return • 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 :: (ListSource list, Monad m) => list (m a) -> m [a]
sequence xs = loop xs.toList []
where
loop [] acc = return (reverse acc)
loop (m:ms) acc = do a <- m; loop ms (a:acc)
{-- foldr ('>>') over a list of monadic values for side effects -}
sequence_ xs = loop xs.toList
where
loop (m:ms) = do _ <- m; loop ms
loop [] = return () -- foldr (>>) (return ()) 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
--- @foldM f a xs@ folds a monadic function @f@ over the list @xs@.
-- foldM :: (ListSource s, Monad m) => (a -> b -> m a) -> a -> s b -> m a
foldM f a bs = fm f bs a
where
fm f (b:bs) a = a `f` b >>= fm f bs
fm f [] a = return a
--- @foldM_@ is the same as 'foldM', but discards the result
foldM_ f a bs = foldM f a bs >> return ()
--- @guard b@ is @return ()@ if @b@ is *@true@*, and 'mzero' otherwise.
guard b = if b then return () else mzero
{--
@when condition monadic@ returns /action/ of type @Monad m => m ()@
if /condition/ is true, otherwise 'return' '()'.
-}
when c ioa = if c then ioa else return ()
{-- opposite of 'when' -}
unless c ios = when (not c) ios
{-
instance Monad (Either a) where
return 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)
-}
instance Functor [] where
fmap = map
instance Monad [] where
return x = [x]
xs >>= f = concat ( map f xs )
instance MonadPlus [] where
mzero = []
mplus = (++)
instance MonadFail [] where
fail = const []
instance Monad (Either left) where
fmap f (Left x) = Left x
fmap f (Right x) = Right (f x)
return = Right
Right x >>= f = f x
Left s >>= _ = Left s
instance MonadFail (Either String) where
fail = Left
instance Monad (State s)
instance Monad (ST s) where
a >> b = a >>= (const b)
-- 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)
-- ----------------------------------------------------------------------------------
-- ---------------- preliminary until better place is found -------------------------
-- ----------------------------------------------------------------------------------
{--
* Type class for native values that may be used in a functional way.
* The 'freeze' operation is a 'ST' action, but yields a result that
* can be returned from a ST thread.
*
* To be implemented with care.
-}
class Freezable f where
{--
* "Freeze" a mutable native value. The result is supposed to be immutable
* or at least not reachable from other parts of the code, especially from java code.
*
* The most prominent way to freeze a value is by 'clone'-ing it, if that is supported.
-}
freeze :: forall f s. f s -> ST s (Frozen f)
{--
* The inverse of 'freeze' creates a value (an object) which can be passed
* to impure functions without compromising the frozen object passed as argument.
* One possibility to thaw an object properly is by cloning it.
* If 'thaw' is not implemented correctly, bad things may happen.
-}
thaw :: forall f s. Frozen f -> Mutable f s
{--
* [Usage] @withFrozen v f@ where @v@ is a mutable native value.
* [Purpose] Temporarily freeze @v@ and pass it to a pure function @f@.
* [Return] the result of @f v@ in the 'ST' monad.
* [Requirements] @f@ must not fork parallel computations that could access @v@
* after @f@ has returned.
*
* This function is needed to synchronize pure computations on a native value with
* manipulations of that same value inside 'ST' actions. Consider the following code:
* > do
* > arr <- IntArray.new 100
* > arr.[42 <- 1]
* > let result = arr.elemAt 42 // actually a type error
* > arr.[42 <- 2]
* > return result
* The placement of the @let@ does not guarantee that @result@ will be evaluated between
* the assignments to cell 42 of the array. To the contrary, the read access to the array
* will most probably not occur before the result of the state action is evaluated.
* Therefore, such constructs are forbidden through the type of 'IntArray.elemAt' which
* requires a frozen array.
*
* The @let@ must be replaced by
* > result <- withFrozen arr (flip IntArray.elemAt 42)
* to sequence evaluation before the next write access to the array.
*
* Because 'Freezable.withFrozen' employs 'Freezable.our' it can be as easily misused.
* In fact @withFrozen v id@ is identical to @our v@.
-}
withFrozen :: forall f s a. f s -> (Frozen f -> a) -> ST s a
withFrozen v f = our v >>= (return • f)
{--
* [Usage] @our v@ as last action in a *do* block that created mutable native value @v@
* [Purpose] Make a value that is identical to @v@ but has 'Immutable' as phantom type.
* This allows escape of mutable native values from 'ST' actions. Yet, because these
* values are tagged 'Immutable', unsafe operations are impossible outside the 'ST'
* monad as long as all impure native functions are correctly defined. One can pass
* the value to another 'ST' action, which may 'Freezable.thaw' it and apply
* impure native functions again.
* [Returns] a copy of @v@ tagged as 'Immutable' in the 'ST' monad
*
* This is intended for cases where we want to keep the native value and we know
* that there are no references to
* the native value other than the ones maintained in the current 'ST' action.
* In those not so rare cases, it would be overkill to obtain a copy
* of a value by cloning it or serializing/deserializing it. Hence, an
* implementation of 'Freezable.our' is allowed to cheat a bit and return just @this@.
*
* The safety of 'Freezable' operations is something the compiler cannot infer.
* It lies entirely in the responsibility
* of the programmer to ensure safety. Remember that violation of the informal
* contract of 'Freezable' (see below)
* will be rewarded with exceptions thrown at runtime or
* with inexplicable, perhaps nondeterministic behaviour of the program.
*
* An example where 'Freezable.our' is employed
* is creation and initialization of arrays, as in 'IntArray.fromList'.
* When the array is completely initialized, it is safe to let it escape
* as a read only value because no further write accesses are possible (unless one
* manages to pass the array to an impure function.)
*
* This is the informal contract of 'Freezable' and its operations.
* It is designed so that the
* type system will detect unsafe usage of mutable native values. The programmer
* should understand that such type errors are a strong signal to go back and rethink
* the code. Inventing "clever" workarounds in the form of creatively typed
* native functions or so is like loading a shotgun that points to ones foot.
* - All mutable native data types have a frege type with a phantom type as its
* last type argument. (i.e. @data Date s = native java.util.Date@)
* - All impure functions have the same type variable (say @s@) for the
* phantom type of mutable types that appear in their type
* and have a result of 'ST' @s@ /a/.
* - All object creation functions have a return type of @ST s (M s)@ or @Mutable M s@
* where @M@ is the type constructor of the native values frege type.
* - If the function relies on global state, alters global state or performs input or output,
* the return type must be 'ST' 'RealWorld' /a/. Consequently,
* all mutable types that appear in
* the type signature must have 'RealWorld' as phantom type.
* - In pure functions, the mutable data types *must* appear as @M Immutable@.
* The return type is an ordinary type (no 'ST' type).
* - If the type is an instance of 'Freezable', then the implmentations of
* 'Freezable.freeze' and 'Freezable.thaw' create fresh objects.
* This is true for instances of 'Cloneable' and 'Serializable' that use the
* default type class methods (i.e., do not supply own implementations).
* - 'Freezable.our' is used only when there are no alien references to the value *or*
* if a fresh object is created.
*
* The default implementation does the same as 'Freezable.freeze'. A generic native
* method to implement a low cost 'Freezable.our'
* is provided in the runtime as @frege.RT.our@. It just returns its argument.
-}
our :: forall f s. f s -> ST s (Frozen f)
our f = freeze f
{--
* For a data type declared like
* > data D s = native Javatype
* where @Javatype@ implements the @java.lang.Cloneable@ interface,
* one can get implementations for 'Freezable.freeze'
* and 'Freezable.thaw' by just stating
* > instance Cloneable D
* The 'freeze' and 'thaw' operations are implemented in terms of 'clone'.
-}
class Cloneable (Freezable f) => f where
{--
* @clone v@ must be a native method that works like @java.lang.Object#clone@.
-}
pure native clone :: f a -> f b
freeze x = ST.return (clone x)
thaw x = ST.return (clone x)
{--
* For a data type declared like
* > data D s = native Javatype
* where @Javatype@ implements the @java.io.Serializable@ interface,
* one can get implementations for 'freeze'
* and 'thaw' by just stating
* > instance Serializable D
* The 'freeze' and 'thaw' operations are implemented in terms of @copySerializable@,
* which serializes its argument to a byte array and creates a new copy by
* deserializing it from the byte array.
-}
class Serializable (Freezable f) => f where
{--
* @copySerializable v@ is supposed to be a native function that is
* implemented by @frege.RT.copySerializable@ at the instantiated type.
-}
pure native copySerializable frege.RT.copySerializable :: f a -> f b
freeze x = ST.return (copySerializable x)
thaw x = ST.return (copySerializable x)