diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +# 0.1.0.0 + +- Changed the role of the value type parameter of `MonoidMap` from + `representational` to `nominal`. This prevents coercions between + `MonoidMap` types with different value types, which could produce maps + that contain `mempty` values. + + This is a breaking change: code that performs such coercions will no + longer compile. + # 0.0.6.1 - Improved the performance of `fromMap`, particularly for maps that diff --git a/components/monoidmap-test/Data/MonoidMap/CoercionSpec.hs b/components/monoidmap-test/Data/MonoidMap/CoercionSpec.hs new file mode 100644 --- /dev/null +++ b/components/monoidmap-test/Data/MonoidMap/CoercionSpec.hs @@ -0,0 +1,42 @@ +{-# OPTIONS_GHC -fdefer-type-errors #-} +{-# OPTIONS_GHC -Wno-deferred-type-errors #-} + +-- | +-- Copyright: © 2022–2026 Jonathan Knowles +-- License: Apache-2.0 +-- +-- Tests for coercions of 'MonoidMap' values. +-- +module Data.MonoidMap.CoercionSpec + ( spec + ) where + +import Prelude + +import Data.Coerce + ( coerce ) +import Data.Monoid + ( Product (..), Sum (..) ) +import Data.MonoidMap + ( MonoidMap ) +import Test.Hspec + ( Spec, describe, it, shouldBe ) +import Test.Hspec.TypeError + ( shouldFailToTypecheckWith ) + +import qualified Data.MonoidMap as MonoidMap + +spec :: Spec +spec = describe "Coercion" $ do + + let source :: MonoidMap Char (Sum Int) + source = MonoidMap.singleton 'a' (Sum 1) + + it "permits coercion to the same value type" $ + (coerce source :: MonoidMap Char (Sum Int)) + `shouldBe` source + + it "forbids coercion to a different value type" $ + (coerce source :: MonoidMap Char (Product Int)) + `shouldFailToTypecheckWith` + ["Couldn't match type", "Sum Int", "Product Int", "coerce"] diff --git a/components/monoidmap-test/Spec.hs b/components/monoidmap-test/Spec.hs new file mode 100644 --- /dev/null +++ b/components/monoidmap-test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/components/monoidmap-test/Test/Hspec/TypeError.hs b/components/monoidmap-test/Test/Hspec/TypeError.hs new file mode 100644 --- /dev/null +++ b/components/monoidmap-test/Test/Hspec/TypeError.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE RankNTypes #-} + +-- | +-- Copyright: © 2022–2026 Jonathan Knowles +-- License: Apache-2.0 +-- +-- Provides expectations about ill-typed expressions. +-- +module Test.Hspec.TypeError + ( shouldFailToTypecheckWith + ) where + +import Prelude + +import Control.DeepSeq + ( NFData, force ) +import Control.Exception + ( TypeError (TypeError), evaluate, throwIO, try ) +import Control.Monad + ( forM_, unless ) +import Data.List + ( isInfixOf, isSuffixOf ) +import Test.Hspec + ( Expectation, expectationFailure ) + +-- | Expects the given expression to be ill-typed, with a type error message +-- that contains all of the given string fragments. +-- +-- The module that calls this function must be compiled with the +-- @-fdefer-type-errors@ option, so that type errors are deferred until +-- runtime, at which point they are thrown as 'TypeError' exceptions. +-- +-- Deferred type error messages are not stable: their layout, wording and +-- quotation marks vary between GHC versions and locales. Therefore, each +-- fragment should be as small as possible, and should not contain quotation +-- marks or line breaks. +-- +-- Notes on the type signature: +-- +-- - The 'NFData' constraint allows the expression to be fully evaluated, +-- which is necessary to trigger a deferred type error. +-- +-- - The @() ~ ()@ constraint delays the deferred type error until the +-- expression is evaluated by this function. Without it, GHC would +-- throw the deferred type error as soon as the enclosing definition +-- was evaluated, before this function had a chance to catch it. +-- +shouldFailToTypecheckWith + :: NFData a + => (() ~ () => a) + -- ^ An expression that should fail to typecheck. + -> [String] + -- ^ String fragments that the type error message should contain. + -> Expectation +shouldFailToTypecheckWith a fragments = + try (evaluate (force a)) >>= \case + Right _ -> + expectationFailure + "Expected a type error, but the expression was well-typed." + Left e@(TypeError message) + | not ("(deferred type error)" `isSuffixOf` message) -> + throwIO e + | otherwise -> + forM_ fragments $ \fragment -> + unless (fragment `isInfixOf` message) $ + expectationFailure $ unlines + [ "Type error message did not contain: " + <> show fragment + , "Type error message:" + , message + ] diff --git a/monoidmap.cabal b/monoidmap.cabal --- a/monoidmap.cabal +++ b/monoidmap.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: monoidmap -version: 0.0.6.1 +version: 0.1.0.0 homepage: https://github.com/jonathanknowles/monoidmap bug-reports: https://github.com/jonathanknowles/monoidmap/issues license: Apache-2.0 @@ -25,10 +25,12 @@ build-depends:deepseq >= 1.4.4.0 && < 1.6 common dependency-groups build-depends:groups >= 0.5.3 && < 0.6 +common dependency-hspec + build-depends:hspec >= 2.10.9 && < 2.12 common dependency-monoid-subclasses build-depends:monoid-subclasses >= 1.2.3 && < 1.3 common dependency-monoidmap-internal - build-depends:monoidmap-internal >= 0.1.2.0 && < 0.2 + build-depends:monoidmap-internal >= 0.2.0.0 && < 0.3 common dependency-nothunks build-depends:nothunks >= 0.1.3 && < 0.4 @@ -73,3 +75,25 @@ Data.MonoidMap default-language: Haskell2010 + +test-suite monoidmap-test + import: + , dependency-base + , dependency-deepseq + , dependency-hspec + , extensions + build-depends: + , monoidmap + main-is: + Spec.hs + hs-source-dirs: + components/monoidmap-test + other-modules: + Data.MonoidMap.CoercionSpec + Test.Hspec.TypeError + type: + exitcode-stdio-1.0 + default-language: + Haskell2010 + build-tool-depends: + hspec-discover:hspec-discover ==2.*