summaryrefslogtreecommitdiff
path: root/compiler/main/Packages.hs
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2017-08-30 01:29:55 +0200
committerHerbert Valerio Riedel <hvr@gnu.org>2017-08-31 09:45:11 +0200
commitc0feee90118333dac817cfad6f2dedc0a886d1bd (patch)
treef1e7bd59e0c8452d9e51f359d504606a8a346bf0 /compiler/main/Packages.hs
parent2c133b67df374c73bc8069cefd7d57e1d2a14fc3 (diff)
downloadhaskell-c0feee90118333dac817cfad6f2dedc0a886d1bd.tar.gz
Add missing Semigroup instances to compiler
This is a pre-requisite for implementing the Semigroup/Monoid proposal. The instances have been introduced in a way to minimise warnings.
Diffstat (limited to 'compiler/main/Packages.hs')
-rw-r--r--compiler/main/Packages.hs29
1 files changed, 13 insertions, 16 deletions
diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs
index 01d66cb740..088f58a675 100644
--- a/compiler/main/Packages.hs
+++ b/compiler/main/Packages.hs
@@ -217,14 +217,7 @@ instance Semigroup ModuleOrigin where
instance Monoid ModuleOrigin where
mempty = ModOrigin Nothing [] [] False
- mappend (ModOrigin e res rhs f) (ModOrigin e' res' rhs' f') =
- ModOrigin (g e e') (res ++ res') (rhs ++ rhs') (f || f')
- where g (Just b) (Just b')
- | b == b' = Just b
- | otherwise = panic "ModOrigin: package both exposed/hidden"
- g Nothing x = x
- g x Nothing = x
- mappend _ _ = panic "ModOrigin: hidden module redefined"
+ mappend = (Semigroup.<>)
-- | Is the name from the import actually visible? (i.e. does it cause
-- ambiguity, or is it only relevant when we're making suggestions?)
@@ -283,6 +276,17 @@ instance Outputable UnitVisibility where
uv_requirements = reqs,
uv_explicit = explicit
}) = ppr (b, rns, mb_pn, reqs, explicit)
+
+instance Semigroup UnitVisibility where
+ uv1 <> uv2
+ = UnitVisibility
+ { uv_expose_all = uv_expose_all uv1 || uv_expose_all uv2
+ , uv_renamings = uv_renamings uv1 ++ uv_renamings uv2
+ , uv_package_name = mappend (uv_package_name uv1) (uv_package_name uv2)
+ , uv_requirements = Map.unionWith Set.union (uv_requirements uv1) (uv_requirements uv2)
+ , uv_explicit = uv_explicit uv1 || uv_explicit uv2
+ }
+
instance Monoid UnitVisibility where
mempty = UnitVisibility
{ uv_expose_all = False
@@ -291,14 +295,7 @@ instance Monoid UnitVisibility where
, uv_requirements = Map.empty
, uv_explicit = False
}
- mappend uv1 uv2
- = UnitVisibility
- { uv_expose_all = uv_expose_all uv1 || uv_expose_all uv2
- , uv_renamings = uv_renamings uv1 ++ uv_renamings uv2
- , uv_package_name = mappend (uv_package_name uv1) (uv_package_name uv2)
- , uv_requirements = Map.unionWith Set.union (uv_requirements uv1) (uv_requirements uv2)
- , uv_explicit = uv_explicit uv1 || uv_explicit uv2
- }
+ mappend = (Semigroup.<>)
type WiredUnitId = DefUnitId
type PreloadUnitId = InstalledUnitId