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