Permalink
Browse files

Support for Haskell Platform 2011.4.0.0.

  • Loading branch information...
1 parent 222f690 commit 09144995f2fa96f0d964b9578267efa52bab98a2 @ekmett committed Dec 7, 2012
View
51 compat/Control/Applicative/Backwards.hs
@@ -0,0 +1,51 @@
+-- |
+-- 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.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)
View
71 compat/Control/Applicative/Lift.hs
@@ -0,0 +1,71 @@
+-- |
+-- 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.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 (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)
View
57 compat/Data/Functor/Reverse.hs
@@ -0,0 +1,57 @@
+-- |
+-- 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.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)
View
21 lens.cabal
@@ -1,6 +1,6 @@
name: lens
category: Data, Lenses
-version: 3.7
+version: 3.7.0.1
license: BSD3
cabal-version: >= 1.8
license-file: LICENSE
@@ -155,6 +155,10 @@ flag safe
-- Assert that we are trustworthy when we can
flag trustworthy
default: True
+ manual: True
+
+flag transformers2
+ default: False
manual: False
library
@@ -164,16 +168,25 @@ library
comonad == 3.0.*,
comonad-transformers == 3.0.*,
comonads-fd == 3.0.*,
- containers >= 0.4.2 && < 0.6,
+ containers >= 0.4.0 && < 0.6,
hashable >= 1.1.2.3 && < 1.2,
- mtl >= 2.1.1 && < 2.2,
+ mtl >= 2.0.1 && < 2.2,
semigroups >= 0.8.4 && < 0.9,
split == 0.2.*,
text >= 0.11 && < 0.12,
- transformers >= 0.3 && < 0.4,
unordered-containers >= 0.2 && < 0.3,
vector >= 0.9 && < 0.11
+ if flag(transformers2)
+ build-depends: transformers >= 0.2 && < 0.3
+ hs-source-dirs: compat
+ exposed-modules:
+ Control.Applicative.Backwards
+ Control.Applicative.Lift
+ Data.Functor.Reverse
+ else
+ build-depends: transformers >= 0.3 && < 0.4
+
exposed-modules:
Control.Exception.Lens
Control.Lens
View
26 src/Control/Lens/Traversal.hs
@@ -1,9 +1,14 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
+#ifndef MIN_VERSION_mtl
+#define MIN_VERSION_mtl(x,y,z) 1
+#endif
+
-----------------------------------------------------------------------------
-- |
-- Module : Control.Lens.Traversal
@@ -276,7 +281,11 @@ mapAccumROf = mapAccumLOf . backwards
-- 'mapAccumLOf' :: 'Traversal' s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
-- @
mapAccumLOf :: LensLike (Lazy.State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
+#if MIN_VERSION_mtl(2,1,1)
mapAccumLOf l f acc0 s = swap (Lazy.runState (l (\a -> State.state (\acc -> swap (f acc a))) s) acc0)
+#else
+mapAccumLOf l f acc0 s = swap (Lazy.runState (l (\a -> do (r,s') <- State.gets (\acc -> swap (f acc a)); State.put s'; return r) s) acc0)
+#endif
{-# INLINE mapAccumLOf #-}
swap :: (a,b) -> (b,a)
@@ -440,11 +449,20 @@ ins = toListOf bazaar
{-# INLINE ins #-}
outs :: Bazaar a a t -> [a] -> t
+#if MIN_VERSION_mtl(2,1,1)
outs = evalState . bazaar (\oldVal -> State.state (unconsWithDefault oldVal))
+#else
+outs = evalState . bazaar (\oldVal -> do (r,s) <- State.gets (unconsWithDefault oldVal); State.put s; return r)
+#endif
{-# INLINE outs #-}
+
unsafeOuts :: Bazaar a b t -> [b] -> t
+#if MIN_VERSION_mtl(2,1,1)
unsafeOuts = evalState . bazaar (\_ -> State.state (unconsWithDefault fakeVal))
+#else
+unsafeOuts = evalState . bazaar (\_-> do (r,s) <- State.gets (unconsWithDefault fakeVal); State.put s; return r)
+#endif
where fakeVal = error "unsafePartsOf': not enough elements were supplied"
{-# INLINE unsafeOuts #-}
@@ -453,11 +471,19 @@ insT = toListOf bazaarT
{-# INLINE insT #-}
outsT :: BazaarT a a f t -> [a] -> t
+#if MIN_VERSION_mtl(2,1,1)
outsT = evalState . bazaarT (\oldVal -> State.state (unconsWithDefault oldVal))
+#else
+outsT = evalState . bazaarT (\oldVal -> do (r,s) <- State.gets (unconsWithDefault oldVal); State.put s; return r)
+#endif
{-# INLINE outsT #-}
unsafeOutsT :: BazaarT a b f t -> [b] -> t
+#if MIN_VERSION_mtl(2,1,1)
unsafeOutsT = evalState . bazaarT (\_ -> State.state (unconsWithDefault fakeVal))
+#else
+unsafeOutsT = evalState . bazaarT (\_-> do (r,s) <- State.gets (unconsWithDefault fakeVal); State.put s; return r)
+#endif
where fakeVal = error "unsafePartsOf: not enough elements were supplied"
{-# INLINE unsafeOutsT #-}
View
7 src/Control/Parallel/Strategies/Lens.hs
@@ -2,6 +2,9 @@
#ifdef TRUSTWORTHY
{-# LANGUAGE Trustworthy #-}
#endif
+#ifndef MIN_VERSION_parallel
+#define MIN_VERSION_parallel(x,y,z) (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL > 700)
+#endif
-----------------------------------------------------------------------------
-- |
-- Module : Control.Parallel.Strategies.Lens
@@ -53,7 +56,11 @@ evalOf l = l
-- 'parOf' :: ((a -> 'Eval' a) -> s -> 'Eval' s) -> 'Strategy' a -> 'Strategy' s
-- @
parOf :: SimpleLensLike Eval s a -> Strategy a -> Strategy s
+#if MIN_VERSION_parallel(3,2,0)
parOf l s = l (rparWith s)
+#else
+parOf l s = l (rpar `dot` s)
+#endif
{-# INLINE parOf #-}
-- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to

0 comments on commit 0914499

Please sign in to comment.