[commit: ghc] wip/nfs-locking: Fix warnings (81fecb8)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 01:21:56 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/81fecb8b3f23e6e09441b43ae874f0554cedf50b/ghc

>---------------------------------------------------------------

commit 81fecb8b3f23e6e09441b43ae874f0554cedf50b
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Fri Aug 4 21:15:29 2017 +0100

    Fix warnings


>---------------------------------------------------------------

81fecb8b3f23e6e09441b43ae874f0554cedf50b
 hadrian.cabal                    | 22 ++++++++++++----------
 src/Base.hs                      |  4 ++--
 src/Expression.hs                | 22 +++++++++++++---------
 src/Settings/Builders/Haddock.hs |  6 +++---
 4 files changed, 30 insertions(+), 24 deletions(-)

diff --git a/hadrian.cabal b/hadrian.cabal
index da905ff..6dab6d0 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -131,13 +131,15 @@ executable hadrian
                        , unordered-containers == 0.2.*
     build-tools:         alex  >= 3.1
                        , happy >= 1.19.4
-    ghc-options:         -Wall
-                         -fno-warn-name-shadowing
-                         -rtsopts
-                         -- Disable idle GC to avoid redundant GCs while waiting
-                         -- for external processes
-                         -with-rtsopts=-I0
-                         -- Don't use parallel GC as the synchronization time tends to eat any
-                         -- benefit.
-                         -with-rtsopts=-qg0
-                         -threaded
+    ghc-options:       -Wall
+                       -Wincomplete-record-updates
+                       -Wredundant-constraints
+                       -fno-warn-name-shadowing
+                       -rtsopts
+                       -- Disable idle GC to avoid redundant GCs while waiting
+                       -- for external processes
+                       -with-rtsopts=-I0
+                       -- Don't use parallel GC as the synchronization time tends to eat any
+                       -- benefit.
+                       -with-rtsopts=-qg0
+                       -threaded
diff --git a/src/Base.hs b/src/Base.hs
index d717f2a..9e2922b 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -6,7 +6,7 @@ module Base (
     module Data.Function,
     module Data.List.Extra,
     module Data.Maybe,
-    module Data.Monoid,
+    module Data.Semigroup,
 
     -- * Shake
     module Development.Shake,
@@ -29,7 +29,7 @@ import Data.Char
 import Data.Function
 import Data.List.Extra
 import Data.Maybe
-import Data.Monoid
+import Data.Semigroup
 import Development.Shake hiding (parallel, unit, (*>), Normal)
 import Development.Shake.Classes
 import Development.Shake.FilePath
diff --git a/src/Expression.hs b/src/Expression.hs
index a09bb8c..251c04f 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -19,7 +19,7 @@ module Expression (
     getTopDirectory,
 
     -- * Re-exports
-    module Data.Monoid,
+    module Data.Semigroup,
     module Builder,
     module Package,
     module Stage,
@@ -28,7 +28,7 @@ module Expression (
 
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans
-import Data.Monoid
+import Data.Semigroup
 
 import Base
 import Builder
@@ -52,9 +52,13 @@ expr = Expr . lift
 exprIO :: IO a -> Expr a
 exprIO = Expr . liftIO
 
-instance Monoid a => Monoid (Expr a) where
-    mempty                    = Expr $ return mempty
-    mappend (Expr x) (Expr y) = Expr $ (<>) <$> x <*> y
+instance Semigroup a => Semigroup (Expr a) where
+    Expr x <> Expr y = Expr $ (<>) <$> x <*> y
+
+-- TODO: The 'Semigroup a' constraint will at some point become redundant.
+instance (Semigroup a, Monoid a) => Monoid (Expr a) where
+    mempty  = pure mempty
+    mappend = (<>)
 
 instance Applicative Expr where
     pure  = Expr . pure
@@ -78,15 +82,15 @@ type Ways      = Expr [Way]
 -- Basic operations on expressions:
 
 -- | Append something to an expression.
-append :: Monoid a => a -> Expr a
-append = Expr . return
+append :: a -> Expr a
+append = pure
 
 -- | Remove given elements from a list expression.
 remove :: Eq a => [a] -> Expr [a] -> Expr [a]
 remove xs e = filter (`notElem` xs) <$> e
 
 -- | Apply a predicate to an expression.
-applyPredicate :: Monoid a => Predicate -> Expr a -> Expr a
+applyPredicate :: (Monoid a, Semigroup a) => Predicate -> Expr a -> Expr a
 applyPredicate predicate expr = do
     bool <- predicate
     if bool then expr else mempty
@@ -97,7 +101,7 @@ arg = append . return
 
 -- | A convenient operator for predicate application.
 class PredicateLike a where
-    (?) :: Monoid m => a -> Expr m -> Expr m
+    (?) :: (Monoid m, Semigroup m) => a -> Expr m -> Expr m
 
 infixr 3 ?
 
diff --git a/src/Settings/Builders/Haddock.hs b/src/Settings/Builders/Haddock.hs
index bb37d0b..4c6f862 100644
--- a/src/Settings/Builders/Haddock.hs
+++ b/src/Settings/Builders/Haddock.hs
@@ -5,9 +5,9 @@ import Settings.Builders.Ghc
 
 -- | Given a version string such as "2.16.2" produce an integer equivalent.
 versionToInt :: String -> Int
-versionToInt s = major * 1000 + minor * 10 + patch
-  where
-    [major, minor, patch] = map read . words $ replaceEq '.' ' ' s
+versionToInt s = case map read . words $ replaceEq '.' ' ' s of
+    [major, minor, patch] -> major * 1000 + minor * 10 + patch
+    _                     -> error "versionToInt: cannot parse version."
 
 haddockBuilderArgs :: Args
 haddockBuilderArgs = builder Haddock ? do



More information about the ghc-commits mailing list