Skip to content
Snippets Groups Projects
Commit fa8364f6 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel :man_dancing:
Browse files

Silence -Wredundant-constraints warnings

In GHC 8.0 -Wall implies -Wredundant-constraints, so we have to
address those warings in one way or another.
parent 880ad15e
No related branches found
No related tags found
No related merge requests found
......@@ -73,7 +73,7 @@ type ComponentDep a = (Component, a)
newtype ComponentDeps a = ComponentDeps { unComponentDeps :: Map Component a }
deriving (Show, Functor, Eq, Ord, Generic)
instance (Semigroup a, Monoid a) => Monoid (ComponentDeps a) where
instance Semigroup a => Monoid (ComponentDeps a) where
mempty = ComponentDeps Map.empty
mappend = (<>)
......
......@@ -451,11 +451,13 @@ probeFileSystem root (MonitorStateFileSet singlePaths globPaths) =
<$> traverseWithKey (probeFileStatus root) singlePaths
<*> traverse (probeGlobStatus root ".") globPaths
traverseWithKey :: (Applicative t, Eq k)
=> (k -> a -> t b) -> Map k a -> t (Map k b)
#if MIN_VERSION_containers(0,5,0)
traverseWithKey :: Applicative t
=> (k -> a -> t b) -> Map k a -> t (Map k b)
traverseWithKey = Map.traverseWithKey
#else
traverseWithKey :: (Applicative t, Eq k)
=> (k -> a -> t b) -> Map k a -> t (Map k b)
traverseWithKey f = fmap Map.fromAscList
. traverse (\(k, v) -> (,) k <$> f k v)
. Map.toAscList
......
......@@ -74,7 +74,7 @@ runRebuild (Rebuild action) = evalStateT action []
--
-- Do not share 'FileMonitor's between different uses of 'rerunIfChanged'.
--
rerunIfChanged :: (Eq a, Binary a, Binary b)
rerunIfChanged :: (Binary a, Binary b)
=> Verbosity
-> FilePath
-> FileMonitor a b
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment