-- | Things that seem like they could be clients of this library, but
-- are instead included as part of the library.
{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Debian.Debianize.Goodies
    ( tightDependencyFixup
    , expandWebsite, doWebsite
    , expandServer, doServer
    , expandBackups, doBackups
    , doExecutable
    , oldClckwrksSiteFlags
    , oldClckwrksServerFlags
    , siteAtoms
    , logrotate
    , serverAtoms
    , backupAtoms
    , execAtoms
    ) where

import Control.Lens
import Control.Monad.State (MonadState(get), modify)
import Data.List as List ({-dropWhileEnd, intercalate,-} intersperse, map)
import Data.Map as Map (insert, insertWith, toList)
import Data.Set as Set (insert, singleton, union)
import Data.Text as Text (pack, {-Text,-} unlines)
import qualified Debian.Debianize.DebInfo as D
import Debian.Debianize.ExecAtoms (execAtoms)
import Debian.Debianize.Monad (CabalInfo, CabalT, DebianT, execCabalM)
--import Debian.Debianize.Prelude (stripWith)
import qualified Debian.Debianize.CabalInfo as A
import qualified Debian.Debianize.BinaryDebDescription as B
import Debian.Orphans ()
import Debian.Policy (apacheAccessLog, apacheErrorLog, apacheLogDirectory, databaseDirectory, dataDirectory, serverAccessLog, serverAppLog)
import Debian.Pretty (ppText)
import Debian.Relation (BinPkgName(BinPkgName), Relation(Rel))
import Distribution.PackageDescription as Cabal (PackageDescription)
import Distribution.Simple.Build.PathsModule (pkgPathEnvVar)
import Prelude hiding (init, log, map, unlines, writeFile)
import System.FilePath ((</>))

showCommand :: String -> [String] -> String
showCommand :: [Char] -> [[Char]] -> [Char]
showCommand [Char]
cmd [[Char]]
args =
    [[Char]] -> [Char]
unwords (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
translate ([Char]
cmd [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
args))

translate :: String -> String
translate :: [Char] -> [Char]
translate [Char]
str =
    Char
'"' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: (Char -> [Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> [Char] -> [Char]
escape [Char]
"\"" [Char]
str
    where
      escape :: Char -> [Char] -> [Char]
escape Char
'"' = [Char] -> [Char] -> [Char]
showString [Char]
"\\\""
      escape Char
c = Char -> [Char] -> [Char]
showChar Char
c

-- | Create equals dependencies.  For each pair (A, B), use dpkg-query
-- to find out B's version number, version B.  Then write a rule into
-- P's .substvar that makes P require that that exact version of A,
-- and another that makes P conflict with any older version of A.
tightDependencyFixup :: Monad m => [(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m ()
tightDependencyFixup :: forall (m :: * -> *).
Monad m =>
[(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m ()
tightDependencyFixup [] BinPkgName
_ = () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
tightDependencyFixup [(BinPkgName, BinPkgName)]
pairs BinPkgName
p =
    (Set Text -> Identity (Set Text)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Text)
D.rulesFragments ((Set Text -> Identity (Set Text)) -> DebInfo -> Identity DebInfo)
-> (Set Text -> Set Text) -> StateT DebInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
Set.insert
          ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
               ([ Text
"binary-fixup/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"::"
                , Text
"\techo -n 'haskell:Depends=' >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars" ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (Text
"\techo -n ', ' >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars") (((BinPkgName, BinPkgName) -> Text)
-> [(BinPkgName, BinPkgName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (BinPkgName, BinPkgName) -> Text
equals [(BinPkgName, BinPkgName)]
pairs) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                [ Text
"\techo '' >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars"
                , Text
"\techo -n 'haskell:Conflicts=' >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars" ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (Text
"\techo -n ', ' >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars") (((BinPkgName, BinPkgName) -> Text)
-> [(BinPkgName, BinPkgName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
List.map (BinPkgName, BinPkgName) -> Text
newer [(BinPkgName, BinPkgName)]
pairs) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                [ Text
"\techo '' >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars" ]))
    where
      equals :: (BinPkgName, BinPkgName) -> Text
equals (BinPkgName
installed, BinPkgName
dependent) = Text
"\tdpkg-query -W -f='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BinPkgName -> Text
display' BinPkgName
dependent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (=$${Version})' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  BinPkgName -> Text
display' BinPkgName
installed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars"
      newer :: (BinPkgName, BinPkgName) -> Text
newer  (BinPkgName
installed, BinPkgName
dependent) = Text
"\tdpkg-query -W -f='" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BinPkgName -> Text
display' BinPkgName
dependent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" (>>$${Version})' " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BinPkgName -> Text
display' BinPkgName
installed Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" >> debian/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".substvars"
      name :: Text
name = BinPkgName -> Text
display' BinPkgName
p
      display' :: BinPkgName -> Text
display' = BinPkgName -> Text
forall a. Pretty (PP a) => a -> Text
ppText

-- | Add a debian binary package to the debianization containing a cabal executable file.
doExecutable :: Monad m => BinPkgName -> D.InstallFile -> CabalT m ()
doExecutable :: forall (m :: * -> *).
Monad m =>
BinPkgName -> InstallFile -> CabalT m ()
doExecutable BinPkgName
p InstallFile
f = ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName InstallFile
     -> Identity (Map BinPkgName InstallFile))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName InstallFile
    -> Identity (Map BinPkgName InstallFile))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName InstallFile
 -> Identity (Map BinPkgName InstallFile))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName InstallFile)
D.executable) ((Map BinPkgName InstallFile
  -> Identity (Map BinPkgName InstallFile))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName InstallFile -> Map BinPkgName InstallFile)
-> StateT CabalInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName
-> InstallFile
-> Map BinPkgName InstallFile
-> Map BinPkgName InstallFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p InstallFile
f

-- | Add a debian binary package to the debianization containing a cabal executable file set up to be a server.
doServer :: Monad m => BinPkgName -> D.Server -> CabalT m ()
doServer :: forall (m :: * -> *).
Monad m =>
BinPkgName -> Server -> CabalT m ()
doServer BinPkgName
p Server
s = ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName Server -> Identity (Map BinPkgName Server))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName Server -> Identity (Map BinPkgName Server))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName Server -> Identity (Map BinPkgName Server))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Server)
D.serverInfo) ((Map BinPkgName Server -> Identity (Map BinPkgName Server))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName Server -> Map BinPkgName Server)
-> StateT CabalInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName
-> Server -> Map BinPkgName Server -> Map BinPkgName Server
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Server
s

-- | Add a debian binary package to the debianization containing a cabal executable file set up to be a web site.
doWebsite :: Monad m => BinPkgName -> D.Site -> CabalT m ()
doWebsite :: forall (m :: * -> *). Monad m => BinPkgName -> Site -> CabalT m ()
doWebsite BinPkgName
p Site
w = ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName Site -> Identity (Map BinPkgName Site))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName Site -> Identity (Map BinPkgName Site))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName Site -> Identity (Map BinPkgName Site))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Site)
D.website) ((Map BinPkgName Site -> Identity (Map BinPkgName Site))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName Site -> Map BinPkgName Site)
-> StateT CabalInfo m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName -> Site -> Map BinPkgName Site -> Map BinPkgName Site
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
p Site
w

