Show version comparision state
[darcs-mirror-hpvt.git] / PlatformOutput.hs
1 {-# LANGUAGE PatternGuards #-}
2 module PlatformOutput (outputPlatform) where
3
4 import Text.XHtml hiding (version)
5 import qualified Data.Map as M
6 import qualified Data.Set as S
7 import Data.Maybe
8 import Data.Char
9 import System.Time
10
11 import Distribution.Package hiding (PackageName)
12 import Distribution.PackageDescription
13 import Distribution.Text
14 import Distribution.Version (VersionRange(ThisVersion))
15 import qualified Data.Version as DV
16 import Data.Version (showVersion, parseVersion)
17 import Text.ParserCombinators.ReadP (readP_to_S, between, eof)
18
19 import Types
20
21 outputPlatform :: (Show t) => t -> 
22  DistroInfo ->
23  [ (PackageDescription,[(String, M.Map PackageName Version)]) ] ->
24  String
25 outputPlatform time hackage datas = showHtml $ page time << mkTable hackage datas
26
27 myTitle = "Haskell Platform Version Tracker"
28
29 page time content = thehtml << (header << thetitle << myTitle +++
30                            body << (
31                                 h1 << myTitle +++
32                                 p << ("Last update: " +++ show time) +++
33                                 content +++
34                                 footer))
35
36 mkTable hackage datas = table << (
37                 tr << (
38                     th << "Package name" +++
39                     concatHtml (map (\(p,dists) ->
40                         th << (display (pkgName (package p)) +++ br +++
41                                display (pkgVersion (package p))) +++
42                         concatHtml (map (\(name,_) ->
43                             th << name
44                         ) dists) +++
45                         th << (spaceHtml +++ spaceHtml +++ spaceHtml +++ spaceHtml +++ spaceHtml)
46                     ) datas) +++
47                     th << "Hackage"
48                 ) +++
49                 (concatHtml $ map row $ S.toList pkgs)
50                 )
51   where buildDependsMap pd = M.fromList (map fromDep deps)
52           where fromDep (Dependency pkg (ThisVersion ver)) = (fromCabal pkg,ver)
53                 fromDep d = error $ "Unexpected dependency format " ++ display d
54                 deps = buildDepends pd ++ buildTools bi
55                 bi = libBuildInfo (fromJust (library pd))
56         maps = map (\(p,dists) -> (buildDependsMap p,dists)) datas
57         pkgs = S.unions (map (M.keysSet . fst) maps)
58         
59
60         row pkg = tr << (
61                       td << show pkg +++
62                       concatHtml (map (\(pm,dists) ->
63                         case M.lookup pkg pm of
64                             Just ver -> 
65                                 td << showVersion ver +++
66                                 concatHtml (map (\(_,dm) -> case M.lookup pkg dm of
67                                     Just dver ->
68                                         mkCell dver $
69                                             " " +++ vCmp ver dver
70                                     Nothing -> none
71                                 ) dists) +++
72                                 emptyCell
73                             Nothing ->
74                                 emptyCell +++
75                                 concatHtml (map (const emptyCell) dists) +++
76                                 emptyCell
77                       ) maps) +++
78                       case M.lookup pkg hackage of
79                         Just hver -> mkCell hver noHtml
80                         Nothing -> none
81                   )
82         mkCell (Version v u) more = td << (hotlink u << v +++ more)
83         none = td << "–"
84         emptyCell = td << noHtml
85
86         vCmp ver (Version dver _) = case dver' `compare` ver of
87             LT -> "(<)"
88             EQ -> "(=)"
89             GT -> "(>)"
90             where upstream_version = takeWhile (/= '-') dver
91                   dver' | Just ver' <- fromDotless upstream_version
92                             = ver'
93                         | otherwise
94                             = parseVersion' upstream_version
95
96 fromDotless str =
97     if length str == 8 && all isDigit str
98     then Just (DV.Version (map read [take 4 str, take 2 (drop 4 str), drop 6 str]) [])
99     else Nothing
100         
101
102 parseVersion' str =
103     case readP_to_S (between (return ()) eof parseVersion) str of
104         [(v,"")] -> v
105         x -> error $ "Could not parse " ++ str ++ ": " ++ show x
106
107
108 footer = p << ("This is created by " +++
109                hotlink "http://darcs.nomeata.de/hpvt/" << "hptv" +++
110                ", written by " +++
111                hotlink "mailto:mail@joachim-breitner.de" << "Joachim Breitner" +++
112                ". At the moment it is updated automatically every night.")