from-sum-0.2.1.0/src/0000755000000000000000000000000012773143721012401 5ustar0000000000000000from-sum-0.2.1.0/src/Control/0000755000000000000000000000000013013255722014012 5ustar0000000000000000from-sum-0.2.1.0/test/0000755000000000000000000000000012773140674012575 5ustar0000000000000000from-sum-0.2.1.0/src/Control/FromSum.hs0000644000000000000000000001614713013255722015747 0ustar0000000000000000{-# LANGUAGE CPP #-} {-| Module : Control.FromSum Copyright : (c) Dennis Gosnell, 2016 License : BSD-style (see LICENSE file) Maintainer : cdep.illabout@gmail.com Stability : experimental Portability : POSIX This Haskell module exports various \"from\" functions for 'Either' and 'Maybe'. -} module Control.FromSum ( -- * Monadic in return value fromEitherM , fromEitherOrM , fromEitherM_ , fromEitherOrM_ , fromMaybeM , fromMaybeOrM , fromMaybeM_ , fromMaybeOrM_ -- * Monadic in both return and sum-type value , fromEitherMM , fromEitherOrMM , fromMaybeMM , fromMaybeOrMM -- * Completely non-monadic functions , fromEither , fromEitherOr , fromMaybe , fromMaybeOr -- * Collapsing funtions , collapseEither , collapseExceptT ) where #if __GLASGOW_HASKELL__ < 710 -- We don't need this import for GHC 7.10 as it exports all required functions -- from Prelude import Control.Applicative #endif import Control.Monad ((<=<)) import Control.Monad.Except (ExceptT, runExceptT) import Data.Maybe (fromMaybe) -- | A monadic version of 'fromEither'. -- -- @ -- 'fromEitherM' leftAction === 'either' leftAction 'pure' -- @ -- -- >>> fromEitherM (\s -> [length s]) $ Right 5 -- [5] -- >>> fromEitherM (\s -> [length s]) $ Left ("foo" :: String) -- [3] fromEitherM :: Applicative m => (e -> m a) -> Either e a -> m a fromEitherM leftAction = either leftAction pure -- | A 'flip'ed version of 'fromEitherM'. -- -- >>> fromEitherOrM (Right 5) $ \s -> [length s] -- [5] -- -- This can be nice to use as an error handler. -- -- >>> fromEitherOrM (Right 5) $ \s -> putStrLn ("error: " ++ s) >> undefined -- 5 -- >>> fromEitherOrM (Left "foo") $ \s -> putStrLn ("error: " ++ s) >> undefined -- error: foo -- ... fromEitherOrM :: Applicative m => Either e a -> (e -> m a) -> m a fromEitherOrM = flip fromEitherM -- | Similar to 'fromEitherM', but only run the monadic 'leftAction' if the -- 'Either' argument is 'Left'. Otherwise, return 'pure' 'mempty'. -- -- @ -- 'fromEitherM_' leftAction === 'either' leftAction ('const' '$' 'pure' 'mempty') -- @ -- -- >>> fromEitherM_ (\err -> putStrLn err >> pure "bye") $ Right 5 -- "" -- >>> fromEitherM_ (\err -> putStrLn err >> pure "bye") $ Left "there was an error" -- there was an error -- "bye" -- -- This can be convenient when you want to run some sort of logging function -- whenever an 'Either' is 'Left'. If you imagine the logging function is -- @b -> 'IO' '()'@, then the effective type of 'fromEitherM_' becomes -- @'fromEitherM_' :: (e -> 'IO' '()') -> 'Either' e a -> 'IO' '()'@, because -- '()' has a 'Monoid' instance, and 'IO', has an 'Applicative' instance. -- -- >>> fromEitherM_ putStrLn $ Left "there was an error" -- there was an error fromEitherM_ :: (Applicative m, Monoid b) => (e -> m b) -> Either e a -> m b fromEitherM_ leftAction = either leftAction (const $ pure mempty) -- | A 'flip'ed version of 'fromEitherM_'. fromEitherOrM_ :: (Applicative m, Monoid b) => Either e a -> (e -> m b) -> m b fromEitherOrM_ = flip fromEitherM_ -- | A monadic version of 'fromMaybe'. -- -- @ -- 'fromMaybeM' nothingAction === 'maybe' nothingAction 'pure' -- @ -- -- >>> fromMaybeM [] $ Just 5 -- [5] -- >>> fromMaybeM [] Nothing -- [] fromMaybeM :: Applicative m => m a -> Maybe a -> m a fromMaybeM nothingAction = maybe nothingAction pure -- | A 'flip'ed version of 'fromMaybeM'. -- -- >>> fromMaybeOrM (Just 5) [] -- [5] -- -- This can be nice to use as an error handler. -- -- >>> fromMaybeOrM (Just 5) $ putStrLn "some error occurred" >> undefined -- 5 -- >>> fromMaybeOrM (Nothing) $ putStrLn "some error occurred" >> undefined -- some error occurred -- ... fromMaybeOrM :: Applicative m => Maybe a -> m a -> m a fromMaybeOrM = flip fromMaybeM -- | Similar to 'fromMaybeM', but only run the monadic 'nothingAction' if the -- 'Maybe' argument is 'Nothing'. Otherwise, return 'pure' 'mempty'. -- -- @ -- 'fromMaybeM_' nothingAction === 'maybe' nothingAction ('const' '$' 'pure' 'mempty') -- @ -- -- >>> fromMaybeM_ (putStrLn "hello" >> pure "bye") $ Just 5 -- "" -- >>> fromMaybeM_ (putStrLn "hello" >> pure "bye") Nothing -- hello -- "bye" -- -- This can be convenient when you want to run some sort of logging function -- whenever a 'Maybe' is 'Nothing'. If you imagine the logging function is -- @'IO' '()'@, then the effective type of 'fromMaybeM_' becomes -- @'fromMaybeM_' :: 'IO' '()' -> 'Maybe' a -> 'IO' '()'@, because '()' has a -- 'Monoid' instance, and 'IO', has an 'Applicative' instance. -- -- >>> fromMaybeM_ (putStrLn "hello") Nothing -- hello fromMaybeM_ :: (Applicative m, Monoid b) => m b -> Maybe a -> m b fromMaybeM_ nothingAction = maybe nothingAction (const $ pure mempty) -- | A 'flip'ed version of 'fromMaybeM'. fromMaybeOrM_ :: (Applicative m, Monoid b) => Maybe a -> m b -> m b fromMaybeOrM_ = flip fromMaybeM_ -- | Similar to 'fromEitherM' but the 'Either' argument is also a monadic value. -- -- >>> fromEitherMM (\s -> [length s]) [Right 5, Right 10] -- [5,10] -- >>> fromEitherMM (\s -> [length s]) [Left ("foo" :: String), Right 100] -- [3,100] -- -- __NOTE__: I don't particularly like the name of this function. If you have a -- suggestion for a better name, please submit a PR or issue. fromEitherMM :: Monad m => (e -> m a) -> m (Either e a) -> m a fromEitherMM eitherAction mEither = fromEitherM eitherAction =<< mEither -- | A 'flip'ed version of 'fromEitherMM'. fromEitherOrMM :: Monad m => m (Either e a) -> (e -> m a) -> m a fromEitherOrMM = flip fromEitherMM -- | Similar to 'fromMaybeM' but the 'Maybe' argument is also a monadic value. -- -- >>> fromMaybeMM [] [Just 6, Just 5] -- [6,5] -- >>> fromMaybeMM [] [Just 6, Nothing, Just 7] -- [6,7] -- -- __NOTE__: I don't particularly like the name of this function. If you have a -- suggestion for a better name, please submit a PR or issue. fromMaybeMM :: Monad m => m a -> m (Maybe a) -> m a fromMaybeMM nothingAction mMaybe = fromMaybeM nothingAction =<< mMaybe -- | A 'flip'ed version of 'fromMaybeMM'. fromMaybeOrMM :: Monad m => m (Maybe a) -> m a -> m a fromMaybeOrMM = flip fromMaybeMM -- | Similar to 'fromMaybe'. -- -- >>> fromEither show $ Left 5 -- "5" -- >>> fromEither show $ Right "hello" -- "hello" fromEither :: (e -> a) -> Either e a -> a fromEither f = either f id -- | A 'flip'ed version of 'fromEither'. fromEitherOr :: Either e a -> (e -> a) -> a fromEitherOr = flip fromEither -- | A 'flip'ed version of 'fromMaybe'. fromMaybeOr :: Maybe a -> a -> a fromMaybeOr = flip fromMaybe -- | Collapse an @'Either' a a@ to an @a@. Defined as @'fromEither' 'id'@. -- -- Note: Other libraries export this function as @fromEither@, but our -- 'fromEither' function is slightly more general. -- -- >>> collapseEither (Right 3) -- 3 -- >>> collapseEither (Left "hello") -- "hello" collapseEither :: Either a a -> a collapseEither = fromEither id -- | Similar to 'collapseEither', but for 'ExceptT'. -- -- >>> import Control.Monad.Except (ExceptT(ExceptT)) -- >>> collapseExceptT (ExceptT $ pure (Right 3)) -- 3 -- >>> collapseExceptT (ExceptT $ pure (Left "hello")) -- "hello" collapseExceptT :: Monad m => ExceptT a m a -> m a collapseExceptT = pure . collapseEither <=< runExceptT from-sum-0.2.1.0/test/DocTest.hs0000644000000000000000000000162712773140674014504 0ustar0000000000000000 module Main (main) where import Prelude import Data.Monoid ((<>)) import System.FilePath.Glob (glob) import Test.DocTest (doctest) main :: IO () main = glob "src/**/*.hs" >>= doDocTest doDocTest :: [String] -> IO () doDocTest options = doctest $ options <> ghcExtensions ghcExtensions :: [String] ghcExtensions = [ -- "-XConstraintKinds" -- , "-XDataKinds" "-XDeriveDataTypeable" , "-XDeriveGeneric" -- , "-XEmptyDataDecls" , "-XFlexibleContexts" -- , "-XFlexibleInstances" -- , "-XGADTs" -- , "-XGeneralizedNewtypeDeriving" -- , "-XInstanceSigs" -- , "-XMultiParamTypeClasses" -- , "-XNoImplicitPrelude" , "-XOverloadedStrings" -- , "-XPolyKinds" -- , "-XRankNTypes" -- , "-XRecordWildCards" , "-XScopedTypeVariables" -- , "-XStandaloneDeriving" -- , "-XTupleSections" -- , "-XTypeFamilies" -- , "-XTypeOperators" ] from-sum-0.2.1.0/LICENSE0000644000000000000000000000276712773140727012636 0ustar0000000000000000Copyright Dennis Gosnell (c) 2016 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 Author name here nor the names of other 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 OWNER 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. from-sum-0.2.1.0/Setup.hs0000644000000000000000000000005612773140673013252 0ustar0000000000000000import Distribution.Simple main = defaultMain from-sum-0.2.1.0/from-sum.cabal0000644000000000000000000000217213013256072014335 0ustar0000000000000000name: from-sum version: 0.2.1.0 synopsis: Canonical fromMaybeM and fromEitherM functions. description: Please see README.md homepage: https://github.com/cdepillabout/from-sum license: BSD3 license-file: LICENSE author: Dennis Gosnell maintainer: cdep.illabout@gmail.com copyright: 2016 Dennis Gosnell category: Control build-type: Simple extra-source-files: README.md cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Control.FromSum build-depends: base >= 4.6 && < 5 , mtl default-language: Haskell2010 ghc-options: -Wall test-suite from-sum-doctest type: exitcode-stdio-1.0 main-is: DocTest.hs hs-source-dirs: test build-depends: base , doctest , Glob default-language: Haskell2010 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N source-repository head type: git location: git@github.com:cdepillabout/from-sum.git from-sum-0.2.1.0/README.md0000644000000000000000000000211112773501153013061 0ustar0000000000000000 Control.FromSum =============== [![Build Status](https://secure.travis-ci.org/cdepillabout/from-sum.svg)](http://travis-ci.org/cdepillabout/from-sum) [![Hackage](https://img.shields.io/hackage/v/from-sum.svg)](https://hackage.haskell.org/package/from-sum) [![Stackage LTS](http://stackage.org/package/from-sum/badge/lts)](http://stackage.org/lts/package/from-sum) [![Stackage Nightly](http://stackage.org/package/from-sum/badge/nightly)](http://stackage.org/nightly/package/from-sum) This Haskell module exports the `fromEitherM` and `fromMaybeM` convenience functions. ```haskell fromMaybeM :: m a -> Maybe a -> m a fromEitherM :: (e -> m a) -> Either e a -> m a ``` `fromEitherM leftAction eitherValue` is the same as `either leftAction pure eitherValue`. `fromMaybeM nothingAction maybeValue` is the same as `maybe nothingAction pure maybeValue`. ## Usage ```haskell >>> import Control.FromSum (fromEitherM, fromMaybeM) >>> fromMaybeM [] $ Just 5 [5] >>> fromMaybeM [] Nothing [] >>> fromEitherM (\s -> [length s]) $ Right 5 [5] >>> fromEitherM (\s -> [length s]) $ Left "foo" [3] ```