-- | Add a debian binary package to the debianization containing a cabal executable file set up to be a backup script.
doBackups :: Monad m => BinPkgName -> String -> CabalT m ()
doBackups :: forall (m :: * -> *).
Monad m =>
BinPkgName -> [Char] -> CabalT m ()
doBackups BinPkgName
bin [Char]
s =
    do ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName [Char] -> Identity (Map BinPkgName [Char]))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName [Char] -> Identity (Map BinPkgName [Char]))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName [Char] -> Identity (Map BinPkgName [Char]))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName [Char])
D.backups) ((Map BinPkgName [Char] -> Identity (Map BinPkgName [Char]))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName [Char] -> Map BinPkgName [Char]) -> CabalT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName
-> [Char] -> Map BinPkgName [Char] -> Map BinPkgName [Char]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
bin [Char]
s
       ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Relations -> Identity Relations)
    -> DebInfo -> Identity DebInfo)
-> (Relations -> Identity Relations)
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> Lens' DebInfo BinaryDebDescription
D.binaryDebDescription BinPkgName
bin ((BinaryDebDescription -> Identity BinaryDebDescription)
 -> DebInfo -> Identity DebInfo)
-> ((Relations -> Identity Relations)
    -> BinaryDebDescription -> Identity BinaryDebDescription)
