Use some lens in D.PD.Parsec

Author: phadej

Cabal/Distribution/Compat/Lens.hs

@@ -26,6 +26,7 @@ module Distribution.Compat.Lens (
     -- * Operators
     (&),
     (.~), (%~),
+    (?~),
     -- * Cabal developer info
     -- $development
     ) where
@@ -110,12 +111,16 @@ _2 f (c, a) = (,) c <$> f a
 {-# INLINE (&) #-}
 infixl 1 &
 
-infixr 4 .~, %~
+infixr 4 .~, %~, ?~
 
 (.~) :: ASetter s t a b -> b -> s -> t
 (.~) = set
 {-# INLINE (.~) #-}
 
+(?~) :: ASetter s t a (Maybe b) -> b -> s -> t
+l ?~ b = set l (Just b)
+{-# INLINE (?~) #-}
+
 (%~) :: ASetter s t a b -> (a -> b) -> s -> t
 (%~) = over
 {-# INLINE (%~) #-}

Cabal/Distribution/PackageDescription/Parsec.hs

@@ -65,6 +65,10 @@ import           System.Directory
 import qualified Text.Parsec                                       as P
 import qualified Text.Parsec.Error                                 as P
 
+import           Distribution.Compat.Lens
+import qualified Distribution.Types.GenericPackageDescription.Lens as L
+import qualified Distribution.Types.PackageDescription.Lens        as L
+
 -- ---------------------------------------------------------------
 -- Parsing
 
@@ -282,10 +286,7 @@ parseGenericPackageDescription' lexWarnings fs = do
 
         | name == "custom-setup" && null args = do
             sbi <- parseFields setupBInfoFieldDescrs warnUnrec mempty fields
-            let pd = packageDescription gpd
-            -- TODO: what if already defined?
-            let gpd' = gpd { packageDescription = pd { setupBuildInfo = Just sbi } }
-            pure gpd'
+            pure $ gpd & L.packageDescription . L.setupBuildInfo ?~ sbi
 
         | name == "source-repository" = do
             kind <- case args of
@@ -298,16 +299,15 @@ parseGenericPackageDescription' lexWarnings fs = do
                     parseFailure pos $ "Invalid source-repository kind " ++ show args
                     pure RepoHead
             sr <- parseFields sourceRepoFieldDescrs warnUnrec (emptySourceRepo kind) fields
-            -- I want lens
-            let pd =  packageDescription gpd
-            let srs = sourceRepos pd
-            let gpd' = gpd { packageDescription = pd { sourceRepos = srs ++ [sr] } }
-            pure gpd'
+
+            pure $ gpd & L.packageDescription . L.sourceRepos %~ snoc sr
 
         | otherwise = do
             parseWarning pos PWTUnknownSection $ "Ignoring section: " ++ show name
             pure gpd
 
+    snoc x xs = xs ++ [x]
+
     newSyntaxVersion :: Version
     newSyntaxVersion = mkVersion [1, 2]
 

Cabal/Distribution/Types/PackageDescription/Lens.hs

@@ -10,6 +10,9 @@ import Distribution.Compat.Lens
 import Distribution.Types.PackageDescription (PackageDescription)
 import qualified Distribution.Types.PackageDescription as T
 
+import Distribution.Types.SetupBuildInfo (SetupBuildInfo)
+import Distribution.Types.SourceRepo (SourceRepo)
+
 customFieldsPD :: Lens' PackageDescription [(String,String)]
 customFieldsPD f pd = fmap (\x -> pd { T.customFieldsPD = x }) (f (T.customFieldsPD pd))
 
@@ -21,3 +24,9 @@ synopsis f pd = fmap (\x -> pd { T.synopsis = x }) (f (T.synopsis pd))
 
 maintainer :: Lens' PackageDescription String
 maintainer f pd = fmap (\x -> pd { T.maintainer = x }) (f (T.maintainer pd))
+
+setupBuildInfo :: Lens' PackageDescription (Maybe SetupBuildInfo)
+setupBuildInfo f pd = fmap (\x -> pd { T.setupBuildInfo = x }) (f (T.setupBuildInfo pd))
+
+sourceRepos :: Lens' PackageDescription [SourceRepo]
+sourceRepos f pd = fmap (\x -> pd { T.sourceRepos = x }) (f (T.sourceRepos pd))