{- 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)