-> (Relations -> Identity Relations)
-> DebInfo
-> Identity DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PackageRelations -> Identity PackageRelations)
-> BinaryDebDescription -> Identity BinaryDebDescription
Lens' BinaryDebDescription PackageRelations
B.relations ((PackageRelations -> Identity PackageRelations)
 -> BinaryDebDescription -> Identity BinaryDebDescription)
-> ((Relations -> Identity Relations)
    -> PackageRelations -> Identity PackageRelations)
-> (Relations -> Identity Relations)
-> BinaryDebDescription
-> Identity BinaryDebDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> Identity Relations)
-> PackageRelations -> Identity PackageRelations
Lens' PackageRelations Relations
B.depends) ((Relations -> Identity Relations)
 -> CabalInfo -> Identity CabalInfo)
-> (Relations -> Relations) -> CabalT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Relations -> Relations -> Relations
forall a. [a] -> [a] -> [a]
++ [[BinPkgName -> Maybe VersionReq -> Maybe ArchitectureReq -> Relation
Rel ([Char] -> BinPkgName
BinPkgName [Char]
"anacron") Maybe VersionReq
forall a. Maybe a
Nothing Maybe ArchitectureReq
forall a. Maybe a
Nothing]])
       -- depends +++= (bin, Rel (BinPkgName "anacron") Nothing Nothing)

oldClckwrksSiteFlags :: D.Site -> [String]
oldClckwrksSiteFlags :: Site -> [[Char]]
oldClckwrksSiteFlags Site
x =
    [ -- According to the happstack-server documentation this needs a trailing slash.
      [Char]
"--base-uri", [Char]
"http://" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Site -> [Char]
D.domain Site
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/"
    , [Char]
"--http-port", Int -> [Char]
forall a. Show a => a -> [Char]
show (Server -> Int
D.port (Site -> Server
D.server Site
x))]
oldClckwrksServerFlags :: D.Server -> [String]
oldClckwrksServerFlags :: Server -> [[Char]]
oldClckwrksServerFlags Server
x =
    [ -- According to the happstack-server documentation this needs a trailing slash.
      [Char]
"--base-uri", [Char]
"http://" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Server -> [Char]
D.hostname Server
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Server -> Int
D.port Server
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/"
    , [Char]
"--http-port", Int -> [Char]
forall a. Show a => a -> [Char]
show (Server -> Int
D.port Server
x)]

siteAtoms :: PackageDescription -> BinPkgName -> D.Site -> CabalInfo -> CabalInfo
siteAtoms :: PackageDescription -> BinPkgName -> Site -> CabalInfo -> CabalInfo
siteAtoms PackageDescription
pkgDesc BinPkgName
b Site
site =
    CabalM () -> CabalInfo -> CabalInfo
forall a. CabalM a -> CabalInfo -> CabalInfo
execCabalM
      (do ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> Atom
D.InstallDir BinPkgName
b [Char]
"/etc/apache2/sites-available")
          ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> [Char] -> Atom
D.Link BinPkgName
b ([Char]
"/etc/apache2/sites-available/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Site -> [Char]
D.domain Site
site [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".conf") ([Char]
"/etc/apache2/sites-enabled/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Site -> [Char]
D.domain Site
site [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".conf"))
          ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> Text -> Atom
D.File BinPkgName
b ([Char]
"/etc/apache2/sites-available" [Char] -> [Char] -> [Char]
</> Site -> [Char]
D.domain Site
site [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".conf") Text
apacheConfig)
          ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Set Atom -> Identity (Set Atom))
    -> DebInfo -> Identity DebInfo)
-> (Set Atom -> Identity (Set Atom))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Atom -> Identity (Set Atom)) -> DebInfo -> Identity DebInfo
Lens' DebInfo (Set Atom)
D.atomSet) ((Set Atom -> Identity (Set Atom))
 -> CabalInfo -> Identity CabalInfo)
-> (Set Atom -> Set Atom) -> CabalM ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Atom -> Set Atom -> Set Atom
forall a. Ord a => a -> Set a -> Set a
Set.insert (Atom -> Set Atom -> Set Atom) -> Atom -> Set Atom -> Set Atom
forall a b. (a -> b) -> a -> b
$ BinPkgName -> [Char] -> Atom
D.InstallDir BinPkgName
b (BinPkgName -> [Char]
apacheLogDirectory BinPkgName
b))
          {-logrotate b-}) (CabalInfo -> CabalInfo)
