{-# 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)