More spacing in header
[darcs-mirror-hpvt.git] / PlatformOutput.hs
1 module PlatformOutput (outputPlatform) where
2
3 import Text.XHtml hiding (version)
4 import qualified Data.Map as M
5 import qualified Data.Set as S
6 import Data.Maybe
7 import System.Time
8
9 import Distribution.Package hiding (PackageName)
10 import Distribution.PackageDescription
11 import Distribution.Text
12 import Distribution.Version (VersionRange(ThisVersion))
13 import Data.Version (showVersion)
14
15 import Types
16
17 outputPlatform :: (Show t) => t -> 
18  DistroInfo ->
19  [ (PackageDescription,[(String, M.Map PackageName Version)]) ] ->
20  String
21 outputPlatform time hackage datas = showHtml $ page time << mkTable hackage datas
22
23 myTitle = "Haskell Platform Version Tracker"
24
25 page time content = thehtml << (header << thetitle << myTitle +++
26                            body << (
27                                 h1 << myTitle +++
28                                 p << ("Last update: " +++ show time) +++
29                                 content +++
30                                 footer))
31
32 mkTable hackage datas = table << (
33                 tr << (
34                     th << "Package name" +++
35                     concatHtml (map (\(p,dists) ->
36                         th << (display (pkgName (package p)) +++ br +++
37                                display (pkgVersion (package p))) +++
38                         concatHtml (map (\(name,_) ->
39                             th << name
40                         ) dists) +++
41                         th << (spaceHtml +++ spaceHtml +++ spaceHtml +++ spaceHtml +++ spaceHtml)
42                     ) datas) +++
43                     th << "Hackage"
44                 ) +++
45                 (concatHtml $ map row $ S.toList pkgs)
46                 )
47   where buildDependsMap pd = M.fromList (map fromDep deps)
48           where fromDep (Dependency pkg (ThisVersion ver)) = (fromCabal pkg,ver)
49                 fromDep d = error $ "Unexpected dependency format " ++ display d
50                 deps = buildDepends pd ++ buildTools bi
51                 bi = libBuildInfo (fromJust (library pd))
52         maps = map (\(p,dists) -> (buildDependsMap p,dists)) datas
53         pkgs = S.unions (map (M.keysSet . fst) maps)
54         
55
56         row pkg = tr << (
57                       td << show pkg +++
58                       concatHtml (map (\(pm,dists) ->
59                         case M.lookup pkg pm of
60                             Just ver -> 
61                                 td << showVersion ver +++
62                                 concatHtml (map (\(_,dm) -> case M.lookup pkg dm of
63                                     Just dver -> mkCell dver
64                                     Nothing -> none
65                                 ) dists) +++
66                                 emptyCell
67                             Nothing ->
68                                 emptyCell +++
69                                 concatHtml (map (const emptyCell) dists) +++
70                                 emptyCell
71                       ) maps) +++
72                       case M.lookup pkg hackage of
73                         Just hver -> mkCell hver
74                         Nothing -> none
75                   )
76         mkCell (Version v u) = td << hotlink u << v
77         none = td << "–"
78         emptyCell = td << noHtml
79
80 footer = p << ("This is created by " +++
81                hotlink "http://darcs.nomeata.de/hpvt/" << "hptv" +++
82                ", written by " +++
83                hotlink "mailto:mail@joachim-breitner.de" << "Joachim Breitner" +++
84                ". At the moment it is updated automatically every night.")