Initial

.travis.yml

@@ -0,0 +1,45 @@
+language: generic
+sudo: false
+
+git:
+  submodules: false  # whether to recursively clone submodules
+
+cache:
+  directories:
+    - $HOME/.cabal/packages
+    - $HOME/.mafia
+
+before_cache:
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
+
+matrix:
+  include:
+    - compiler: "ghc-8.0.2"
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}
+    - compiler: "ghc-8.2.1"
+      addons: {apt: {packages: [ghc-ppa-tools,cabal-install-1.24,ghc-8.2.1], sources: [hvr-ghc]}}
+
+before_install:
+ - unset CC
+ - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
+
+install:
+ - travis_retry cabal update -v
+ - bin/travis_install
+
+script:
+ - bin/travis_script
+
+deploy:
+  skip_cleanup: true
+  provider: hackage
+  username: $HACKAGE_USERNAME
+  password: $HACKAGE_PASSWORD
+  on:
+    repo: tmcgilchrist/transformers-either
+    tags: true

bin/mafia

@@ -0,0 +1,63 @@
+#!/bin/sh -eu
+
+: ${MAFIA_HOME:=$HOME/.mafia}
+: ${MAFIA_VERSIONS:=$MAFIA_HOME/versions}
+
+latest_version () {
+    git ls-remote https://github.com/ambiata/mafia | grep refs/heads/master | cut -f 1
+}
+
+build_version() {
+    MAFIA_VERSION="$1"
+    MAFIA_TEMP=$(mktemp -d 2>/dev/null || mktemp -d -t 'exec_mafia')
+    MAFIA_FILE=mafia-$MAFIA_VERSION
+    MAFIA_PATH=$MAFIA_VERSIONS/$MAFIA_FILE
+    mkdir -p $MAFIA_VERSIONS
+    echo "Building $MAFIA_FILE in $MAFIA_TEMP"
+    git clone https://github.com/ambiata/mafia $MAFIA_TEMP
+    git --git-dir="$MAFIA_TEMP/.git" --work-tree="$MAFIA_TEMP" reset --hard $MAFIA_VERSION || {
+        echo "mafia version ($MAFIA_VERSION) could not be found." >&2
+        exit 1
+    }
+    (cd "$MAFIA_TEMP" && ./bin/bootstrap) || {
+        got=$?
+        echo "mafia version ($MAFIA_VERSION) could not be built." >&2
+        exit "$got"
+    }
+    chmod +x "$MAFIA_TEMP/.cabal-sandbox/bin/mafia"
+    # Ensure executable is on same file-system so final mv is atomic.
+    mv -f "$MAFIA_TEMP/.cabal-sandbox/bin/mafia" "$MAFIA_PATH.$$"
+    mv "$MAFIA_PATH.$$" "$MAFIA_PATH" || {
+        rm -f "$MAFIA_PATH.$$"
+        echo "INFO: mafia version ($MAFIA_VERSION) already exists not overiding," >&2
+        echo "INFO: this is expected if parallel builds of the same version of" >&2
+        echo "INFO: mafia occur, we are playing by first in, wins." >&2
+        exit 0
+    }
+}
+
+enable_version() {
+    if [ $# -eq 0 ]; then
+        MAFIA_VERSION="$(latest_version)"
+        echo "INFO: No explicit mafia version requested installing latest ($MAFIA_VERSION)." >&2
+    else
+        MAFIA_VERSION="$1"
+    fi
+    [ -x "$MAFIA_HOME/versions/mafia-$MAFIA_VERSION" ] || build_version "$MAFIA_VERSION"
+    ln -sf "$MAFIA_HOME/versions/mafia-$MAFIA_VERSION" "$MAFIA_HOME/versions/mafia"
+}
+
+exec_mafia () {
+    [ -x "$MAFIA_HOME/versions/mafia" ] || enable_version
+    "$MAFIA_HOME/versions/mafia" "$@"
+}
+
+#
+# The actual start of the script.....
+#
+
+case "${1:-}" in
+upgrade) shift; enable_version "$@" ;;
+*) exec_mafia "$@"
+esac
+# Version: b9795b4d9ca1b221e6b71e71cc207855ce8b4b08

bin/travis_install

@@ -0,0 +1,9 @@
+#!/bin/sh -eu
+
+cabal --version
+echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+
+ROOT=$PWD
+
+$ROOT/bin/mafia lock # FIXME mafia really needs 'mafia setup'
+$ROOT/bin/mafia install doctest

bin/travis_script

@@ -0,0 +1,9 @@
+#!/bin/sh -eu
+
+cabal --version
+echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+
+ROOT=$PWD
+
+$ROOT/bin/mafia build
+$ROOT/bin/mafia testci

mafia

@@ -0,0 +1 @@
+./bin/mafia

src/Control/Monad/Trans/Either.hs

