Difference between revisions of "The Other Prelude"
From HaskellWiki
Uchchwhash (talk | contribs) m (x => y (yikes!)) |
Nmessenger (talk | contribs) (Pulled (>>) into Applicative. Performance seems less of a concern than generality, IMO, for this exercise. Or is Applicative.(>>) strictly invalid?) |
||
Line 30: | Line 30: | ||
-- module: TheOtherPrelude | -- module: TheOtherPrelude | ||
import Prelude () -- hide everything | import Prelude () -- hide everything | ||
+ | |||
-- the idea is to remove 'fmap'. | -- the idea is to remove 'fmap'. | ||
Line 42: | Line 43: | ||
map = (.) | map = (.) | ||
(.) = map | (.) = map | ||
+ | |||
-- the following has been shamelessly copied, | -- the following has been shamelessly copied, | ||
− | -- from the | + | -- from the Functor hierarchy proposal[1] wiki page. |
class Functor f => Applicative f where | class Functor f => Applicative f where | ||
-- lifting a value | -- lifting a value | ||
Line 54: | Line 56: | ||
(<*>) :: f (a -> b) -> f a -> f b | (<*>) :: f (a -> b) -> f a -> f b | ||
+ | -- when the second is independent of the first | ||
+ | (>>) :: m a -> m b -> m b | ||
+ | |||
+ | -- is there a better definition? | ||
+ | fa >> fb = (map (const id) fa) <*> fb | ||
+ | |||
+ | |||
-- this leaves little left for the actual Monad class | -- this leaves little left for the actual Monad class | ||
− | class | + | class Applicative m => Monad m where |
-- the binding operation, gist of a monad | -- the binding operation, gist of a monad | ||
(>>=) :: m a -> (a -> m b) -> m b | (>>=) :: m a -> (a -> m b) -> m b | ||
Line 61: | Line 70: | ||
-- throwing out the outer monad | -- throwing out the outer monad | ||
join :: m (m a) -> m a | join :: m (m a) -> m a | ||
− | |||
− | |||
− | |||
− | |||
-- intuitive definitions | -- intuitive definitions | ||
− | |||
x >>= f = join (map f x) | x >>= f = join (map f x) | ||
join x = x >>= id | join x = x >>= id | ||
− | -- we shamelessly copy from the | + | |
+ | -- we shamelessly copy from the MonadPlus reform proposal[2] now. | ||
-- zero will be used when pattern matching against refutable patterns in | -- zero will be used when pattern matching against refutable patterns in | ||
Line 77: | Line 82: | ||
-- should satisfy 'left zero': zero >>= f = zero | -- should satisfy 'left zero': zero >>= f = zero | ||
− | class | + | class Monad m => MonadZero m where |
zero :: m a | zero :: m a | ||
+ | |||
-- should satisfy 'monoid' | -- should satisfy 'monoid' | ||
Line 84: | Line 90: | ||
-- and 'left distribution' | -- and 'left distribution' | ||
-- (a ++ b) >>= f = (a >>= f) ++ (b >>= f) | -- (a ++ b) >>= f = (a >>= f) ++ (b >>= f) | ||
− | class | + | class MonadZero m => MonadPlus m where |
(++) :: m a -> m a -> m a | (++) :: m a -> m a -> m a | ||
+ | |||
-- should satisfy 'monoid' | -- should satisfy 'monoid' | ||
Line 92: | Line 99: | ||
-- and 'left catch' | -- and 'left catch' | ||
-- (return a) `orElse` b = a | -- (return a) `orElse` b = a | ||
− | class | + | class MonadZero m => MonadOr m where |
orElse :: m a -> m a -> m a | orElse :: m a -> m a -> m a | ||
</haskell> | </haskell> | ||
+ | |||
+ | [1]: [[Functor hierarchy proposal]]<br /> | ||
+ | [2]: [[MonadPlus reform proposal]] | ||
=== <hask>TheOtherPrelude.Utilities</hask> === | === <hask>TheOtherPrelude.Utilities</hask> === |
Revision as of 17:57, 2 January 2007
Contents
Call For Contribution
This fun project, called The Other Prelude, is a creative reconstruction of the standard Prelude. By disregarding history and compatibility, we get a clean sheet.
Committee
This project has no committee whatsoever. Haskell community discussed the issues here.
Naming Conventions
- Function names should be easy for beginners to consume.
- Specifically, The Other Prelude naming convention is to use
- descriptive symbols for functions that are naturally infix (e.g.,
mplus
is replaced by(++)
) - whole English words and camelCase for functions (e.g.,
orElse
but notfmap
)
- descriptive symbols for functions that are naturally infix (e.g.,
The Hierarchy
Although, not Haskell 98, hierarchical modules will definitely be in Haskell'. We take it for granted.
TheOtherPrelude
- Minimalistic module.TheOtherPrelude.Utilities
- Convenient definitions. The reasoning behind its existence is that we want the Prelude to be very concise. It should not steal good names.
Open Issues
- Should Prelude functions use
Integer
instead ofInt
? - Should
String
be a class rather than a type synonym?
The Code
Currently, the code is in Wiki form. If people do agree that the collaborative decisions begot something pretty, we'll have a group of files in darcs.haskell.org some time.
The imaginery Prelude as it stands,
TheOtherPrelude
-- module: TheOtherPrelude
import Prelude () -- hide everything
-- the idea is to remove 'fmap'.
-- both map :: (a -> b) -> [a] -> [b] ('fmap' for the monad [])
-- and (.) :: (a -> b) -> (e -> a) -> (e -> b) ('fmap' for the (->) e monad)
-- are good names, and are intuitively prefix and infix respectively.
class Functor f where
-- 'fmap' is guilty of nothing but a bad name
map, (.) :: (a -> b) -> f a -> f b
-- implementing either is enough
map = (.)
(.) = map
-- the following has been shamelessly copied,
-- from the Functor hierarchy proposal[1] wiki page.
class Functor f => Applicative f where
-- lifting a value
return :: a -> f a
-- should this be named 'ap'? is 'ap' a good name?
-- can you come up with a better name?
-- can it refactor the liftM* type gymnastics?
(<*>) :: f (a -> b) -> f a -> f b
-- when the second is independent of the first
(>>) :: m a -> m b -> m b
-- is there a better definition?
fa >> fb = (map (const id) fa) <*> fb
-- this leaves little left for the actual Monad class
class Applicative m => Monad m where
-- the binding operation, gist of a monad
(>>=) :: m a -> (a -> m b) -> m b
-- throwing out the outer monad
join :: m (m a) -> m a
-- intuitive definitions
x >>= f = join (map f x)
join x = x >>= id
-- we shamelessly copy from the MonadPlus reform proposal[2] now.
-- zero will be used when pattern matching against refutable patterns in
-- do-notation as well as to provide support for monad comprehensions.
-- should satisfy 'left zero': zero >>= f = zero
class Monad m => MonadZero m where
zero :: m a
-- should satisfy 'monoid'
-- zero ++ b = b, b ++ zero = b, (a ++ b) ++ c = a ++ (b ++ c)
-- and 'left distribution'
-- (a ++ b) >>= f = (a >>= f) ++ (b >>= f)
class MonadZero m => MonadPlus m where
(++) :: m a -> m a -> m a
-- 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
class MonadZero m => MonadOr m where
orElse :: m a -> m a -> m a
[1]: Functor hierarchy proposal
[2]: MonadPlus reform proposal
TheOtherPrelude.Utilities
-- module: TheOtherPrelude.Utilities
import Prelude () -- hide everything
-- this is the if-then-else proposal
-- the name has been chosen to reflect the magic of Church booleans!
boolean True x _ = x
boolean False _ y = y
How To Use
-- ''The Other Prelude'' is an alternative, not a replacement.
-- So we need to hide everything from the Prelude
import Prelude ()
-- This is just an example assuming there is nothing to hide
import TheOtherPrelude
-- Hopefully, this module will contain lift,...
-- Standard convention is to use M.lift (instead of liftM)
import qualified TheOtherPrelude.Monad.Kleisli as M
See also
- Mathematical prelude discussion - A numeric Prelude in good shape already. Will a merger be ever possible?
- Prelude extensions and Prelude function suggestions - Unlike The Other Prelude they enhance the Prelude.
- Functor hierarchy proposal - Making
Monad m
implyFunctor m
(adopted by The Other Prelude). - If-then-else - Making
if
a function (partially adopted by The Other Prelude, we are silent on the bigger issue of sugar). - MissingH - Functions "missing" from the Haskell Prelude/libraries.
- MonadPlus reform proposal - Clarifies ambiguities around MonadPlus laws (adopted by The Other Prelude)