-> (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      PackageDescription
-> BinPkgName -> Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms PackageDescription
pkgDesc BinPkgName
b (Site -> Server
D.server Site
site) Bool
True
    where
      -- An apache site configuration file.  This is installed via a line
      -- in debianFiles.
      apacheConfig :: Text
apacheConfig =
          [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                   [  Text
"<VirtualHost *:80>"
                   , Text
"    ServerAdmin " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Site -> [Char]
D.serverAdmin Site
site)
                   , Text
"    ServerName www." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Site -> [Char]
D.domain Site
site)
                   , Text
"    ServerAlias " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Site -> [Char]
D.domain Site
site)
                   , Text
""
                   , Text
"    ErrorLog " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
apacheErrorLog BinPkgName
b)
                   , Text
"    CustomLog " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
apacheAccessLog BinPkgName
b) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" combined"
                   , Text
""
                   , Text
"    ProxyRequests Off"
                   , Text
"    AllowEncodedSlashes NoDecode"
                   , Text
""
                   , Text
"    <Proxy *>"
                   , Text
"                AddDefaultCharset off"
                   , Text
"                Order deny,allow"
                   , Text
"                #Allow from .example.com"
                   , Text
"                Deny from all"
                   , Text
"                #Allow from all"
                   , Text
"    </Proxy>"
                   , Text
""
                   , Text
"    <Proxy http://127.0.0.1:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
port' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/*>"
                   , Text
"                AddDefaultCharset off"
                   , Text
"                Order deny,allow"
                   , Text
"                #Allow from .example.com"
                   , Text
"                #Deny from all"
                   , Text
"                Allow from all"
                   , Text
"    </Proxy>"
                   , Text
""
                   , Text
"    SetEnv proxy-sendcl 1"
                   , Text
""
                   , Text
"    ProxyPass / http://127.0.0.1:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
port' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/ nocanon"
                   , Text
"    ProxyPassReverse / http://127.0.0.1:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
port' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
                   , Text
"</VirtualHost>" ]
      port' :: Text
port' = [Char] -> Text
pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (Server -> Int
D.port (Site -> Server
D.server Site
site)))

-- | Install configuration files to do log rotation.  This does not
-- work well with the haskell logging library, so it is no longer
-- called in siteAtoms.
logrotate :: MonadState CabalInfo m => BinPkgName -> m ()
logrotate :: forall (m :: * -> *). MonadState CabalInfo m => BinPkgName -> m ()
logrotate BinPkgName
b = do
          ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName (Set Text)
     -> Identity (Map BinPkgName (Set Text)))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName (Set Text)
    -> Identity (Map BinPkgName (Set Text)))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName (Set Text) -> Identity (Map BinPkgName (Set Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) ((Map BinPkgName (Set Text)
  -> Identity (Map BinPkgName (Set Text)))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName (Set Text) -> Map BinPkgName (Set Text)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Set Text -> Set Text -> Set Text)
-> BinPkgName
-> Set Text
-> Map BinPkgName (Set Text)
-> Map BinPkgName (Set Text)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set Text -> Set Text -> Set Text
forall a. Monoid a => a -> a -> a
mappend BinPkgName
b
                              (Text -> Set Text
forall a. a -> Set a
singleton
                                   ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
apacheAccessLog BinPkgName
b) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {"
                                                   , Text
"  weekly"
                                                   , Text
"  rotate 5"
                                                   , Text
"  compress"
                                                   , Text
"  missingok"
                                                   , Text
"}"]))
          ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName (Set Text)
     -> Identity (Map BinPkgName (Set Text)))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName (Set Text)
    -> Identity (Map BinPkgName (Set Text)))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName (Set Text) -> Identity (Map BinPkgName (Set Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) ((Map BinPkgName (Set Text)
  -> Identity (Map BinPkgName (Set Text)))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName (Set Text) -> Map BinPkgName (Set Text)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Set Text -> Set Text -> Set Text)
-> BinPkgName
-> Set Text
-> Map BinPkgName (Set Text)
-> Map BinPkgName (Set Text)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set Text -> Set Text -> Set Text
forall a. Monoid a => a -> a -> a
mappend BinPkgName
b
                              (Text -> Set Text
forall a. a -> Set a
singleton
                                   ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
apacheErrorLog BinPkgName
b) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {"
                                                   , Text
"  weekly"
                                                   , Text
"  rotate 5"
                                                   , Text
"  compress"
                                                   , Text
"  missingok"
                                                   , Text
"}" ]))