@@ -0,0 +1,129 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Either
+-- Copyright   :  (C) 2017 Tim McGilchrist
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  timmcgil@gmail.com
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- This monad transformer extends "Control.Monad.Trans.Except" with a more
+-- familar "Either" naming.
+-----------------------------------------------------------------------------
+module Control.Monad.Trans.Either (
+  -- * Control.Monad.Trans.Either
+    EitherT
+  , newEitherT
+  , pattern EitherT
+  , runEitherT
+  , eitherT
+  , left
+  , right
+  , mapEitherT
+  , hoistEither
+  , bimapEitherT
+
+  -- * Extensions
+  , firstEitherT
+  , secondEitherT
+  , hoistMaybe
+  , hoistEitherT
+  ) where
+
+import           Control.Monad (Monad(..), (=<<))
+import           Control.Monad.Trans.Except (ExceptT(..))
+
+import           Data.Maybe (Maybe, maybe)
+import           Data.Either (Either(..), either)
+import           Data.Function ((.), id)
+import           Data.Functor (Functor(..))
+
+------------------------------------------------------------------------
+-- Control.Monad.Trans.Either
+
+-- | Type alias for "ExceptT"
+--
+type EitherT = ExceptT
+
+pattern EitherT :: m (Either x a) -> ExceptT x m a
+pattern EitherT m = ExceptT m
+
+-- | Extractor for computations in the either monad.
+-- (The inverse of 'newEitherT').
+runEitherT :: EitherT x m a -> m (Either x a)
+runEitherT (ExceptT m) = m
+{-# INLINE runEitherT #-}
+
+-- | Constructor for computations in the either monad.
+-- (The inverse of 'runEitherT').
+newEitherT :: m (Either x a) -> EitherT x m a
+newEitherT =
+  ExceptT
+{-# INLINE newEitherT #-}
+
+eitherT :: Monad m => (x -> m b) -> (a -> m b) -> EitherT x m a -> m b
+eitherT f g m =
+  either f g =<< runEitherT m
+{-# INLINE eitherT #-}
+
+-- | Constructor for left computations.
+left :: Monad m => x -> EitherT x m a
+left =
+  EitherT . return . Left
+{-# INLINE left #-}
+
+-- | Constructor for right computations.
+right :: Monad m => a -> EitherT x m a
+right =
+  return
+{-# INLINE right #-}
+
+-- |
+mapEitherT :: (m (Either x a) -> n (Either y b)) -> EitherT x m a -> EitherT y n b
+mapEitherT f =
+  EitherT . f . runEitherT
+{-# INLINE mapEitherT #-}
+
+-- | Hoist an "Either" into an "EitherT m"
+hoistEither :: Monad m => Either x a -> EitherT x m a
+hoistEither =
+  EitherT . return
+{-# INLINE hoistEither #-}
+
+-- | Map the unwrapped computation using the given function.
+bimapEitherT :: Functor m => (x -> y) -> (a -> b) -> EitherT x m a -> EitherT y m b
+bimapEitherT f g =
+  let
+    h (Left  e) = Left  (f e)
+    h (Right a) = Right (g a)
+  in
+    mapEitherT (fmap h)
+{-# INLINE bimapEitherT #-}
+
+-- | Map the 'Left' unwrapped computation using the given function.
+firstEitherT :: Functor m => (x -> y) -> EitherT x m a -> EitherT y m a
+firstEitherT f =
+  bimapEitherT f id
+{-# INLINE firstEitherT #-}
+
+-- | Map the 'Right' unwrapped computation using the given function.
+secondEitherT :: Functor m => (a -> b) -> EitherT x m a -> EitherT x m b
+secondEitherT =
+  bimapEitherT id
+{-# INLINE secondEitherT #-}
+
+-- | Hoist a 'Maybe a' into a 'Right a'
+hoistMaybe :: Monad m => x -> Maybe a -> EitherT x m a
+hoistMaybe x =
+  maybe (left x) return
+{-# INLINE hoistMaybe #-}
+
+-- | Hoist
+hoistEitherT :: (forall b. m b -> n b) -> EitherT x m a -> EitherT x n a
+hoistEitherT f =
+  EitherT . f . runEitherT
+{-# INLINE hoistEitherT #-}

transformers-either.cabal

@@ -0,0 +1,34 @@
+name:                  transformers-either
+version:               0.0.1
+license:               BSD3
+license-file:          LICENSE
+author:                Tim McGilchrist <timmcgil@gmail.com>
+maintainer:            Tim McGilchrist <timmcgil@gmail.com>
+copyright:             (c) 2017 Tim McGilchrist
+synopsis:              An Either monad transformer
+category:              System
+cabal-version:         >= 1.8
+build-type:            Simple
+description:
+            Drop in alternative to ExceptT.
+
+            Uses a pattern synonym to maintain compatibility with the old EitherT types
+            but is actually ExceptT under the covers.
+
+source-repository head
+  type: git
+  location: https://github.com/tmcgilchrist/transformers-either.git
+
+library
+  build-depends:
+                       base                            >= 3          && < 5
+                     , transformers                    >= 0.4        && < 0.6
+
+  ghc-options:
+                       -Wall
+
+  hs-source-dirs:
+                       src
+
+  exposed-modules:
+                       Control.Monad.Trans.Either