Show version comparision state

diff --git a/PlatformOutput.hs b/PlatformOutput.hs
index 4a4e89f..fe89c70 100644 (file)
--- a/PlatformOutput.hs
+++ b/PlatformOutput.hs
@@ -1,16 +1,20 @@
+{-# LANGUAGE PatternGuards #-}
 module PlatformOutput (outputPlatform) where
 
 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)
 import Distribution.PackageDescription
 import Distribution.Text
 import Distribution.Version (VersionRange(ThisVersion))
-import Data.Version (showVersion)
+import qualified Data.Version as DV
+import Data.Version (showVersion, parseVersion)
+import Text.ParserCombinators.ReadP (readP_to_S, between, eof)
 
 import Types
 
@@ -60,7 +64,9 @@ mkTable hackage datas = table << (
                             Just ver -> 
                                 td << showVersion ver +++
                                 concatHtml (map (\(_,dm) -> case M.lookup pkg dm of
-                                    Just dver -> mkCell dver
+                                    Just dver ->
+                                        mkCell dver $
+                                            " " +++ vCmp ver dver
                                     Nothing -> none
                                 ) dists) +++
                                 emptyCell
@@ -70,13 +76,35 @@ mkTable hackage datas = table << (
                                 emptyCell
                       ) maps) +++
                       case M.lookup pkg hackage of
-                        Just hver -> mkCell hver
+                        Just hver -> mkCell hver noHtml
                         Nothing -> none
                   )
-        mkCell (Version v u) = td << hotlink u << v
+        mkCell (Version v u) more = td << (hotlink u << v +++ more)
        none = td << "–"
         emptyCell = td << noHtml
 
+        vCmp ver (Version dver _) = case dver' `compare` ver of
+            LT -> "(<)"
+            EQ -> "(=)"
+            GT -> "(>)"
+            where upstream_version = takeWhile (/= '-') dver
+                  dver' | Just ver' <- fromDotless upstream_version
+                            = ver'
+                        | otherwise
+                            = parseVersion' upstream_version
+
+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" +++
               ", written by " +++