transformers-compat-0.4.0.4/0000755000000000000000000000000012467323744014065 5ustar0000000000000000transformers-compat-0.4.0.4/.ghci0000644000000000000000000000012512467323744014776 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h transformers-compat-0.4.0.4/.gitignore0000644000000000000000000000006512467323744016056 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo transformers-compat-0.4.0.4/.travis.yml0000644000000000000000000000136012467323744016176 0ustar0000000000000000language: haskell before_install: # Uncomment whenever hackage is down. # - mkdir -p ~/.cabal && cp config ~/.cabal/config && cabal update # Try installing some of the build-deps with apt-get for speed. - ./travis-cabal-apt-install --only-dependencies --force-reinstall $mode - sudo apt-get -q -y install hlint || cabal install hlint install: - cabal configure $mode - cabal build script: - $script - hlint 0.2 --cpp-define HLINT - hlint 0.3 --cpp-define HLINT notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313transformers-compat\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" env: - mode="--enable-tests" script="cabal test" transformers-compat-0.4.0.4/.vim.custom0000644000000000000000000000137712467323744016202 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" transformers-compat-0.4.0.4/CHANGELOG.markdown0000644000000000000000000000334212467323744017122 0ustar00000000000000000.4.0.4 ------- 0.4.0.3 ------- 0.4.0.2 ------- * Each of these is a build with a different set of flags configured. Building this way allows us to work around bugs in `cabal`'s backtracker. 0.4 --- * Added support for the missing `ExceptT` instances from `mtl`. This was not done lightly. While this means that by default incurring a dependency on `transformers-compat` drags in `mtl` when you are using an old `transformers`, it means that users do not have to orphan these instances and permits wider adoption of `ExceptT`. If you absolutely can't stand `mtl` and really want this package to build as valid `Haskell98`, then you can use `cabal install transformers-compat -f-mtl` to avoid incurring the dependency to get these instances. However, that is effectively an unsupported configuration. 0.3.3.4 ------- 0.3.3.3 ------- 0.3.3.2 ------- * These releases were a successful attempt to fix build problems caused by the cabal backtracker. * Each of these is a build with a different set of flags configured. 0.3.2 ----- * This release was a failed (or at least, only partially successful) attempt to fix build problems caused by the cabal backtracker. 0.3.1 ----- * `transformers 0.4.1` compatibility 0.3 --- * Added the instances for `Data.Functor.Classes` from `transformers 0.4` * Switched `Control.Applicative.Backwards` and `Data.Functor.Reverse` to the split constructor/accessor style from `transformers 0.4`. 0.2 --- * Added the new types and classes from `transformers 0.4` 0.1.1.1 ------- * Wrote a better synopsis 0.1.1 ----- * Updated to trick `cabal` into building an empty `libHStransformers-compat-0.1.a` on GHC 7.6. 0.1 --- * Repository initialized by pulling the `transformers-0.2` compatibility layer out of `lens`. transformers-compat-0.4.0.4/config0000644000000000000000000000120612467323744015254 0ustar0000000000000000-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix -- -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. -- -- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive remote-repo-cache: ~/.cabal/packages world-file: ~/.cabal/world build-summary: ~/.cabal/logs/build.log remote-build-reporting: anonymous install-dirs user install-dirs global transformers-compat-0.4.0.4/HLint.hs0000644000000000000000000000003712467323744015437 0ustar0000000000000000ignore "Warning: Avoid lambda" transformers-compat-0.4.0.4/LICENSE0000644000000000000000000000265312467323744015100 0ustar0000000000000000Copyright 2012 Edward Kmett 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. transformers-compat-0.4.0.4/README.markdown0000644000000000000000000000115512467323744016570 0ustar0000000000000000transformers-compat =================== [![Build Status](https://secure.travis-ci.org/ekmett/transformers-compat.png?branch=master)](http://travis-ci.org/ekmett/transformers-compat) This provides a thin compatibility shim on top of transformers-0.2 to add the types that were added in transformers-0.3. This enables users to maintain haskell-platform compatibility, while still gaining access ot the new functionality. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett transformers-compat-0.4.0.4/Setup.lhs0000644000000000000000000000016512467323744015677 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain transformers-compat-0.4.0.4/transformers-compat.cabal0000644000000000000000000000514212467323744021061 0ustar0000000000000000name: transformers-compat category: Compatibility version: 0.4.0.4 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/transformers-compat/ bug-reports: http://github.com/ekmett/transformers-compat/issues copyright: Copyright (C) 2012 Edward A. Kmett synopsis: A small compatibility shim exposing the new types from transformers 0.3 and 0.4 to older Haskell platforms. description: This package includes backported versions of types that were added to transformers in transformers 0.3 and 0.4 for users who need strict transformers 0.2 or 0.3 compatibility to run on old versions of the platform, but also need those types. . Those users should be able to just depend on @transformers >= 0.2@ and @transformers-compat >= 0.3@. . Note: missing methods are not supplied, but this at least permits the types to be used. build-type: Simple tested-with: GHC == 7.0.4, GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.1, GHC == 7.8.2 extra-source-files: .travis.yml .ghci .gitignore .vim.custom config HLint.hs README.markdown CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/transformers-compat.git flag two default: False description: Use transformers 0.2. This must be selected manually and should probably only be used on older GHCs around 7.0.x. manual: True flag three default: False manual: True description: Use transformers 0.3. This should toggle on/off automatically. flag mtl default: True manual: True description: -f-mtl Disables support for mtl for transformers 0.2 and 0.3. That is an unsupported configuration, and results in missing instances for `ExceptT`, but keeps the package Haskell 98. library build-depends: base >= 4.3 && < 5 other-modules: Paths_transformers_compat if flag(three) hs-source-dirs: 0.3 build-depends: transformers >= 0.3 && < 0.4, mtl >= 2.1 && < 2.2 else if flag(two) hs-source-dirs: 0.2 0.3 build-depends: transformers >= 0.2 && < 0.3, mtl >= 2.0 && < 2.1 else build-depends: transformers >= 0.4.1 && < 0.5 if !flag(mtl) cpp-options: -DHASKELL98 if flag(two) exposed-modules: Control.Applicative.Backwards Control.Applicative.Lift Data.Functor.Reverse if flag(two) || flag(three) exposed-modules: Control.Monad.Trans.Except Control.Monad.Signatures Data.Functor.Classes Data.Functor.Sum transformers-compat-0.4.0.4/0.2/0000755000000000000000000000000012467323744014364 5ustar0000000000000000transformers-compat-0.4.0.4/0.2/Control/0000755000000000000000000000000012467323744016004 5ustar0000000000000000transformers-compat-0.4.0.4/0.2/Control/Applicative/0000755000000000000000000000000012467323744020245 5ustar0000000000000000transformers-compat-0.4.0.4/0.2/Control/Applicative/Backwards.hs0000644000000000000000000000473112467323744022507 0ustar0000000000000000-- | -- Module : Control.Applicative.Backwards -- Copyright : (c) Russell O'Connor 2009 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Making functors with an 'Applicative' instance that performs actions -- in the reverse order. -- -- NB: This module is only included in @lens@ for backwards compatibility with -- @transformers@ versions before 3.0. module Control.Applicative.Backwards where import Prelude hiding (foldr, foldr1, foldl, foldl1) import Control.Applicative import Data.Foldable import Data.Functor.Classes import Data.Traversable -- | The same functor, but with an 'Applicative' instance that performs -- actions in the reverse order. newtype Backwards f a = Backwards { forwards :: f a } -- | Derived instance. instance (Functor f) => Functor (Backwards f) where fmap f (Backwards a) = Backwards (fmap f a) -- | Apply @f@-actions in the reverse order. instance (Applicative f) => Applicative (Backwards f) where pure a = Backwards (pure a) Backwards f <*> Backwards a = Backwards (a <**> f) -- | Try alternatives in the same order as @f@. instance (Alternative f) => Alternative (Backwards f) where empty = Backwards empty Backwards x <|> Backwards y = Backwards (x <|> y) -- | Derived instance. instance (Foldable f) => Foldable (Backwards f) where foldMap f (Backwards t) = foldMap f t foldr f z (Backwards t) = foldr f z t foldl f z (Backwards t) = foldl f z t foldr1 f (Backwards t) = foldl1 f t foldl1 f (Backwards t) = foldr1 f t -- | Derived instance. instance (Traversable f) => Traversable (Backwards f) where traverse f (Backwards t) = fmap Backwards (traverse f t) sequenceA (Backwards t) = fmap Backwards (sequenceA t) instance (Eq1 f, Eq a) => Eq (Backwards f a) where Backwards x == Backwards y = eq1 x y instance (Ord1 f, Ord a) => Ord (Backwards f a) where compare (Backwards x) (Backwards y) = compare1 x y instance (Read1 f, Read a) => Read (Backwards f a) where readsPrec = readsData $ readsUnary1 "Backwards" Backwards instance (Show1 f, Show a) => Show (Backwards f a) where showsPrec d (Backwards x) = showsUnary1 "Backwards" d x instance Eq1 f => Eq1 (Backwards f) where eq1 = (==) instance Ord1 f => Ord1 (Backwards f) where compare1 = compare instance Read1 f => Read1 (Backwards f) where readsPrec1 = readsPrec instance Show1 f => Show1 (Backwards f) where showsPrec1 = showsPrec transformers-compat-0.4.0.4/0.2/Control/Applicative/Lift.hs0000644000000000000000000000622112467323744021500 0ustar0000000000000000-- | -- Module : Control.Applicative.Lift -- Copyright : (c) Ross Paterson 2010 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Adding a new kind of pure computation to an applicative functor. -- -- NB: This module is only included in @lens@ for backwards compatibility with -- @transformers@ versions before 3.0. module Control.Applicative.Lift ( Lift(..), unLift, -- * Collecting errors Errors, failure ) where import Control.Applicative import Data.Foldable (Foldable(foldMap)) import Data.Functor.Constant import Data.Functor.Classes import Data.Monoid import Data.Traversable (Traversable(traverse)) -- | Applicative functor formed by adding pure computations to a given -- applicative functor. data Lift f a = Pure a | Other (f a) instance (Eq1 f, Eq a) => Eq (Lift f a) where Pure x1 == Pure x2 = x1 == x2 Other y1 == Other y2 = eq1 y1 y2 _ == _ = False instance (Ord1 f, Ord a) => Ord (Lift f a) where compare (Pure x1) (Pure x2) = compare x1 x2 compare (Pure _) (Other _) = LT compare (Other _) (Pure _) = GT compare (Other y1) (Other y2) = compare1 y1 y2 instance (Read1 f, Read a) => Read (Lift f a) where readsPrec = readsData $ readsUnary "Pure" Pure `mappend` readsUnary1 "Other" Other instance (Show1 f, Show a) => Show (Lift f a) where showsPrec d (Pure x) = showsUnary "Pure" d x showsPrec d (Other y) = showsUnary1 "Other" d y instance (Eq1 f) => Eq1 (Lift f) where eq1 = (==) instance (Ord1 f) => Ord1 (Lift f) where compare1 = compare instance (Read1 f) => Read1 (Lift f) where readsPrec1 = readsPrec instance (Show1 f) => Show1 (Lift f) where showsPrec1 = showsPrec instance (Functor f) => Functor (Lift f) where fmap f (Pure x) = Pure (f x) fmap f (Other y) = Other (fmap f y) instance (Foldable f) => Foldable (Lift f) where foldMap f (Pure x) = f x foldMap f (Other y) = foldMap f y instance (Traversable f) => Traversable (Lift f) where traverse f (Pure x) = Pure <$> f x traverse f (Other y) = Other <$> traverse f y -- | A combination is 'Pure' only if both parts are. instance (Applicative f) => Applicative (Lift f) where pure = Pure Pure f <*> Pure x = Pure (f x) Pure f <*> Other y = Other (f <$> y) Other f <*> Pure x = Other (($ x) <$> f) Other f <*> Other y = Other (f <*> y) -- | A combination is 'Pure' only either part is. instance Alternative f => Alternative (Lift f) where empty = Other empty Pure x <|> _ = Pure x Other _ <|> Pure y = Pure y Other x <|> Other y = Other (x <|> y) -- | Projection to the other functor. unLift :: Applicative f => Lift f a -> f a unLift (Pure x) = pure x unLift (Other e) = e -- | An applicative functor that collects a monoid (e.g. lists) of errors. -- A sequence of computations fails if any of its components do, but -- unlike monads made with 'ErrorT' from "Control.Monad.Trans.Error", -- these computations continue after an error, collecting all the errors. type Errors e = Lift (Constant e) -- | Report an error. failure :: Monoid e => e -> Errors e a failure e = Other (Constant e) transformers-compat-0.4.0.4/0.2/Data/0000755000000000000000000000000012467323744015235 5ustar0000000000000000transformers-compat-0.4.0.4/0.2/Data/Functor/0000755000000000000000000000000012467323744016655 5ustar0000000000000000transformers-compat-0.4.0.4/0.2/Data/Functor/Reverse.hs0000644000000000000000000000503012467323744020622 0ustar0000000000000000-- | -- Module : Data.Functor.Reverse -- Copyright : (c) Russell O'Connor 2009 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- -- Making functors whose elements are notionally in the reverse order -- from the original functor. -- -- /NB:/ Note this module is only included in @lens@ for backwards -- compatibility with older @containers@ versions. module Data.Functor.Reverse where import Control.Applicative.Backwards import Prelude hiding (foldr, foldr1, foldl, foldl1) import Control.Applicative import Data.Foldable import Data.Functor.Classes import Data.Traversable import Data.Monoid -- | The same functor, but with 'Foldable' and 'Traversable' instances -- that process the elements in the reverse order. newtype Reverse f a = Reverse { getReverse :: f a } -- | Derived instance. instance (Functor f) => Functor (Reverse f) where fmap f (Reverse a) = Reverse (fmap f a) -- | Derived instance. instance (Applicative f) => Applicative (Reverse f) where pure a = Reverse (pure a) Reverse f <*> Reverse a = Reverse (f <*> a) -- | Derived instance. instance (Alternative f) => Alternative (Reverse f) where empty = Reverse empty Reverse x <|> Reverse y = Reverse (x <|> y) -- | Fold from right to left. instance (Foldable f) => Foldable (Reverse f) where foldMap f (Reverse t) = getDual (foldMap (Dual . f) t) foldr f z (Reverse t) = foldl (flip f) z t foldl f z (Reverse t) = foldr (flip f) z t foldr1 f (Reverse t) = foldl1 (flip f) t foldl1 f (Reverse t) = foldr1 (flip f) t -- | Traverse from right to left. instance (Traversable f) => Traversable (Reverse f) where traverse f (Reverse t) = fmap Reverse . forwards $ traverse (Backwards . f) t sequenceA (Reverse t) = fmap Reverse . forwards $ sequenceA (fmap Backwards t) instance (Eq1 f, Eq a) => Eq (Reverse f a) where Reverse x == Reverse y = eq1 x y instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare (Reverse x) (Reverse y) = compare1 x y instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsData $ readsUnary1 "Reverse" Reverse instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec d (Reverse x) = showsUnary1 "Reverse" d x instance Eq1 f => Eq1 (Reverse f) where eq1 = (==) instance Ord1 f => Ord1 (Reverse f) where compare1 = compare instance Read1 f => Read1 (Reverse f) where readsPrec1 = readsPrec instance Show1 f => Show1 (Reverse f) where showsPrec1 = showsPrec transformers-compat-0.4.0.4/0.3/0000755000000000000000000000000012467323744014365 5ustar0000000000000000transformers-compat-0.4.0.4/0.3/Control/0000755000000000000000000000000012467323744016005 5ustar0000000000000000transformers-compat-0.4.0.4/0.3/Control/Monad/0000755000000000000000000000000012467323744017043 5ustar0000000000000000transformers-compat-0.4.0.4/0.3/Control/Monad/Signatures.hs0000644000000000000000000000205312467323744021523 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Signatures -- Copyright : (c) Ross Paterson 2012 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Signatures for monad operations that require specialized lifting. ----------------------------------------------------------------------------- module Control.Monad.Signatures ( CallCC, Catch, Listen, Pass ) where -- | Signature of the @callCC@ operation, -- introduced in "Control.Monad.Trans.Cont". type CallCC m a b = ((a -> m b) -> m a) -> m a -- | Signature of the @catchE@ operation, -- introduced in "Control.Monad.Trans.Except". type Catch e m a = m a -> (e -> m a) -> m a -- | Signature of the @listen@ operation, -- introduced in "Control.Monad.Trans.Writer". type Listen w m a = m a -> m (a, w) -- | Signature of the @pass@ operation, -- introduced in "Control.Monad.Trans.Writer". type Pass w m a = m (a, w -> w) -> m a transformers-compat-0.4.0.4/0.3/Control/Monad/Trans/0000755000000000000000000000000012467323744020132 5ustar0000000000000000transformers-compat-0.4.0.4/0.3/Control/Monad/Trans/Except.hs0000644000000000000000000002115512467323744021722 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifndef MIN_VERSION_mtl #define MIN_VERSION_mtl(x,y,z) 1 #endif #ifndef HASKELL98 {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Except -- Copyright : (C) 2013 Ross Paterson -- (C) 2015 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- This monad transformer extends a monad with the ability throw exceptions. -- -- A sequence of actions terminates normally, producing a value, -- only if none of the actions in the sequence throws an exception. -- If one throws an exception, the rest of the sequence is skipped and -- the composite action exits with that exception. -- -- If the value of the exception is not required, the variant in -- "Control.Monad.Trans.Maybe" may be used instead. ----------------------------------------------------------------------------- module Control.Monad.Trans.Except ( -- * The Except monad Except, except, runExcept, mapExcept, withExcept, -- * The ExceptT monad transformer ExceptT(..), mapExceptT, withExceptT, -- * Exception operations throwE, catchE, -- * Lifting other operations liftCallCC, liftListen, liftPass, ) where import Control.Applicative import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Signatures import Control.Monad.Trans.Class #ifndef HASKELL98 import Control.Monad.Writer.Class import Control.Monad.State.Class import Control.Monad.Reader.Class import Control.Monad.Cont.Class import Control.Monad.Error.Class import Control.Monad.RWS.Class #endif import Data.Foldable (Foldable(foldMap)) import Data.Functor.Classes import Data.Functor.Identity import Data.Monoid import Data.Traversable (Traversable(traverse)) -- | The parameterizable exception monad. -- -- Computations are either exceptions or normal values. -- -- The 'return' function returns a normal value, while @>>=@ exits -- on the first exception. type Except e = ExceptT e Identity -- | Constructor for computations in the exception monad. -- (The inverse of 'runExcept'). except :: Either e a -> Except e a except m = ExceptT (Identity m) -- | Extractor for computations in the exception monad. -- (The inverse of 'except'). runExcept :: Except e a -> Either e a runExcept (ExceptT m) = runIdentity m -- | Map the unwrapped computation using the given function. -- -- * @'runExcept' ('mapExcept' f m) = f ('runExcept' m)@ mapExcept :: (Either e a -> Either e' b) -> Except e a -> Except e' b mapExcept f = mapExceptT (Identity . f . runIdentity) -- | Transform any exceptions thrown by the computation using the given -- function (a specialization of 'withExceptT'). withExcept :: (e -> e') -> Except e a -> Except e' a withExcept = withExceptT -- | A monad transformer that adds exceptions to other monads. -- -- @ExceptT@ constructs a monad parameterized over two things: -- -- * e - The exception type. -- -- * m - The inner monad. -- -- The 'return' function yields a computation that produces the given -- value, while @>>=@ sequences two subcomputations, exiting on the -- first exception. newtype ExceptT e m a = ExceptT { runExceptT :: m (Either e a) } instance (Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) where ExceptT x == ExceptT y = eq1 x y instance (Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) where compare (ExceptT x) (ExceptT y) = compare1 x y instance (Read e, Read1 m, Read a) => Read (ExceptT e m a) where readsPrec = readsData $ readsUnary1 "ExceptT" ExceptT instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where showsPrec d (ExceptT m) = showsUnary1 "ExceptT" d m instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where eq1 = (==) instance (Ord e, Ord1 m) => Ord1 (ExceptT e m) where compare1 = compare instance (Read e, Read1 m) => Read1 (ExceptT e m) where readsPrec1 = readsPrec instance (Show e, Show1 m) => Show1 (ExceptT e m) where showsPrec1 = showsPrec -- | Map the unwrapped computation using the given function. -- -- * @'runExceptT' ('mapExceptT' f m) = f ('runExceptT' m)@ mapExceptT :: (m (Either e a) -> n (Either e' b)) -> ExceptT e m a -> ExceptT e' n b mapExceptT f m = ExceptT $ f (runExceptT m) -- | Transform any exceptions thrown by the computation using the -- given function. withExceptT :: (Functor m) => (e -> e') -> ExceptT e m a -> ExceptT e' m a withExceptT f = mapExceptT $ fmap $ either (Left . f) Right instance (Functor m) => Functor (ExceptT e m) where fmap f = ExceptT . fmap (fmap f) . runExceptT instance (Foldable f) => Foldable (ExceptT e f) where foldMap f (ExceptT a) = foldMap (either (const mempty) f) a instance (Traversable f) => Traversable (ExceptT e f) where traverse f (ExceptT a) = ExceptT <$> traverse (either (pure . Left) (fmap Right . f)) a instance (Functor m, Monad m) => Applicative (ExceptT e m) where pure a = ExceptT $ return (Right a) ExceptT f <*> ExceptT v = ExceptT $ do mf <- f case mf of Left e -> return (Left e) Right k -> do mv <- v case mv of Left e -> return (Left e) Right x -> return (Right (k x)) instance (Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) where empty = mzero (<|>) = mplus instance (Monad m) => Monad (ExceptT e m) where return a = ExceptT $ return (Right a) m >>= k = ExceptT $ do a <- runExceptT m case a of Left e -> return (Left e) Right x -> runExceptT (k x) fail = ExceptT . fail instance (Monad m, Monoid e) => MonadPlus (ExceptT e m) where mzero = ExceptT $ return (Left mempty) ExceptT m `mplus` ExceptT n = ExceptT $ do a <- m case a of Left e -> liftM (either (Left . mappend e) Right) n Right x -> return (Right x) instance (MonadFix m) => MonadFix (ExceptT e m) where mfix f = ExceptT $ mfix $ \ a -> runExceptT $ f $ case a of Right x -> x Left _ -> error "mfix ExceptT: Left" instance MonadTrans (ExceptT e) where lift = ExceptT . liftM Right instance (MonadIO m) => MonadIO (ExceptT e m) where liftIO = lift . liftIO -- | Signal an exception value @e@. -- -- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@ -- -- * @'throwE' e >>= m = 'throwE' e@ throwE :: (Monad m) => e -> ExceptT e m a throwE = ExceptT . return . Left -- | Handle an exception. -- -- * @'catchE' h ('lift' m) = 'lift' m@ -- -- * @'catchE' h ('throwE' e) = h e@ catchE :: (Monad m) => ExceptT e m a -- ^ the inner computation -> (e -> ExceptT e' m a) -- ^ a handler for exceptions in the inner -- computation -> ExceptT e' m a m `catchE` h = ExceptT $ do a <- runExceptT m case a of Left l -> runExceptT (h l) Right r -> return (Right r) -- | Lift a @callCC@ operation to the new monad. liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b liftCallCC callCC f = ExceptT $ callCC $ \ c -> runExceptT (f (\ a -> ExceptT $ c (Right a))) -- | Lift a @listen@ operation to the new monad. liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ExceptT e m) a liftListen listen = mapExceptT $ \ m -> do (a, w) <- listen m return $! fmap (\ r -> (r, w)) a -- | Lift a @pass@ operation to the new monad. liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ExceptT e m) a liftPass pass = mapExceptT $ \ m -> pass $ do a <- m return $! case a of Left l -> (Left l, id) Right (r, f) -> (Right r, f) -- incurring the mtl dependency for these avoids packages that need them introducing orphans. #ifndef HASKELL98 instance Monad m => MonadError e (ExceptT e m) where throwError = throwE catchError = catchE instance MonadWriter w m => MonadWriter w (ExceptT e m) where tell = lift . tell listen = liftListen listen pass = liftPass pass #if MIN_VERSION_mtl(2,1,0) writer = lift . writer #endif instance MonadState s m => MonadState s (ExceptT e m) where get = lift get put = lift . put #if MIN_VERSION_mtl(2,1,0) state = lift . state #endif instance MonadReader r m => MonadReader r (ExceptT e m) where ask = lift ask local = mapExceptT . local #if MIN_VERSION_mtl(2,1,0) reader = lift . reader #endif instance MonadRWS r w s m => MonadRWS r w s (ExceptT e m) instance MonadCont m => MonadCont (ExceptT e m) where callCC = liftCallCC callCC #endif transformers-compat-0.4.0.4/0.3/Data/0000755000000000000000000000000012467323744015236 5ustar0000000000000000transformers-compat-0.4.0.4/0.3/Data/Functor/0000755000000000000000000000000012467323744016656 5ustar0000000000000000transformers-compat-0.4.0.4/0.3/Data/Functor/Classes.hs0000644000000000000000000003602512467323744020615 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifndef MIN_VERSION_transformers #define MIN_VERSION_transformers(a,b,c) 1 #endif -- | -- Module : Data.Functor.Classes -- Copyright : (c) Ross Paterson 2013, Edward Kmett 2014 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Prelude classes, lifted to unary type constructors. module Data.Functor.Classes ( -- * Liftings of Prelude classes Eq1(..), Ord1(..), Read1(..), Show1(..), -- * Helper functions readsData, readsUnary, readsUnary1, readsBinary1, showsUnary, showsUnary1, showsBinary1, ) where import Control.Monad.Trans.Error import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.Writer.Lazy as Lazy import Control.Monad.Trans.Writer.Strict as Strict import Data.Functor.Compose import Data.Functor.Constant import Data.Functor.Identity import Data.Functor.Product import Data.Monoid (Monoid(mappend)) #if MIN_VERSION_transformers(0,3,0) import Control.Applicative.Lift import Control.Applicative.Backwards import Data.Functor.Reverse #endif instance Show a => Show (Identity a) where showsPrec d (Identity a) = showParen (d > 10) $ showString "Identity " . showsPrec 11 a instance Read a => Read (Identity a) where readsPrec d = readParen (d > 10) (\r -> [(Identity m,t) | ("Identity",s) <- lex r, (m,t) <- readsPrec 11 s]) instance Eq a => Eq (Identity a) where Identity a == Identity b = a == b instance Ord a => Ord (Identity a) where compare (Identity a) (Identity b) = compare a b instance Show a => Show (Constant a b) where showsPrec d (Constant a) = showParen (d > 10) $ showString "Constant " . showsPrec 11 a instance Read a => Read (Constant a b) where readsPrec d = readParen (d > 10) (\r -> [(Constant m,t) | ("Constant",s) <- lex r, (m,t) <- readsPrec 11 s]) instance Eq a => Eq (Constant a b) where Constant a == Constant b = a == b instance Ord a => Ord (Constant a b) where compare (Constant a) (Constant b) = compare a b -- | Lifting of the 'Eq' class to unary type constructors. class Eq1 f where eq1 :: (Eq a) => f a -> f a -> Bool -- | Lifting of the 'Ord' class to unary type constructors. class (Eq1 f) => Ord1 f where compare1 :: (Ord a) => f a -> f a -> Ordering -- | Lifting of the 'Read' class to unary type constructors. class Read1 f where readsPrec1 :: (Read a) => Int -> ReadS (f a) -- | Lifting of the 'Show' class to unary type constructors. class Show1 f where showsPrec1 :: (Show a) => Int -> f a -> ShowS -- Instances for Prelude type constructors instance Eq1 Maybe where eq1 = (==) instance Ord1 Maybe where compare1 = compare instance Read1 Maybe where readsPrec1 = readsPrec instance Show1 Maybe where showsPrec1 = showsPrec instance Eq1 [] where eq1 = (==) instance Ord1 [] where compare1 = compare instance Read1 [] where readsPrec1 = readsPrec instance Show1 [] where showsPrec1 = showsPrec instance (Eq a) => Eq1 ((,) a) where eq1 = (==) instance (Ord a) => Ord1 ((,) a) where compare1 = compare instance (Read a) => Read1 ((,) a) where readsPrec1 = readsPrec instance (Show a) => Show1 ((,) a) where showsPrec1 = showsPrec instance (Eq a) => Eq1 (Either a) where eq1 = (==) instance (Ord a) => Ord1 (Either a) where compare1 = compare instance (Read a) => Read1 (Either a) where readsPrec1 = readsPrec instance (Show a) => Show1 (Either a) where showsPrec1 = showsPrec -- Building blocks -- | @'readsData' p d@ is a parser for datatypes where each alternative -- begins with a data constructor. It parses the constructor and -- passes it to @p@. Parsers for various constructors can be constructed -- with 'readsUnary', 'readsUnary1' and 'readsBinary1', and combined with -- @mappend@ from the @Monoid@ class. readsData :: (String -> ReadS a) -> Int -> ReadS a readsData reader d = readParen (d > 10) $ \ r -> [res | (kw,s) <- lex r, res <- reader kw s] -- | @'readsUnary' n c n'@ matches the name of a unary data constructor -- and then parses its argument using 'readsPrec'. readsUnary :: (Read a) => String -> (a -> t) -> String -> ReadS t readsUnary name cons kw s = [(cons x,t) | kw == name, (x,t) <- readsPrec 11 s] -- | @'readsUnary1' n c n'@ matches the name of a unary data constructor -- and then parses its argument using 'readsPrec1'. readsUnary1 :: (Read1 f, Read a) => String -> (f a -> t) -> String -> ReadS t readsUnary1 name cons kw s = [(cons x,t) | kw == name, (x,t) <- readsPrec1 11 s] -- | @'readsBinary1' n c n'@ matches the name of a binary data constructor -- and then parses its arguments using 'readsPrec1'. readsBinary1 :: (Read1 f, Read1 g, Read a) => String -> (f a -> g a -> t) -> String -> ReadS t readsBinary1 name cons kw s = [(cons x y,u) | kw == name, (x,t) <- readsPrec1 11 s, (y,u) <- readsPrec1 11 t] -- | @'showsUnary' n d x@ produces the string representation of a unary data -- constructor with name @n@ and argument @x@, in precedence context @d@. showsUnary :: (Show a) => String -> Int -> a -> ShowS showsUnary name d x = showParen (d > 10) $ showString name . showChar ' ' . showsPrec 11 x -- | @'showsUnary1' n d x@ produces the string representation of a unary data -- constructor with name @n@ and argument @x@, in precedence context @d@. showsUnary1 :: (Show1 f, Show a) => String -> Int -> f a -> ShowS showsUnary1 name d x = showParen (d > 10) $ showString name . showChar ' ' . showsPrec1 11 x -- | @'showsBinary1' n d x@ produces the string representation of a binary -- data constructor with name @n@ and arguments @x@ and @y@, in precedence -- context @d@. showsBinary1 :: (Show1 f, Show1 g, Show a) => String -> Int -> f a -> g a -> ShowS showsBinary1 name d x y = showParen (d > 10) $ showString name . showChar ' ' . showsPrec1 11 x . showChar ' ' . showsPrec1 11 y instance (Eq e, Eq1 m, Eq a) => Eq (ErrorT e m a) where ErrorT x == ErrorT y = eq1 x y instance (Ord e, Ord1 m, Ord a) => Ord (ErrorT e m a) where compare (ErrorT x) (ErrorT y) = compare1 x y instance (Read e, Read1 m, Read a) => Read (ErrorT e m a) where readsPrec = readsData $ readsUnary1 "ErrorT" ErrorT instance (Show e, Show1 m, Show a) => Show (ErrorT e m a) where showsPrec d (ErrorT m) = showsUnary1 "ErrorT" d m instance (Eq e, Eq1 m) => Eq1 (ErrorT e m) where eq1 = (==) instance (Ord e, Ord1 m) => Ord1 (ErrorT e m) where compare1 = compare instance (Read e, Read1 m) => Read1 (ErrorT e m) where readsPrec1 = readsPrec instance (Show e, Show1 m) => Show1 (ErrorT e m) where showsPrec1 = showsPrec instance (Eq1 f, Eq a) => Eq (IdentityT f a) where IdentityT x == IdentityT y = eq1 x y instance (Ord1 f, Ord a) => Ord (IdentityT f a) where compare (IdentityT x) (IdentityT y) = compare1 x y instance (Read1 f, Read a) => Read (IdentityT f a) where readsPrec = readsData $ readsUnary1 "IdentityT" IdentityT instance (Show1 f, Show a) => Show (IdentityT f a) where showsPrec d (IdentityT m) = showsUnary1 "IdentityT" d m instance Eq1 f => Eq1 (IdentityT f) where eq1 = (==) instance Ord1 f => Ord1 (IdentityT f) where compare1 = compare instance Read1 f => Read1 (IdentityT f) where readsPrec1 = readsPrec instance Show1 f => Show1 (IdentityT f) where showsPrec1 = showsPrec instance (Eq1 m, Eq a) => Eq (ListT m a) where ListT x == ListT y = eq1 x y instance (Ord1 m, Ord a) => Ord (ListT m a) where compare (ListT x) (ListT y) = compare1 x y instance (Read1 m, Read a) => Read (ListT m a) where readsPrec = readsData $ readsUnary1 "ListT" ListT instance (Show1 m, Show a) => Show (ListT m a) where showsPrec d (ListT m) = showsUnary1 "ListT" d m instance Eq1 m => Eq1 (ListT m) where eq1 = (==) instance Ord1 m => Ord1 (ListT m) where compare1 = compare instance Read1 m => Read1 (ListT m) where readsPrec1 = readsPrec instance Show1 m => Show1 (ListT m) where showsPrec1 = showsPrec instance (Eq1 m, Eq a) => Eq (MaybeT m a) where MaybeT x == MaybeT y = eq1 x y instance (Ord1 m, Ord a) => Ord (MaybeT m a) where compare (MaybeT x) (MaybeT y) = compare1 x y instance (Read1 m, Read a) => Read (MaybeT m a) where readsPrec = readsData $ readsUnary1 "MaybeT" MaybeT instance (Show1 m, Show a) => Show (MaybeT m a) where showsPrec d (MaybeT m) = showsUnary1 "MaybeT" d m instance Eq1 m => Eq1 (MaybeT m) where eq1 = (==) instance Ord1 m => Ord1 (MaybeT m) where compare1 = compare instance Read1 m => Read1 (MaybeT m) where readsPrec1 = readsPrec instance Show1 m => Show1 (MaybeT m) where showsPrec1 = showsPrec instance (Eq w, Eq1 m, Eq a) => Eq (Lazy.WriterT w m a) where Lazy.WriterT x == Lazy.WriterT y = eq1 x y instance (Ord w, Ord1 m, Ord a) => Ord (Lazy.WriterT w m a) where compare (Lazy.WriterT x) (Lazy.WriterT y) = compare1 x y instance (Read w, Read1 m, Read a) => Read (Lazy.WriterT w m a) where readsPrec = readsData $ readsUnary1 "WriterT" Lazy.WriterT instance (Show w, Show1 m, Show a) => Show (Lazy.WriterT w m a) where showsPrec d (Lazy.WriterT m) = showsUnary1 "WriterT" d m instance (Eq w, Eq1 m) => Eq1 (Lazy.WriterT w m) where eq1 = (==) instance (Ord w, Ord1 m) => Ord1 (Lazy.WriterT w m) where compare1 = compare instance (Read w, Read1 m) => Read1 (Lazy.WriterT w m) where readsPrec1 = readsPrec instance (Show w, Show1 m) => Show1 (Lazy.WriterT w m) where showsPrec1 = showsPrec instance (Eq w, Eq1 m, Eq a) => Eq (Strict.WriterT w m a) where Strict.WriterT x == Strict.WriterT y = eq1 x y instance (Ord w, Ord1 m, Ord a) => Ord (Strict.WriterT w m a) where compare (Strict.WriterT x) (Strict.WriterT y) = compare1 x y instance (Read w, Read1 m, Read a) => Read (Strict.WriterT w m a) where readsPrec = readsData $ readsUnary1 "WriterT" Strict.WriterT instance (Show w, Show1 m, Show a) => Show (Strict.WriterT w m a) where showsPrec d (Strict.WriterT m) = showsUnary1 "WriterT" d m instance (Eq w, Eq1 m) => Eq1 (Strict.WriterT w m) where eq1 = (==) instance (Ord w, Ord1 m) => Ord1 (Strict.WriterT w m) where compare1 = compare instance (Read w, Read1 m) => Read1 (Strict.WriterT w m) where readsPrec1 = readsPrec instance (Show w, Show1 m) => Show1 (Strict.WriterT w m) where showsPrec1 = showsPrec instance (Functor f, Eq1 f, Eq1 g, Eq a) => Eq (Compose f g a) where Compose x == Compose y = eq1 (fmap Apply x) (fmap Apply y) instance (Functor f, Ord1 f, Ord1 g, Ord a) => Ord (Compose f g a) where compare (Compose x) (Compose y) = compare1 (fmap Apply x) (fmap Apply y) instance (Functor f, Read1 f, Read1 g, Read a) => Read (Compose f g a) where readsPrec = readsData $ readsUnary1 "Compose" (Compose . fmap getApply) instance (Functor f, Show1 f, Show1 g, Show a) => Show (Compose f g a) where showsPrec d (Compose x) = showsUnary1 "Compose" d (fmap Apply x) instance (Functor f, Eq1 f, Eq1 g) => Eq1 (Compose f g) where eq1 = (==) instance (Functor f, Ord1 f, Ord1 g) => Ord1 (Compose f g) where compare1 = compare instance (Functor f, Read1 f, Read1 g) => Read1 (Compose f g) where readsPrec1 = readsPrec instance (Functor f, Show1 f, Show1 g) => Show1 (Compose f g) where showsPrec1 = showsPrec instance (Eq1 f, Eq1 g, Eq a) => Eq (Product f g a) where Pair x1 y1 == Pair x2 y2 = eq1 x1 x2 && eq1 y1 y2 instance (Ord1 f, Ord1 g, Ord a) => Ord (Product f g a) where compare (Pair x1 y1) (Pair x2 y2) = compare1 x1 x2 `mappend` compare1 y1 y2 instance (Read1 f, Read1 g, Read a) => Read (Product f g a) where readsPrec = readsData $ readsBinary1 "Pair" Pair instance (Show1 f, Show1 g, Show a) => Show (Product f g a) where showsPrec d (Pair x y) = showsBinary1 "Pair" d x y instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where eq1 = (==) instance (Ord1 f, Ord1 g) => Ord1 (Product f g) where compare1 = compare instance (Read1 f, Read1 g) => Read1 (Product f g) where readsPrec1 = readsPrec instance (Show1 f, Show1 g) => Show1 (Product f g) where showsPrec1 = showsPrec instance Eq a => Eq1 (Constant a) where eq1 = (==) instance Ord a => Ord1 (Constant a) where compare1 = compare instance Read a => Read1 (Constant a) where readsPrec1 = readsPrec instance Show a => Show1 (Constant a) where showsPrec1 = showsPrec instance Eq1 Identity where eq1 = (==) instance Ord1 Identity where compare1 = compare instance Read1 Identity where readsPrec1 = readsPrec instance Show1 Identity where showsPrec1 = showsPrec -- Instances of Prelude classes -- kludge to get type with the same instances as g a newtype Apply g a = Apply (g a) getApply :: Apply g a -> g a getApply (Apply x) = x instance (Eq1 g, Eq a) => Eq (Apply g a) where Apply x == Apply y = eq1 x y instance (Ord1 g, Ord a) => Ord (Apply g a) where compare (Apply x) (Apply y) = compare1 x y instance (Read1 g, Read a) => Read (Apply g a) where readsPrec d s = [(Apply a, t) | (a, t) <- readsPrec1 d s] instance (Show1 g, Show a) => Show (Apply g a) where showsPrec d (Apply x) = showsPrec1 d x #if MIN_VERSION_transformers(0,3,0) instance (Eq1 f, Eq a) => Eq (Lift f a) where Pure x1 == Pure x2 = x1 == x2 Other y1 == Other y2 = eq1 y1 y2 _ == _ = False instance (Ord1 f, Ord a) => Ord (Lift f a) where compare (Pure x1) (Pure x2) = compare x1 x2 compare (Pure _) (Other _) = LT compare (Other _) (Pure _) = GT compare (Other y1) (Other y2) = compare1 y1 y2 instance (Read1 f, Read a) => Read (Lift f a) where readsPrec = readsData $ readsUnary "Pure" Pure `mappend` readsUnary1 "Other" Other instance (Show1 f, Show a) => Show (Lift f a) where showsPrec d (Pure x) = showsUnary "Pure" d x showsPrec d (Other y) = showsUnary1 "Other" d y instance Eq1 f => Eq1 (Lift f) where eq1 = (==) instance Ord1 f => Ord1 (Lift f) where compare1 = compare instance Read1 f => Read1 (Lift f) where readsPrec1 = readsPrec instance Show1 f => Show1 (Lift f) where showsPrec1 = showsPrec instance (Eq1 f, Eq a) => Eq (Backwards f a) where Backwards x == Backwards y = eq1 x y instance (Ord1 f, Ord a) => Ord (Backwards f a) where compare (Backwards x) (Backwards y) = compare1 x y instance (Read1 f, Read a) => Read (Backwards f a) where readsPrec = readsData $ readsUnary1 "Backwards" Backwards instance (Show1 f, Show a) => Show (Backwards f a) where showsPrec d (Backwards x) = showsUnary1 "Backwards" d x instance Eq1 f => Eq1 (Backwards f) where eq1 = (==) instance Ord1 f => Ord1 (Backwards f) where compare1 = compare instance Read1 f => Read1 (Backwards f) where readsPrec1 = readsPrec instance Show1 f => Show1 (Backwards f) where showsPrec1 = showsPrec instance (Eq1 f, Eq a) => Eq (Reverse f a) where Reverse x == Reverse y = eq1 x y instance (Ord1 f, Ord a) => Ord (Reverse f a) where compare (Reverse x) (Reverse y) = compare1 x y instance (Read1 f, Read a) => Read (Reverse f a) where readsPrec = readsData $ readsUnary1 "Reverse" Reverse instance (Show1 f, Show a) => Show (Reverse f a) where showsPrec d (Reverse x) = showsUnary1 "Reverse" d x instance (Eq1 f) => Eq1 (Reverse f) where eq1 = (==) instance (Ord1 f) => Ord1 (Reverse f) where compare1 = compare instance (Read1 f) => Read1 (Reverse f) where readsPrec1 = readsPrec instance (Show1 f) => Show1 (Reverse f) where showsPrec1 = showsPrec #endif transformers-compat-0.4.0.4/0.3/Data/Functor/Sum.hs0000644000000000000000000000362212467323744017761 0ustar0000000000000000-- | -- Module : Data.Functor.Sum -- Copyright : (c) Ross Paterson 2014 -- License : BSD-style (see the file LICENSE) -- -- Maintainer : ross@soi.city.ac.uk -- Stability : experimental -- Portability : portable -- -- Sums, lifted to functors. module Data.Functor.Sum ( Sum(..), ) where import Control.Applicative import Data.Foldable (Foldable(foldMap)) import Data.Functor.Classes import Data.Monoid (mappend) import Data.Traversable (Traversable(traverse)) -- | Lifted sum of functors. data Sum f g a = InL (f a) | InR (g a) instance (Eq1 f, Eq1 g, Eq a) => Eq (Sum f g a) where InL x1 == InL x2 = eq1 x1 x2 InR y1 == InR y2 = eq1 y1 y2 _ == _ = False instance (Ord1 f, Ord1 g, Ord a) => Ord (Sum f g a) where compare (InL x1) (InL x2) = compare1 x1 x2 compare (InL _) (InR _) = LT compare (InR _) (InL _) = GT compare (InR y1) (InR y2) = compare1 y1 y2 instance (Read1 f, Read1 g, Read a) => Read (Sum f g a) where readsPrec = readsData $ readsUnary1 "InL" InL `mappend` readsUnary1 "InR" InR instance (Show1 f, Show1 g, Show a) => Show (Sum f g a) where showsPrec d (InL x) = showsUnary1 "InL" d x showsPrec d (InR y) = showsUnary1 "InR" d y instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where eq1 = (==) instance (Ord1 f, Ord1 g) => Ord1 (Sum f g) where compare1 = compare instance (Read1 f, Read1 g) => Read1 (Sum f g) where readsPrec1 = readsPrec instance (Show1 f, Show1 g) => Show1 (Sum f g) where showsPrec1 = showsPrec instance (Functor f, Functor g) => Functor (Sum f g) where fmap f (InL x) = InL (fmap f x) fmap f (InR y) = InR (fmap f y) instance (Foldable f, Foldable g) => Foldable (Sum f g) where foldMap f (InL x) = foldMap f x foldMap f (InR y) = foldMap f y instance (Traversable f, Traversable g) => Traversable (Sum f g) where traverse f (InL x) = InL <$> traverse f x traverse f (InR y) = InR <$> traverse f y