diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,17 @@ # Revision history for mmzk-typeid +## 0.7.0.1 -- 2024-10-10 + +* Add `Generic` derivation to `TypeID'`, `KindID'`, and `UUIDVersion`. + +* Test the type-level constraints of `KindID` using an external GHC interpreter. + +* Stop testing on GHC 9.2, replacing with tests on GHC 9.4. + +* Update description in "Data.UUID.V7" to reflect the fact that UUIDv7 standard has been finalised. + + ## 0.7.0.0 -- 2024-07-03 * Use `String`s instead of `Text`s inside the constructors of `TypeIDError` so that it is easier to use the promoted constructors. diff --git a/mmzk-typeid.cabal b/mmzk-typeid.cabal --- a/mmzk-typeid.cabal +++ b/mmzk-typeid.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: mmzk-typeid -version: 0.7.0.0 +version: 0.7.0.1 synopsis: A TypeID and UUIDv7 implementation for Haskell description: @@ -35,8 +35,8 @@ maintainer: Yitang Chen category: Data, UUID, UUIDv7, TypeID tested-with: - GHC == 9.2.8 - GHC == 9.6.1 + GHC == 9.4.8 + GHC == 9.6.4 GHC == 9.8.2 extra-source-files: CHANGELOG.md @@ -173,6 +173,7 @@ containers ^>=0.6, entropy, hashable, + hint ^>=0.9, hspec ^>=2.11, random, text, diff --git a/src/Data/KindID/Internal.hs b/src/Data/KindID/Internal.hs --- a/src/Data/KindID/Internal.hs +++ b/src/Data/KindID/Internal.hs @@ -32,6 +32,7 @@ import qualified Data.UUID.V7 as V7 import Data.UUID.Versions import Foreign +import GHC.Generics (Generic) import GHC.TypeLits (symbolVal) -- | A TypeID with the prefix encoded at type level. @@ -39,7 +40,7 @@ -- It is dubbed 'Data.KindID.V7.KindID' because the prefix here is a data kind -- rather than a type. newtype KindID' (version :: UUIDVersion) prefix = KindID' UUID - deriving (Eq, Ord, Data, Typeable) + deriving (Eq, Ord, Data, Typeable, Generic) instance (ToPrefix prefix, ValidPrefix (PrefixSymbol prefix)) => Show (KindID' version prefix) where diff --git a/src/Data/TypeID/Internal.hs b/src/Data/TypeID/Internal.hs --- a/src/Data/TypeID/Internal.hs +++ b/src/Data/TypeID/Internal.hs @@ -41,6 +41,7 @@ import qualified Data.UUID.V5 as V5 import qualified Data.UUID.V7 as V7 import Data.UUID.Versions +import GHC.Generics (Generic) import Foreign import System.Random @@ -50,7 +51,7 @@ -- The constructor is not exposed to the public API to prevent generating -- invalid 'TypeID''s. data TypeID' (version :: UUIDVersion) = TypeID' Text UUID - deriving (Eq, Ord, Data, Typeable) + deriving (Eq, Ord, Data, Typeable, Generic) instance Show (TypeID' version) where show :: TypeID' version -> String diff --git a/src/Data/UUID/V7.hs b/src/Data/UUID/V7.hs --- a/src/Data/UUID/V7.hs +++ b/src/Data/UUID/V7.hs @@ -9,10 +9,6 @@ -- UUIDv7 is not currently present in the uuid package, therefore I have to -- make a quick patch of my own. -- --- Note that since the specification for v7 is not yet finalised, this module's --- implementation may change in the future according to the potential --- adjustments in the specification. --- module Data.UUID.V7 ( -- * Data type @@ -39,7 +35,6 @@ import Data.IORef import Data.Time.Clock.POSIX import Data.UUID.Types.Internal - import Data.UUID.Versions import System.Entropy import System.IO.Unsafe (unsafePerformIO) @@ -141,7 +136,7 @@ -- | The global mutable state of (timestamp, sequence number). -- --- The "NOINLINE" pragma is IMPORTANT! The logic would be flawed if it is +-- The \"NOINLINE\" pragma is IMPORTANT! The logic would be flawed if it is -- is inlined by its definition. __state__ :: IORef (Word64, Word16) __state__ = unsafePerformIO (newIORef (0, 0)) diff --git a/src/Data/UUID/Versions.hs b/src/Data/UUID/Versions.hs --- a/src/Data/UUID/Versions.hs +++ b/src/Data/UUID/Versions.hs @@ -16,11 +16,12 @@ import Data.Bits import Data.UUID.Types.Internal +import GHC.Generics (Generic) -- | The supported 'UUID' versions. These constructors are used as type-level -- tags for 'Data.TypeID.TypeID''. data UUIDVersion = V1 | V4 | V5 | V7 - deriving (Eq, Ord, Bounded, Enum, Show) + deriving (Eq, Ord, Bounded, Enum, Show, Generic) toInt :: Num a => UUIDVersion -> a toInt V1 = 1 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -36,6 +36,19 @@ import Data.UUID.Versions import Foreign import GHC.Generics (Generic) +import Language.Haskell.Interpreter + ( Extension(..) + , OptionVal(..) + , InterpreterError(..) + , GhcError(..) + , eval + , runInterpreter + , set + , languageExtensions + , loadModules + , setImports + , searchPath + , runStmt ) import Test.Hspec data TestData = TestData { name :: String @@ -64,6 +77,20 @@ anyTypeIDError :: Selector TypeIDError anyTypeIDError = const True +prefixHasExpectedError :: String -> String -> IO () +prefixHasExpectedError str expectedErr = do + result <- runInterpreter do + set [languageExtensions := [AllowAmbiguousTypes, DataKinds, TypeFamilies], searchPath := ["./src"]] + loadModules ["Data.KindID.Class"] + setImports ["Prelude", "Data.KindID.Class"] + runStmt $ "foo :: ValidPrefix " <> show str <> " => () <- return ()" + eval "foo" + case result of + Left (WontCompile [e]) -> head (lines (errMsg e)) `shouldBe` expectedErr + Left (WontCompile _) -> fail "Unexpected number of type errors!" + Left _ -> fail "Impossible: cannot interpret!" + Right _ -> fail "Unexpected success!" + withCheck :: HasCallStack => (IDConv a, IDGen a) => IO a -> IO a withCheck action = do tid <- action @@ -84,10 +111,25 @@ main :: IO () main = hspec do + typeLevelTest v7Test v1Test v4Test v5Test + +typeLevelTest :: Spec +typeLevelTest = describe "Reject malformed KindID previx at compile time" do + it "rejects invalid alphabet" do + prefixHasExpectedError "sZb" "The prefix \"sZb\" contains invalid character 'Z'!" + it "rejects single underscore" do + prefixHasExpectedError "_" "The underscore separator should not be present if the prefix is empty!" + it "rejects trailing underscore" do + prefixHasExpectedError "a_" "The prefix \"a_\" should not end with an underscore!" + it "rejects starting underscore" do + prefixHasExpectedError "_a" "The prefix \"_a\" should not start with an underscore!" + it "rejects long prefix" do + prefixHasExpectedError "qwertyuiopasdfghjklzxcvbnm____________qwertyuiopasdfghjklzxcvbnm" + "The prefix \"qwertyuiopasdfghjklzxcvbnm____________qwertyuiopasdfghjklzxcvbnm\" with 64 characters is too long!" v7Test :: Spec v7Test = do