Correctly(?) sort versions
authorJoachim Breitner <mail@joachim-breitner.de>
Wed, 9 Mar 2011 06:08:47 +0000 (06:08 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Wed, 9 Mar 2011 06:08:47 +0000 (06:08 +0000)
PlatformOutput.hs
Types.hs
Utils.hs

index add86e6..82f17a0 100644 (file)
@@ -5,7 +5,6 @@ import Text.XHtml hiding (version)
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Maybe
-import Data.Char
 import System.Time
 
 import Distribution.Package hiding (PackageName)
@@ -14,7 +13,6 @@ import Distribution.Text
 import Distribution.Version (VersionRange(ThisVersion))
 import qualified Data.Version as DV
 import Data.Version (showVersion, parseVersion)
-import Text.ParserCombinators.ReadP (readP_to_S, between, eof)
 
 import Types
 import Utils
@@ -67,7 +65,7 @@ mkTable hackage datas = table << (
                                 concatHtml (map (\(_,dm) -> case M.lookup pkg dm of
                                     Just dver ->
                                         mkCell dver $
-                                            " " +++ vCmp ver dver
+                                            " " +++ showVCmp ver dver
                                     Nothing -> none
                                 ) dists) +++
                                 emptyCell
@@ -84,26 +82,10 @@ mkTable hackage datas = table << (
        none = td << "–"
         emptyCell = td << noHtml
 
-        vCmp ver (Version dver _) = case dver' `compare` ver of
+        showVCmp ver (Version dver _) = case dver `vCmp` showVersion ver of
             LT -> "(<)"
             EQ -> "(=)"
             GT -> "(>)"
-            where dver' | Just ver' <- fromDotless (upstream dver)
-                            = ver'
-                        | otherwise
-                            = parseVersion' (upstream dver)
-
-fromDotless str =
-    if length str == 8 && all isDigit str
-    then Just (DV.Version (map read [take 4 str, take 2 (drop 4 str), drop 6 str]) [])
-    else Nothing
-        
-
-parseVersion' str =
-    case readP_to_S (between (return ()) eof parseVersion) str of
-        [(v,"")] -> v
-        x -> error $ "Could not parse " ++ str ++ ": " ++ show x
-
 
 footer = p << ("This is created by " +++
               hotlink "http://darcs.nomeata.de/hpvt/" << "hptv" +++
index 22d1a34..bb5f98e 100644 (file)
--- a/Types.hs
+++ b/Types.hs
@@ -5,13 +5,15 @@ import qualified Data.Map as M
 
 import qualified Distribution.Package as D
 
+import Utils
+
 type DistroInfo = M.Map PackageName Version
 
 newtype PackageName = PN String
 data Version = Version { version :: String, url :: URL} deriving (Eq)
 
 instance Ord Version where
-       v1 `compare` v2 = version v1 `compare` version v2
+       v1 `compare` v2 = version v1 `vCmp` version v2
 
 type URL = String
 
@@ -27,3 +29,4 @@ instance Show PackageName where
 fromHackage = PN
 fromDebian = PN
 fromCabal (D.PackageName n) = PN n
+
index a8f5a90..5a462c5 100644 (file)
--- a/Utils.hs
+++ b/Utils.hs
@@ -1,8 +1,13 @@
+{-# LANGUAGE PatternGuards #-}
 module Utils where
 
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.List
+import Data.Char
+import qualified Data.Version as DV
+import Data.Version (showVersion, parseVersion)
+import Text.ParserCombinators.ReadP (readP_to_S, between, eof)
 
 isSublistOf []   _   = True
 isSublistOf what l = contains' l
@@ -38,3 +43,20 @@ upstream str = case elemIndices '-' str of
                [] -> str
                idx -> take (last idx) str
  
+vCmp ver1 ver2 = toDVer ver1 `compare` toDVer ver2
+
+toDVer ver | Just ver' <- fromDotless (upstream ver) = ver'
+           | otherwise                               = parseVersion' (upstream ver)
+
+
+fromDotless str =
+    if length str == 8 && all isDigit str
+    then Just (DV.Version (map read [take 4 str, take 2 (drop 4 str), drop 6 str]) [])
+    else Nothing
+        
+
+parseVersion' str =
+    case readP_to_S (between (return ()) eof parseVersion) str of
+        [(v,"")] -> v
+        x -> error $ "Could not parse \"" ++ str ++ "\" as a version: " ++ show x
+