hoogle/Deploy.hs at master · rul/hoogle · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
{-|
    Helper code for deployment of releases
    sdist + sanity checks + database generation
-}

module Main(main) where

import Control.Exception
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import System.Cmd
import System.Directory
import System.Environment
import System.Exit
import System.FilePath


cmds = let (*) = (,) in
       ["sdist" * sdist
       ,"sanity" * sanity
       ,"linecount" * linecount
       ,"web" * web
       ,"database" * databases
       ]


main = do
    xs <- getArgs
    case flip lookup cmds =<< listToMaybe xs of
        Nothing -> error $ "Expected one of: " ++ unwords (map fst cmds)
        Just act -> act


---------------------------------------------------------------------
-- SDIST

sdist = do
    sanity
    databases
    sanity
    system_ "cabal install --global"
    system_ "cabal sdist"


databases = do
    system_ "cabal configure"
    system_ "cabal build"
    withDirectory "data/generate" $
        system_ "run.bat"


---------------------------------------------------------------------
-- SANITY CHECK

sanity = do
    src <- liftM (map (dropWhile isSpace) . lines) $ readFile "hoogle.cabal"
    let grab x = takeWhile (/= "") $ drop 1 $ dropWhile (/= x) src

    dbs <- filterM (doesFileExist . (</>) "database") =<< getDirectoryContents "database"
    let dataFiles = grab "data-files:"
    check dataFiles (dbs `intersect` dataFiles)

    system_ "ghc -M src/Main -isrc -i."
    deps <- readFile "Makefile"
    length deps `seq` removeFile "Makefile"
    check (grab "other-modules:") (parseMakefile deps \\ ["Main"])

    putStrLn "Sanity check passed"


parseMakefile = nub . concatMap f . concatMap words . lines
    where
        f xs = [map g $ dropExtension $ drop 4 xs | "src/" `isPrefixOf` xs]
        g x = if x == '/' then '.' else x


check left right = do
    let badLeft = left \\ right
        badRight = right \\ left
    when (not $ null badLeft && null badRight) $ do
        print (badLeft,badRight)
        error "Discrepancy detected"


---------------------------------------------------------------------
-- SDIST

web = do
    createDirectoryIfMissing True "dist/web/res"
    databases
    system_ "ssh ndm@community.haskell.org -m misc/build-compile.sh"
    system_ "scp ndm@community.haskell.org:/tmp/ndm/hoogle/dist/build/hoogle/hoogle dist/web/index.cgi"
    copyFiles "database" "dist/web/res" ["hoo"]
    copyFiles "src/res" "dist/web/res" ["js","css","png","xml"]
    withDirectory "dist/web" $ system_ "tar -cf ../web.tar *"
    system_ "gzip dist/web.tar --force"
    system_ "scp -r dist/web.tar.gz ndm@haskell.org:/haskell/hoogle/release.tar.gz"
    system_ "ssh ndm@haskell.org -m misc/build-unpack.sh"


---------------------------------------------------------------------
-- LINECOUNT

linecount = do
    src <- liftM (map (dropWhile isSpace) . lines) $ readFile "hoogle.cabal"
    let files = sort $ (:) "Main" $ takeWhile (/= "") $ drop 1 $ dropWhile (/= "other-modules:") src
        lenfiles = maximum $ map length files

    let out x n = do let s = show n
                     putStrLn $ x ++ replicate (8 + lenfiles - length x - length s) ' ' ++ s

    let f x = do sz <- size x
                 out x sz
                 return sz

    xs <- mapM f files
    out "Total" (sum xs)


size modu = do
    let file = "src" </> map (\x -> if x == '.' then '/' else x) modu <.> "hs"
    src <- readFile file
    return $ length $ lines src

---------------------------------------------------------------------
-- UTIL

system_ x = do
    putStrLn $ "Running " ++ x
    r <- system x
    when (r /= ExitSuccess) $ error "System command failed"


copyFiles from to exts = do
    xs <- getDirectoryContents from
    sequence [copyFile (from </> x) (to </> x) | x <- xs
             ,takeExtension x `elem` map ('.':) exts]


withDirectory dir act = do
    x <- getCurrentDirectory
    bracket_
        (setCurrentDirectory dir)
        (setCurrentDirectory x)
        act