serverAtoms :: PackageDescription -> BinPkgName -> D.Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms :: PackageDescription
-> BinPkgName -> Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms PackageDescription
pkgDesc BinPkgName
b Server
server' Bool
isSite =
    ASetter
  CabalInfo CabalInfo (Map BinPkgName Text) (Map BinPkgName Text)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> CabalInfo
-> CabalInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
    -> DebInfo -> Identity DebInfo)
-> ASetter
     CabalInfo CabalInfo (Map BinPkgName Text) (Map BinPkgName Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
D.postInst) ((Text -> Text -> Text)
-> BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith Text -> Text -> Text
forall {a}. (Eq a, Show a) => a -> a -> a
failOnMismatch BinPkgName
b Text
debianPostinst) (CabalInfo -> CabalInfo)
-> (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ASetter
  CabalInfo CabalInfo (Map BinPkgName Text) (Map BinPkgName Text)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> CabalInfo
-> CabalInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
    -> DebInfo -> Identity DebInfo)
-> ASetter
     CabalInfo CabalInfo (Map BinPkgName Text) (Map BinPkgName Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
D.installInit) ((Text -> Text -> Text)
-> BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Text -> Text -> Text
forall {a}. (Eq a, Show a) => a -> a -> a
failOnMismatch BinPkgName
b Text
debianInit) (CabalInfo -> CabalInfo)
-> (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    BinPkgName -> CabalInfo -> CabalInfo
serverLogrotate' BinPkgName
b (CabalInfo -> CabalInfo)
-> (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
execAtoms BinPkgName
b InstallFile
exec
    where
      -- Combine two values (for insertWith) when there should only be
      -- one.  If it happens twice with different values we should
      -- really find out why.
      failOnMismatch :: a -> a -> a
failOnMismatch a
old a
new = if a
old a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
new then [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"serverAtoms: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
old [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
new) else a
old
      exec :: InstallFile
exec = Server -> InstallFile
D.installFile Server
server'
      debianInit :: Text
debianInit =
          [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                   [ Text
"#! /bin/sh -e"
                   , Text
""
                   , Text
". /lib/lsb/init-functions"
                   , Text
"test -f /etc/default/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" && . /etc/default/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec)
                   , Text
""
                   , Text
"case \"$1\" in"
                   , Text
"  start)"
                   , Text
"    test -x /usr/bin/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" || exit 0"
                   , Text
"    log_begin_msg \"Starting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...\""
                   , Text
"    mkdir -p " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
databaseDirectory BinPkgName
b)
                   , Text
"    export " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (PackageDescription -> [Char] -> [Char]
pkgPathEnvVar PackageDescription
pkgDesc [Char]
"datadir") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (PackageDescription -> [Char]
dataDirectory PackageDescription
pkgDesc)
                   , Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
startCommand
                   , Text
"    log_end_msg $?"
                   , Text
"    ;;"
                   , Text
"  stop)"
                   , Text
"    log_begin_msg \"Stopping " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (InstallFile -> [Char]
D.destName InstallFile
exec) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"...\""
                   , Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stopCommand
                   , Text
"    log_end_msg $?"
                   , Text
"    ;;"
                   , Text
"  *)"
                   , Text
"    log_success_msg \"Usage: ${0} {start|stop}\""
                   , Text
"    exit 1"
                   , Text
"esac"
                   , Text
""
                   , Text
"exit 0" ]
      startCommand :: Text
startCommand = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
showCommand [Char]
"start-stop-daemon" ([[Char]]
startOptions [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
commonOptions [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"--"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Server -> [[Char]]
D.serverFlags Server
server')
      stopCommand :: Text
stopCommand = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
showCommand [Char]
"start-stop-daemon" ([[Char]]
stopOptions [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
commonOptions)
      commonOptions :: [[Char]]
commonOptions = [[Char]
"--pidfile", [Char]
"/var/run/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ InstallFile -> [Char]
D.destName InstallFile
exec]
      startOptions :: [[Char]]
startOptions = [[Char]
"--start", [Char]
"-b", [Char]
"--make-pidfile", [Char]
"-d", BinPkgName -> [Char]
databaseDirectory BinPkgName
b, [Char]
"--exec", [Char]
"/usr/bin" [Char] -> [Char] -> [Char]
</> InstallFile -> [Char]
D.destName InstallFile
exec]
      stopOptions :: [[Char]]
stopOptions = [[Char]
"--stop", [Char]
"--oknodo"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ if Server -> [Char]
D.retry Server
server' [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
"" then [[Char]
"--retry=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Server -> [Char]
D.retry Server
server' ] else []

      debianPostinst :: Text
debianPostinst =
          [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                   ([ Text
"#!/bin/sh"
                    , Text
""
                    , Text
"case \"$1\" in"
                    , Text
"  configure)" ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                    (if Bool
isSite
                     then [ Text
"    # Apache won't start if this directory doesn't exist"
                          , Text
"    mkdir -p " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (BinPkgName -> [Char]
apacheLogDirectory BinPkgName
b)
                          , Text
"    # Restart apache so it sees the new file in /etc/apache2/sites-enabled"
                          , Text
"    /usr/sbin/a2enmod proxy"
                          , Text
"    /usr/sbin/a2enmod proxy_http"
                          , Text
"    service apache2 restart" ]
                     else []) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
                    [ -- This gets done by the #DEBHELPER# code below.
                      {- "    service " <> pack (show (pPrint b)) <> " start", -}
                      Text
"    ;;"
                    , Text
"esac"
                    , Text
""
                    , Text
"#DEBHELPER#"
                    , Text
""
                    , Text
"exit 0" ])

-- | A configuration file for the logrotate facility, installed via a line
-- in debianFiles.
serverLogrotate' :: BinPkgName -> CabalInfo -> CabalInfo
serverLogrotate' :: BinPkgName -> CabalInfo -> CabalInfo
serverLogrotate' BinPkgName
b =
    ((Map BinPkgName (Set Text)
  -> Identity (Map BinPkgName (Set Text)))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName (Set Text) -> Map BinPkgName (Set Text))
-> CabalInfo
-> CabalInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName (Set Text)
     -> Identity (Map BinPkgName (Set Text)))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName (Set Text)
    -> Identity (Map BinPkgName (Set Text)))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName (Set Text) -> Identity (Map BinPkgName (Set Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) ((Set Text -> Set Text -> Set Text)
-> BinPkgName
-> Set Text
-> Map BinPkgName (Set Text)
-> Map BinPkgName (Set Text)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.union BinPkgName
b (Text -> Set Text
forall a. a -> Set a
singleton ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
serverAccessLog BinPkgName
b) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {"
                                 , Text
"  weekly"
                                 , Text
"  rotate 5"
                                 , Text
"  compress"
                                 , Text
"  missingok"
                                 , Text
"}" ]))) (CabalInfo -> CabalInfo)
-> (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((Map BinPkgName (Set Text)
  -> Identity (Map BinPkgName (Set Text)))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName (Set Text) -> Map BinPkgName (Set Text))
-> CabalInfo
-> CabalInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName (Set Text)
     -> Identity (Map BinPkgName (Set Text)))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName (Set Text)
    -> Identity (Map BinPkgName (Set Text)))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName (Set Text) -> Identity (Map BinPkgName (Set Text)))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName (Set Text))
D.logrotateStanza) ((Set Text -> Set Text -> Set Text)
-> BinPkgName
-> Set Text
-> Map BinPkgName (Set Text)
-> Map BinPkgName (Set Text)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
Set.union BinPkgName
b (Text -> Set Text
forall a. a -> Set a
singleton ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [ [Char] -> Text
pack (BinPkgName -> [Char]
serverAppLog BinPkgName
b) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" {"
                                 , Text
"  weekly"
                                 , Text
"  rotate 5"
                                 , Text
"  compress"
                                 , Text
"  missingok"
                                 , Text
"}" ])))

backupAtoms :: BinPkgName -> String -> CabalInfo -> CabalInfo
backupAtoms :: BinPkgName -> [Char] -> CabalInfo -> CabalInfo
backupAtoms BinPkgName
b [Char]
name =
    ASetter
  CabalInfo CabalInfo (Map BinPkgName Text) (Map BinPkgName Text)
-> (Map BinPkgName Text -> Map BinPkgName Text)
-> CabalInfo
-> CabalInfo
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName Text -> Identity (Map BinPkgName Text))
    -> DebInfo -> Identity DebInfo)
