+{-# 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
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
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 " +++