cabal-debian-4.30: test-data/artvaluereport2/input/debian/Debianize.hs
{-# LANGUAGE CPP, 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) >>= evalCabalT (liftCabal inputChangeLog >> use (debInfo . changelog))
new <- withCurrentDirectory "test-data/artvaluereport2/input" $ parseProgramArguments >>= \opts -> newCabalInfo (_flags opts) >>= 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)