diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 2c9d2cdcee2aba21700fca796772bb9f92249929..210ceb17eec59bd22cbdd642cc10b3a06b95213f 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -290,6 +290,7 @@ library -- Lens functionality exposed-modules: Distribution.Compat.Lens + Distribution.Types.Lens Distribution.Types.Benchmark.Lens Distribution.Types.BuildInfo.Lens Distribution.Types.Executable.Lens @@ -297,6 +298,7 @@ library Distribution.Types.GenericPackageDescription.Lens Distribution.Types.Library.Lens Distribution.Types.PackageDescription.Lens + Distribution.Types.PackageId.Lens Distribution.Types.SetupBuildInfo.Lens Distribution.Types.SourceRepo.Lens Distribution.Types.TestSuite.Lens diff --git a/Cabal/Distribution/Compat/Lens.hs b/Cabal/Distribution/Compat/Lens.hs index 8370cce677eac3ba388a50875bce70617c601203..fc2af816177639f8cd7d66d8142779feba8e9cfd 100644 --- a/Cabal/Distribution/Compat/Lens.hs +++ b/Cabal/Distribution/Compat/Lens.hs @@ -11,6 +11,7 @@ module Distribution.Compat.Lens ( Traversal', -- ** LensLike LensLike, + LensLike', -- ** rank-1 types Getting, AGetter, @@ -26,8 +27,13 @@ module Distribution.Compat.Lens ( toDListOf, toListOf, toSetOf, + -- * Lens + cloneLens, + aview, -- * Common lenses _1, _2, + non, + fromNon, -- * Operators (&), (^.), (.~), (%~), @@ -52,7 +58,8 @@ import qualified Data.Set as Set -- Types ------------------------------------------------------------------------------- -type LensLike f s t a b = (a -> f b) -> s -> f t +type LensLike f s t a b = (a -> f b) -> s -> f t +type LensLike' f s a = (a -> f a) -> s -> f s type Lens s t a b = forall f. Functor f => LensLike f s t a b type Traversal s t a b = forall f. Applicative f => LensLike f s t a b @@ -72,8 +79,8 @@ type ALens' s a = ALens s s a a -- Getter ------------------------------------------------------------------------------- -view :: s -> Getting a s a -> a -view s l = getConst (l Const s) +view :: Getting a s a -> s -> a +view l s = getConst (l Const s) ------------------------------------------------------------------------------- -- Setter @@ -102,6 +109,9 @@ toSetOf l s = getConst (l (\x -> Const (Set.singleton x)) s) -- Lens ------------------------------------------------------------------------------- +aview :: ALens s t a b -> s -> a +aview l = pretextPos . l pretextSell +{-# INLINE aview #-} {- lens :: (s -> a) -> (s -> a -> s) -> Lens' s a lens sa sbt afb s = sbt s <$> afb (sa s) @@ -117,6 +127,24 @@ _1 f (a, c) = flip (,) c <$> f a _2 :: Lens (c, a) (c, b) a b _2 f (c, a) = (,) c <$> f a +-- | /Note:/ not an isomorphism here. +non :: Eq a => a -> Lens' (Maybe a) a +non def f s = wrap <$> f (unwrap s) + where + wrap x | x == def = Nothing + wrap x = Just x + + unwrap = fromMaybe def + + +fromNon :: Eq a => a -> Lens' a (Maybe a) +fromNon def f s = unwrap <$> f (wrap s) + where + wrap x | x == def = Nothing + wrap x = Just x + + unwrap = fromMaybe def + ------------------------------------------------------------------------------- -- Operators ------------------------------------------------------------------------------- @@ -147,7 +175,7 @@ l ?~ b = set l (Just b) {-# INLINE (%~) #-} (^#) :: s -> ALens s t a b -> a -s ^# l = pretextPos (l pretextSell s) +s ^# l = aview l s (#~) :: ALens s t a b -> b -> s -> t (#~) l b s = pretextPeek b (l pretextSell s) @@ -173,6 +201,10 @@ pretextPos :: Pretext a b t -> a pretextPos (Pretext m) = getConst (m Const) {-# INLINE pretextPos #-} +cloneLens :: Functor f => ALens s t a b -> LensLike f s t a b +cloneLens l f s = runPretext (l pretextSell s) f +{-# INLINE cloneLens #-} + ------------------------------------------------------------------------------- -- Comonads ------------------------------------------------------------------------------- diff --git a/Cabal/Distribution/Types/Executable/Lens.hs b/Cabal/Distribution/Types/Executable/Lens.hs index 959c0f0b663c5068ae89d9629357f7848ab437b3..a9169423b4425bb0f516bfb8578b1b605cc1abc8 100644 --- a/Cabal/Distribution/Types/Executable/Lens.hs +++ b/Cabal/Distribution/Types/Executable/Lens.hs @@ -7,7 +7,6 @@ import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () -import Distribution.Types.BuildInfo (BuildInfo) import Distribution.Types.Executable (Executable) import Distribution.Types.ExecutableScope (ExecutableScope) import Distribution.Types.UnqualComponentName (UnqualComponentName) @@ -26,6 +25,8 @@ exeScope :: Lens' Executable ExecutableScope exeScope f s = fmap (\x -> s { T.exeScope = x }) (f (T.exeScope s)) {-# INLINE exeScope #-} +{- buildInfo :: Lens' Executable BuildInfo buildInfo f s = fmap (\x -> s { T.buildInfo = x }) (f (T.buildInfo s)) {-# INLINE buildInfo #-} +-} diff --git a/Cabal/Distribution/Types/Lens.hs b/Cabal/Distribution/Types/Lens.hs new file mode 100644 index 0000000000000000000000000000000000000000..1581ff23cdd4b1380872980fe5e2f3b8c17b433d --- /dev/null +++ b/Cabal/Distribution/Types/Lens.hs @@ -0,0 +1,25 @@ +module Distribution.Types.Lens ( + module Distribution.Types.Benchmark.Lens, + module Distribution.Types.BuildInfo.Lens, + module Distribution.Types.Executable.Lens, + module Distribution.Types.ForeignLib.Lens, + module Distribution.Types.GenericPackageDescription.Lens, + module Distribution.Types.Library.Lens, + module Distribution.Types.PackageDescription.Lens, + module Distribution.Types.PackageId.Lens, + module Distribution.Types.SetupBuildInfo.Lens, + module Distribution.Types.SourceRepo.Lens, + module Distribution.Types.TestSuite.Lens, + ) where + +import Distribution.Types.Benchmark.Lens +import Distribution.Types.BuildInfo.Lens +import Distribution.Types.Executable.Lens +import Distribution.Types.ForeignLib.Lens +import Distribution.Types.GenericPackageDescription.Lens +import Distribution.Types.Library.Lens +import Distribution.Types.PackageDescription.Lens +import Distribution.Types.PackageId.Lens +import Distribution.Types.SetupBuildInfo.Lens +import Distribution.Types.SourceRepo.Lens +import Distribution.Types.TestSuite.Lens diff --git a/Cabal/Distribution/Types/PackageId/Lens.hs b/Cabal/Distribution/Types/PackageId/Lens.hs new file mode 100644 index 0000000000000000000000000000000000000000..d2a669a89afa770a9d69eae014fa44658dc50b11 --- /dev/null +++ b/Cabal/Distribution/Types/PackageId/Lens.hs @@ -0,0 +1,22 @@ +module Distribution.Types.PackageId.Lens ( + PackageIdentifier, + module Distribution.Types.PackageId.Lens, + ) where + +import Distribution.Compat.Lens +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.Types.PackageId (PackageIdentifier) +import Distribution.Types.PackageName (PackageName) +import Distribution.Version (Version) + +import qualified Distribution.Types.PackageId as T + +pkgName :: Lens' PackageIdentifier PackageName +pkgName f s = fmap (\x -> s { T.pkgName = x }) (f (T.pkgName s)) +{-# INLINE pkgName #-} + +pkgVersion :: Lens' PackageIdentifier Version +pkgVersion f s = fmap (\x -> s { T.pkgVersion = x }) (f (T.pkgVersion s)) +{-# INLINE pkgVersion #-}