Skip to content

Instantly share code, notes, and snippets.

@josephcsible
Last active May 27, 2022 03:58
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save josephcsible/7ee0681ac9bb67b4ccad1ead5d8300e3 to your computer and use it in GitHub Desktop.
Save josephcsible/7ee0681ac9bb67b4ccad1ead5d8300e3 to your computer and use it in GitHub Desktop.
A comparator for upstream_version and debian_revision strings, as described at https://www.debian.org/doc/debian-policy/ch-controlfields.html#version
{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving, TypeApplications #-}
import Data.Char
import Data.Function
newtype DebianVersionString = DebianVersionString String deriving newtype Show
instance Eq DebianVersionString where
x == y = compare x y == EQ
instance Ord DebianVersionString where
DebianVersionString x `compare` DebianVersionString y = nondigitCompare x y where
nondigitCompare :: String -> String -> Ordering
nondigitCompare "" "" = EQ
nondigitCompare xs ys = tildeCompare xns yns <> digitCompare xds yds where
(xns, xds) = break isDigit xs
(yns, yds) = break isDigit ys
digitCompare :: String -> String -> Ordering
digitCompare "" "" = EQ
digitCompare xs ys = numericCompare xds yds <> nondigitCompare xns yns where
(xds, xns) = span isDigit xs
(yds, yns) = span isDigit ys
tildeCompare :: String -> String -> Ordering
tildeCompare ('~':xs) ('~':ys) = tildeCompare xs ys
tildeCompare ('~':_) _ = LT
tildeCompare _ ('~':_) = GT
tildeCompare [] [] = EQ
tildeCompare [] _ = LT
tildeCompare _ [] = GT
tildeCompare (x:xs) (y:ys) = letterFirstCompare x y <> tildeCompare xs ys
letterFirstCompare :: Char -> Char -> Ordering
letterFirstCompare x y = case (isLetter x, isLetter y) of
(False, True) -> GT
(True, False) -> LT
_ -> compare x y
numericCompare :: String -> String -> Ordering
numericCompare = compare @Integer `on` (read . ('0':))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment