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
|
{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
import Control.Lens
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty)
import Data.Set as Set (singleton, insert)
import Data.Text as Text (intercalate)
import Debian.Changes (ChangeLog(..))
import Debian.Debianize
import Debian.Debianize.Finalize (debianize)
import Debian.Debianize.Optparse (parseProgramArguments, CommandLineOptions(..))
import Debian.Pretty (ppShow)
import Debian.Policy (databaseDirectory, PackageArchitectures(All), StandardsVersion(StandardsVersion))
import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel), SrcPkgName(..), VersionReq(SLT))
import Debian.Version (parseDebianVersion')
-- This looks somewhat like a "real" Debianize.hs file except that (1) it
-- expects to be run from the cabal-debian source directory and (2) it returns
-- the comparison string instead of doing a writeDebianization, and (3) it reads
-- and writes the test-data directories instead of ".". Also, you wouldn't want
-- to copyFirstLogEntry in real life, this is to make sure old and new match.
main :: IO ()
main =
do log <- withCurrentDirectory "test-data/artvaluereport2/input" $ parseProgramArguments >>= \opts -> newCabalInfo (_flags opts) >>= either error (evalCabalT (liftCabal inputChangeLog >> use (debInfo . changelog)))
new <- withCurrentDirectory "test-data/artvaluereport2/input" $ parseProgramArguments >>= \opts -> newCabalInfo (_flags opts) >>= either error (execCabalT (debianize (debianDefaults >> customize log {- >> removeFirstLogEntry -})))
old <- withCurrentDirectory "test-data/artvaluereport2/output" $ parseProgramArguments >>= \opts -> execDebianT inputDebianization (makeDebInfo (_flags opts))
-- The newest log entry gets modified when the Debianization is
-- generated, it won't match so drop it for the comparison.
putStr $ concat $ compareDebianization old $ view debInfo new
where
customize :: Maybe ChangeLog -> CabalT IO ()
customize log =
do (debInfo . revision) .= Nothing
(debInfo . sourceFormat) .= Native3
(debInfo . changelog) .?= log
(debInfo . atomSet) %= (Set.insert $ InstallCabalExec (BinPkgName "appraisalscope") "lookatareport" "usr/bin")
doExecutable (BinPkgName "appraisalscope") (InstallFile {execName = "appraisalscope", sourceDir = Nothing, destDir = Nothing, destName = "appraisalscope"})
doServer (BinPkgName "artvaluereport2-development") (theServer (BinPkgName "artvaluereport2-development"))
doServer (BinPkgName "artvaluereport2-staging") (theServer (BinPkgName "artvaluereport2-staging"))
doWebsite (BinPkgName "artvaluereport2-production") (theSite (BinPkgName "artvaluereport2-production"))
doBackups (BinPkgName "artvaluereport2-backups") "artvaluereport2-backups"
-- This should go into the "real" data directory. And maybe a different icon for each server?
-- install (BinPkgName "artvaluereport2-server") ("theme/ArtValueReport_SunsetSpectrum.ico", "usr/share/artvaluereport2-data")
(debInfo . binaryDebDescription (BinPkgName "artvaluereport2-backups") . description) .=
Just (Text.intercalate "\n"
[ "backup program for the appraisalreportonline.com site"
, " Install this somewhere other than where the server is running get"
, " automated backups of the database." ])
addDep (BinPkgName "artvaluereport2-production") (BinPkgName "apache2")
addServerData
addServerDeps
(debInfo . binaryDebDescription (BinPkgName "appraisalscope") . description) .= Just "Offline manipulation of appraisal database"
(debInfo . control . buildDependsIndep) %= (++ [[Rel (BinPkgName "libjs-jquery-ui") (Just (SLT (parseDebianVersion' ("1.10" :: String)))) Nothing]])
(debInfo . control . buildDependsIndep) %= (++ [[Rel (BinPkgName "libjs-jquery") Nothing Nothing]])
(debInfo . control . buildDependsIndep) %= (++ [[Rel (BinPkgName "libjs-jcrop") Nothing Nothing]])
(debInfo . binaryDebDescription (BinPkgName "artvaluereport2-staging") . architecture) .= Just All
(debInfo . binaryDebDescription (BinPkgName "artvaluereport2-production") . architecture) .= Just All
(debInfo . binaryDebDescription (BinPkgName "artvaluereport2-development") . architecture) .= Just All
-- utilsPackageNames [BinPkgName "artvaluereport2-server"]
(debInfo . sourcePackageName) .= Just (SrcPkgName "haskell-artvaluereport2")
(debInfo . control . standardsVersion) .= Just (StandardsVersion 3 9 6 Nothing)
(debInfo . control . homepage) .= Just "http://appraisalreportonline.com"
(debInfo . compat) .= Just 9
addServerDeps :: CabalT IO ()
addServerDeps = mapM_ addDeps (map BinPkgName ["artvaluereport2-development", "artvaluereport2-staging", "artvaluereport2-production"])
addDeps p = mapM_ (addDep p) (map BinPkgName ["libjpeg-progs", "libjs-jcrop", "libjs-jquery", "libjs-jquery-ui", "netpbm", "texlive-fonts-extra", "texlive-fonts-recommended", "texlive-latex-extra", "texlive-latex-recommended"])
addDep p dep = (debInfo . binaryDebDescription p . relations . depends) %= (++ [[Rel dep Nothing Nothing]])
addServerData :: CabalT IO ()
addServerData = mapM_ addData (map BinPkgName ["artvaluereport2-development", "artvaluereport2-staging", "artvaluereport2-production"])
addData p =
do (debInfo . atomSet) %= (Set.insert $ InstallData p "theme/ArtValueReport_SunsetSpectrum.ico" "ArtValueReport_SunsetSpectrum.ico")
mapM_ (addDataFile p) ["Udon.js", "flexbox.css", "DataTables-1.8.2", "html5sortable", "jGFeed", "searchMag.png",
"Clouds.jpg", "tweaks.css", "verticalTabs.css", "blueprint", "jquery.blockUI", "jquery.tinyscrollbar"]
addDataFile p path = (debInfo . atomSet) %= (Set.insert $ InstallData p path path)
theSite :: BinPkgName -> Site
theSite deb =
Site { domain = hostname'
, serverAdmin = "logic@seereason.com"
, server = theServer deb }
theServer :: BinPkgName -> Server
theServer deb =
Server { hostname =
case deb of
BinPkgName "artvaluereport2-production" -> hostname'
_ -> hostname'
, port = portNum deb
, headerMessage = "Generated by artvaluereport2/Setup.hs"
, retry = "60"
, serverFlags =
([ "--http-port", show (portNum deb)
, "--base-uri", case deb of
BinPkgName "artvaluereport2-production" -> "http://" ++ hostname' ++ "/"
_ -> "http://seereason.com:" ++ show (portNum deb) ++ "/"
, "--top", databaseDirectory deb
, "--logs", "/var/log/" ++ ppShow deb
, "--log-mode", case deb of
BinPkgName "artvaluereport2-production" -> "Production"
_ -> "Development"
, "--static", "/usr/share/artvaluereport2-data"
, "--no-validate" ] ++
(case deb of
BinPkgName "artvaluereport2-production" -> [{-"--enable-analytics"-}]
_ -> []) {- ++
[ "--jquery-path", "/usr/share/javascript/jquery/"
, "--jqueryui-path", "/usr/share/javascript/jquery-ui/"
, "--jstree-path", jstreePath
, "--json2-path",json2Path ] -})
, installFile =
InstallFile { execName = "artvaluereport2-server"
, destName = ppShow deb
, sourceDir = Nothing
, destDir = Nothing }
}
hostname' = "my.appraisalreportonline.com"
portNum :: BinPkgName -> Int
portNum (BinPkgName deb) =
case deb of
"artvaluereport2-production" -> 9027
"artvaluereport2-staging" -> 9031
"artvaluereport2-development" -> 9032
_ -> error $ "Unexpected package name: " ++ deb
anyrel :: BinPkgName -> Relation
anyrel b = Rel b Nothing Nothing
removeFirstLogEntry :: Monad m => CabalT m ()
removeFirstLogEntry = (debInfo . changelog) %= fmap (\ (ChangeLog (_ : tl)) -> ChangeLog tl)
copyFirstLogEntry :: DebInfo -> DebInfo -> DebInfo
copyFirstLogEntry deb1 deb2 =
over changelog (const (Just (ChangeLog (hd1 : tl2)))) deb2
where
ChangeLog (hd1 : _) = fromMaybe (error "Missing debian/changelog") (view changelog deb1)
ChangeLog (_ : tl2) = fromMaybe (error "Missing debian/changelog") (view changelog deb2)
|