From 41706061810410cc38f602ccc9a4c9560502251f Mon Sep 17 00:00:00 2001 From: dummy Date: Sat, 19 Oct 2013 01:44:52 +0000 Subject: [PATCH] hackity --- lens.cabal | 12 +----------- src/Control/Exception/Lens.hs | 2 +- src/Control/Lens.hs | 6 +++--- src/Control/Lens/Equality.hs | 4 ++-- src/Control/Lens/Fold.hs | 6 +++--- src/Control/Lens/Internal.hs | 2 +- src/Control/Lens/Internal/Exception.hs | 26 +------------------------- src/Control/Lens/Internal/Instances.hs | 14 -------------- src/Control/Lens/Internal/Zipper.hs | 2 +- src/Control/Lens/Iso.hs | 2 -- src/Control/Lens/Lens.hs | 2 +- src/Control/Lens/Operators.hs | 2 +- src/Control/Lens/Plated.hs | 2 +- src/Control/Lens/Prism.hs | 2 -- src/Control/Lens/Setter.hs | 2 -- src/Control/Lens/TH.hs | 2 +- src/Data/Data/Lens.hs | 6 +++--- 17 files changed, 20 insertions(+), 74 deletions(-) diff --git a/lens.cabal b/lens.cabal index b25adf4..3e5c30c 100644 --- a/lens.cabal +++ b/lens.cabal @@ -10,7 +10,7 @@ stability: provisional homepage: http://github.com/ekmett/lens/ bug-reports: http://github.com/ekmett/lens/issues copyright: Copyright (C) 2012-2013 Edward A. Kmett -build-type: Custom +build-type: Simple tested-with: GHC == 7.6.3 synopsis: Lenses, Folds and Traversals description: @@ -235,14 +235,12 @@ library Control.Lens.Review Control.Lens.Setter Control.Lens.Simple - Control.Lens.TH Control.Lens.Traversal Control.Lens.Tuple Control.Lens.Type Control.Lens.Wrapped Control.Lens.Zipper Control.Lens.Zoom - Control.Monad.Error.Lens Control.Parallel.Strategies.Lens Control.Seq.Lens Data.Array.Lens @@ -266,12 +264,8 @@ library Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens - Generics.Deriving.Lens - GHC.Generics.Lens System.Exit.Lens System.FilePath.Lens - System.IO.Error.Lens - Language.Haskell.TH.Lens Numeric.Lens if flag(safe) @@ -370,7 +364,6 @@ test-suite doctests deepseq, doctest >= 0.9.1, filepath, - generic-deriving, mtl, nats, parallel, @@ -396,7 +389,6 @@ benchmark plated comonad, criterion, deepseq, - generic-deriving, lens, transformers @@ -431,7 +423,6 @@ benchmark unsafe comonads-fd, criterion, deepseq, - generic-deriving, lens, transformers @@ -448,6 +439,5 @@ benchmark zipper comonads-fd, criterion, deepseq, - generic-deriving, lens, transformers diff --git a/src/Control/Exception/Lens.hs b/src/Control/Exception/Lens.hs index 0619335..c97ad9b 100644 --- a/src/Control/Exception/Lens.hs +++ b/src/Control/Exception/Lens.hs @@ -112,7 +112,7 @@ import Prelude , Maybe(..), Either(..), Functor(..), String, IO ) -{-# ANN module "HLint: ignore Use Control.Exception.catch" #-} + -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs index 242c3c1..2ab9cdb 100644 --- a/src/Control/Lens.hs +++ b/src/Control/Lens.hs @@ -59,7 +59,7 @@ module Control.Lens , module Control.Lens.Review , module Control.Lens.Setter , module Control.Lens.Simple -#ifndef DISABLE_TEMPLATE_HASKELL +#if 0 , module Control.Lens.TH #endif , module Control.Lens.Traversal @@ -89,7 +89,7 @@ import Control.Lens.Reified import Control.Lens.Review import Control.Lens.Setter import Control.Lens.Simple -#ifndef DISABLE_TEMPLATE_HASKELL +#if 0 import Control.Lens.TH #endif import Control.Lens.Traversal @@ -99,4 +99,4 @@ import Control.Lens.Wrapped import Control.Lens.Zipper import Control.Lens.Zoom -{-# ANN module "HLint: ignore Use import/export shortcut" #-} + diff --git a/src/Control/Lens/Equality.hs b/src/Control/Lens/Equality.hs index 982c2d7..3a3fe1a 100644 --- a/src/Control/Lens/Equality.hs +++ b/src/Control/Lens/Equality.hs @@ -28,8 +28,8 @@ module Control.Lens.Equality import Control.Lens.Internal.Setter import Control.Lens.Type -{-# ANN module "HLint: ignore Use id" #-} -{-# ANN module "HLint: ignore Eta reduce" #-} + + -- $setup -- >>> import Control.Lens diff --git a/src/Control/Lens/Fold.hs b/src/Control/Lens/Fold.hs index 32a4073..cc7da1e 100644 --- a/src/Control/Lens/Fold.hs +++ b/src/Control/Lens/Fold.hs @@ -163,9 +163,9 @@ import Data.Traversable -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force -{-# ANN module "HLint: ignore Eta reduce" #-} -{-# ANN module "HLint: ignore Use camelCase" #-} -{-# ANN module "HLint: ignore Use curry" #-} + + + infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?! diff --git a/src/Control/Lens/Internal.hs b/src/Control/Lens/Internal.hs index 295662e..539642d 100644 --- a/src/Control/Lens/Internal.hs +++ b/src/Control/Lens/Internal.hs @@ -43,4 +43,4 @@ import Control.Lens.Internal.Review import Control.Lens.Internal.Setter import Control.Lens.Internal.Zoom -{-# ANN module "HLint: ignore Use import/export shortcut" #-} + diff --git a/src/Control/Lens/Internal/Exception.hs b/src/Control/Lens/Internal/Exception.hs index 387203e..8bea89b 100644 --- a/src/Control/Lens/Internal/Exception.hs +++ b/src/Control/Lens/Internal/Exception.hs @@ -36,6 +36,7 @@ import Data.Monoid import Data.Proxy import Data.Reflection import Data.Typeable +import Data.Typeable import System.IO.Unsafe ------------------------------------------------------------------------------ @@ -128,18 +129,6 @@ class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where handler_ l = handler l . const {-# INLINE handler_ #-} -instance Handleable SomeException IO Exception.Handler where - handler = handlerIO - -instance Handleable SomeException m (CatchIO.Handler m) where - handler = handlerCatchIO - -handlerIO :: forall a r. Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r -handlerIO l f = reify (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a) - -handlerCatchIO :: forall m a r. Getting (First a) SomeException a -> (a -> m r) -> CatchIO.Handler m r -handlerCatchIO l f = reify (preview l) $ \ (_ :: Proxy s) -> CatchIO.Handler (\(Handling a :: Handling a s m) -> f a) - ------------------------------------------------------------------------------ -- Helpers ------------------------------------------------------------------------------ @@ -159,21 +148,8 @@ supply = unsafePerformIO $ newIORef 0 -- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does. newtype Handling a s (m :: * -> *) = Handling a --- the m parameter exists simply to break the Typeable1 pattern, so we can provide this without overlap. --- here we simply generate a fresh TypeRep so we'll fail to compare as equal to any other TypeRep. -instance Typeable (Handling a s m) where - typeOf _ = unsafePerformIO $ do - i <- atomicModifyIORef supply $ \a -> let a' = a + 1 in a' `seq` (a', a) - return $ mkTyConApp (mkTyCon3 "lens" "Control.Lens.Internal.Exception" ("Handling" ++ show i)) [] - {-# INLINE typeOf #-} - -- The @Handling@ wrapper is uninteresting, and should never be thrown, so you won't get much benefit here. instance Show (Handling a s m) where showsPrec d _ = showParen (d > 10) $ showString "Handling ..." {-# INLINE showsPrec #-} -instance Reifies s (SomeException -> Maybe a) => Exception (Handling a s m) where - toException _ = SomeException HandlingException - {-# INLINE toException #-} - fromException = fmap Handling . reflect (Proxy :: Proxy s) - {-# INLINE fromException #-} diff --git a/src/Control/Lens/Internal/Instances.hs b/src/Control/Lens/Internal/Instances.hs index 6783f33..17715ce 100644 --- a/src/Control/Lens/Internal/Instances.hs +++ b/src/Control/Lens/Internal/Instances.hs @@ -24,26 +24,12 @@ import Data.Traversable -- Orphan Instances ------------------------------------------------------------------------------- -instance Foldable ((,) b) where - foldMap f (_, a) = f a - instance Foldable1 ((,) b) where foldMap1 f (_, a) = f a -instance Traversable ((,) b) where - traverse f (b, a) = (,) b <$> f a - instance Traversable1 ((,) b) where traverse1 f (b, a) = (,) b <$> f a -instance Foldable (Either a) where - foldMap _ (Left _) = mempty - foldMap f (Right a) = f a - -instance Traversable (Either a) where - traverse _ (Left b) = pure (Left b) - traverse f (Right a) = Right <$> f a - instance Foldable (Const m) where foldMap _ _ = mempty diff --git a/src/Control/Lens/Internal/Zipper.hs b/src/Control/Lens/Internal/Zipper.hs index 95875b7..76060be 100644 --- a/src/Control/Lens/Internal/Zipper.hs +++ b/src/Control/Lens/Internal/Zipper.hs @@ -53,7 +53,7 @@ import Data.Profunctor.Unsafe -- >>> import Control.Lens -- >>> import Data.Char -{-# ANN module "HLint: ignore Use foldl" #-} + ------------------------------------------------------------------------------ -- * Jacket diff --git a/src/Control/Lens/Iso.hs b/src/Control/Lens/Iso.hs index 1152af4..80c3175 100644 --- a/src/Control/Lens/Iso.hs +++ b/src/Control/Lens/Iso.hs @@ -82,8 +82,6 @@ import Data.Maybe import Data.Profunctor import Data.Profunctor.Unsafe -{-# ANN module "HLint: ignore Use on" #-} - -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs index b26cc06..6f84943 100644 --- a/src/Control/Lens/Lens.hs +++ b/src/Control/Lens/Lens.hs @@ -126,7 +126,7 @@ import Data.Profunctor.Rep import Data.Profunctor.Unsafe import Data.Void -{-# ANN module "HLint: ignore Use ***" #-} + -- $setup -- >>> :set -XNoOverloadedStrings diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs index 11868e0..475c945 100644 --- a/src/Control/Lens/Operators.hs +++ b/src/Control/Lens/Operators.hs @@ -108,4 +108,4 @@ import Control.Lens.Review import Control.Lens.Setter import Control.Lens.Zipper -{-# ANN module "HLint: ignore Use import/export shortcut" #-} + diff --git a/src/Control/Lens/Plated.hs b/src/Control/Lens/Plated.hs index a8c4d20..cef574e 100644 --- a/src/Control/Lens/Plated.hs +++ b/src/Control/Lens/Plated.hs @@ -95,7 +95,7 @@ import Data.Data.Lens import Data.Monoid import Data.Tree -{-# ANN module "HLint: ignore Reduce duplication" #-} + -- | A 'Plated' type is one where we know how to extract its immediate self-similar children. -- diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs index 45b5cfe..88c7ff9 100644 --- a/src/Control/Lens/Prism.hs +++ b/src/Control/Lens/Prism.hs @@ -53,8 +53,6 @@ import Unsafe.Coerce import Data.Profunctor.Unsafe #endif -{-# ANN module "HLint: ignore Use camelCase" #-} - -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens diff --git a/src/Control/Lens/Setter.hs b/src/Control/Lens/Setter.hs index 2acbfa6..4a12c6b 100644 --- a/src/Control/Lens/Setter.hs +++ b/src/Control/Lens/Setter.hs @@ -87,8 +87,6 @@ import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Unsafe -{-# ANN module "HLint: ignore Avoid lambda" #-} - -- $setup -- >>> import Control.Lens -- >>> import Control.Monad.State diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs index a05eb07..49218b5 100644 --- a/src/Control/Lens/TH.hs +++ b/src/Control/Lens/TH.hs @@ -87,7 +87,7 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Haskell.TH.Lens -{-# ANN module "HLint: ignore Use foldl" #-} + -- | Flags for 'Lens' construction data LensFlag diff --git a/src/Data/Data/Lens.hs b/src/Data/Data/Lens.hs index cf1e7c9..b39dacf 100644 --- a/src/Data/Data/Lens.hs +++ b/src/Data/Data/Lens.hs @@ -65,9 +65,9 @@ import Data.Monoid import GHC.Exts (realWorld#) #endif -{-# ANN module "HLint: ignore Eta reduce" #-} -{-# ANN module "HLint: ignore Use foldl" #-} -{-# ANN module "HLint: ignore Reduce duplication" #-} + + + -- $setup -- >>> :set -XNoOverloadedStrings -- 1.7.10.4