-> ASetter
     CabalInfo CabalInfo (Map BinPkgName Text) (Map BinPkgName Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName Text -> Identity (Map BinPkgName Text))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName Text)
D.postInst) ((Text -> Text -> Text)
-> BinPkgName -> Text -> Map BinPkgName Text -> Map BinPkgName Text
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith (\ Text
old Text
new -> if Text
old Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
new then [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"backupAtoms: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
old [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
forall a. Show a => a -> [Char]
show Text
new else Text
old) BinPkgName
b
                 ([Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                  [ Text
"#!/bin/sh"
                  , Text
""
                  , Text
"case \"$1\" in"
                  , Text
"  configure)"
                  , Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack ([Char]
"/etc/cron.hourly" [Char] -> [Char] -> [Char]
</> [Char]
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" --initialize"
                  , Text
"    ;;"
                  , Text
"esac" ])) (CabalInfo -> CabalInfo)
-> (CabalInfo -> CabalInfo) -> CabalInfo -> CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    BinPkgName -> InstallFile -> CabalInfo -> CabalInfo
execAtoms BinPkgName
b (D.InstallFile { execName :: [Char]
D.execName = [Char]
name
                               , destName :: [Char]
D.destName = [Char]
name
                               , sourceDir :: Maybe [Char]
D.sourceDir = Maybe [Char]
forall a. Maybe a
Nothing
                               , destDir :: Maybe [Char]
D.destDir = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"/etc/cron.hourly" })

expandWebsite :: Monad m => CabalT m ()
expandWebsite :: forall (m :: * -> *). Monad m => CabalT m ()
expandWebsite =
    do Map BinPkgName Site
mp <- StateT CabalInfo m CabalInfo
forall s (m :: * -> *). MonadState s m => m s
get StateT CabalInfo m CabalInfo
-> (CabalInfo -> StateT CabalInfo m (Map BinPkgName Site))
-> StateT CabalInfo m (Map BinPkgName Site)
forall a b.
StateT CabalInfo m a
-> (a -> StateT CabalInfo m b) -> StateT CabalInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map BinPkgName Site -> StateT CabalInfo m (Map BinPkgName Site)
forall a. a -> StateT CabalInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map BinPkgName Site -> StateT CabalInfo m (Map BinPkgName Site))
-> (CabalInfo -> Map BinPkgName Site)
-> CabalInfo
-> StateT CabalInfo m (Map BinPkgName Site)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map BinPkgName Site) CabalInfo (Map BinPkgName Site)
-> CabalInfo -> Map BinPkgName Site
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DebInfo -> Const (Map BinPkgName Site) DebInfo)
-> CabalInfo -> Const (Map BinPkgName Site) CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Const (Map BinPkgName Site) DebInfo)
 -> CabalInfo -> Const (Map BinPkgName Site) CabalInfo)
