Permalink
Browse files

Switched .Combinators to {-# RULES #-} instead of explicit unsafeCoerce

Unfortunately this interacts badly and causes eta-expansion in cases
like `over mapped` in its current form.
  • Loading branch information...
1 parent 5111ab8 commit e30aee4cf5d5a4cab5686d9da03e25fbf90aa09b @shachaf shachaf committed Dec 2, 2012
@@ -1,4 +1,3 @@
-{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
@@ -61,20 +60,20 @@ type Acting m r s t a b = (a -> Effect m r b) -> s -> Effect m r t
--
-- @'perform' ≡ 'flip' ('^!')@
perform :: Monad m => Acting m a s t a b -> s -> m a
-perform l = getEffect# (l (effect# return))
+perform l = getEffect # (l (_Effect # return))
{-# INLINE perform #-}
-- | Perform an 'Action' and modify the result.
performs :: Monad m => Acting m e s t a b -> (a -> e) -> s -> m e
-performs l f = getEffect# (l (effect# (return . f)))
+performs l f = getEffect # (l (_Effect # (return . f)))
-- | Perform an 'Action'
--
-- >>> ["hello","world"]^!folded.act putStrLn
-- hello
-- world
(^!) :: Monad m => s -> Acting m a s t a b -> m a
-a ^! l = getEffect (l (effect# return) a)
+a ^! l = getEffect (l (_Effect # return) a)
{-# INLINE (^!) #-}
-- | Construct an 'Action' from a monadic side-effect
@@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -47,15 +46,6 @@ import Data.Functor.Compose
import Data.Functor.Identity
import Data.Monoid
import Prelude hiding ((.),id)
-#ifndef SAFE
-import Unsafe.Coerce
-#endif
-
-#ifndef SAFE
-#define UNSAFELY(x) unsafeCoerce
-#else
-#define UNSAFELY(f) (\g -> g `seq` \x -> (f) (g x))
-#endif
-------------------------------------------------------------------------------
@@ -116,19 +106,9 @@ instance Effective m r f => Effective m (Dual r) (Backwards f) where
class Applicative f => Settable f where
untainted :: f a -> a
- untainted# :: (a -> f b) -> a -> b
- untainted# g = g `seq` \x -> untainted (g x)
-
- tainted# :: (a -> b) -> a -> f b
- tainted# g = g `seq` \x -> pure (g x)
-
-- | so you can pass our a 'Control.Lens.Setter.Setter' into combinators from other lens libraries
instance Settable Identity where
untainted = runIdentity
- untainted# = UNSAFELY(runIdentity)
- {-# INLINE untainted #-}
- tainted# = UNSAFELY(Identity)
- {-# INLINE tainted# #-}
-- | 'Control.Lens.Fold.backwards'
instance Settable f => Settable (Backwards f) where
View
@@ -1,4 +1,3 @@
-{-# LANGUAGE MagicHash #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
@@ -136,7 +135,7 @@ folding sfa agb = coerce . traverse_ agb . sfa
-- >>> [(1,2),(3,4)]^..folded.both
-- [1,2,3,4]
folded :: Foldable f => Fold (f a) a
-folded f = coerce . getFolding . foldMap (folding# f)
+folded f = coerce # getFolding # foldMap (Folding # f)
{-# INLINE folded #-}
-- | Fold by repeating the input forever.
@@ -216,7 +215,7 @@ filtered p f a
--
-- To change the direction of an 'Control.Lens.Iso.Iso', use 'Control.Lens.Isomorphic.from'.
backwards :: LensLike (Backwards f) s t a b -> LensLike f s t a b
-backwards l f = forwards# $ l (backwards# f)
+backwards l f = forwards # l (Backwards # f)
{-# INLINE backwards #-}
-- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Control.Lens.Iso.Iso', 'Getter' or 'Control.Lens.Traversal.Traversal' while a predicate holds.
@@ -266,7 +265,7 @@ droppingWhile p l f = fst . foldrOf l (\a r -> let s = f a *> snd r in if p a th
-- 'foldMapOf' :: 'Monoid' r => 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> r) -> s -> r
-- @
foldMapOf :: Getting r s t a b -> (a -> r) -> s -> r
-foldMapOf l f = runAccessor# (l (accessor# f))
+foldMapOf l f = runAccessor # (l (_Accessor # f))
{-# INLINE foldMapOf #-}
-- |
@@ -282,7 +281,7 @@ foldMapOf l f = runAccessor# (l (accessor# f))
-- 'foldOf' :: 'Monoid' m => 'Simple' 'Control.Lens.Traversal.Traversal' s m -> s -> m
-- @
foldOf :: Getting a s t a b -> s -> a
-foldOf l = runAccessor# (l Accessor)
+foldOf l = runAccessor # (l _Accessor)
{-# INLINE foldOf #-}
-- |
@@ -298,7 +297,7 @@ foldOf l = runAccessor# (l Accessor)
-- 'foldrOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> r -> r) -> r -> s -> r
-- @
foldrOf :: Getting (Endo r) s t a b -> (a -> r -> r) -> r -> s -> r
-foldrOf l f z t = appEndo (foldMapOf l (endo# f) t) z
+foldrOf l f z t = appEndo (foldMapOf l (_Endo # f) t) z
{-# INLINE foldrOf #-}
-- |
@@ -314,7 +313,7 @@ foldrOf l f z t = appEndo (foldMapOf l (endo# f) t) z
-- 'foldlOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (r -> a -> r) -> r -> s -> r
-- @
foldlOf :: Getting (Dual (Endo r)) s t a b -> (r -> a -> r) -> r -> s -> r
-foldlOf l f z t = appEndo (getDual (foldMapOf l (dual# (endo# (flip f))) t)) z
+foldlOf l f z t = appEndo (getDual (foldMapOf l (_Dual # (Endo # (flip f))) t)) z
{-# INLINE foldlOf #-}
-- | Extract a list of the targets of a 'Fold'. See also ('^..').
@@ -382,7 +381,7 @@ s ^.. l = toListOf l s
-- 'andOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s 'Bool' -> s -> 'Bool'
-- @
andOf :: Getting All s t Bool b -> s -> Bool
-andOf l = getAll# (foldMapOf l All)
+andOf l = getAll # (foldMapOf l All)
{-# INLINE andOf #-}
-- | Returns 'True' if any target of a 'Fold' is 'True'.
@@ -402,7 +401,7 @@ andOf l = getAll# (foldMapOf l All)
-- 'orOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s 'Bool' -> s -> 'Bool'
-- @
orOf :: Getting Any s t Bool b -> s -> Bool
-orOf l = getAny# (foldMapOf l Any)
+orOf l = getAny # (foldMapOf l Any)
{-# INLINE orOf #-}
-- | Returns 'True' if any target of a 'Fold' satisfies a predicate.
@@ -423,7 +422,7 @@ orOf l = getAny# (foldMapOf l Any)
-- 'anyOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> 'Bool') -> s -> 'Bool'
-- @
anyOf :: Getting Any s t a b -> (a -> Bool) -> s -> Bool
-anyOf l f = getAny# $ foldMapOf l (any# f)
+anyOf l f = getAny # foldMapOf l (_Any # f)
{-# INLINE anyOf #-}
-- | Returns 'True' if every target of a 'Fold' satisfies a predicate.
@@ -443,7 +442,7 @@ anyOf l f = getAny# $ foldMapOf l (any# f)
-- 'allOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> 'Bool') -> s -> 'Bool'
-- @
allOf :: Getting All s t a b -> (a -> Bool) -> s -> Bool
-allOf l f = getAll# $ foldMapOf l (all# f)
+allOf l f = getAll # foldMapOf l (All # f)
{-# INLINE allOf #-}
-- | Calculate the product of every number targeted by a 'Fold'
@@ -463,7 +462,7 @@ allOf l f = getAll# $ foldMapOf l (all# f)
-- 'productOf' :: 'Num' a => 'Simple' 'Control.Lens.Traversal.Traversal' s a -> s -> a
-- @
productOf :: Getting (Product a) s t a b -> s -> a
-productOf l = getProduct# $ foldMapOf l Product
+productOf l = getProduct # foldMapOf l Product
{-# INLINE productOf #-}
-- | Calculate the sum of every number targeted by a 'Fold'.
@@ -493,7 +492,7 @@ productOf l = getProduct# $ foldMapOf l Product
-- 'sumOf' :: 'Num' a => 'Simple' 'Control.Lens.Traversal.Traversal' s a -> s -> a
-- @
sumOf :: Getting (Sum a) s t a b -> s -> a
-sumOf l = getSum# $ foldMapOf l Sum
+sumOf l = getSum # foldMapOf l Sum
{-# INLINE sumOf #-}
-- | Traverse over all of the targets of a 'Fold' (or 'Getter'), computing an 'Applicative' (or 'Functor') -based answer,
@@ -524,7 +523,7 @@ sumOf l = getSum# $ foldMapOf l Sum
-- 'traverseOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> f r) -> s -> f ()
-- @
traverseOf_ :: Functor f => Getting (Traversed f) s t a b -> (a -> f r) -> s -> f ()
-traverseOf_ l f = getTraversed# (foldMapOf l (traversed# (void . f)))
+traverseOf_ l f = getTraversed # foldMapOf l (_Traversed # (void . f))
{-# INLINE traverseOf_ #-}
-- | Traverse over all of the targets of a 'Fold' (or 'Getter'), computing an 'Applicative' (or 'Functor') -based answer,
@@ -561,7 +560,7 @@ forOf_ = flip . traverseOf_
-- 'sequenceAOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' s (f ()) -> s -> f ()
-- @
sequenceAOf_ :: Functor f => Getting (Traversed f) s t (f ()) b -> s -> f ()
-sequenceAOf_ l = getTraversed# (foldMapOf l (traversed# void))
+sequenceAOf_ l = getTraversed # foldMapOf l (_Traversed # void)
{-# INLINE sequenceAOf_ #-}
-- | Map each target of a 'Fold' on a structure to a monadic action, evaluate these actions from left to right, and ignore the results.
@@ -576,7 +575,7 @@ sequenceAOf_ l = getTraversed# (foldMapOf l (traversed# void))
-- 'mapMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> m r) -> s -> m ()
-- @
mapMOf_ :: Monad m => Getting (Sequenced m) s t a b -> (a -> m r) -> s -> m ()
-mapMOf_ l f = getSequenced# (foldMapOf l (sequenced# (liftM skip . f)))
+mapMOf_ l f = getSequenced # (foldMapOf l (_Sequenced # (liftM skip . f)))
{-# INLINE mapMOf_ #-}
skip :: a -> ()
@@ -610,7 +609,7 @@ forMOf_ = flip . mapMOf_
-- 'sequenceOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' s (m a) -> s -> m ()
-- @
sequenceOf_ :: Monad m => Getting (Sequenced m) s t (m a) b -> s -> m ()
-sequenceOf_ l = getSequenced# (foldMapOf l (sequenced# (liftM skip)))
+sequenceOf_ l = getSequenced # (foldMapOf l (_Sequenced # liftM skip))
{-# INLINE sequenceOf_ #-}
-- | The sum of a collection of actions, generalizing 'concatOf'.
@@ -688,7 +687,7 @@ notElemOf l = allOf l . (/=)
-- 'concatMapOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> [r]) -> s -> [r]
-- @
concatMapOf :: Getting [r] s t a b -> (a -> [r]) -> s -> [r]
-concatMapOf l ces = runAccessor# (l (accessor# ces))
+concatMapOf l ces = runAccessor # l (_Accessor # ces)
{-# INLINE concatMapOf #-}
-- | Concatenate all of the lists targeted by a 'Fold' into a longer list.
@@ -730,7 +729,7 @@ concatOf = view
-- 'lengthOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> s -> 'Int'
-- @
lengthOf :: Getting (Sum Int) s t a b -> s -> Int
-lengthOf l = getSum# (foldMapOf l (\_ -> Sum 1))
+lengthOf l = getSum # foldMapOf l (\_ -> Sum 1)
{-# INLINE lengthOf #-}
-- | Perform a safe 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result
@@ -746,7 +745,7 @@ lengthOf l = getSum# (foldMapOf l (\_ -> Sum 1))
-- 'headOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> s -> 'Maybe' a
-- @
headOf :: Getting (First a) s t a b -> s -> Maybe a
-headOf l = getFirst# (foldMapOf l (first# Just))
+headOf l = getFirst # foldMapOf l (_First # Just)
{-# INLINE headOf #-}
-- | Perform a safe 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result
@@ -765,7 +764,7 @@ headOf l = getFirst# (foldMapOf l (first# Just))
-- ('^?') :: s -> 'Simple' 'Control.Lens.Traversal.Traversal' s a -> 'Maybe' a
-- @
(^?) :: s -> Getting (First a) s t a b -> Maybe a
-a ^? l = getFirst (foldMapOf l (first# Just) a)
+a ^? l = getFirst (foldMapOf l (_First # Just) a)
{-# INLINE (^?) #-}
-- | Perform an *UNSAFE* 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' assuming that it is there.
@@ -778,7 +777,7 @@ a ^? l = getFirst (foldMapOf l (first# Just) a)
-- ('^?!') :: s -> 'Simple' 'Control.Lens.Traversal.Traversal' s a -> a
-- @
(^?!) :: s -> Getting (First a) s t a b -> a
-a ^?! l = fromMaybe (error "(^?!): empty Fold") $ getFirst (foldMapOf l (first# Just) a)
+a ^?! l = fromMaybe (error "(^?!): empty Fold") $ getFirst (foldMapOf l (_First # Just) a)
{-# INLINE (^?!) #-}
-- | Perform a safe 'last' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result
@@ -792,7 +791,7 @@ a ^?! l = fromMaybe (error "(^?!): empty Fold") $ getFirst (foldMapOf l (first#
-- 'lastOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> s -> 'Maybe' a
-- @
lastOf :: Getting (Last a) s t a b -> s -> Maybe a
-lastOf l = getLast# (foldMapOf l (last# Just))
+lastOf l = getLast # foldMapOf l (_Last # Just)
{-# INLINE lastOf #-}
-- |
@@ -817,7 +816,7 @@ lastOf l = getLast# (foldMapOf l (last# Just))
-- 'nullOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> s -> 'Bool'
-- @
nullOf :: Getting All s t a b -> s -> Bool
-nullOf l = getAll# (foldMapOf l (\_ -> All False))
+nullOf l = getAll # foldMapOf l (\_ -> All False)
{-# INLINE nullOf #-}
-- |
@@ -906,7 +905,7 @@ minimumByOf l cmp = foldrOf l step Nothing where
-- 'findOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> 'Bool') -> s -> 'Maybe' a
-- @
findOf :: Getting (First a) s t a b -> (a -> Bool) -> s -> Maybe a
-findOf l p = getFirst# (foldMapOf l step) where
+findOf l p = getFirst # (foldMapOf l step) where
step a
| p a = First (Just a)
| otherwise = First Nothing
@@ -1,4 +1,3 @@
-{-# LANGUAGE MagicHash #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -231,7 +230,7 @@ type Getting r s t a b = (a -> Accessor r b) -> s -> Accessor r t
-- 'view' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> m a
-- @
view :: MonadReader s m => Getting a s t a b -> m a
-view l = Reader.asks (runAccessor# (l Accessor))
+view l = Reader.asks (runAccessor # (l _Accessor))
{-# INLINE view #-}
-- | View the value of a 'Getter', 'Control.Lens.Iso.Iso',
@@ -271,7 +270,7 @@ view l = Reader.asks (runAccessor# (l Accessor))
-- 'view' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> m a
-- @
views :: MonadReader s m => Getting r s t a b -> (a -> r) -> m r
-views l f = Reader.asks (runAccessor# (l (accessor# f)))
+views l f = Reader.asks (runAccessor # (l (_Accessor # f)))
{-# INLINE views #-}
-- | View the value pointed to by a 'Getter', 'Control.Lens.Iso.Iso' or
@@ -479,7 +478,7 @@ uses' l f = State.gets (views' l f)
-- 'view'' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> m a
-- @
view' :: MonadReader s m => Getting a s s a a -> m a
-view' l = Reader.asks (runAccessor# (l Accessor))
+view' l = Reader.asks (runAccessor # (l _Accessor))
{-# INLINE view' #-}
-- | This is a type restricted version of 'views' that expects a 'Simple' 'Getter'.
@@ -518,7 +517,7 @@ view' l = Reader.asks (runAccessor# (l Accessor))
-- 'views'' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> r) -> m r
-- @
views' :: MonadReader s m => Getting r s s a a -> (a -> r) -> m r
-views' l f = Reader.asks (runAccessor# (l (accessor# f)))
+views' l f = Reader.asks (runAccessor # (l (_Accessor # f)))
{-# INLINE views' #-}
------------------------------------------------------------------------------
Oops, something went wrong.

0 comments on commit e30aee4

Please sign in to comment.