diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## 6.0.6 (2024-03-08) + +#### Fixed + +- Account for large numbers when parsing on 32-bit (or smaller) systems. + ## 6.0.5 (2024-01-24) #### Fixed diff --git a/Data/Versions.hs b/Data/Versions.hs --- a/Data/Versions.hs +++ b/Data/Versions.hs @@ -91,13 +91,13 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Void (Void) +import Data.Word (Word64) import GHC.Generics (Generic) import Language.Haskell.TH (Exp, Q) import Language.Haskell.TH.Syntax (Lift(..)) import Text.Megaparsec hiding (chunk) import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L -import Text.Megaparsec.Char.Lexer (decimal) --- @@ -105,7 +105,7 @@ -- This allows each subtype to have its own parser, and for said parsers to be -- composed. This is useful for specifying custom behaviour for when a certain -- parser fails. -data Versioning = Ideal SemVer | General Version | Complex Mess +data Versioning = Ideal !SemVer | General !Version | Complex !Mess deriving (Eq, Show, Generic, NFData, Hashable, Lift, Data) -- | Short-hand for detecting a `SemVer`. @@ -476,7 +476,7 @@ -- r3 -- 0rc1-abc3 -- @ -data Chunk = Numeric Word | Alphanum Text +data Chunk = Numeric !Word | Alphanum !Text deriving stock (Eq, Show, Read, Generic, Lift, Data) deriving anyclass (NFData, Hashable) @@ -671,11 +671,11 @@ -- it could be, alongside the original text it came from. This preserves both -- `Ord` and pretty-print behaviour for versions like @1.003.0@. data MChunk - = MDigit Word Text + = MDigit !Word !Text -- ^ A nice numeric value. - | MRev Word Text + | MRev !Word !Text -- ^ A numeric value preceeded by an @r@, indicating a revision. - | MPlain Text + | MPlain !Text -- ^ Anything else. deriving stock (Eq, Show, Generic, Lift, Data) deriving anyclass (NFData, Hashable) @@ -850,8 +850,18 @@ -- | Parse a group of digits, which can't be lead by a 0, unless it is 0. unsignedP :: Parsec Void Text Word -unsignedP = (0 <$ char '0') <|> decimal +unsignedP = asWord64 >>= convertOrFail + where + asWord64 :: Parsec Void Text Word64 + asWord64 = (0 <$ char '0') <|> L.decimal + convertOrFail :: Word64 -> Parsec Void Text Word + convertOrFail w | w > bound = fail $ "Value (" ++ show w ++ ") larger than Word size: " ++ show bound + | otherwise = pure $ fromIntegral w + where + bound :: Word64 + bound = fromIntegral (maxBound :: Word) + majorP :: Parsec Void Text Word majorP = unsignedP <* char '.' @@ -904,7 +914,7 @@ -- | Internal megaparsec parser of `pvp`. pvp' :: Parsec Void Text PVP -pvp' = L.lexeme space (PVP <$> L.decimal `PC.sepBy1` char '.') +pvp' = L.lexeme space (PVP <$> unsignedP `PC.sepBy1` char '.') -- | Parse a (General) `Version`, as defined above. version :: Text -> Either ParsingError Version @@ -918,7 +928,7 @@ version'' = Version <$> optional (try epochP) <*> chunksP <*> optional releaseP <*> optional metaData epochP :: Parsec Void Text Word -epochP = read <$> (some digitChar <* char ':') +epochP = unsignedP <* char ':' chunksP :: Parsec Void Text Chunks chunksP = Chunks <$> chunkWithoutHyphensP `PC.sepBy1` char '.' @@ -1022,7 +1032,7 @@ hush (Left _) = Nothing hush (Right b) = Just b -data These a b = This a | That b | Both a b +data These a b = This !a | That !b | Both !a !b zipLongest :: [a] -> [b] -> [These a b] zipLongest [] [] = [] diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -71,3 +71,16 @@ > incPatch "1.2.3" "1.2.4" ``` + +#### Caveats + +The largest number that can be parsed as part of a version is: + +``` haskell +ghci> maxBound :: Word64 +18446744073709551615 +``` + +However, on 32-bit systems (or smaller), the maximum is their `maxBound :: Word`. +A number larger than that, even if smaller than `maxBound :: Word64`, +will yield a parse error. diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -26,6 +26,7 @@ goodVers = [ "1", "1.2", "1.0rc0", "1.0rc1", "1.1rc1", "1.58.0-3", "44.0.2403.157-1" , "0.25-2", "8.u51-1", "21-2", "7.1p1-1", "20150826-1", "1:0.10.16-3" , "1.11.0.git.20200404-1", "1.11.0+20200830-1", "1:3.20", "9.2.1.b-debug+lol" + , "0:1.2.3" ] badVers :: [T.Text] @@ -44,7 +45,12 @@ ] badSemVs :: [T.Text] -badSemVs = [ "1", "1.2", "a.b.c", "1.01.1", "1.2.3+a1b!2c3.1", "", "1.2.3 " +badSemVs = [ -- Not enough version slots + "1", "1.2", "a.b.c" + -- Illegal characters + , "1.01.1", "1.2.3+a1b!2c3.1", "", "1.2.3 " + -- Really large version + -- , "18446744073709551610000000000000000.0.0" ] goodSemVs :: [T.Text] @@ -56,6 +62,8 @@ , "1.0.0-alpha+001", "1.0.0+21AF26D3---117B344092BD" -- Zeroes , "1.2.2-00a" + -- Really large version + , "18446744073709551610.0.0" ] -- | The exact example from `http://semver.org` @@ -80,8 +88,7 @@ suite = testGroup "Tests" [ testGroup "Unit Tests" [ testGroup "(Ideal) Semantic Versioning" - [ testGroup "Bad Versions (shouldn't parse)" $ - map (\s -> testCase (T.unpack s) $ assertBool "A bad version parsed" $ isLeft $ semver s) badSemVs + [ testGroup "Bad Versions (shouldn't parse)" $ map bad badSemVs , testGroup "Good Versions (should parse)" $ map (\s -> testCase (T.unpack s) $ isomorphSV s) goodSemVs , testGroup "Comparisons" $ @@ -205,6 +212,11 @@ ] ] ] + +bad :: T.Text -> TestTree +bad s = testCase (T.unpack s) $ case semver s of + Left _ -> pure () + Right s' -> assertFailure $ "A bad version parsed: " ++ T.unpack (prettySemVer s') compVer :: T.Text -> T.Text -> TestTree compVer a b = testCase (printf "%s < %s" a b) $ comp versioning a b diff --git a/versions.cabal b/versions.cabal --- a/versions.cabal +++ b/versions.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: versions -version: 6.0.5 +version: 6.0.6 synopsis: Types and parsers for software version numbers. description: A library for parsing and comparing software version numbers. We like to give