summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTomLokhorst <>2009-05-13 08:24:59 (GMT)
committerLuite Stegeman <luite@luite.com>2009-05-13 08:24:59 (GMT)
commitb42168b73eacfec6ebd68489e4837af3b725b403 (patch)
tree28a4c904467fc36204170bff72d5e9348458bba2
version 0.2.00.2.0
-rw-r--r--LICENSE28
-rwxr-xr-xSetup.lhs4
-rw-r--r--bool-extras.cabal37
-rw-r--r--examples/Arrow.hs9
-rw-r--r--examples/Bool.hs9
-rw-r--r--examples/Monoid.hs9
-rw-r--r--examples/Morphisms.hs11
-rw-r--r--src/Data/Bool/Extras.hs103
8 files changed, 210 insertions, 0 deletions
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..e2c8493
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,28 @@
+Copyright (c) 2009, Erik Hesselink, Jeroen Leeuwestein, Tom Lokhorst,
+ Sebastiaan Visser
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. 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.
+3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100755
index 0000000..6b32049
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain
diff --git a/bool-extras.cabal b/bool-extras.cabal
new file mode 100644
index 0000000..72acadf
--- /dev/null
+++ b/bool-extras.cabal
@@ -0,0 +1,37 @@
+name: bool-extras
+version: 0.2.0
+synopsis: A fold function for Bool
+description: The `bool' function allows folding over boolean values.
+ .
+ This is comparable to the `maybe' or `either' functions
+ on their respective types.
+ .
+ The `bool' function is a replacement for the build-in
+ @if then else@-syntax. However, since it is a function, it
+ can be partially applied and passed around to higher order
+ functions, like so:
+ .
+ > ghci> :m + Data.Bool.Extras
+ > ghci> let yesOrNo = bool "no" "yes"
+ > ghci> map yesOrNo [True, False, True]
+ > ["yes", "no", "yes"]
+ .
+ Note that the arguments to `bool' are in the opposite order
+ of the @if then else@-syntax; First the false value, then
+ the true value, and finally the boolean.
+license: BSD3
+license-file: LICENSE
+author: Erik Hesselink,
+ Jeroen Leeuwestein,
+ Tom Lokhorst,
+ Sebastiaan Visser
+maintainer: Tom Lokhorst <tom@lokhorst.eu>
+stability: Stable
+category: Data
+build-type: Simple
+cabal-version: >= 1.6
+extra-source-files: examples/*.hs
+hs-source-dirs: src
+exposed-modules: Data.Bool.Extras
+build-depends: base
+
diff --git a/examples/Arrow.hs b/examples/Arrow.hs
new file mode 100644
index 0000000..ab1e10e
--- /dev/null
+++ b/examples/Arrow.hs
@@ -0,0 +1,9 @@
+module Arrow where
+
+import Data.Bool.Extras
+
+maybePlus5 :: Bool -> Int -> Int
+maybePlus5 b = (+5) `whenA` b
+
+main = print (maybePlus5 True 4)
+
diff --git a/examples/Bool.hs b/examples/Bool.hs
new file mode 100644
index 0000000..4343f65
--- /dev/null
+++ b/examples/Bool.hs
@@ -0,0 +1,9 @@
+module Bool where
+
+import Data.Bool.Extras
+
+yesOrNo :: Bool -> String
+yesOrNo = bool "no" "yes"
+
+main = putStrLn (yesOrNo True)
+
diff --git a/examples/Monoid.hs b/examples/Monoid.hs
new file mode 100644
index 0000000..e788a65
--- /dev/null
+++ b/examples/Monoid.hs
@@ -0,0 +1,9 @@
+module Monoid where
+
+import Data.Bool.Extras
+
+xsB :: Bool -> [Int]
+xsB = mwhen [1..5]
+
+main = print (xsB False)
+
diff --git a/examples/Morphisms.hs b/examples/Morphisms.hs
new file mode 100644
index 0000000..72617df
--- /dev/null
+++ b/examples/Morphisms.hs
@@ -0,0 +1,11 @@
+module Morphisms where
+
+import Data.Bool.Extras
+
+bit :: Bool -> Int
+bit = cata (0, 1)
+
+main = do
+ print (bit False)
+ print (ana even 3)
+
diff --git a/src/Data/Bool/Extras.hs b/src/Data/Bool/Extras.hs
new file mode 100644
index 0000000..a006f14
--- /dev/null
+++ b/src/Data/Bool/Extras.hs
@@ -0,0 +1,103 @@
+-- | This module provides some convenient functions for dealing with Booleans.
+--
+-- The most important one being 'bool', a function that can be used in place of
+-- the build-in @if then else@-syntax.
+module Data.Bool.Extras
+ (
+ -- * Main function
+ bool
+
+ -- * Other functions
+ , mwhen
+ , whenA
+ , whenC
+ , whenM
+
+ -- * Morphisms
+ , BoolAlgebra
+ , cata
+ , ana
+ ) where
+
+import Control.Arrow
+import Control.Category (Category)
+import qualified Control.Category as Cat
+import Control.Monad
+import Data.Bool
+import Data.Monoid
+
+-- | Defines the fold over a boolean value.
+--
+-- Returns its first argument when applied to `False',
+-- returns its second argument when applied to `True'.
+--
+-- Comparable to the `maybe' or `either' functions for their respective data
+-- types.
+bool :: a -> a -> Bool -> a
+bool x _ False = x
+bool _ y True = y
+-- Expressed in terms of `cata':
+-- bool = curry cata
+
+
+-- | Boolean operation for monoids.
+--
+-- Returns its first argument when applied to `True',
+-- returns `mempty' when applied to `False'.
+mwhen :: (Monoid a) => a -> Bool -> a
+mwhen = bool mempty
+
+-- | Boolean operation for arrows.
+--
+-- Returns its first argument when applied to `True',
+-- returns `returnA' when applied to `False'.
+whenA :: Arrow a => a b b -> Bool -> a b b
+whenA = bool returnA
+
+-- | Boolean operation for categories.
+--
+-- Returns its first argument when applied to `True',
+-- returns @Control.Category.@`Cat.id' when applied to `False'.
+whenC :: Category cat => cat b b -> Bool -> cat b b
+whenC = bool Cat.id
+
+-- | Boolean operation for monads.
+--
+-- Returns its first argument when applied to `True',
+-- returns @Control.Category.@`Cat.id' when applied to `False'.
+--
+-- @Control.Monad.@`when' can be expressed in terms of `whenM', like so:
+--
+-- > when :: Monad m => Bool -> m () -> m ()
+-- > when b m = (const m `whenM` b) ()
+whenM :: Monad m => (b -> m b) -> Bool -> (b -> m b)
+whenM = bool return
+-- Alternative implementation using Kleisli arrows:
+-- whenM m = runKleisli . whenC (Kleisli m)
+
+{-
+-- Functions that are also possible, but we haven't found an explicit need for
+
+whenP :: MonadPlus m => a -> Bool -> m a
+whenP = bool mzero . return
+
+(<?>) :: Applicative f => (a -> f a) -> Bool -> (a -> f a)
+(<?>) = bool pure
+-}
+
+
+-- | Algebra for Bool data type.
+--
+-- The first field of the pair represents the `False' value,
+-- the second field represents the `True' value.
+type BoolAlgebra r = (r, r)
+
+-- | Catamorphism for booleans.
+cata :: BoolAlgebra r -> Bool -> r
+cata (x, _) False = x
+cata (_, y) True = y
+
+-- | Anamorphism for booleans.
+ana :: (b -> Bool) -> b -> Bool
+ana f b = f b
+