lens 4.13 → 4.13.1
raw patch · 91 files changed
+1030/−284 lines, 91 filesdep ~comonaddep ~hlintdep ~kan-extensionssetup-changed
Dependency ranges changed: comonad, hlint, kan-extensions, transformers
Files
- .ghci +0/−1
- .gitignore +1/−0
- .travis.yml +16/−4
- CHANGELOG.markdown +11/−0
- LICENSE +1/−1
- README.markdown +2/−2
- Setup.lhs +4/−0
- lens.cabal +13/−9
- src/Control/Exception/Lens.hs +1/−1
- src/Control/Lens.hs +1/−1
- src/Control/Lens/At.hs +1/−1
- src/Control/Lens/Combinators.hs +1/−1
- src/Control/Lens/Cons.hs +1/−1
- src/Control/Lens/Each.hs +1/−1
- src/Control/Lens/Empty.hs +1/−1
- src/Control/Lens/Equality.hs +14/−3
- src/Control/Lens/Extras.hs +1/−1
- src/Control/Lens/Fold.hs +22/−3
- src/Control/Lens/Getter.hs +1/−1
- src/Control/Lens/Indexed.hs +1/−1
- src/Control/Lens/Internal.hs +1/−1
- src/Control/Lens/Internal/Bazaar.hs +1/−1
- src/Control/Lens/Internal/ByteString.hs +1/−1
- src/Control/Lens/Internal/Coerce.hs +1/−1
- src/Control/Lens/Internal/Context.hs +1/−1
- src/Control/Lens/Internal/Deque.hs +2/−2
- src/Control/Lens/Internal/Exception.hs +1/−1
- src/Control/Lens/Internal/FieldTH.hs +28/−6
- src/Control/Lens/Internal/Fold.hs +1/−1
- src/Control/Lens/Internal/Getter.hs +1/−1
- src/Control/Lens/Internal/Indexed.hs +7/−3
- src/Control/Lens/Internal/Instances.hs +1/−1
- src/Control/Lens/Internal/Iso.hs +5/−1
- src/Control/Lens/Internal/Level.hs +1/−1
- src/Control/Lens/Internal/List.hs +1/−1
- src/Control/Lens/Internal/Magma.hs +1/−1
- src/Control/Lens/Internal/Prism.hs +1/−1
- src/Control/Lens/Internal/PrismTH.hs +25/−11
- src/Control/Lens/Internal/Review.hs +1/−1
- src/Control/Lens/Internal/Setter.hs +1/−1
- src/Control/Lens/Internal/TH.hs +5/−1
- src/Control/Lens/Internal/Zoom.hs +1/−1
- src/Control/Lens/Iso.hs +27/−2
- src/Control/Lens/Lens.hs +1/−1
- src/Control/Lens/Level.hs +1/−1
- src/Control/Lens/Operators.hs +1/−1
- src/Control/Lens/Plated.hs +1/−1
- src/Control/Lens/Prism.hs +1/−1
- src/Control/Lens/Reified.hs +9/−3
- src/Control/Lens/Review.hs +1/−1
- src/Control/Lens/Setter.hs +1/−1
- src/Control/Lens/TH.hs +119/−47
- src/Control/Lens/Traversal.hs +14/−14
- src/Control/Lens/Tuple.hs +1/−1
- src/Control/Lens/Type.hs +15/−2
- src/Control/Lens/Wrapped.hs +6/−9
- src/Control/Lens/Zoom.hs +1/−1
- src/Control/Monad/Error/Lens.hs +1/−1
- src/Control/Parallel/Strategies/Lens.hs +1/−1
- src/Control/Seq/Lens.hs +1/−1
- src/Data/Array/Lens.hs +1/−1
- src/Data/Bits/Lens.hs +1/−1
- src/Data/ByteString/Lazy/Lens.hs +1/−1
- src/Data/ByteString/Lens.hs +1/−1
- src/Data/ByteString/Strict/Lens.hs +1/−1
- src/Data/Complex/Lens.hs +1/−1
- src/Data/Data/Lens.hs +1/−1
- src/Data/Dynamic/Lens.hs +1/−1
- src/Data/HashSet/Lens.hs +1/−1
- src/Data/IntSet/Lens.hs +1/−1
- src/Data/List/Lens.hs +1/−1
- src/Data/Map/Lens.hs +1/−1
- src/Data/Sequence/Lens.hs +1/−1
- src/Data/Set/Lens.hs +1/−1
- src/Data/Text/Lazy/Lens.hs +1/−1
- src/Data/Text/Lens.hs +1/−1
- src/Data/Text/Strict/Lens.hs +1/−1
- src/Data/Tree/Lens.hs +1/−1
- src/Data/Typeable/Lens.hs +1/−1
- src/Data/Vector/Generic/Lens.hs +1/−1
- src/Data/Vector/Lens.hs +1/−1
- src/GHC/Generics/Lens.hs +1/−1
- src/Generics/Deriving/Lens.hs +1/−1
- src/Language/Haskell/TH/Lens.hs +533/−92
- src/Numeric/Lens.hs +1/−1
- src/System/Exit/Lens.hs +1/−1
- src/System/FilePath/Lens.hs +1/−1
- src/System/IO/Error/Lens.hs +1/−1
- tests/doctests.hsc +3/−3
- tests/properties.hs +41/−0
- tests/templates.hs +42/−0
− .ghci
@@ -1,1 +0,0 @@-:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h
.gitignore view
@@ -14,4 +14,5 @@ *# .cabal-sandbox/ cabal.sandbox.config+.stack-work/ codex.tags
.travis.yml view
@@ -13,18 +13,30 @@ matrix: include:- - env: CABALVER=1.16 GHCVER=7.4.2+ - env: CABALVER=1.18 GHCVER=7.4.2 compiler: ": #GHC 7.4.2"- addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}- - env: CABALVER=1.16 GHCVER=7.6.3+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.18 GHCVER=7.6.3 compiler: ": #GHC 7.6.3"- addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.18 GHCVER=7.8.4 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} - env: CABALVER=1.22 GHCVER=7.10.1 compiler: ": #GHC 7.10.1" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.22 GHCVER=7.10.2+ compiler: ": #GHC 7.10.2"+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=8.0.1+ compiler: ": #GHC 8.0.1"+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.24 GHCVER=head+ compiler: ": #GHC head"+ addons: {apt: {packages: [cabal-install-1.24,ghc-head,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}++ allow_failures:+ - env: CABALVER=1.24 GHCVER=head before_install: - unset CC
CHANGELOG.markdown view
@@ -1,3 +1,14 @@+4.13.1+------+* Modified to enable the `doctests` to build with `stack`.+* Removed `.ghci`.+* Added `lookupOf`+* Support GHC 8+* Support `transformers` 0.5+* Support `kan-extensions` 5+* Support `comonad` 5+* Better support for `Closed` from `profunctors`.+ 4.13 ---- * Pattern synonyms
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2012-2015 Edward Kmett+Copyright 2012-2016 Edward Kmett All rights reserved.
README.markdown view
@@ -193,11 +193,11 @@ 5 ``` -You can automatically derive isomorphisms for your own newtypes with `makeIso`. e.g.+You can automatically derive isomorphisms for your own newtypes with `makePrisms`. e.g. ```haskell newtype Neither a b = Neither { _nor :: Either a b } deriving (Show)-makeIso ''Neither+makePrisms ''Neither ``` will automatically derive
Setup.lhs view
@@ -41,6 +41,10 @@ withTestLBI pkg lbi $ \suite suitecfg -> do rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines [ "module Build_" ++ testName suite ++ " where"+ , ""+ , "autogen_dir :: String"+ , "autogen_dir = " ++ show dir+ , "" , "deps :: [String]" , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) ]
lens.cabal view
@@ -1,6 +1,6 @@ name: lens category: Data, Lenses, Generics-version: 4.13+version: 4.13.1 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -9,10 +9,10 @@ stability: provisional homepage: http://github.com/ekmett/lens/ bug-reports: http://github.com/ekmett/lens/issues-copyright: Copyright (C) 2012-2015 Edward A. Kmett+copyright: Copyright (C) 2012-2016 Edward A. Kmett build-type: Custom -- build-tools: cpphs-tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2+tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2, GHC == 8.0.1 synopsis: Lenses, Folds and Traversals description: This package comes \"Batteries Included\" with many useful lenses for the types@@ -89,7 +89,6 @@ extra-source-files: .travis.yml- .ghci .gitignore .vim.custom examples/LICENSE@@ -186,7 +185,7 @@ base-orphans >= 0.3 && < 1, bifunctors >= 5 && < 6, bytestring >= 0.9.1.10 && < 0.11,- comonad >= 4 && < 5,+ comonad >= 4 && < 6, contravariant >= 1.3 && < 2, containers >= 0.4.0 && < 0.6, distributive >= 0.3 && < 1,@@ -194,7 +193,7 @@ free >= 4 && < 5, ghc-prim, hashable >= 1.1.2.3 && < 1.3,- kan-extensions >= 4.2.1 && < 5,+ kan-extensions >= 5 && < 6, exceptions >= 0.1.1 && < 1, mtl >= 2.0.1 && < 2.3, parallel >= 3.1.0.1 && < 3.3,@@ -203,9 +202,9 @@ semigroupoids >= 5 && < 6, semigroups >= 0.8.4 && < 1, tagged >= 0.4.4 && < 1,- template-haskell >= 2.4 && < 2.11,+ template-haskell >= 2.4 && < 2.12, text >= 0.11 && < 1.3,- transformers >= 0.2 && < 0.5,+ transformers >= 0.2 && < 0.6, transformers-compat >= 0.4 && < 1, unordered-containers >= 0.2.4 && < 0.3, vector >= 0.9 && < 0.12,@@ -314,10 +313,15 @@ if impl(ghc<7.4) ghc-options: -fno-spec-constr-count + -- hack around the buggy unused matches check for class associated types in ghc 8 rc1+ if impl(ghc >= 8)+ ghc-options: -fno-warn-missing-pat-syn-sigs -fno-warn-unused-matches+ if flag(j) && impl(ghc>=7.8) ghc-options: -j4 ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10+ hs-source-dirs: src -- Verify that Template Haskell expansion works@@ -387,7 +391,7 @@ other-extensions: Trustworthy cpp-options: -DTRUSTWORTHY=1 - if !flag(test-doctests)+ if !flag(test-doctests) || impl(ghc>=8) buildable: False else build-depends:
src/Control/Exception/Lens.hs view
@@ -28,7 +28,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Exception.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/At.hs view
@@ -24,7 +24,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.At--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Combinators.hs view
@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Combinators--- Copyright : (C) 2013-15 Edward Kmett+-- Copyright : (C) 2013-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Cons.hs view
@@ -14,7 +14,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Cons--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Each.hs view
@@ -17,7 +17,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Each--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Empty.hs view
@@ -14,7 +14,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Empty--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Equality.hs view
@@ -2,10 +2,13 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-}+#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Equality--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional@@ -29,7 +32,7 @@ ) where import Control.Lens.Type-import Data.Functor.Identity+import Data.Proxy (Proxy) #ifdef HLINT {-# ANN module "HLint: ignore Use id" #-}@@ -48,7 +51,11 @@ Identical :: Identical a b a b -- | When you see this as an argument to a function, it expects an 'Equality'.-type AnEquality s t a b = Identical a (Identity b) a (Identity b) -> Identical a (Identity b) s (Identity t)+#if __GLASGOW_HASKELL__ >= 706+type AnEquality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = Identical a (Proxy b) a (Proxy b) -> Identical a (Proxy b) s (Proxy t)+#else+type AnEquality s t a b = Identical a (Proxy b) a (Proxy b) -> Identical a (Proxy b) s (Proxy t)+#endif -- | A 'Simple' 'AnEquality'. type AnEquality' s a = AnEquality s s a a@@ -65,7 +72,11 @@ {-# INLINE substEq #-} -- | We can use 'Equality' to do substitution into anything.+#if __GLASGOW_HASKELL__ >= 706+mapEq :: forall (s :: k1) (t :: k2) (a :: k1) (b :: k2) (f :: k1 -> *) . AnEquality s t a b -> f s -> f a+#else mapEq :: AnEquality s t a b -> f s -> f a+#endif mapEq l r = substEq l r {-# INLINE mapEq #-}
src/Control/Lens/Extras.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.List.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Fold.hs view
@@ -20,7 +20,7 @@ ---------------------------------------------------------------------------- -- | -- Module : Control.Lens.Fold--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional@@ -101,6 +101,7 @@ , foldr1Of, foldl1Of , foldr1Of', foldl1Of' , foldrMOf, foldlMOf+ , lookupOf -- * Indexed Folds , (^@..)@@ -689,7 +690,7 @@ -- @ -- -- @--- 'ianyOf' l ≡ 'allOf' l '.' 'Indexed'+-- 'ianyOf' l ≡ 'anyOf' l '.' 'Indexed' -- @ -- -- @@@ -1296,7 +1297,7 @@ -- Note: 'notNullOf' on a valid 'Iso', 'Lens' or 'Getter' should always return 'True'. -- -- @--- 'null' ≡ 'notNullOf' 'folded'+-- 'not' '.' 'null' ≡ 'notNullOf' 'folded' -- @ -- -- This may be rather inefficient compared to the @'not' '.' 'null'@ check of many containers.@@ -1517,6 +1518,24 @@ findMOf :: Monad m => Getting (Endo (m (Maybe a))) s a -> (a -> m Bool) -> s -> m (Maybe a) findMOf l f = foldrOf l (\a y -> f a >>= \r -> if r then return (Just a) else y) $ return Nothing {-# INLINE findMOf #-}++-- | The 'lookupOf' function takes a 'Fold' (or 'Getter', 'Traversal',+-- 'Lens', 'Iso', etc.), a key, and a structure containing key/value pairs.+-- It returns the first value corresponding to the given key. This function+-- generalizes 'lookup' to work on an arbitrary 'Fold' instead of lists.+--+-- >>> lookupOf folded 4 [(2, 'a'), (4, 'b'), (4, 'c')]+-- Just 'b'+--+-- >>> lookupOf each 2 [(2, 'a'), (4, 'b'), (4, 'c')]+-- Just 'a'+--+-- @+-- 'lookupOf' :: 'Eq' k => 'Fold' s (k,v) -> k -> s -> 'Maybe' v+-- @+lookupOf :: Eq k => Getting (Endo (Maybe v)) s (k,v) -> k -> s -> Maybe v+lookupOf l k = foldrOf l (\(k',v) next -> if k == k' then Just v else next) Nothing+{-# INLINE lookupOf #-} -- | A variant of 'foldrOf' that has no base case and thus may only be applied -- to lenses and structures such that the 'Lens' views at least one element of
src/Control/Lens/Getter.hs view
@@ -19,7 +19,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Getter--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Indexed.hs view
@@ -22,7 +22,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Indexed--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Internal.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/Bazaar.hs view
@@ -14,7 +14,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Bazaar--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/ByteString.hs view
@@ -18,7 +18,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Strict.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/Coerce.hs view
@@ -14,7 +14,7 @@ #endif ----------------------------------------------------------------------------- -- |--- Copyright : (C) 2015 Edward Kmett and Eric Mertens+-- Copyright : (C) 2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/Context.hs view
@@ -15,7 +15,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Context--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/Deque.hs view
@@ -10,7 +10,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Deque--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -141,7 +141,7 @@ {-# INLINE (>>-) #-} instance Monad Deque where- return a = BD 1 [a] 0 []+ return = pure {-# INLINE return #-} ma >>= k = fromList (toList ma >>= toList . k) {-# INLINE (>>=) #-}
src/Control/Lens/Internal/Exception.hs view
@@ -19,7 +19,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Exception--- Copyright : (C) 2013-2015 Edward Kmett+-- Copyright : (C) 2013-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/FieldTH.hs view
@@ -4,10 +4,13 @@ {-# LANGUAGE Trustworthy #-} #endif +#ifndef MIN_VERSION_template_haskell+#define MIN_VERSION_template_haskell(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.FieldTH--- Copyright : (C) 2014-2015 Edward Kmett, (C) 2014 Eric Mertens+-- Copyright : (C) 2014-2016 Edward Kmett, (C) 2014 Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -65,6 +68,16 @@ makeFieldOpticsForDec :: LensRules -> Dec -> DecsQ makeFieldOpticsForDec rules dec = case dec of+#if MIN_VERSION_template_haskell(2,11,0)+ DataD _ tyName vars _ cons _ ->+ makeFieldOpticsForDec' rules tyName (mkS tyName vars) cons+ NewtypeD _ tyName vars _ con _ ->+ makeFieldOpticsForDec' rules tyName (mkS tyName vars) [con]+ DataInstD _ tyName args _ cons _ ->+ makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) cons+ NewtypeInstD _ tyName args _ con _ ->+ makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) [con]+#else DataD _ tyName vars cons _ -> makeFieldOpticsForDec' rules tyName (mkS tyName vars) cons NewtypeD _ tyName vars con _ ->@@ -73,6 +86,7 @@ makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) cons NewtypeInstD _ tyName args con _ -> makeFieldOpticsForDec' rules tyName (tyName `conAppsT` args) [con]+#endif _ -> fail "makeFieldOptics: Expected data or newtype type-constructor" where mkS tyName vars = tyName `conAppsT` map VarT (toListOf typeVars vars)@@ -108,6 +122,8 @@ -- | Normalized the Con type into a uniform positional representation, -- eliminating the variance between records, infix constructors, and normal -- constructors.+--+-- For 'GadtC' and 'RecGadtC', the leftmost name is chosen. normalizeConstructor :: Con -> Q (Name, [(Maybe Name, Type)]) -- ^ constructor name, field name, field type@@ -125,7 +141,13 @@ do con' <- normalizeConstructor con return (set (_2 . mapped . _1) Nothing con') +#if MIN_VERSION_template_haskell(2,11,0)+normalizeConstructor (GadtC ns xs _) =+ return (head ns, [ (Nothing, ty) | (_,ty) <- xs]) +normalizeConstructor (RecGadtC ns xs _) =+ return (head ns, [ (Just fieldName, ty) | (fieldName,_,ty) <- xs])+#endif data OpticType = GetterType | LensType | IsoType @@ -397,7 +419,7 @@ -- constructor. makePureClause :: Name -> Int -> ClauseQ makePureClause conName fieldCount =- do xs <- replicateM fieldCount (newName "x")+ do xs <- newNames "x" fieldCount -- clause: _ (Con x1..xn) = pure (Con x1..xn) clause [wildP, conP conName (map varP xs)] (normalB (appE (varE pureValName) (appsE (conE conName : map varE xs))))@@ -410,7 +432,7 @@ makeGetterClause conName fieldCount [] = makePureClause conName fieldCount makeGetterClause conName fieldCount fields = do f <- newName "f"- xs <- replicateM (length fields) (newName "x")+ xs <- newNames "x" (length fields) let pats (i:is) (y:ys) | i `elem` fields = varP y : pats is ys@@ -435,8 +457,8 @@ makePureClause conName fieldCount makeFieldOpticClause conName fieldCount (field:fields) irref = do f <- newName "f"- xs <- replicateM fieldCount (newName "x")- ys <- replicateM (1 + length fields) (newName "y")+ xs <- newNames "x" fieldCount+ ys <- newNames "y" (1 + length fields) let xs' = foldr (\(i,x) -> set (ix i) x) xs (zip (field:fields) ys) @@ -541,7 +563,7 @@ -- Field generation parameters ------------------------------------------------------------------------ -+-- | Rules to construct lenses for data fields. data LensRules = LensRules { _simpleLenses :: Bool , _generateSigs :: Bool
src/Control/Lens/Internal/Fold.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Fold--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/Getter.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Getter--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Internal/Indexed.hs view
@@ -17,7 +17,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Indexed--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -54,6 +54,7 @@ import Data.Functor.Bind import Data.Functor.Contravariant import Data.Int+import Data.Profunctor.Closed import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve@@ -74,7 +75,7 @@ class ( Choice p, Corepresentable p, Comonad (Corep p), Traversable (Corep p) , Strong p, Representable p, Monad (Rep p), MonadFix (Rep p), Distributive (Rep p)- , Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p+ , Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p ) => Conjoined p where -- | 'Conjoined' is strong enough to let us distribute every 'Conjoined'@@ -141,7 +142,7 @@ {-# INLINE (>>-) #-} instance Monad (Indexed i a) where- return b = Indexed $ \_ _ -> b+ return = pure {-# INLINE return #-} Indexed f >>= k = Indexed $ \i a -> runIndexed (k (f i a)) i a {-# INLINE (>>=) #-}@@ -163,6 +164,9 @@ ( #. ) _ = coerce' {-# INLINE ( #. ) #-} #endif++instance Closed (Indexed i) where+ closed (Indexed iab) = Indexed $ \i xa x -> iab i (xa x) instance Costrong (Indexed i) where unfirst (Indexed iadbd) = Indexed $ \i a -> let
src/Control/Lens/Internal/Instances.hs view
@@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Instances--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/Iso.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Iso--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -24,6 +24,7 @@ #endif import Data.ByteString as StrictB import Data.ByteString.Lazy as LazyB+import Data.List.NonEmpty as NonEmpty import Data.Text as StrictT import Data.Text.Lazy as LazyT import Data.Vector as Vector@@ -68,6 +69,9 @@ instance Reversing [a] where reversing = Prelude.reverse++instance Reversing (NonEmpty.NonEmpty a) where+ reversing = NonEmpty.reverse instance Reversing StrictB.ByteString where reversing = StrictB.reverse
src/Control/Lens/Internal/Level.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Level--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/List.hs view
@@ -1,7 +1,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.List--- Copyright : (C) 2014-2015 Edward Kmett and Eric Mertens+-- Copyright : (C) 2014-2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Internal/Magma.hs view
@@ -13,7 +13,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Magma--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/Prism.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Prism--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Internal/PrismTH.hs view
@@ -3,10 +3,13 @@ {-# LANGUAGE Trustworthy #-} #endif +#ifndef MIN_VERSION_template_haskell+#define MIN_VERSION_template_haskell(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.PrismTH--- Copyright : (C) 2014-2015 Edward Kmett and Eric Mertens+-- Copyright : (C) 2014-2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -94,7 +97,7 @@ -- -- instance AsFooBarBaz (FooBarBaz a) a -- @--- +-- -- Generate an "As" class of prisms. Names are selected by prefixing the constructor -- name with an underscore. Constructors with multiple fields will -- construct Prisms to tuples of those fields.@@ -114,10 +117,17 @@ -- | Generate prisms for the given 'Dec' makeDecPrisms :: Bool {- ^ generate top-level definitions -} -> Dec -> DecsQ makeDecPrisms normal dec = case dec of- DataD _ ty vars cons _ -> next ty (convertTVBs vars) cons- NewtypeD _ ty vars con _ -> next ty (convertTVBs vars) [con]- DataInstD _ ty tys cons _ -> next ty tys cons- NewtypeInstD _ ty tys con _ -> next ty tys [con]+#if MIN_VERSION_template_haskell(2,11,0)+ DataD _ ty vars _ cons _ -> next ty (convertTVBs vars) cons+ NewtypeD _ ty vars _ con _ -> next ty (convertTVBs vars) [con]+ DataInstD _ ty tys _ cons _ -> next ty tys cons+ NewtypeInstD _ ty tys _ con _ -> next ty tys [con]+#else+ DataD _ ty vars cons _ -> next ty (convertTVBs vars) cons+ NewtypeD _ ty vars con _ -> next ty (convertTVBs vars) [con]+ DataInstD _ ty tys cons _ -> next ty tys cons+ NewtypeInstD _ ty tys con _ -> next ty tys [con]+#endif _ -> fail "makePrisms: expected type constructor dec" where convertTVBs = map (VarT . bndrName)@@ -321,7 +331,7 @@ makeSimpleRemitter :: Name -> Int -> ExpQ makeSimpleRemitter conName fields = do x <- newName "x"- xs <- replicateM fields (newName "y")+ xs <- newNames "y" fields let matches = [ match (conP conName (map varP xs)) (normalB (appE (conE rightDataName) (toTupleE (map varE xs))))@@ -343,7 +353,7 @@ lam1E (varP x) (caseE (varE x) (map mkMatch cons)) where mkMatch (NCon conName _ n) =- do xs <- replicateM (length n) (newName "y")+ do xs <- newNames "y" (length n) match (conP conName (map varP xs)) (normalB (if conName == target@@ -357,7 +367,7 @@ -- (\(Con x y z) -> (x,y,z)) :: s -> a makeIsoRemitter :: Name -> Int -> ExpQ makeIsoRemitter conName fields =- do xs <- replicateM fields (newName "x")+ do xs <- newNames "x" fields lam1E (conP conName (map varP xs)) (toTupleE (map varE xs)) @@ -463,7 +473,8 @@ nconTypes f x = fmap (\y -> x {_nconTypes = y}) (f (_nconTypes x)) --- | Normalize 'Con' to its constructor name and field types.+-- | Normalize 'Con' to its constructor name and field types. For 'GadtC' and+-- 'RecGadtC', it takes the leftmost name. normalizeCon :: Con -> NCon normalizeCon (RecC conName xs) = NCon conName Nothing (map (view _3) xs) normalizeCon (NormalC conName xs) = NCon conName Nothing (map (view _2) xs)@@ -473,7 +484,10 @@ where cx1 = Just cx NCon n cx2 tys = normalizeCon con-+#if MIN_VERSION_template_haskell(2,11,0)+normalizeCon (GadtC conNames xs _) = NCon (head conNames) Nothing (map (view _2) xs)+normalizeCon (RecGadtC conNames xs _) = NCon (head conNames) Nothing (map (view _3) xs)+#endif -- | Compute a prism's name by prefixing an underscore for normal -- constructors and period for operators.
src/Control/Lens/Internal/Review.hs view
@@ -6,7 +6,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Review--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Internal/Setter.hs view
@@ -11,7 +11,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Setter--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Internal/TH.hs view
@@ -21,7 +21,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.TH--- Copyright : (C) 2013-2015 Edward Kmett and Eric Mertens+-- Copyright : (C) 2013-2016 Edward Kmett and Eric Mertens -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -87,6 +87,10 @@ #else fromSet f x = Map.fromDistinctAscList [ (k,f k) | k <- Set.toAscList x ] #endif++-- | Generate many new names from a given base name.+newNames :: String {- ^ base name -} -> Int {- ^ count -} -> Q [Name]+newNames base n = sequence [ newName (base++show i) | i <- [1..n] ] ------------------------------------------------------------------------ -- Manually quoted names
src/Control/Lens/Internal/Zoom.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Zoom--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Iso.hs view
@@ -23,7 +23,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Iso--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional@@ -85,6 +85,8 @@ , rmapping -- * Bifunctors , bimapping+ , firsting+ , seconding #if __GLASGOW_HASKELL__ >= 710 -- * Coercions , coerced@@ -108,6 +110,7 @@ import Control.Monad.Writer.Strict as Strict import Control.Monad.RWS.Lazy as Lazy import Control.Monad.RWS.Strict as Strict+import Data.Bifunctor import Data.ByteString as StrictB hiding (reverse) import Data.ByteString.Lazy as LazyB hiding (reverse) @@ -228,7 +231,7 @@ -- @ -- -- but the signature is general.-auf :: (Functor f, Functor g) => Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t+auf :: Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t auf = coerce {-# INLINE auf #-} @@ -574,6 +577,28 @@ bimapping f g = withIso f $ \ sa bt -> withIso g $ \s'a' b't' -> iso (bimap sa s'a') (bimap bt b't') {-# INLINE bimapping #-}++-- | Lift an 'Iso' into the first argument of a 'Bifunctor'.+--+-- @+-- firsting :: 'Bifunctor' p => 'Iso' s t a b -> 'Iso' (p s x) (p t y) (p a x) (p b y)+-- firsting :: 'Bifunctor' p => 'Iso'' s a -> 'Iso'' (p s x) (p a x)+-- @+firsting :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f s x) (g t y) (f a x) (g b y)+firsting p = withIso p $ \ sa bt -> iso (first sa) (first bt)+{-# INLINE firsting #-}++-- | Lift an 'Iso' into the second argument of a 'Bifunctor'. This is+-- essentially the same as 'mapping', but it takes a 'Bifunctor p'+-- constraint instead of a 'Functor (p a)' one.+--+-- @+-- seconding :: 'Bifunctor' p => 'Iso' s t a b -> 'Iso' (p x s) (p y t) (p x a) (p y b)+-- seconding :: 'Bifunctor' p => 'Iso'' s a -> 'Iso'' (p x s) (p x a)+-- @+seconding :: (Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b)+seconding p = withIso p $ \ sa bt -> iso (second sa) (second bt)+{-# INLINE seconding #-} #if __GLASGOW_HASKELL__ >= 710 -- | Data types that are representationally equal are isomorphic.
src/Control/Lens/Lens.hs view
@@ -20,7 +20,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Level.hs view
@@ -12,7 +12,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Level--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Operators.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Operators--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Control/Lens/Plated.hs view
@@ -27,7 +27,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Plated--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Prism.hs view
@@ -12,7 +12,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Prism--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Reified.hs view
@@ -5,7 +5,7 @@ ------------------------------------------------------------------------------ -- | -- Module : Control.Lens.Reified--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional@@ -33,6 +33,7 @@ import Data.Functor.Extend import Data.Functor.Identity import Data.Functor.Plus+import Data.Profunctor.Closed import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve@@ -150,7 +151,7 @@ {-# INLINE (>>-) #-} instance Monad (ReifiedGetter s) where- return a = Getter $ to $ \_ -> a+ return = pure {-# INLINE return #-} Getter ma >>= f = Getter $ to $ \s -> view (runGetter (f (view ma s))) s {-# INLINE (>>=) #-}@@ -169,6 +170,9 @@ rmap f l = Getter $ runGetter l.to f {-# INLINE rmap #-} +instance Closed ReifiedGetter where+ closed l = Getter $ to $ \f -> view (runGetter l) . f+ instance Cosieve ReifiedGetter Identity where cosieve (Getter l) = view l . runIdentity @@ -276,6 +280,7 @@ (j, a) -> phantom $ indexed k (i <> j) (f a) {-# INLINE (<.>) #-} + ------------------------------------------------------------------------------ -- Fold ------------------------------------------------------------------------------@@ -383,7 +388,7 @@ {-# INLINE (>>-) #-} instance Monad (ReifiedFold s) where- return a = Fold $ folding $ \_ -> [a]+ return = pure {-# INLINE return #-} Fold ma >>= f = Fold $ folding $ \s -> toListOf ma s >>= \a -> toListOf (runFold (f a)) s {-# INLINE (>>=) #-}@@ -471,6 +476,7 @@ second' l = IndexedFold $ \f (c,s) -> phantom $ runIndexedFold l (dimap ((,) c) phantom f) s {-# INLINE second' #-}+ ------------------------------------------------------------------------------ -- Setter
src/Control/Lens/Review.hs view
@@ -11,7 +11,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Review--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Setter.hs view
@@ -14,7 +14,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Setter--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/TH.hs view
@@ -14,7 +14,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.TH--- Copyright : (C) 2012-15 Edward Kmett, 2012-13 Michael Sloan+-- Copyright : (C) 2012-16 Edward Kmett, 2012-13 Michael Sloan -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -24,38 +24,57 @@ module Control.Lens.TH ( -- * Constructing Lenses Automatically+ -- ** Lenses for data fields makeLenses, makeLensesFor , makeClassy, makeClassyFor, makeClassy_+ , makeFields+ -- ** Prisms , makePrisms , makeClassyPrisms+ -- ** Wrapped , makeWrapped- , makeFields -- * Constructing Lenses Given a Declaration Quote+ -- ** Lenses for data fields , declareLenses, declareLensesFor , declareClassy, declareClassyFor+ , declareFields+ -- ** Prisms , declarePrisms+ -- ** Wrapped , declareWrapped- , declareFields -- * Configuring Lenses+ -- ** Running LensRules , makeLensesWith , declareLensesWith- , defaultFieldRules- , camelCaseFields- , underscoreFields- , abbreviatedFields+ -- ** LensRules type , LensRules- , DefName(..)+ -- ** Predefined LensRules , lensRules , lensRulesFor , classyRules , classyRules_+ , defaultFieldRules+ , camelCaseFields+ , underscoreFields+ , abbreviatedFields+ -- ** LensRules configuration accessors , lensField+ , FieldNamer+ , DefName(..) , lensClass+ , ClassyNamer , simpleLenses , createClass , generateSignatures , generateUpdateableOptics , generateLazyPatterns+ -- ** FieldNamers+ , underscoreNoPrefixNamer+ , lookingupNamer+ , mappingNamer+ , camelCaseNamer+ , underscoreNamer+ , abbreviatedNamer ) where #if !MIN_VERSION_base(4,8,0)@@ -75,6 +94,8 @@ import Control.Lens.Internal.TH import Control.Lens.Internal.FieldTH import Control.Lens.Internal.PrismTH+import Control.Lens.Wrapped () -- haddocks+import Control.Lens.Type () -- haddocks import Data.Char (toLower, isUpper) import Data.Foldable hiding (concat, any) import Data.List as List@@ -86,6 +107,7 @@ import Data.Traversable hiding (mapM) import Language.Haskell.TH import Language.Haskell.TH.Lens+import Language.Haskell.TH.Syntax #ifdef HLINT {-# ANN module "HLint: ignore Eta reduce" #-}@@ -129,7 +151,7 @@ -- > undefined & x .~ 8 & y .~ True -- Foo {_x = 8, _y = True} -- @--- +-- -- The downside of this flag is that it can lead to space-leaks and -- code-size/compile-time increases when generated for large records. By -- default this flag is turned off, and strict optics are generated.@@ -151,30 +173,31 @@ fmap (\x -> r { _generateClasses = x}) (f (_generateClasses r)) -- | 'Lens'' to access the convention for naming fields in our 'LensRules'.------ Defaults to stripping the _ off of the field name, lowercasing the name, and--- skipping the field if it doesn't start with an '_'. The field naming rule--- provides the names of all fields in the type as well as the current field.--- This extra generality enables field naming conventions that depend on the--- full set of names in a type.------ The field naming rule has access to the type name, the names of all the field--- of that type (including the field being named), and the name of the field--- being named.------ TypeName -> FieldNames -> FieldName -> DefinitionNames-lensField :: Lens' LensRules (Name -> [Name] -> Name -> [DefName])+lensField :: Lens' LensRules FieldNamer lensField f r = fmap (\x -> r { _fieldToDef = x}) (f (_fieldToDef r)) --- | Retrieve options such as the name of the class and method to put in it to--- build a class around monomorphic data types. "Classy" lenses are generated--- when this naming convention is provided.--- TypeName -> Maybe (ClassName, MainMethodName)-lensClass :: Lens' LensRules (Name -> Maybe (Name, Name))+-- | The rule to create function names of lenses for data fields.+--+-- Although it's sometimes useful, you won't need the first two+-- arguments most of the time.+type FieldNamer = Name -- ^ Name of the data type that lenses are being generated for.+ -> [Name] -- ^ Names of all fields (including the field being named) in the data type.+ -> Name -- ^ Name of the field being named.+ -> [DefName] -- ^ Name(s) of the lens functions. If empty, no lens is created for that field.++-- | 'Lens'' to access the option for naming "classy" lenses.+lensClass :: Lens' LensRules ClassyNamer lensClass f r = fmap (\x -> r { _classyLenses = x }) (f (_classyLenses r)) +-- | The optional rule to create a class and method around a+-- monomorphic data type. If this naming convention is provided, it+-- generates a "classy" lens.+type ClassyNamer = Name -- ^ Name of the data type that lenses are being generated for.+ -> Maybe (Name, Name) -- ^ Names of the class and the main method it generates, respectively.+ -- | Rules for making fairly simple partial lenses, ignoring the special cases -- for isomorphisms and traversals, and not making any classes.+-- It uses 'underscoreNoPrefixNamer'. lensRules :: LensRules lensRules = LensRules { _simpleLenses = False@@ -184,23 +207,37 @@ , _allowUpdates = True , _lazyPatterns = False , _classyLenses = const Nothing- , _fieldToDef = \_ _ n ->- case nameBase n of- '_':x:xs -> [TopName (mkName (toLower x:xs))]- _ -> []+ , _fieldToDef = underscoreNoPrefixNamer } +-- | A 'FieldNamer' that strips the _ off of the field name,+-- lowercases the name, and skips the field if it doesn't start with+-- an '_'.+underscoreNoPrefixNamer :: FieldNamer+underscoreNoPrefixNamer _ _ n =+ case nameBase n of+ '_':x:xs -> [TopName (mkName (toLower x:xs))]+ _ -> []++ -- | Construct a 'LensRules' value for generating top-level definitions -- using the given map from field names to definition names. lensRulesFor :: [(String, String)] {- ^ [(Field Name, Definition Name)] -} -> LensRules-lensRulesFor fields = lensRules & lensField .~ mkNameLookup fields+lensRulesFor fields = lensRules & lensField .~ lookingupNamer fields -mkNameLookup :: [(String,String)] -> Name -> [Name] -> Name -> [DefName]-mkNameLookup kvs _ _ field =+-- | Create a 'FieldNamer' from explicit pairings of @(fieldName, lensName)@.+lookingupNamer :: [(String,String)] -> FieldNamer+lookingupNamer kvs _ _ field = [ TopName (mkName v) | (k,v) <- kvs, k == nameBase field] +-- | Create a 'FieldNamer' from a mapping function. If the function+-- returns @[]@, it creates no lens for the field.+mappingNamer :: (String -> [String]) -- ^ A function that maps a @fieldName@ to @lensName@s.+ -> FieldNamer+mappingNamer mapper _ _ = fmap (TopName . mkName) . mapper . nameBase+ -- | Rules for making lenses and traversals that precompose another 'Lens'. classyRules :: LensRules classyRules = LensRules@@ -214,10 +251,7 @@ case nameBase n of x:xs -> Just (mkName ("Has" ++ x:xs), mkName (toLower x:xs)) [] -> Nothing- , _fieldToDef = \_ _ n ->- case nameBase n of- '_':x:xs -> [TopName (mkName (toLower x:xs))]- _ -> []+ , _fieldToDef = underscoreNoPrefixNamer } -- | Rules for making lenses and traversals that precompose another 'Lens'@@ -229,8 +263,9 @@ LensRules classyRulesFor classFun fields = classyRules & lensClass .~ (over (mapped . both) mkName . classFun . nameBase)- & lensField .~ mkNameLookup fields+ & lensField .~ lookingupNamer fields +-- | A 'LensRules' used by 'makeClassy_'. classyRules_ :: LensRules classyRules_ = classyRules & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))]@@ -400,7 +435,7 @@ $ classyRulesFor (`Prelude.lookup`classes) fields & lensField .~ \_ _ n -> [TopName n] --- | Generate a 'Prism' for each constructor of each data type.+-- | Generate a 'Control.Lens.Type.Prism' for each constructor of each data type. -- -- /e.g./ --@@ -423,7 +458,7 @@ emit =<< Trans.lift (makeDecPrisms True dec) return dec --- | Build 'Wrapped' instance for each newtype.+-- | Build 'Control.Lens.Wrapped.Wrapped' instance for each newtype. declareWrapped :: DecsQ -> DecsQ declareWrapped = declareWith $ \dec -> do maybeDecs <- Trans.lift (makeWrappedForDec dec)@@ -449,8 +484,13 @@ -- | Transform @NewtypeD@s declarations to @DataD@s and @NewtypeInstD@s to -- @DataInstD@s. deNewtype :: Dec -> Dec+#if MIN_VERSION_template_haskell(2,11,0)+deNewtype (NewtypeD ctx tyName args kind c d) = DataD ctx tyName args kind [c] d+deNewtype (NewtypeInstD ctx tyName args kind c d) = DataInstD ctx tyName args kind [c] d+#else deNewtype (NewtypeD ctx tyName args c d) = DataD ctx tyName args [c] d deNewtype (NewtypeInstD ctx tyName args c d) = DataInstD ctx tyName args [c] d+#endif deNewtype d = d @@ -466,14 +506,22 @@ makeDataDecl :: Dec -> Maybe DataDecl makeDataDecl dec = case deNewtype dec of- DataD ctx tyName args cons _ -> Just DataDecl+ DataD ctx tyName args+#if MIN_VERSION_template_haskell(2,11,0)+ _+#endif+ cons _ -> Just DataDecl { dataContext = ctx , tyConName = Just tyName , dataParameters = args , fullType = apps $ ConT tyName , constructors = cons }- DataInstD ctx familyName args cons _ -> Just DataDecl+ DataInstD ctx familyName args+#if MIN_VERSION_template_haskell(2,11,0)+ _+#endif+ cons _ -> Just DataDecl { dataContext = ctx , tyConName = Nothing , dataParameters = map PlainTV vars@@ -597,7 +645,8 @@ underscoreFields :: LensRules underscoreFields = defaultFieldRules & lensField .~ underscoreNamer -underscoreNamer :: Name -> [Name] -> Name -> [DefName]+-- | A 'FieldNamer' for 'underscoreFields'.+underscoreNamer :: FieldNamer underscoreNamer _ _ field = maybeToList $ do _ <- prefix field' method <- niceLens@@ -620,7 +669,8 @@ camelCaseFields :: LensRules camelCaseFields = defaultFieldRules -camelCaseNamer :: Name -> [Name] -> Name -> [DefName]+-- | A 'FieldNamer' for 'camelCaseFields'.+camelCaseNamer :: FieldNamer camelCaseNamer tyName fields field = maybeToList $ do fieldPart <- stripPrefix expectedPrefix (nameBase field)@@ -648,7 +698,8 @@ abbreviatedFields :: LensRules abbreviatedFields = defaultFieldRules { _fieldToDef = abbreviatedNamer } -abbreviatedNamer :: Name -> [Name] -> Name -> [DefName]+-- | A 'FieldNamer' for 'abbreviatedFields'.+abbreviatedNamer :: FieldNamer abbreviatedNamer _ fields field = maybeToList $ do fieldPart <- stripMaxLc (nameBase field)@@ -752,6 +803,16 @@ stripFields :: Dec -> Dec stripFields dec = case dec of+#if MIN_VERSION_template_haskell(2,11,0)+ DataD ctx tyName tyArgs kind cons derivings ->+ DataD ctx tyName tyArgs kind (map deRecord cons) derivings+ NewtypeD ctx tyName tyArgs kind con derivings ->+ NewtypeD ctx tyName tyArgs kind (deRecord con) derivings+ DataInstD ctx tyName tyArgs kind cons derivings ->+ DataInstD ctx tyName tyArgs kind (map deRecord cons) derivings+ NewtypeInstD ctx tyName tyArgs kind con derivings ->+ NewtypeInstD ctx tyName tyArgs kind (deRecord con) derivings+#else DataD ctx tyName tyArgs cons derivings -> DataD ctx tyName tyArgs (map deRecord cons) derivings NewtypeD ctx tyName tyArgs con derivings ->@@ -760,6 +821,7 @@ DataInstD ctx tyName tyArgs (map deRecord cons) derivings NewtypeInstD ctx tyName tyArgs con derivings -> NewtypeInstD ctx tyName tyArgs (deRecord con) derivings+#endif _ -> dec deRecord :: Con -> Con@@ -767,4 +829,14 @@ deRecord con@InfixC{} = con deRecord (ForallC tyVars ctx con) = ForallC tyVars ctx $ deRecord con deRecord (RecC conName fields) = NormalC conName (map dropFieldName fields)- where dropFieldName (_, str, typ) = (str, typ)+#if MIN_VERSION_template_haskell(2,11,0)+deRecord con@GadtC{} = con+deRecord (RecGadtC ns fields retTy) = GadtC ns (map dropFieldName fields) retTy+#endif++#if MIN_VERSION_template_haskell(2,11,0)+dropFieldName :: VarBangType -> BangType+#else+dropFieldName :: VarStrictType -> StrictType+#endif+dropFieldName (_, str, typ) = (str, typ)
src/Control/Lens/Traversal.hs view
@@ -14,7 +14,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Traversal--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional@@ -34,12 +34,12 @@ -- type 'Traversal' s t a b = forall f. 'Applicative' f => (a -> f b) -> s -> f t -- @ ----- While a 'Traversal' isn't quite a 'Fold', it _can_ be used for--- 'Control.Lens.Getter.Getting' like a 'Fold', because given a--- 'Data.Monoid.Monoid' @m@, we have an 'Applicative'--- for @('Const' m)@. Everything you know how to do with a 'Traversable'--- container, you can with with a 'Traversal', and here we provide--- combinators that generalize the usual 'Traversable' operations.+-- A 'Traversal' can be used as a 'Fold'.+-- Any 'Traversal' can be used for 'Control.Lens.Getter.Getting' like a 'Fold',+-- because given a 'Data.Monoid.Monoid' @m@, we have an 'Applicative' for+-- @('Const' m)@. Everything you know how to do with a 'Traversable' container,+-- you can with a 'Traversal', and here we provide combinators that generalize+-- the usual 'Traversable' operations. ---------------------------------------------------------------------------- module Control.Lens.Traversal (@@ -148,7 +148,7 @@ import Data.Foldable (Foldable) #endif import Data.Functor.Compose-import Data.Functor.Kan.Rift+import Data.Functor.Day.Curried import Data.Functor.Yoneda import Data.Int import Data.IntMap as IntMap@@ -1276,7 +1276,7 @@ -- However, @foo@ and @bar@ are each going to use the 'Applicative' they are given. -- -- 'confusing' exploits the 'Yoneda' lemma to merge their separate uses of 'fmap' into a single 'fmap'.--- and it further exploits an interesting property of the right Kan lift (or 'Rift') to left associate+-- and it further exploits an interesting property of the right Kan lift (or 'Curried') to left associate -- all of the uses of '(<*>)' to make it possible to fuse together more fmaps. -- -- This is particularly effective when the choice of functor 'f' is unknown at compile@@ -1288,12 +1288,12 @@ -- @ -- 'confusing' :: 'Traversal' s t a b -> 'Traversal' s t a b -- @-confusing :: Applicative f => LensLike (Rift (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b-confusing t = \f -> lowerYoneda . lowerRift . t (liftRiftYoneda . f)+confusing :: Applicative f => LensLike (Curried (Yoneda f) (Yoneda f)) s t a b -> LensLike f s t a b+confusing t = \f -> lowerYoneda . lowerCurried . t (liftCurriedYoneda . f) where- liftRiftYoneda :: Applicative f => f a -> Rift (Yoneda f) (Yoneda f) a- liftRiftYoneda fa = Rift (`yap` fa)- {-# INLINE liftRiftYoneda #-}+ liftCurriedYoneda :: Applicative f => f a -> Curried (Yoneda f) (Yoneda f) a+ liftCurriedYoneda fa = Curried (`yap` fa)+ {-# INLINE liftCurriedYoneda #-} yap :: Applicative f => Yoneda f (a -> b) -> f a -> Yoneda f b yap (Yoneda k) fa = Yoneda (\ab_r -> k (ab_r .) <*> fa)
src/Control/Lens/Tuple.hs view
@@ -19,7 +19,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Tuple--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Lens/Type.hs view
@@ -9,10 +9,13 @@ #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TypeInType #-}+#endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Type--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional@@ -66,6 +69,9 @@ import Data.Functor.Identity import Data.Functor.Contravariant import Data.Functor.Apply+#if __GLASGOW_HASKELL__ >= 800+import Data.Kind+#endif import Data.Profunctor import Data.Tagged import Prelude ()@@ -443,7 +449,14 @@ -- | A witness that @(a ~ s, b ~ t)@. -- -- Note: Composition with an 'Equality' is index-preserving.-type Equality s t a b = forall p (f :: * -> *). p a (f b) -> p s (f t)+#if __GLASGOW_HASKELL__ >= 800+type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> *) (f :: k2 -> k3) .+#elif __GLASGOW_HASKELL__ >= 706+type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall (p :: k1 -> * -> *) (f :: k2 -> *) .+#else+type Equality s t a b = forall p (f :: * -> *) .+#endif+ p a (f b) -> p s (f t) -- | A 'Simple' 'Equality'. type Equality' s a = Equality s s a a
src/Control/Lens/Wrapped.hs view
@@ -29,7 +29,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Wrapped--- Copyright : (C) 2012-15 Edward Kmett, Michael Sloan+-- Copyright : (C) 2012-16 Edward Kmett, Michael Sloan -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -105,7 +105,6 @@ import Data.Functor.Contravariant import qualified Data.Functor.Contravariant.Compose as Contravariant import Data.Functor.Constant-import Data.Functor.Coproduct import Data.Functor.Identity import Data.Functor.Reverse import Data.Hashable@@ -277,7 +276,7 @@ {-# INLINE _Wrapped' #-} #endif -instance (t ~ ArrowMonad m' a', ArrowApply m) => Rewrapped (ArrowMonad m a) t+instance t ~ ArrowMonad m' a' => Rewrapped (ArrowMonad m a) t instance Wrapped (ArrowMonad m a) where type Unwrapped (ArrowMonad m a) = m () a _Wrapped' = iso getArrowMonad ArrowMonad@@ -390,12 +389,6 @@ -- * comonad-transformers -instance (t ~ Coproduct f' g' a') => Rewrapped (Coproduct f g a) t-instance Wrapped (Coproduct f g a) where- type Unwrapped (Coproduct f g a) = Either (f a) (g a)- _Wrapped' = iso getCoproduct Coproduct- {-# INLINE _Wrapped' #-}- instance (t ~ TracedT m' w' a') => Rewrapped (TracedT m w a) t instance Wrapped (TracedT m w a) where type Unwrapped (TracedT m w a) = w (m -> a)@@ -615,7 +608,11 @@ {-# INLINE _Wrapped' #-} getErrorCall :: ErrorCall -> String+#if __GLASGOW_HASKELL__ < 800 getErrorCall (ErrorCall x) = x+#else+getErrorCall (ErrorCallWithLocation x _) = x+#endif {-# INLINE getErrorCall #-} getRecUpdError :: RecUpdError -> String
src/Control/Lens/Zoom.hs view
@@ -21,7 +21,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Zoom--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Monad/Error/Lens.hs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Error.Lens--- Copyright : (C) 2014-2015 Edward Kmett+-- Copyright : (C) 2014-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Parallel/Strategies/Lens.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Parallel.Strategies.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Control/Seq/Lens.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Control.Seq.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/Array/Lens.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Array.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/Bits/Lens.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Bits.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/ByteString/Lazy/Lens.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Lazy.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/ByteString/Lens.hs view
@@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/ByteString/Strict/Lens.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Strict.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Complex/Lens.hs view
@@ -12,7 +12,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Complex.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Data/Lens.hs view
@@ -17,7 +17,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Data.Lens--- Copyright : (C) 2012-2015 Edward Kmett, (C) 2006-2012 Neil Mitchell+-- Copyright : (C) 2012-2016 Edward Kmett, (C) 2006-2012 Neil Mitchell -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Dynamic/Lens.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Dynamic.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/HashSet/Lens.hs view
@@ -6,7 +6,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.HashSet.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/IntSet/Lens.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.IntSet.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/List/Lens.hs view
@@ -9,7 +9,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.List.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/Map/Lens.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Copyright : (C) 2014-2015 Edward Kmett+-- Copyright : (C) 2014-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Sequence/Lens.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Sequence.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Set/Lens.hs view
@@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Set.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/Text/Lazy/Lens.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Lazy.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Text/Lens.hs view
@@ -10,7 +10,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Text/Strict/Lens.hs view
@@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Strict.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Tree/Lens.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Tree.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/Typeable/Lens.hs view
@@ -8,7 +8,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Typeable.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Data/Vector/Generic/Lens.hs view
@@ -11,7 +11,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Data.Vector.Generic.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/Data/Vector/Lens.hs view
@@ -8,7 +8,7 @@ ------------------------------------------------------------------------------- -- | -- Module : Data.Vector.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/GHC/Generics/Lens.hs view
@@ -6,7 +6,7 @@ ----------------------------------------------------------------------------- -- | -- Module : GHC.Generics.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Generics/Deriving/Lens.hs view
@@ -15,7 +15,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Generics.Deriving.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/Language/Haskell/TH/Lens.hs view
@@ -10,7 +10,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.TH.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental@@ -61,6 +61,19 @@ , tySynEqnPatterns , tySynEqnResult #endif+#if MIN_VERSION_template_haskell(2,11,0)+ -- ** InjectivityAnn Lenses+ , injectivityAnnOutput+ , injectivityAnnInputs+ -- ** TypeFamilyHead Lenses+ , typeFamilyHeadName+ , typeFamilyHeadTyVarBndrs+ , typeFamilyHeadResultSig+ , typeFamilyHeadInjectivityAnn+ -- ** Bang Prisms+ , bangSourceUnpackedness+ , bangSourceStrictness+#endif -- * Prisms -- ** Info Prisms , _ClassI@@ -85,7 +98,6 @@ , _InfixD #endif , _PragmaD- , _FamilyD , _DataInstD , _NewtypeInstD , _TySynInstD@@ -97,15 +109,40 @@ , _StandaloneDerivD , _DefaultSigD #endif+#if MIN_VERSION_template_haskell(2,11,0)+ , _DataFamilyD+ , _OpenTypeFamilyD+#else+ , _FamilyD+#endif -- ** Con Prisms , _NormalC , _RecC , _InfixC , _ForallC+#if MIN_VERSION_template_haskell(2,11,0)+ , _GadtC+ , _RecGadtC+#endif+#if MIN_VERSION_template_haskell(2,11,0)+ -- ** SourceUnpackedness Prisms+ , _NoSourceUnpackedness+ , _SourceNoUnpack+ , _SourceUnpack+ -- ** SourceStrictness Prisms+ , _NoSourceStrictness+ , _SourceLazy+ , _SourceStrict+ -- ** DecidedStrictness Prisms+ , _DecidedLazy+ , _DecidedStrict+ , _DecidedUnpack+#else -- ** Strict Prisms , _IsStrict , _NotStrict , _Unpacked+#endif -- ** Foreign Prisms , _ImportF , _ExportF@@ -193,6 +230,9 @@ #if MIN_VERSION_template_haskell(2,10,0) , _StaticE #endif+#if MIN_VERSION_template_haskell(2,11,0)+ , _UnboundVarE+#endif -- ** Body Prisms , _GuardedB , _NormalB@@ -219,6 +259,9 @@ , _FloatPrimL , _DoublePrimL , _StringPrimL+#if MIN_VERSION_template_haskell(2,11,0)+ , _CharPrimL+#endif -- ** Pat Prisms , _LitP , _VarP@@ -260,9 +303,21 @@ , _ConstraintT , _LitT #endif+#if MIN_VERSION_template_haskell(2,11,0)+ , _InfixT+ , _UInfixT+ , _ParensT+ , _WildCardT+#endif -- ** TyVarBndr Prisms , _PlainTV , _KindedTV+#if MIN_VERSION_template_haskell(2,11,0)+ -- ** FamilyResultSig Prisms+ , _NoSig+ , _KindSig+ , _TyVarSig+#endif #if MIN_VERSION_template_haskell(2,8,0) -- ** TyLit Prisms , _NumTyLit@@ -316,12 +371,41 @@ instance HasName Name where name = id +-- | On @template-haskell-2.11.0.0@ or later, if a 'GadtC' or 'RecGadtC' has+-- multiple 'Name's, the leftmost 'Name' will be chosen. instance HasName Con where name f (NormalC n tys) = (`NormalC` tys) <$> f n name f (RecC n tys) = (`RecC` tys) <$> f n name f (InfixC l n r) = (\n' -> InfixC l n' r) <$> f n name f (ForallC bds ctx con) = ForallC bds ctx <$> name f con+#if MIN_VERSION_template_haskell(2,11,0)+ name f (GadtC ns argTys retTy) =+ (\n -> GadtC [n] argTys retTy) <$> f (head ns)+ name f (RecGadtC ns argTys retTy) =+ (\n -> RecGadtC [n] argTys retTy) <$> f (head ns)+#endif +instance HasName Foreign where+ name f (ImportF cc saf str n ty) =+ (\n' -> ImportF cc saf str n' ty) <$> f n+ name f (ExportF cc str n ty) =+ (\n' -> ExportF cc str n' ty) <$> f n++#if MIN_VERSION_template_haskell(2,8,0)+instance HasName RuleBndr where+ name f (RuleVar n) = RuleVar <$> f n+ name f (TypedRuleVar n ty) = (`TypedRuleVar` ty) <$> f n+#endif++#if MIN_VERSION_template_haskell(2,11,0)+instance HasName TypeFamilyHead where+ name f (TypeFamilyHead n tvbs frs mia) =+ (\n' -> TypeFamilyHead n' tvbs frs mia) <$> f n++instance HasName InjectivityAnn where+ name f (InjectivityAnn n deps) = (`InjectivityAnn` deps) <$> f n+#endif+ -- | Contains some amount of `Type`s inside class HasTypes t where -- | Traverse all the types@@ -336,7 +420,23 @@ types f (InfixC t1 n t2) = InfixC <$> _2 (types f) t1 <*> pure n <*> _2 (types f) t2 types f (ForallC vb ctx con) = ForallC vb ctx <$> types f con+#if MIN_VERSION_template_haskell(2,11,0)+ types f (GadtC ns argTys retTy) =+ GadtC ns <$> traverse (_2 (types f)) argTys <*> types f retTy+ types f (RecGadtC ns argTys retTy) =+ RecGadtC ns <$> traverse (_3 (types f)) argTys <*> types f retTy+#endif +instance HasTypes Foreign where+ types f (ImportF cc saf str n t) = ImportF cc saf str n <$> types f t+ types f (ExportF cc str n t) = ExportF cc str n <$> types f t++#if MIN_VERSION_template_haskell(2,9,0)+instance HasTypes TySynEqn where+ types f (TySynEqn lhss rhs) = TySynEqn <$> traverse (types f) lhss+ <*> types f rhs+#endif+ instance HasTypes t => HasTypes [t] where types = traverse . types @@ -363,6 +463,15 @@ typeVarsEx s f (SigT t k) = (`SigT` k) <$> typeVarsEx s f t typeVarsEx s f (ForallT bs ctx ty) = ForallT bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f ty where s' = s `Set.union` setOf typeVars bs+#if MIN_VERSION_template_haskell(2,11,0)+ typeVarsEx s f (InfixT t1 n t2) = InfixT <$> typeVarsEx s f t1+ <*> pure n+ <*> typeVarsEx s f t2+ typeVarsEx s f (UInfixT t1 n t2) = UInfixT <$> typeVarsEx s f t1+ <*> pure n+ <*> typeVarsEx s f t2+ typeVarsEx s f (ParensT t) = ParensT <$> typeVarsEx s f t+#endif typeVarsEx _ _ t = pure t #if !MIN_VERSION_template_haskell(2,10,0)@@ -378,6 +487,14 @@ where g (i, t) = (,) i <$> typeVarsEx s f t typeVarsEx s f (ForallC bs ctx c) = ForallC bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f c where s' = s `Set.union` setOf typeVars bs+#if MIN_VERSION_template_haskell(2,11,0)+ typeVarsEx s f (GadtC ns argTys retTy) =+ GadtC ns <$> traverseOf (traverse . _2) (typeVarsEx s f) argTys+ <*> typeVarsEx s f retTy+ typeVarsEx s f (RecGadtC ns argTys retTy) =+ RecGadtC ns <$> traverseOf (traverse . _3) (typeVarsEx s f) argTys+ <*> typeVarsEx s f retTy+#endif instance HasTypeVars t => HasTypeVars [t] where typeVarsEx s = traverse . typeVarsEx s@@ -404,6 +521,11 @@ where m' = foldrOf typeVars Map.delete m bs substType m (SigT t k) = SigT (substType m t) k substType m (AppT l r) = AppT (substType m l) (substType m r)+#if MIN_VERSION_template_haskell(2,11,0)+ substType m (InfixT t1 n t2) = InfixT (substType m t1) n (substType m t2)+ substType m (UInfixT t1 n t2) = UInfixT (substType m t1) n (substType m t2)+ substType m (ParensT t) = ParensT (substType m t)+#endif substType _ t = t instance SubstType t => SubstType [t] where@@ -416,17 +538,43 @@ #endif -- | Provides a 'Traversal' of the types of each field of a constructor.-conFields :: Traversal' Con StrictType+conFields :: Traversal' Con+#if MIN_VERSION_template_haskell(2,11,0)+ BangType+#else+ StrictType+#endif conFields f (NormalC n fs) = NormalC n <$> traverse f fs-conFields f (RecC n fs) = RecC n <$> traverse sans_var fs- where sans_var (fn,s,t) = (\(s', t') -> (fn,s',t')) <$> f (s, t)+conFields f (RecC n fs) = RecC n <$> traverse (sansVar f) fs conFields f (InfixC l n r) = InfixC <$> f l <*> pure n <*> f r conFields f (ForallC bds ctx c) = ForallC bds ctx <$> conFields f c+#if MIN_VERSION_template_haskell(2,11,0)+conFields f (GadtC ns argTys retTy) =+ GadtC ns <$> traverse f argTys <*> pure retTy+conFields f (RecGadtC ns argTys retTy) =+ RecGadtC ns <$> traverse (sansVar f) argTys <*> pure retTy+#endif +#if MIN_VERSION_template_haskell(2,11,0)+sansVar :: Traversal' VarBangType BangType+#else+sansVar :: Traversal' VarStrictType StrictType+#endif+sansVar f (fn,s,t) = (\(s', t') -> (fn,s',t')) <$> f (s, t)+ -- | 'Traversal' of the types of the /named/ fields of a constructor.-conNamedFields :: Traversal' Con VarStrictType+conNamedFields :: Traversal' Con+#if MIN_VERSION_template_haskell(2,11,0)+ VarBangType+#else+ VarStrictType+#endif conNamedFields f (RecC n fs) = RecC n <$> traverse f fs conNamedFields f (ForallC a b fs) = ForallC a b <$> conNamedFields f fs+#if MIN_VERSION_template_haskell(2,11,0)+conNamedFields f (RecGadtC ns argTys retTy) =+ RecGadtC ns <$> traverse f argTys <*> pure retTy+#endif conNamedFields _ c = pure c -- Lenses and Prisms@@ -512,8 +660,53 @@ g (Clause _ _ ds) = ds s (Clause x y _ ) = Clause x y +#if MIN_VERSION_template_haskell(2,11,0)+injectivityAnnOutput :: Lens' InjectivityAnn Name+injectivityAnnOutput = lens g s where+ g (InjectivityAnn o _) = o+ s (InjectivityAnn _ i) o = InjectivityAnn o i++injectivityAnnInputs :: Lens' InjectivityAnn [Name]+injectivityAnnInputs = lens g s where+ g (InjectivityAnn _ i) = i+ s (InjectivityAnn o _) = InjectivityAnn o++typeFamilyHeadName :: Lens' TypeFamilyHead Name+typeFamilyHeadName = lens g s where+ g (TypeFamilyHead n _ _ _ ) = n+ s (TypeFamilyHead _ tvbs rs ia) n = TypeFamilyHead n tvbs rs ia++typeFamilyHeadTyVarBndrs :: Lens' TypeFamilyHead [TyVarBndr]+typeFamilyHeadTyVarBndrs = lens g s where+ g (TypeFamilyHead _ tvbs _ _ ) = tvbs+ s (TypeFamilyHead n _ rs ia) tvbs = TypeFamilyHead n tvbs rs ia++typeFamilyHeadResultSig :: Lens' TypeFamilyHead FamilyResultSig+typeFamilyHeadResultSig = lens g s where+ g (TypeFamilyHead _ _ rs _ ) = rs+ s (TypeFamilyHead n tvbs _ ia) rs = TypeFamilyHead n tvbs rs ia++typeFamilyHeadInjectivityAnn :: Lens' TypeFamilyHead (Maybe InjectivityAnn)+typeFamilyHeadInjectivityAnn = lens g s where+ g (TypeFamilyHead _ _ _ ia) = ia+ s (TypeFamilyHead n tvbs rs _ ) = TypeFamilyHead n tvbs rs++bangSourceUnpackedness :: Lens' Bang SourceUnpackedness+bangSourceUnpackedness = lens g s where+ g (Bang su _ ) = su+ s (Bang _ ss) su = Bang su ss++bangSourceStrictness :: Lens' Bang SourceStrictness+bangSourceStrictness = lens g s where+ g (Bang _ su) = su+ s (Bang ss _ ) = Bang ss+#endif+ #if MIN_VERSION_template_haskell(2,8,0) _ClassI :: Prism' Info (Dec, [InstanceDec])+#else+_ClassI :: Prism' Info (Dec, [Dec])+#endif _ClassI = prism' reviewer remitter where@@ -521,24 +714,20 @@ remitter (ClassI x y) = Just (x, y) remitter _ = Nothing -_ClassOpI :: Prism' Info (Name, Type, ParentName, Fixity)+#if MIN_VERSION_template_haskell(2,11,0)+_ClassOpI :: Prism' Info (Name, Type, ParentName) _ClassOpI = prism' reviewer remitter where- reviewer (x, y, z, w) = ClassOpI x y z w- remitter (ClassOpI x y z w) = Just (x, y, z, w)+ reviewer (x, y, z) = ClassOpI x y z+ remitter (ClassOpI x y z) = Just (x, y, z) remitter _ = Nothing- #else-_ClassI :: Prism' Info (Dec, [Dec])-_ClassI- = prism' reviewer remitter- where- reviewer (x, y) = ClassI x y- remitter (ClassI x y) = Just (x, y)- remitter _ = Nothing-+# if MIN_VERSION_template_haskell(2,8,0)+_ClassOpI :: Prism' Info (Name, Type, ParentName, Fixity)+# else _ClassOpI :: Prism' Info (Name, Type, Name, Fixity)+# endif _ClassOpI = prism' reviewer remitter where@@ -555,8 +744,11 @@ remitter (TyConI x) = Just x remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,8,0)+#if MIN_VERSION_template_haskell(2,11,0) _FamilyI :: Prism' Info (Dec, [InstanceDec])+#else+_FamilyI :: Prism' Info (Dec, [Dec])+#endif _FamilyI = prism' reviewer remitter where@@ -564,7 +756,11 @@ remitter (FamilyI x y) = Just (x, y) remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,8,0) _PrimTyConI :: Prism' Info (Name, Arity, Unlifted)+#else+_PrimTyConI :: Prism' Info (Name, Int, Bool)+#endif _PrimTyConI = prism' reviewer remitter where@@ -572,40 +768,37 @@ remitter (PrimTyConI x y z) = Just (x, y, z) remitter _ = Nothing -_DataConI :: Prism' Info (Name, Type, ParentName, Fixity)+#if MIN_VERSION_template_haskell(2,11,0)+_DataConI :: Prism' Info (Name, Type, ParentName) _DataConI = prism' reviewer remitter where- reviewer (x, y, z, w) = DataConI x y z w- remitter (DataConI x y z w) = Just (x, y, z, w)+ reviewer (x, y, z) = DataConI x y z+ remitter (DataConI x y z) = Just (x, y, z) remitter _ = Nothing #else-_FamilyI :: Prism' Info (Dec, [Dec])-_FamilyI- = prism' reviewer remitter- where- reviewer (x, y) = FamilyI x y- remitter (FamilyI x y) = Just (x, y)- remitter _ = Nothing--_PrimTyConI :: Prism' Info (Name, Int, Bool)-_PrimTyConI- = prism' reviewer remitter- where- reviewer (x, y, z) = PrimTyConI x y z- remitter (PrimTyConI x y z) = Just (x, y, z)- remitter _ = Nothing-+# if MIN_VERSION_template_haskell(2,8,0)+_DataConI :: Prism' Info (Name, Type, ParentName, Fixity)+# else _DataConI :: Prism' Info (Name, Type, Name, Fixity)+# endif _DataConI = prism' reviewer remitter where reviewer (x, y, z, w) = DataConI x y z w remitter (DataConI x y z w) = Just (x, y, z, w) remitter _ = Nothing- #endif +#if MIN_VERSION_template_haskell(2,11,0)+_VarI :: Prism' Info (Name, Type, Maybe Dec)+_VarI+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = VarI x y z+ remitter (VarI x y z) = Just (x, y, z)+ remitter _ = Nothing+#else _VarI :: Prism' Info (Name, Type, Maybe Dec, Fixity) _VarI = prism' reviewer remitter@@ -613,6 +806,7 @@ reviewer (x, y, z, w) = VarI x y z w remitter (VarI x y z w) = Just (x, y, z, w) remitter _ = Nothing+#endif _TyVarI :: Prism' Info (Name, Type) _TyVarI@@ -638,22 +832,6 @@ remitter (ValD x y z) = Just (x, y, z) remitter _ = Nothing -_DataD :: Prism' Dec (Cxt, Name, [TyVarBndr], [Con], [Name])-_DataD- = prism' reviewer remitter- where- reviewer (x, y, z, w, u) = DataD x y z w u- remitter (DataD x y z w u) = Just (x, y, z, w, u)- remitter _ = Nothing--_NewtypeD :: Prism' Dec (Cxt, Name, [TyVarBndr], Con, [Name])-_NewtypeD- = prism' reviewer remitter- where- reviewer (x, y, z, w, u) = NewtypeD x y z w u- remitter (NewtypeD x y z w u) = Just (x, y, z, w, u)- remitter _ = Nothing- _TySynD :: Prism' Dec (Name, [TyVarBndr], Type) _TySynD = prism' reviewer remitter@@ -712,30 +890,6 @@ remitter (PragmaD x) = Just x remitter _ = Nothing -_FamilyD :: Prism' Dec (FamFlavour, Name, [TyVarBndr], Maybe Kind)-_FamilyD- = prism' reviewer remitter- where- reviewer (x, y, z, w) = FamilyD x y z w- remitter (FamilyD x y z w) = Just (x, y, z, w)- remitter _ = Nothing--_DataInstD :: Prism' Dec (Cxt, Name, [Type], [Con], [Name])-_DataInstD- = prism' reviewer remitter- where- reviewer (x, y, z, w, u) = DataInstD x y z w u- remitter (DataInstD x y z w u) = Just (x, y, z, w, u)- remitter _ = Nothing--_NewtypeInstD :: Prism' Dec (Cxt, Name, [Type], Con, [Name])-_NewtypeInstD- = prism' reviewer remitter- where- reviewer (x, y, z, w, u) = NewtypeInstD x y z w u- remitter (NewtypeInstD x y z w u) = Just (x, y, z, w, u)- remitter _ = Nothing- #if MIN_VERSION_template_haskell(2,9,0) _TySynInstD :: Prism' Dec (Name, TySynEqn) _TySynInstD@@ -745,14 +899,6 @@ remitter (TySynInstD x y) = Just (x, y) remitter _ = Nothing -_ClosedTypeFamilyD :: Prism' Dec (Name, [TyVarBndr], Maybe Kind, [TySynEqn])-_ClosedTypeFamilyD- = prism' reviewer remitter- where- reviewer (x, y, z, w) = ClosedTypeFamilyD x y z w- remitter (ClosedTypeFamilyD x y z w) = Just (x, y, z, w)- remitter _ = Nothing- _RoleAnnotD :: Prism' Dec (Name, [Role]) _RoleAnnotD = prism' reviewer remitter@@ -789,8 +935,122 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,11,0)+_ClosedTypeFamilyD :: Prism' Dec (TypeFamilyHead, [TySynEqn])+_ClosedTypeFamilyD+ = prism' reviewer remitter+ where+ reviewer (x, y) = ClosedTypeFamilyD x y+ remitter (ClosedTypeFamilyD x y) = Just (x, y)+ remitter _ = Nothing+#elif MIN_VERSION_template_haskell(2,9,0)+_ClosedTypeFamilyD :: Prism' Dec (Name, [TyVarBndr], Maybe Kind, [TySynEqn])+_ClosedTypeFamilyD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w) = ClosedTypeFamilyD x y z w+ remitter (ClosedTypeFamilyD x y z w) = Just (x, y, z, w)+ remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,11,0)+_DataD :: Prism' Dec (Cxt, Name, [TyVarBndr], Maybe Kind, [Con], Cxt)+_DataD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u, v) = DataD x y z w u v+ remitter (DataD x y z w u v) = Just (x, y, z, w, u, v)+ remitter _ = Nothing++_NewtypeD :: Prism' Dec (Cxt, Name, [TyVarBndr], Maybe Kind, Con, Cxt)+_NewtypeD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u, v) = NewtypeD x y z w u v+ remitter (NewtypeD x y z w u v) = Just (x, y, z, w, u, v)+ remitter _ = Nothing++_DataInstD :: Prism' Dec (Cxt, Name, [Type], Maybe Kind, [Con], Cxt)+_DataInstD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u, v) = DataInstD x y z w u v+ remitter (DataInstD x y z w u v) = Just (x, y, z, w, u, v)+ remitter _ = Nothing++_NewtypeInstD :: Prism' Dec (Cxt, Name, [Type], Maybe Kind, Con, Cxt)+_NewtypeInstD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u, v) = NewtypeInstD x y z w u v+ remitter (NewtypeInstD x y z w u v) = Just (x, y, z, w, u, v)+ remitter _ = Nothing++_DataFamilyD :: Prism' Dec (Name, [TyVarBndr], Maybe Kind)+_DataFamilyD+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = DataFamilyD x y z+ remitter (DataFamilyD x y z) = Just (x, y, z)+ remitter _ = Nothing++_OpenTypeFamilyD :: Prism' Dec TypeFamilyHead+_OpenTypeFamilyD+ = prism' reviewer remitter+ where+ reviewer = OpenTypeFamilyD+ remitter (OpenTypeFamilyD x) = Just x+ remitter _ = Nothing+#else+_DataD :: Prism' Dec (Cxt, Name, [TyVarBndr], [Con], [Name])+_DataD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u) = DataD x y z w u+ remitter (DataD x y z w u) = Just (x, y, z, w, u)+ remitter _ = Nothing++_NewtypeD :: Prism' Dec (Cxt, Name, [TyVarBndr], Con, [Name])+_NewtypeD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u) = NewtypeD x y z w u+ remitter (NewtypeD x y z w u) = Just (x, y, z, w, u)+ remitter _ = Nothing++_DataInstD :: Prism' Dec (Cxt, Name, [Type], [Con], [Name])+_DataInstD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u) = DataInstD x y z w u+ remitter (DataInstD x y z w u) = Just (x, y, z, w, u)+ remitter _ = Nothing++_NewtypeInstD :: Prism' Dec (Cxt, Name, [Type], Con, [Name])+_NewtypeInstD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w, u) = NewtypeInstD x y z w u+ remitter (NewtypeInstD x y z w u) = Just (x, y, z, w, u)+ remitter _ = Nothing++_FamilyD :: Prism' Dec (FamFlavour, Name, [TyVarBndr], Maybe Kind)+_FamilyD+ = prism' reviewer remitter+ where+ reviewer (x, y, z, w) = FamilyD x y z w+ remitter (FamilyD x y z w) = Just (x, y, z, w)+ remitter _ = Nothing+#endif+ _NormalC ::- Prism' Con (Name, [StrictType])+ Prism' Con ( Name+#if MIN_VERSION_template_haskell(2,11,0)+ , [BangType]+#else+ , [StrictType]+#endif+ ) _NormalC = prism' reviewer remitter where@@ -799,7 +1059,13 @@ remitter _ = Nothing _RecC ::- Prism' Con (Name, [VarStrictType])+ Prism' Con ( Name+#if MIN_VERSION_template_haskell(2,11,0)+ , [VarBangType]+#else+ , [VarStrictType]+#endif+ ) _RecC = prism' reviewer remitter where@@ -808,9 +1074,12 @@ remitter _ = Nothing _InfixC ::- Prism' Con (StrictType,- Name,- StrictType)+ Prism' Con+#if MIN_VERSION_template_haskell(2,11,0)+ (BangType, Name, BangType )+#else+ (StrictType, Name, StrictType)+#endif _InfixC = prism' reviewer remitter where@@ -826,6 +1095,97 @@ remitter (ForallC x y z) = Just (x, y, z) remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,11,0)+_GadtC :: Prism' Con ([Name], [BangType], Type)+_GadtC+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = GadtC x y z+ remitter (GadtC x y z) = Just (x, y, z)+ remitter _ = Nothing++_RecGadtC :: Prism' Con ([Name], [VarBangType], Type)+_RecGadtC+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = RecGadtC x y z+ remitter (RecGadtC x y z) = Just (x, y, z)+ remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,11,0)+_NoSourceUnpackedness :: Prism' SourceUnpackedness ()+_NoSourceUnpackedness+ = prism' reviewer remitter+ where+ reviewer () = NoSourceUnpackedness+ remitter NoSourceUnpackedness = Just ()+ remitter _ = Nothing++_SourceNoUnpack :: Prism' SourceUnpackedness ()+_SourceNoUnpack+ = prism' reviewer remitter+ where+ reviewer () = SourceNoUnpack+ remitter SourceNoUnpack = Just ()+ remitter _ = Nothing++_SourceUnpack :: Prism' SourceUnpackedness ()+_SourceUnpack+ = prism' reviewer remitter+ where+ reviewer () = SourceUnpack+ remitter SourceUnpack = Just ()+ remitter _ = Nothing++_NoSourceStrictness :: Prism' SourceStrictness ()+_NoSourceStrictness+ = prism' reviewer remitter+ where+ reviewer () = NoSourceStrictness+ remitter NoSourceStrictness = Just ()+ remitter _ = Nothing++_SourceLazy :: Prism' SourceStrictness ()+_SourceLazy+ = prism' reviewer remitter+ where+ reviewer () = SourceLazy+ remitter SourceLazy = Just ()+ remitter _ = Nothing++_SourceStrict :: Prism' SourceStrictness ()+_SourceStrict+ = prism' reviewer remitter+ where+ reviewer () = SourceStrict+ remitter SourceStrict = Just ()+ remitter _ = Nothing++_DecidedLazy :: Prism' DecidedStrictness ()+_DecidedLazy+ = prism' reviewer remitter+ where+ reviewer () = DecidedLazy+ remitter DecidedLazy = Just ()+ remitter _ = Nothing++_DecidedStrict :: Prism' DecidedStrictness ()+_DecidedStrict+ = prism' reviewer remitter+ where+ reviewer () = DecidedStrict+ remitter DecidedStrict = Just ()+ remitter _ = Nothing++_DecidedUnpack :: Prism' DecidedStrictness ()+_DecidedUnpack+ = prism' reviewer remitter+ where+ reviewer () = DecidedUnpack+ remitter DecidedUnpack = Just ()+ remitter _ = Nothing+#else _IsStrict :: Prism' Strict () _IsStrict = prism' reviewer remitter@@ -849,6 +1209,7 @@ reviewer () = Unpacked remitter Unpacked = Just () remitter _ = Nothing+#endif _ImportF :: Prism' Foreign (Callconv, Safety, String, Name, Type) _ImportF@@ -1361,6 +1722,16 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,11,0)+_UnboundVarE :: Prism' Exp Name+_UnboundVarE+ = prism' reviewer remitter+ where+ reviewer = UnboundVarE+ remitter (UnboundVarE x) = Just x+ remitter _ = Nothing+#endif+ _GuardedB :: Prism' Body [(Guard, Exp)] _GuardedB = prism' reviewer remitter@@ -1539,6 +1910,16 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,11,0)+_CharPrimL :: Prism' Lit Char+_CharPrimL+ = prism' reviewer remitter+ where+ reviewer = CharPrimL+ remitter (CharPrimL x) = Just x+ remitter _ = Nothing+#endif+ _LitP :: Prism' Pat Lit _LitP = prism' reviewer remitter@@ -1809,6 +2190,40 @@ remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,11,0)+_InfixT :: Prism' Type (Type, Name, Type)+_InfixT+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = InfixT x y z+ remitter (InfixT x y z) = Just (x, y, z)+ remitter _ = Nothing++_UInfixT :: Prism' Type (Type, Name, Type)+_UInfixT+ = prism' reviewer remitter+ where+ reviewer (x, y, z) = UInfixT x y z+ remitter (UInfixT x y z) = Just (x, y, z)+ remitter _ = Nothing++_ParensT :: Prism' Type Type+_ParensT+ = prism' reviewer remitter+ where+ reviewer = ParensT+ remitter (ParensT x) = Just x+ remitter _ = Nothing++_WildCardT :: Prism' Type ()+_WildCardT+ = prism' reviewer remitter+ where+ reviewer () = WildCardT+ remitter WildCardT = Just ()+ remitter _ = Nothing+#endif+ _PlainTV :: Prism' TyVarBndr Name _PlainTV = prism' reviewer remitter@@ -1824,6 +2239,32 @@ reviewer (x, y) = KindedTV x y remitter (KindedTV x y) = Just (x, y) remitter _ = Nothing++#if MIN_VERSION_template_haskell(2,11,0)+_NoSig :: Prism' FamilyResultSig ()+_NoSig+ = prism' reviewer remitter+ where+ reviewer () = NoSig+ remitter NoSig = Just ()+ remitter _ = Nothing++_KindSig :: Prism' FamilyResultSig Kind+_KindSig+ = prism' reviewer remitter+ where+ reviewer = KindSig+ remitter (KindSig x) = Just x+ remitter _ = Nothing++_TyVarSig :: Prism' FamilyResultSig TyVarBndr+_TyVarSig+ = prism' reviewer remitter+ where+ reviewer = TyVarSig+ remitter (TyVarSig x) = Just x+ remitter _ = Nothing+#endif #if MIN_VERSION_template_haskell(2,8,0) _NumTyLit :: Prism' TyLit Integer
src/Numeric/Lens.hs view
@@ -7,7 +7,7 @@ -------------------------------------------------------------------------------- -- | -- Module : Numeric.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/System/Exit/Lens.hs view
@@ -14,7 +14,7 @@ ----------------------------------------------------------------------------- -- | -- Module : System.Exit.Lens--- Copyright : (C) 2013-15 Edward Kmett+-- Copyright : (C) 2013-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : provisional
src/System/FilePath/Lens.hs view
@@ -7,7 +7,7 @@ ----------------------------------------------------------------------------- -- | -- Module : System.FilePath.Lens--- Copyright : (C) 2012-15 Edward Kmett+-- Copyright : (C) 2012-16 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
src/System/IO/Error/Lens.hs view
@@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : System.IO.Error.Lens--- Copyright : (C) 2012-2015 Edward Kmett+-- Copyright : (C) 2012-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett <ekmett@gmail.com> -- Stability : experimental
tests/doctests.hsc view
@@ -15,7 +15,7 @@ ----------------------------------------------------------------------------- module Main where -import Build_doctests (deps)+import Build_doctests (autogen_dir, deps) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif@@ -56,9 +56,9 @@ main :: IO () main = withUnicode $ getSources >>= \sources -> doctest $ "-isrc"- : "-idist/build/autogen"+ : ("-i" ++ autogen_dir) : "-optP-include"- : "-optPdist/build/autogen/cabal_macros.h"+ : ("-optP" ++ autogen_dir ++ "/cabal_macros.h") : "-hide-all-packages" #ifdef TRUSTWORTHY : "-DTRUSTWORTHY=1"
tests/properties.hs view
@@ -1,9 +1,17 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE LiberalTypeSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE KindSignatures #-}+#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ConstraintKinds #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Main (properties)@@ -29,6 +37,7 @@ import Data.Maybe import Data.List.Lens import Data.Functor.Compose+import GHC.Exts (Constraint) import Numeric (showHex, showOct, showSigned) import Numeric.Lens import Control.Lens.Properties (isIso, isLens, isPrism, isSetter, isTraversal)@@ -95,6 +104,38 @@ isValid = (not . null) sPos && all isValidChar sPos sPos = case s of { ('-':s') -> s'; _ -> s } isValidChar c = isAscii c && isAlphaNum c++-- Things that should typecheck but that we don't need to run+#if __GLASGOW_HASKELL__ >= 708+data Foo (a :: Constraint) (b :: Constraint) where+ Foo :: Foo (Num Int) b++sampleExtremePoly :: Equality s t a b -> Foo a (Functor b) -> Foo s (Functor t)+sampleExtremePoly f foo = f foo+#endif++#if __GLASGOW_HASKELL__ >= 706+samplePolyEquality :: Equality Monad Identity Monad Identity+samplePolyEquality f = f++lessSimplePoly :: forall (s :: k1) (t :: k2) (a :: k1) (b :: k2) .+ Equality a b a b+lessSimplePoly f = f++equalityAnEqualityPoly ::+ forall (s :: k1) (t :: k2) (a :: k1) (b :: k2) .+ Equality s t a b -> AnEquality s t a b+equalityAnEqualityPoly f = f+#else+lessSimple :: Equality a b a b+lessSimple f = f++equalityAnEquality :: Equality s t a b -> AnEquality s t a b+equalityAnEquality f = f+#endif+equalityIso :: Equality s t a b -> Iso s t a b+equalityIso f = f+ main :: IO () main = $defaultMainGenerator
tests/templates.hs view
@@ -369,5 +369,47 @@ data ReviewTest where ReviewTest :: a -> ReviewTest makePrisms ''ReviewTest ++-- test FieldNamers++data CheckUnderscoreNoPrefixNamer = CheckUnderscoreNoPrefixNamer+ { _fieldUnderscoreNoPrefix :: Int }+makeLensesWith (lensRules & lensField .~ underscoreNoPrefixNamer ) ''CheckUnderscoreNoPrefixNamer+checkUnderscoreNoPrefixNamer :: Lens' CheckUnderscoreNoPrefixNamer Int+checkUnderscoreNoPrefixNamer = fieldUnderscoreNoPrefix++-- how can we test NOT generating a lens for some fields?++data CheckMappingNamer = CheckMappingNamer+ { fieldMappingNamer :: String }+makeLensesWith (lensRules & lensField .~ (mappingNamer (return . ("hogehoge_" ++)))) ''CheckMappingNamer+checkMappingNamer :: Lens' CheckMappingNamer String+checkMappingNamer = hogehoge_fieldMappingNamer++data CheckLookingupNamer = CheckLookingupNamer+ { fieldLookingupNamer :: Int }+makeLensesWith (lensRules & lensField .~ (lookingupNamer [("fieldLookingupNamer", "foobarFieldLookingupNamer")])) ''CheckLookingupNamer+checkLookingupNamer :: Lens' CheckLookingupNamer Int+checkLookingupNamer = foobarFieldLookingupNamer++data CheckUnderscoreNamer = CheckUnderscoreNamer+ { _hogeprefix_fieldCheckUnderscoreNamer :: Int }+makeLensesWith (defaultFieldRules & lensField .~ underscoreNamer) ''CheckUnderscoreNamer+checkUnderscoreNamer :: Lens' CheckUnderscoreNamer Int+checkUnderscoreNamer = fieldCheckUnderscoreNamer++data CheckCamelCaseNamer = CheckCamelCaseNamer+ { _checkCamelCaseNamerFieldCamelCaseNamer :: Int }+makeLensesWith (defaultFieldRules & lensField .~ camelCaseNamer) ''CheckCamelCaseNamer+checkCamelCaseNamer :: Lens' CheckCamelCaseNamer Int+checkCamelCaseNamer = fieldCamelCaseNamer++data CheckAbbreviatedNamer = CheckAbbreviatedNamer+ { _hogeprefixFieldAbbreviatedNamer :: Int }+makeLensesWith (defaultFieldRules & lensField .~ abbreviatedNamer ) ''CheckAbbreviatedNamer+checkAbbreviatedNamer :: Lens' CheckAbbreviatedNamer Int+checkAbbreviatedNamer = fieldAbbreviatedNamer++ main :: IO () main = putStrLn "test/templates.hs: ok"