diff --git a/Data/Either/Unwrap.hs b/Data/Either/Unwrap.hs new file mode 100644 --- /dev/null +++ b/Data/Either/Unwrap.hs @@ -0,0 +1,79 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Either.Unwrap +-- Copyright : (c) Gregory Crosswhite +-- License : BSD-style +-- +-- Maintainer : gcross@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- Functions for probing and unwrapping values inside of Either. +-- +----------------------------------------------------------------------------- + +module Data.Either.Unwrap + ( isLeft + , isRight + , fromLeft + , fromRight + , eitherM + , whenLeft + , whenRight + , unlessLeft + , unlessRight + ) where + +-- --------------------------------------------------------------------------- +-- Functions over Either + +-- |The 'isLeft' function returns 'True' iff its argument is of the form @Left _@. +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft _ = False + +-- |The 'isRight' function returns 'True' iff its argument is of the form @Right _@. +isRight :: Either a b -> Bool +isRight (Right _) = True +isRight _ = False + +-- | The 'fromLeft' function extracts the element out of a 'Left' and +-- throws an error if its argument take the form @Right _@. +fromLeft :: Either a b -> a +fromLeft (Right _) = error "Either.Unwrap.fromLeft: Argument takes form 'Right _'" -- yuck +fromLeft (Left x) = x + +-- | The 'fromRight' function extracts the element out of a 'Right' and +-- throws an error if its argument take the form @Left _@. +fromRight :: Either a b -> b +fromRight (Left _) = error "Either.Unwrap.fromRight: Argument takes form 'Left _'" -- yuck +fromRight (Right x) = x + +-- | The 'eitherM' function takes an 'Either' value and two functions which return monads. +-- If the argument takes the form @Left _@ then the element within is passed to the first +-- function, otherwise the element within is passed to the second function. +eitherM :: Monad m => Either a b -> (a -> m c) -> (b -> m c) -> m c +eitherM (Left x) f _ = f x +eitherM (Right x) _ f = f x + +-- | The 'whenLeft' function takes an 'Either' value and a function which returns a monad. +-- The monad is only executed when the given argument takes the form @Left _@, otherwise +-- it does nothing. +whenLeft :: Monad m => Either a b -> (a -> m ()) -> m () +whenLeft (Left x) f = f x +whenLeft _ _ = return () + +-- | The 'whenLeft' function takes an 'Either' value and a function which returns a monad. +-- The monad is only executed when the given argument takes the form @Right _@, otherwise +-- it does nothing. +whenRight :: Monad m => Either a b -> (b -> m ()) -> m () +whenRight (Right x) f = f x +whenRight _ _ = return () + +-- | A synonym of 'whenRight'. +unlessLeft :: Monad m => Either a b -> (b -> m ()) -> m () +unlessLeft = whenRight + +-- | A synonym of 'whenLeft'. +unlessRight :: Monad m => Either a b -> (a -> m ()) -> m () +unlessRight = whenLeft diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2009 Gregory M. Crosswhite +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 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 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.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,24 @@ +import Control.Monad +import Distribution.Simple +import System.Exit +import System.IO +import System.Process +import Text.Printf + +main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests}) + +runzeTests _ _ _ _= do + putStrLn "Checking for required modules..." + found <- forM ["test-framework","test-framework-hunit"] $ \package_name -> do + putStr $ printf "Checking for package %s... " package_name + hFlush stdout + error_code <- system $ printf "ghc-pkg field %s version" package_name + return (error_code == ExitSuccess) + when ((not.and) found) $ do + putStrLn "One or more packages needed for testing was not found." + exitWith $ ExitFailure 1 + putStrLn "" + putStrLn "Running tests..." + putStrLn "" + system "runhaskell -i. -i./tests tests/runtests.hs" + return () diff --git a/either-unwrap.cabal b/either-unwrap.cabal new file mode 100644 --- /dev/null +++ b/either-unwrap.cabal @@ -0,0 +1,18 @@ +Name: either-unwrap +Description: Functions for probing and unwrapping values inside of Either. +Version: 1.0 +Category: Data +Cabal-Version: >= 1.2 +License: BSD3 +License-File: LICENSE +Author: Gregory Crosswhite +Maintainer: Gregory Crosswhite +Homepage: http://github.com/gcross/either-unwrap +Synopsis: Functions for probing and unwrapping values inside of Either. +Build-Type: Simple + +Library + Build-Depends: base >= 3 + Hs-Source-Dirs: . + Exposed-Modules: Data.Either.Unwrap + GHC-Options: -Wall