Skip to content

Commit

Permalink
Fix Monoid instances for ForeignLib & Executable
Browse files Browse the repository at this point in the history
The Semigroup and Monoid instances for ForeignLib were completely
broken: for the `foreignLibVersionInfo` and `foreignLibVersionInfo`,
we essentially had the following:

  mempty :: Maybe XYZ
  mempty = Nothing

  (<>) :: Maybe XYZ -> Maybe XYZ -> Maybe XYZ
  _ <> b = b

which is obviously not a valid Monoid, as `Just x <> Nothing = Nothing`,
violating the identity law.

The Semigroup instance for Executable was also deeply suspicious, as
it combined the module paths, which makes no sense. Now we instead error
if the two module paths are different (and both nonempty).
  • Loading branch information
mpickering authored and Mikolaj committed Jan 9, 2024
1 parent 6389954 commit 78d89a9
Show file tree
Hide file tree
Showing 3 changed files with 17 additions and 15 deletions.
2 changes: 1 addition & 1 deletion Cabal-syntax/src/Distribution/Types/Executable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ instance Semigroup Executable where
a <> b =
Executable
{ exeName = combineNames a b exeName "executable"
, modulePath = combine modulePath
, modulePath = combineNames a b modulePath "modulePath"
, exeScope = combine exeScope
, buildInfo = combine buildInfo
}
Expand Down
8 changes: 5 additions & 3 deletions Cabal-syntax/src/Distribution/Types/ForeignLib.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ import Distribution.Types.ForeignLibType
import Distribution.Types.UnqualComponentName
import Distribution.Version

import Data.Monoid
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp
import qualified Text.Read as Read
Expand Down Expand Up @@ -144,13 +145,14 @@ instance Semigroup ForeignLib where
, foreignLibType = combine foreignLibType
, foreignLibOptions = combine foreignLibOptions
, foreignLibBuildInfo = combine foreignLibBuildInfo
, foreignLibVersionInfo = combine'' foreignLibVersionInfo
, foreignLibVersionLinux = combine'' foreignLibVersionLinux
, foreignLibVersionInfo = chooseLast foreignLibVersionInfo
, foreignLibVersionLinux = chooseLast foreignLibVersionLinux
, foreignLibModDefFile = combine foreignLibModDefFile
}
where
combine field = field a `mappend` field b
combine'' field = field b
-- chooseLast: the second field overrides the first, unless it is Nothing
chooseLast field = getLast (Last (field a) <> Last (field b))

instance Monoid ForeignLib where
mempty =
Expand Down
22 changes: 11 additions & 11 deletions Cabal-syntax/src/Distribution/Types/UnqualComponentName.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,6 @@ module Distribution.Types.UnqualComponentName

import Distribution.Compat.Prelude
import Distribution.Utils.ShortText
import Prelude as P (null)

import Distribution.Parsec
import Distribution.Pretty
Expand Down Expand Up @@ -111,28 +110,29 @@ unqualComponentNameToPackageName = mkPackageNameST . unUnqualComponentNameST
-- (partial function).
-- Useful in 'Semigroup' and similar instances.
combineNames
:: a
:: (Monoid b, Eq b, Show b)
=> a
-> a
-> (a -> UnqualComponentName)
-> (a -> b)
-> String
-> UnqualComponentName
-> b
combineNames a b tacc tt
-- One empty or the same.
| P.null unb
|| una == unb =
| nb == mempty
|| na == nb =
na
| P.null una = nb
| na == mempty =
nb
-- Both non-empty, different.
| otherwise =
error $
"Ambiguous values for "
++ tt
++ " field: '"
++ una
++ show na
++ "' and '"
++ unb
++ show nb
++ "'"
where
(na, nb) = (tacc a, tacc b)
una = unUnqualComponentName na
unb = unUnqualComponentName nb
{-# INLINEABLE combineNames #-}

0 comments on commit 78d89a9

Please sign in to comment.