-> ((Map BinPkgName Site
     -> Const (Map BinPkgName Site) (Map BinPkgName Site))
    -> DebInfo -> Const (Map BinPkgName Site) DebInfo)
-> Getting (Map BinPkgName Site) CabalInfo (Map BinPkgName Site)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName Site
 -> Const (Map BinPkgName Site) (Map BinPkgName Site))
-> DebInfo -> Const (Map BinPkgName Site) DebInfo
Lens' DebInfo (Map BinPkgName Site)
D.website)
       PackageDescription
pkgDesc <- Getting PackageDescription CabalInfo PackageDescription
-> StateT CabalInfo m PackageDescription
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting PackageDescription CabalInfo PackageDescription
Lens' CabalInfo PackageDescription
A.packageDescription
       ((BinPkgName, Site) -> CabalT m ())
-> [(BinPkgName, Site)] -> CabalT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (BinPkgName
b, Site
site) -> (CabalInfo -> CabalInfo) -> CabalT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (PackageDescription -> BinPkgName -> Site -> CabalInfo -> CabalInfo
siteAtoms PackageDescription
pkgDesc BinPkgName
b Site
site)) (Map BinPkgName Site -> [(BinPkgName, Site)]
forall k a. Map k a -> [(k, a)]
Map.toList Map BinPkgName Site
mp)

expandServer :: Monad m => CabalT m ()
expandServer :: forall (m :: * -> *). Monad m => CabalT m ()
expandServer =
    do Map BinPkgName Server
mp <- StateT CabalInfo m CabalInfo
forall s (m :: * -> *). MonadState s m => m s
get StateT CabalInfo m CabalInfo
-> (CabalInfo -> StateT CabalInfo m (Map BinPkgName Server))
-> StateT CabalInfo m (Map BinPkgName Server)
forall a b.
StateT CabalInfo m a
-> (a -> StateT CabalInfo m b) -> StateT CabalInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map BinPkgName Server -> StateT CabalInfo m (Map BinPkgName Server)
forall a. a -> StateT CabalInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map BinPkgName Server
 -> StateT CabalInfo m (Map BinPkgName Server))
