-- | 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 :: String -> [String] -> String
showCommand String
cmd [String]
args =
    [String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
translate (String
cmd String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args))

translate :: String -> String
translate :: String -> String
translate String
str =
    Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String -> String) -> String -> String -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
escape String
"\"" String
str
    where
      escape :: Char -> String -> String
escape Char
'"' = String -> String -> String
showString String
"\\\""
      escape Char
c = Char -> String -> String
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 :: [(BinPkgName, BinPkgName)] -> BinPkgName -> DebianT m ()
tightDependencyFixup [] BinPkgName
_ = () -> DebianT m ()
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) -> DebianT 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 :: 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)
-> CabalT 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 :: 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) -> CabalT 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 :: 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) -> CabalT 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 :: BinPkgName -> String -> CabalT m ()
doBackups BinPkgName
bin String
s =
    do ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo
Lens' CabalInfo DebInfo
A.debInfo ((DebInfo -> Identity DebInfo) -> CabalInfo -> Identity CabalInfo)
-> ((Map BinPkgName String -> Identity (Map BinPkgName String))
    -> DebInfo -> Identity DebInfo)
-> (Map BinPkgName String -> Identity (Map BinPkgName String))
-> CabalInfo
-> Identity CabalInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map BinPkgName String -> Identity (Map BinPkgName String))
-> DebInfo -> Identity DebInfo
Lens' DebInfo (Map BinPkgName String)
D.backups) ((Map BinPkgName String -> Identity (Map BinPkgName String))
 -> CabalInfo -> Identity CabalInfo)
-> (Map BinPkgName String -> Map BinPkgName String) -> CabalT m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= BinPkgName
-> String -> Map BinPkgName String -> Map BinPkgName String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert BinPkgName
bin String
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 (String -> BinPkgName
BinPkgName String
"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 -> [String]
oldClckwrksSiteFlags Site
x =
    [ -- According to the happstack-server documentation this needs a trailing slash.
      String
"--base-uri", String
"http://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Site -> String
D.domain Site
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
    , String
"--http-port", Int -> String
forall a. Show a => a -> String
show (Server -> Int
D.port (Site -> Server
D.server Site
x))]
oldClckwrksServerFlags :: D.Server -> [String]
oldClckwrksServerFlags :: Server -> [String]
oldClckwrksServerFlags Server
x =
    [ -- According to the happstack-server documentation this needs a trailing slash.
      String
"--base-uri", String
"http://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Server -> String
D.hostname Server
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Server -> Int
D.port Server
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
    , String
"--http-port", Int -> String
forall a. Show a => a -> String
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 -> String -> Atom
D.InstallDir BinPkgName
b String
"/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 -> String -> String -> Atom
D.Link BinPkgName
b (String
"/etc/apache2/sites-available/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Site -> String
D.domain Site
site String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".conf") (String
"/etc/apache2/sites-enabled/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Site -> String
D.domain Site
site String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".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 -> String -> Text -> Atom
D.File BinPkgName
b (String
"/etc/apache2/sites-available" String -> String -> String
</> Site -> String
D.domain Site
site String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".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 -> String -> Atom
D.InstallDir BinPkgName
b (BinPkgName -> String
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
<> String -> Text
pack (Site -> String
D.serverAdmin Site
site)
                   , Text
"    ServerName www." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Site -> String
D.domain Site
site)
                   , Text
"    ServerAlias " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Site -> String
D.domain Site
site)
                   , Text
""
                   , Text
"    ErrorLog " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (BinPkgName -> String
apacheErrorLog BinPkgName
b)
                   , Text
"    CustomLog " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (BinPkgName -> String
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' = String -> Text
pack (Int -> String
forall a. Show a => a -> String
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 :: 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
$ [ String -> Text
pack (BinPkgName -> String
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
$ [ String -> Text
pack (BinPkgName -> String
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 p. (Eq p, Show p) => p -> p -> p
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 p. (Eq p, Show p) => p -> p -> p
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 :: p -> p -> p
failOnMismatch p
old p
new = if p
old p -> p -> Bool
forall a. Eq a => a -> a -> Bool
/= p
new then String -> p
forall a. HasCallStack => String -> a
error (String
"serverAtoms: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
old String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ p -> String
forall a. Show a => a -> String
show p
new) else p
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
<> String -> Text
pack (InstallFile -> String
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
<> String -> Text
pack (InstallFile -> String
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
<> String -> Text
pack (InstallFile -> String
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
<> String -> Text
pack (InstallFile -> String
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
<> String -> Text
pack (BinPkgName -> String
databaseDirectory BinPkgName
b)
                   , Text
"    export " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (PackageDescription -> String -> String
pkgPathEnvVar PackageDescription
pkgDesc String
"datadir") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (PackageDescription -> String
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
<> String -> Text
pack (InstallFile -> String
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 = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
showCommand String
"start-stop-daemon" ([String]
startOptions [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
commonOptions [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Server -> [String]
D.serverFlags Server
server')
      stopCommand :: Text
stopCommand = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
showCommand String
"start-stop-daemon" ([String]
stopOptions [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
commonOptions)
      commonOptions :: [String]
commonOptions = [String
"--pidfile", String
"/var/run/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ InstallFile -> String
D.destName InstallFile
exec]
      startOptions :: [String]
startOptions = [String
"--start", String
"-b", String
"--make-pidfile", String
"-d", BinPkgName -> String
databaseDirectory BinPkgName
b, String
"--exec", String
"/usr/bin" String -> String -> String
</> InstallFile -> String
D.destName InstallFile
exec]
      stopOptions :: [String]
stopOptions = [String
"--stop", String
"--oknodo"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if Server -> String
D.retry Server
server' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" then [String
"--retry=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Server -> String
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
<> String -> Text
pack (BinPkgName -> String
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
$ [ String -> Text
pack (BinPkgName -> String
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
$ [ String -> Text
pack (BinPkgName -> String
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 -> String -> CabalInfo -> CabalInfo
backupAtoms BinPkgName
b String
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 String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"backupAtoms: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
old String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
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
<> String -> Text
pack (String
"/etc/cron.hourly" String -> String -> String
</> String
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 (InstallFile :: String -> Maybe String -> Maybe String -> String -> InstallFile
D.InstallFile { execName :: String
D.execName = String
name
                               , destName :: String
D.destName = String
name
                               , sourceDir :: Maybe String
D.sourceDir = Maybe String
forall a. Maybe a
Nothing
                               , destDir :: Maybe String
D.destDir = String -> Maybe String
forall a. a -> Maybe a
Just String
"/etc/cron.hourly" })

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