-> (CabalInfo -> Map BinPkgName Server)
-> CabalInfo
-> StateT CabalInfo m (Map BinPkgName Server)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map BinPkgName Server) CabalInfo (Map BinPkgName Server)
-> CabalInfo -> Map BinPkgName Server
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DebInfo -> Const (Map BinPkgName Server) DebInfo)
-> CabalInfo -> Const (Map BinPkgName Server) CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Const (Map BinPkgName Server) DebInfo)
 -> CabalInfo -> Const (Map BinPkgName Server) CabalInfo)
-> ((Map BinPkgName Server
     -> Const (Map BinPkgName Server) (Map BinPkgName Server))
    -> DebInfo -> Const (Map BinPkgName Server) DebInfo)
-> Getting
     (Map BinPkgName Server) CabalInfo (Map BinPkgName Server)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName Server
 -> Const (Map BinPkgName Server) (Map BinPkgName Server))
-> DebInfo -> Const (Map BinPkgName Server) DebInfo
Lens' DebInfo (Map BinPkgName Server)
D.serverInfo)
       PackageDescription
pkgDesc <- Getting PackageDescription CabalInfo PackageDescription
-> StateT CabalInfo m PackageDescription
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting PackageDescription CabalInfo PackageDescription
Lens' CabalInfo PackageDescription
A.packageDescription
       ((BinPkgName, Server) -> CabalT m ())
-> [(BinPkgName, Server)] -> CabalT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (BinPkgName
b, Server
x) -> (CabalInfo -> CabalInfo) -> CabalT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (PackageDescription
-> BinPkgName -> Server -> Bool -> CabalInfo -> CabalInfo
serverAtoms PackageDescription
pkgDesc BinPkgName
b Server
x Bool
False)) (Map BinPkgName Server -> [(BinPkgName, Server)]
forall k a. Map k a -> [(k, a)]
Map.toList Map BinPkgName Server
mp)

expandBackups :: Monad m => CabalT m ()
expandBackups :: forall (m :: * -> *). Monad m => CabalT m ()
expandBackups =
    do Map BinPkgName [Char]
mp <- StateT CabalInfo m CabalInfo
forall s (m :: * -> *). MonadState s m => m s
get StateT CabalInfo m CabalInfo
-> (CabalInfo -> StateT CabalInfo m (Map BinPkgName [Char]))
-> StateT CabalInfo m (Map BinPkgName [Char])
forall a b.
StateT CabalInfo m a
-> (a -> StateT CabalInfo m b) -> StateT CabalInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map BinPkgName [Char] -> StateT CabalInfo m (Map BinPkgName [Char])
forall a. a -> StateT CabalInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map BinPkgName [Char]
 -> StateT CabalInfo m (Map BinPkgName [Char]))
-> (CabalInfo -> Map BinPkgName [Char])
-> CabalInfo
-> StateT CabalInfo m (Map BinPkgName [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Map BinPkgName [Char]) CabalInfo (Map BinPkgName [Char])
-> CabalInfo -> Map BinPkgName [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((DebInfo -> Const (Map BinPkgName [Char]) DebInfo)
-> CabalInfo -> Const (Map BinPkgName [Char]) CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Const (Map BinPkgName [Char]) DebInfo)
 -> CabalInfo -> Const (Map BinPkgName [Char]) CabalInfo)
-> ((Map BinPkgName [Char]
     -> Const (Map BinPkgName [Char]) (Map BinPkgName [Char]))
    -> DebInfo -> Const (Map BinPkgName [Char]) DebInfo)
-> Getting
     (Map BinPkgName [Char]) CabalInfo (Map BinPkgName [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName [Char]
 -> Const (Map BinPkgName [Char]) (Map BinPkgName [Char]))
-> DebInfo -> Const (Map BinPkgName [Char]) DebInfo
Lens' DebInfo (Map BinPkgName [Char])
D.backups)
       ((BinPkgName, [Char]) -> CabalT m ())
-> [(BinPkgName, [Char])] -> CabalT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\ (BinPkgName
b, [Char]
name) -> (CabalInfo -> CabalInfo) -> CabalT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (BinPkgName -> [Char] -> CabalInfo -> CabalInfo
backupAtoms BinPkgName
b [Char]
name)) (Map BinPkgName [Char] -> [(BinPkgName, [Char])]
forall k a. Map k a -> [(k, a)]
Map.toList Map BinPkgName [Char]
mp)