-- | Wrappers around the debianization function to perform various
-- tasks - output, describe, validate a debianization, run an external
-- script to produce a debianization.
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables, StandaloneDeriving, TupleSections, TypeSynonymInstances, RankNTypes #-}
{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-orphans #-}

module Debian.Debianize.Output
    ( finishDebianization
    , runDebianizeScript
    , writeDebianization
    , describeDebianization
    , compareDebianization
    , validateDebianization
    , performDebianization
    , performDebianizationOfWebsite
    , performDebianizationWith
    ) where

import Control.Exception as E (throw)
import Control.Lens
import Control.Monad.Fail (MonadFail)
import Control.Monad.State (get, put, StateT)
import Control.Monad.Trans (liftIO, MonadIO)
import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff)
import Data.Map as Map (elems, toList)
import Data.Maybe (fromMaybe)
import Data.Text as Text (split, Text, unpack)
import Debian.Debianize.CabalInfo (newCabalInfo)
import Debian.Changes (ChangeLog(..), ChangeLogEntry(..))
import Debian.Debianize.BasicInfo (dryRun, validate, upgrade, roundtrip)
import Debian.Debianize.CabalInfo (CabalInfo, debInfo)
import qualified Debian.Debianize.DebInfo as D
import Debian.Debianize.Files (debianizationFileMap)
import Debian.Debianize.InputDebian (inputDebianization)
import Debian.Debianize.Goodies (expandWebsite)
import Debian.Debianize.Monad (DebianT, CabalT, evalDebianT, evalCabalT)
import Debian.Debianize.Prelude (indent, replaceFile, zipMaps)
import Debian.Debianize.Finalize (debianizeWith)
import Debian.Debianize.Optparse
import Debian.Debianize.BinaryDebDescription as B (canonical, package)
import qualified Debian.Debianize.SourceDebDescription as S
import Debian.Pretty (ppShow, ppPrint)
import Prelude hiding (unlines, writeFile)
import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, getPermissions, Permissions(executable), setPermissions)
import System.Exit (ExitCode(ExitSuccess))
import System.FilePath ((</>), takeDirectory)
import System.IO (hPutStrLn, stderr)
import System.Process (readProcessWithExitCode, showCommandForUser)
import Text.PrettyPrint.HughesPJClass (text)
-- import System.Posix.Env (setEnv)

-- | Run the script in @debian/Debianize.hs@ with the given command
-- line arguments.  Returns @True@ if the script exists and succeeds.
-- In this case it may be assumed that a debianization was created (or
-- updated) in the debian subdirectory of the current directory.  In
-- this way we can include a script in a package to produce a
-- customized debianization more sophisticated than the one that would
-- be produced by the cabal-debian executable.  An example is included
-- in the debian subdirectory of this library.
runDebianizeScript :: [String] -> IO Bool
runDebianizeScript :: [[Char]] -> IO Bool
runDebianizeScript [[Char]]
args =
    IO [Char]
getCurrentDirectory IO [Char] -> ([Char] -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Char]
here ->
    [Char] -> IO Bool
doesFileExist [Char]
"debian/Debianize.hs" IO Bool -> (Bool -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Bool
exists ->
    case Bool
exists of
      Bool
False -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Bool
True -> do
        -- By default runhaskell looks for source in ., we will also look
        -- in src.  Better would be to see where the cabal file looks.
        let args' :: [[Char]]
args' = [[Char]
"-i.:src", [Char]
"debian/Debianize.hs"] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
args
        Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char]
"running external debianization script in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
here [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":\n  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
showCommandForUser [Char]
"runhaskell" [[Char]]
args')
        (ExitCode, [Char], [Char])
result <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
"runhaskell" [[Char]]
args' [Char]
""
        case (ExitCode, [Char], [Char])
result of
          (ExitCode
ExitSuccess, [Char]
_, [Char]
_) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          (ExitCode
code, [Char]
out, [Char]
err) -> [Char] -> IO Bool
forall a. HasCallStack => [Char] -> a
error ([Char]
" external debianization script failed:\n  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
showCommandForUser [Char]
"runhaskell" [[Char]]
args' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ExitCode -> [Char]
forall a. Show a => a -> [Char]
show ExitCode
code [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                                     [Char]
"\n stdout: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
out [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n stderr: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
err)

-- | Perform whole debianization. You provide your customization,
-- this function does everything else.
performDebianization :: CabalT IO () -> IO ()
performDebianization :: CabalT IO () -> IO ()
performDebianization = CabalT IO () -> CabalT IO () -> IO ()
performDebianizationWith (() -> CabalT IO ()
forall a. a -> StateT CabalInfo IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

performDebianizationOfWebsite :: CabalT IO () -> IO ()
performDebianizationOfWebsite :: CabalT IO () -> IO ()
performDebianizationOfWebsite = CabalT IO () -> CabalT IO () -> IO ()
performDebianizationWith CabalT IO ()
forall (m :: * -> *). Monad m => CabalT m ()
expandWebsite

performDebianizationWith :: CabalT IO () -> CabalT IO () -> IO ()
performDebianizationWith :: CabalT IO () -> CabalT IO () -> IO ()
performDebianizationWith CabalT IO ()
goodies CabalT IO ()
custom =
  IO CommandLineOptions
parseProgramArguments IO CommandLineOptions -> (CommandLineOptions -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CommandLineOptions {Flags
BehaviorAdjustment
_flags :: Flags
_adjustment :: BehaviorAdjustment
_flags :: CommandLineOptions -> Flags
_adjustment :: CommandLineOptions -> BehaviorAdjustment
..} -> do
    -- _ <- try (readProcessWithExitCode "apt-get" ["install", "-y", "--force-yes", hcDeb (view compilerFlavor _flags)] "")
    Flags -> IO (Either [Char] CabalInfo)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Flags -> m (Either [Char] CabalInfo)
newCabalInfo Flags
_flags IO (Either [Char] CabalInfo)
-> (Either [Char] CabalInfo -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> IO ())
-> (CabalInfo -> IO ()) -> Either [Char] CabalInfo -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                               ([Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> ([Char] -> [Char]) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"peformDebianization - " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++))
                               (CabalT IO () -> CabalInfo -> IO ()
forall (m :: * -> *) a. Monad m => CabalT m a -> CabalInfo -> m a
evalCabalT (CabalT IO () -> CabalInfo -> IO ())
-> CabalT IO () -> CabalInfo -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                                BehaviorAdjustment -> CabalT IO ()
forall (m :: * -> *).
MonadIO m =>
BehaviorAdjustment -> CabalT m ()
handleBehaviorAdjustment BehaviorAdjustment
_adjustment
                                CabalT IO () -> CabalT IO () -> CabalT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
CabalT m () -> CabalT m () -> CabalT m ()
debianizeWith CabalT IO ()
goodies CabalT IO ()
custom
                                CabalT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
StateT CabalInfo m ()
finishDebianization)

-- hcDeb :: CompilerFlavor -> String
-- hcDeb GHC = "ghc"
-- hcDeb GHCJS = "ghcjs"
-- hcDeb flavor = error $ "hcDeb - unexpected CompilerFlavor: " ++ show flavor

-- | Depending on the options in @atoms@, either validate, describe,
-- or write the generated debianization.
finishDebianization :: forall m. (MonadIO m, MonadFail m) => StateT CabalInfo m ()
finishDebianization :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
StateT CabalInfo m ()
finishDebianization = LensLike' (Zoomed (StateT DebInfo m) ()) CabalInfo DebInfo
-> StateT DebInfo m () -> StateT CabalInfo m ()
forall c.
LensLike' (Zoomed (StateT DebInfo m) c) CabalInfo DebInfo
-> StateT DebInfo m c -> StateT CabalInfo m c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (DebInfo -> Focusing m () DebInfo)
-> CabalInfo -> Focusing m () CabalInfo
LensLike' (Zoomed (StateT DebInfo m) ()) CabalInfo DebInfo
Lens' CabalInfo DebInfo
debInfo (StateT DebInfo m () -> StateT CabalInfo m ())
-> StateT DebInfo m () -> StateT CabalInfo m ()
forall a b. (a -> b) -> a -> b
$
    do DebInfo
new <- StateT DebInfo m DebInfo
forall s (m :: * -> *). MonadState s m => m s
get
       case () of
         ()
_ | Getting Bool DebInfo Bool -> DebInfo -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo
Lens' DebInfo Flags
D.flags ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo)
-> ((Bool -> Const Bool Bool) -> Flags -> Const Bool Flags)
-> Getting Bool DebInfo Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Flags -> Const Bool Flags
Lens' Flags Bool
validate) DebInfo
new ->
               do StateT DebInfo m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
inputDebianization
                  DebInfo
old <- StateT DebInfo m DebInfo
forall s (m :: * -> *). MonadState s m => m s
get
                  () -> StateT DebInfo m ()
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> StateT DebInfo m ()) -> () -> StateT DebInfo m ()
forall a b. (a -> b) -> a -> b
$ DebInfo -> DebInfo -> ()
validateDebianization DebInfo
old DebInfo
new
         ()
_ | Getting Bool DebInfo Bool -> DebInfo -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo
Lens' DebInfo Flags
D.flags ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo)
-> ((Bool -> Const Bool Bool) -> Flags -> Const Bool Flags)
-> Getting Bool DebInfo Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Flags -> Const Bool Flags
Lens' Flags Bool
dryRun) DebInfo
new ->
               do StateT DebInfo m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
inputDebianization
                  DebInfo
old <- StateT DebInfo m DebInfo
forall s (m :: * -> *). MonadState s m => m s
get
                  let diff :: [[Char]]
diff = DebInfo -> DebInfo -> [[Char]]
compareDebianization DebInfo
old DebInfo
new
                  IO () -> StateT DebInfo m ()
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT DebInfo m ()) -> IO () -> StateT DebInfo m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char]
"Debianization (dry run):\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
diff then [Char]
"  No changes\n" else [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
diff)
         ()
_ | Getting Bool DebInfo Bool -> DebInfo -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo
Lens' DebInfo Flags
D.flags ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo)
-> ((Bool -> Const Bool Bool) -> Flags -> Const Bool Flags)
-> Getting Bool DebInfo Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Flags -> Const Bool Flags
Lens' Flags Bool
upgrade) DebInfo
new ->
               do StateT DebInfo m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
inputDebianization
                  DebInfo
old <- StateT DebInfo m DebInfo
forall s (m :: * -> *). MonadState s m => m s
get
                  let merged :: DebInfo
merged = DebInfo -> DebInfo -> DebInfo
mergeDebianization DebInfo
old DebInfo
new
                  DebInfo -> StateT DebInfo m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put DebInfo
merged
                  StateT DebInfo m ()
forall (m :: * -> *). (MonadIO m, MonadFail m) => DebianT m ()
writeDebianization
         ()
_ | Getting Bool DebInfo Bool -> DebInfo -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo
Lens' DebInfo Flags
D.flags ((Flags -> Const Bool Flags) -> DebInfo -> Const Bool DebInfo)
-> ((Bool -> Const Bool Bool) -> Flags -> Const Bool Flags)
-> Getting Bool DebInfo Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Flags -> Const Bool Flags
Lens' Flags Bool
roundtrip) DebInfo
new ->
               do StateT DebInfo m ()
forall (m :: * -> *). MonadIO m => DebianT m ()
inputDebianization
                  StateT DebInfo m ()
forall (m :: * -> *). (MonadIO m, MonadFail m) => DebianT m ()
writeDebianization
         ()
_ -> StateT DebInfo m ()
forall (m :: * -> *). (MonadIO m, MonadFail m) => DebianT m ()
writeDebianization


-- | Write the files of the debianization @d@ to ./debian
writeDebianization :: (MonadIO m, MonadFail m) => DebianT m ()
writeDebianization :: forall (m :: * -> *). (MonadIO m, MonadFail m) => DebianT m ()
writeDebianization =
    do Map [Char] Text
files <- DebianT m (Map [Char] Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map [Char] Text)
debianizationFileMap
       IO () -> DebianT m ()
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DebianT m ()) -> IO () -> DebianT m ()
forall a b. (a -> b) -> a -> b
$ (([Char], Text) -> IO ()) -> [([Char], Text)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (([Char] -> Text -> IO ()) -> ([Char], Text) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> Text -> IO ()
doFile) (Map [Char] Text -> [([Char], Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map [Char] Text
files)
       IO () -> DebianT m ()
forall a. IO a -> StateT DebInfo m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DebianT m ()) -> IO () -> DebianT m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Permissions
getPermissions [Char]
"debian/rules" IO Permissions -> (Permissions -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Permissions -> IO ()
setPermissions [Char]
"debian/rules" (Permissions -> IO ())
-> (Permissions -> Permissions) -> Permissions -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ Permissions
p -> Permissions
p {executable = True})
    where
      doFile :: [Char] -> Text -> IO ()
doFile [Char]
path Text
text =
          do Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True ([Char] -> [Char]
takeDirectory [Char]
path)
             [Char] -> [Char] -> IO ()
replaceFile [Char]
path (Text -> [Char]
unpack Text
text)

-- | Return a string describing the debianization - a list of file
-- names and their contents in a somewhat human readable format.
describeDebianization :: (MonadIO m, MonadFail m) => DebianT m String
describeDebianization :: forall (m :: * -> *). (MonadIO m, MonadFail m) => DebianT m [Char]
describeDebianization =
    DebianT m (Map [Char] Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map [Char] Text)
debianizationFileMap DebianT m (Map [Char] Text)
-> (Map [Char] Text -> StateT DebInfo m [Char])
-> StateT DebInfo m [Char]
forall a b.
StateT DebInfo m a
-> (a -> StateT DebInfo m b) -> StateT DebInfo m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> StateT DebInfo m [Char]
forall a. a -> StateT DebInfo m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> StateT DebInfo m [Char])
-> (Map [Char] Text -> [Char])
-> Map [Char] Text
-> StateT DebInfo m [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], Text) -> [Char]) -> [([Char], Text)] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ ([Char]
path, Text
text) -> [Char]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> [Char]
indent [Char]
" > " (Text -> [Char]
unpack Text
text)) ([([Char], Text)] -> [Char])
-> (Map [Char] Text -> [([Char], Text)])
-> Map [Char] Text
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [Char] Text -> [([Char], Text)]
forall k a. Map k a -> [(k, a)]
Map.toList

-- | Do only the usual maintenance changes when upgrading to a new version
-- and avoid changing anything that is usually manually maintained.
mergeDebianization :: D.DebInfo -> D.DebInfo -> D.DebInfo
mergeDebianization :: DebInfo -> DebInfo -> DebInfo
mergeDebianization DebInfo
old DebInfo
new =
    Lens' DebInfo Relations -> DebInfo -> DebInfo
forall b. Lens' DebInfo b -> DebInfo -> DebInfo
override ((SourceDebDescription -> f SourceDebDescription)
-> DebInfo -> f DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription -> f SourceDebDescription)
 -> DebInfo -> f DebInfo)
-> ((Relations -> f Relations)
    -> SourceDebDescription -> f SourceDebDescription)
-> (Relations -> f Relations)
-> DebInfo
-> f DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> f Relations)
-> SourceDebDescription -> f SourceDebDescription
Lens' SourceDebDescription Relations
S.buildDepends) (DebInfo -> DebInfo) -> (DebInfo -> DebInfo) -> DebInfo -> DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Lens' DebInfo Relations -> DebInfo -> DebInfo
forall b. Lens' DebInfo b -> DebInfo -> DebInfo
override ((SourceDebDescription -> f SourceDebDescription)
-> DebInfo -> f DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription -> f SourceDebDescription)
 -> DebInfo -> f DebInfo)
-> ((Relations -> f Relations)
    -> SourceDebDescription -> f SourceDebDescription)
-> (Relations -> f Relations)
-> DebInfo
-> f DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relations -> f Relations)
-> SourceDebDescription -> f SourceDebDescription
Lens' SourceDebDescription Relations
S.buildDependsIndep) (DebInfo -> DebInfo) -> (DebInfo -> DebInfo) -> DebInfo -> DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Lens' DebInfo (Maybe Text) -> DebInfo -> DebInfo
forall b. Lens' DebInfo b -> DebInfo -> DebInfo
override ((SourceDebDescription -> f SourceDebDescription)
-> DebInfo -> f DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription -> f SourceDebDescription)
 -> DebInfo -> f DebInfo)
-> ((Maybe Text -> f (Maybe Text))
    -> SourceDebDescription -> f SourceDebDescription)
-> (Maybe Text -> f (Maybe Text))
-> DebInfo
-> f DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> f (Maybe Text))
-> SourceDebDescription -> f SourceDebDescription
Lens' SourceDebDescription (Maybe Text)
S.homepage) (DebInfo -> DebInfo) -> (DebInfo -> DebInfo) -> DebInfo -> DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Lens' DebInfo (Set VersionControlSpec) -> DebInfo -> DebInfo
forall b. Lens' DebInfo b -> DebInfo -> DebInfo
override ((SourceDebDescription -> f SourceDebDescription)
-> DebInfo -> f DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription -> f SourceDebDescription)
 -> DebInfo -> f DebInfo)
-> ((Set VersionControlSpec -> f (Set VersionControlSpec))
    -> SourceDebDescription -> f SourceDebDescription)
-> (Set VersionControlSpec -> f (Set VersionControlSpec))
-> DebInfo
-> f DebInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set VersionControlSpec -> f (Set VersionControlSpec))
-> SourceDebDescription -> f SourceDebDescription
Lens' SourceDebDescription (Set VersionControlSpec)
S.vcsFields) (DebInfo -> DebInfo) -> DebInfo -> DebInfo
forall a b. (a -> b) -> a -> b
$
    DebInfo
old
  where
    override :: forall b. Lens' D.DebInfo b -> (D.DebInfo -> D.DebInfo)
    override :: forall b. Lens' DebInfo b -> DebInfo -> DebInfo
override Lens' DebInfo b
lens = ASetter DebInfo DebInfo b b -> b -> DebInfo -> DebInfo
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter DebInfo DebInfo b b
Lens' DebInfo b
lens (DebInfo
new DebInfo -> Getting b DebInfo b -> b
forall s a. s -> Getting a s a -> a
^. Getting b DebInfo b
Lens' DebInfo b
lens)


-- | Compare the old and new debianizations, returning a string
-- describing the differences.
compareDebianization :: D.DebInfo -> D.DebInfo -> [String]
compareDebianization :: DebInfo -> DebInfo -> [[Char]]
compareDebianization DebInfo
old DebInfo
new =
    let ~(Just Map [Char] Text
oldFiles) = DebianT Maybe (Map [Char] Text)
-> DebInfo -> Maybe (Map [Char] Text)
forall (m :: * -> *) a. Monad m => DebianT m a -> DebInfo -> m a
evalDebianT DebianT Maybe (Map [Char] Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map [Char] Text)
debianizationFileMap (DebInfo -> DebInfo
forall a. Canonical a => a -> a
canonical DebInfo
old)
        ~(Just Map [Char] Text
newFiles) = DebianT Maybe (Map [Char] Text)
-> DebInfo -> Maybe (Map [Char] Text)
forall (m :: * -> *) a. Monad m => DebianT m a -> DebInfo -> m a
evalDebianT DebianT Maybe (Map [Char] Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map [Char] Text)
debianizationFileMap (DebInfo -> DebInfo
forall a. Canonical a => a -> a
canonical DebInfo
new) in
    Map [Char] [Char] -> [[Char]]
forall k a. Map k a -> [a]
elems (Map [Char] [Char] -> [[Char]]) -> Map [Char] [Char] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Maybe Text -> Maybe Text -> Maybe [Char])
-> Map [Char] Text -> Map [Char] Text -> Map [Char] [Char]
forall k a b c.
Ord k =>
(k -> Maybe a -> Maybe b -> Maybe c)
-> Map k a -> Map k b -> Map k c
zipMaps [Char] -> Maybe Text -> Maybe Text -> Maybe [Char]
doFile Map [Char] Text
oldFiles Map [Char] Text
newFiles
    where
      doFile :: FilePath -> Maybe Text -> Maybe Text -> Maybe String
      doFile :: [Char] -> Maybe Text -> Maybe Text -> Maybe [Char]
doFile [Char]
path (Just Text
_) Maybe Text
Nothing = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": Deleted\n")
      doFile [Char]
path Maybe Text
Nothing (Just Text
n) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char]
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": Created\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char] -> [Char]
indent [Char]
" | " (Text -> [Char]
unpack Text
n))
      doFile [Char]
path (Just Text
o) (Just Text
n) =
          if Text
o Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n
          then Maybe [Char]
forall a. Maybe a
Nothing -- Just (path ++ ": Unchanged\n")
          else [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just (Doc -> [Char]
forall a. Show a => a -> [Char]
show (Doc -> Doc -> (Text -> Doc) -> ContextDiff Text -> Doc
forall c. Doc -> Doc -> (c -> Doc) -> ContextDiff c -> Doc
prettyContextDiff ([Char] -> Doc
text ([Char]
"old" [Char] -> [Char] -> [Char]
</> [Char]
path)) ([Char] -> Doc
text ([Char]
"new" [Char] -> [Char] -> [Char]
</> [Char]
path)) ([Char] -> Doc
text ([Char] -> Doc) -> (Text -> [Char]) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack) (Int -> [Text] -> [Text] -> ContextDiff Text
forall a. Eq a => Int -> [a] -> [a] -> ContextDiff a
getContextDiff Int
2 ((Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
o) ((Char -> Bool) -> Text -> [Text]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
n))))
      doFile [Char]
_path Maybe Text
Nothing Maybe Text
Nothing = [Char] -> Maybe [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Internal error in zipMaps"

-- | Make sure the new debianization matches the existing
-- debianization in several ways - specifically, version number, and
-- the names of the source and binary packages.  Some debian packages
-- come with a skeleton debianization that needs to be filled in, this
-- can be used to make sure the debianization we produce is usable.
validateDebianization :: D.DebInfo -> D.DebInfo -> ()
validateDebianization :: DebInfo -> DebInfo -> ()
validateDebianization DebInfo
old DebInfo
new =
    case () of
      ()
_ | DebianVersion
oldVersion DebianVersion -> DebianVersion -> Bool
forall a. Eq a => a -> a -> Bool
/= DebianVersion
newVersion -> IOError -> ()
forall a e. Exception e => e -> a
throw ([Char] -> IOError
userError ([Char]
"Version mismatch, expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DebianVersion -> [Char]
forall a. Pretty (PP a) => a -> [Char]
ppShow DebianVersion
oldVersion [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", found " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DebianVersion -> [Char]
forall a. Pretty (PP a) => a -> [Char]
ppShow DebianVersion
newVersion))
        | Maybe SrcPkgName
oldSource Maybe SrcPkgName -> Maybe SrcPkgName -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe SrcPkgName
newSource -> IOError -> ()
forall a e. Exception e => e -> a
throw ([Char] -> IOError
userError ([Char]
"Source mismatch, expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe SrcPkgName -> [Char]
forall a. Pretty (PP a) => a -> [Char]
ppShow Maybe SrcPkgName
oldSource [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", found " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe SrcPkgName -> [Char]
forall a. Pretty (PP a) => a -> [Char]
ppShow Maybe SrcPkgName
newSource))
        | [BinPkgName]
oldPackages [BinPkgName] -> [BinPkgName] -> Bool
forall a. Eq a => a -> a -> Bool
/= [BinPkgName]
newPackages -> IOError -> ()
forall a e. Exception e => e -> a
throw ([Char] -> IOError
userError ([Char]
"Package mismatch, expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Doc] -> [Char]
forall a. Show a => a -> [Char]
show ((BinPkgName -> Doc) -> [BinPkgName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BinPkgName -> Doc
forall a. Pretty (PP a) => a -> Doc
ppPrint [BinPkgName]
oldPackages) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", found " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Doc] -> [Char]
forall a. Show a => a -> [Char]
show ((BinPkgName -> Doc) -> [BinPkgName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BinPkgName -> Doc
forall a. Pretty (PP a) => a -> Doc
ppPrint [BinPkgName]
newPackages)))
        | Bool
True -> ()
    where
      oldVersion :: DebianVersion
oldVersion = ChangeLogEntry -> DebianVersion
logVersion ([ChangeLogEntry] -> ChangeLogEntry
forall a. HasCallStack => [a] -> a
head (ChangeLog -> [ChangeLogEntry]
unChangeLog (ChangeLog -> Maybe ChangeLog -> ChangeLog
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ChangeLog
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing changelog") (Getting (Maybe ChangeLog) DebInfo (Maybe ChangeLog)
-> DebInfo -> Maybe ChangeLog
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ChangeLog) DebInfo (Maybe ChangeLog)
Lens' DebInfo (Maybe ChangeLog)
D.changelog DebInfo
old))))
      newVersion :: DebianVersion
newVersion = ChangeLogEntry -> DebianVersion
logVersion ([ChangeLogEntry] -> ChangeLogEntry
forall a. HasCallStack => [a] -> a
head (ChangeLog -> [ChangeLogEntry]
unChangeLog (ChangeLog -> Maybe ChangeLog -> ChangeLog
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ChangeLog
forall a. HasCallStack => [Char] -> a
error [Char]
"Missing changelog") (Getting (Maybe ChangeLog) DebInfo (Maybe ChangeLog)
-> DebInfo -> Maybe ChangeLog
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ChangeLog) DebInfo (Maybe ChangeLog)
Lens' DebInfo (Maybe ChangeLog)
D.changelog DebInfo
new))))
      oldSource :: Maybe SrcPkgName
oldSource = Getting (Maybe SrcPkgName) DebInfo (Maybe SrcPkgName)
-> DebInfo -> Maybe SrcPkgName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceDebDescription
 -> Const (Maybe SrcPkgName) SourceDebDescription)
-> DebInfo -> Const (Maybe SrcPkgName) DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription
  -> Const (Maybe SrcPkgName) SourceDebDescription)
 -> DebInfo -> Const (Maybe SrcPkgName) DebInfo)
-> ((Maybe SrcPkgName
     -> Const (Maybe SrcPkgName) (Maybe SrcPkgName))
    -> SourceDebDescription
    -> Const (Maybe SrcPkgName) SourceDebDescription)
-> Getting (Maybe SrcPkgName) DebInfo (Maybe SrcPkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SrcPkgName -> Const (Maybe SrcPkgName) (Maybe SrcPkgName))
-> SourceDebDescription
-> Const (Maybe SrcPkgName) SourceDebDescription
Lens' SourceDebDescription (Maybe SrcPkgName)
S.source) DebInfo
old
      newSource :: Maybe SrcPkgName
newSource = Getting (Maybe SrcPkgName) DebInfo (Maybe SrcPkgName)
-> DebInfo -> Maybe SrcPkgName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceDebDescription
 -> Const (Maybe SrcPkgName) SourceDebDescription)
-> DebInfo -> Const (Maybe SrcPkgName) DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription
  -> Const (Maybe SrcPkgName) SourceDebDescription)
 -> DebInfo -> Const (Maybe SrcPkgName) DebInfo)
-> ((Maybe SrcPkgName
     -> Const (Maybe SrcPkgName) (Maybe SrcPkgName))
    -> SourceDebDescription
    -> Const (Maybe SrcPkgName) SourceDebDescription)
-> Getting (Maybe SrcPkgName) DebInfo (Maybe SrcPkgName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SrcPkgName -> Const (Maybe SrcPkgName) (Maybe SrcPkgName))
-> SourceDebDescription
-> Const (Maybe SrcPkgName) SourceDebDescription
Lens' SourceDebDescription (Maybe SrcPkgName)
S.source) DebInfo
new
      oldPackages :: [BinPkgName]
oldPackages = (BinaryDebDescription -> BinPkgName)
-> [BinaryDebDescription] -> [BinPkgName]
forall a b. (a -> b) -> [a] -> [b]
map (Getting BinPkgName BinaryDebDescription BinPkgName
-> BinaryDebDescription -> BinPkgName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BinPkgName BinaryDebDescription BinPkgName
Lens' BinaryDebDescription BinPkgName
B.package) ([BinaryDebDescription] -> [BinPkgName])
-> [BinaryDebDescription] -> [BinPkgName]
forall a b. (a -> b) -> a -> b
$ Getting [BinaryDebDescription] DebInfo [BinaryDebDescription]
-> DebInfo -> [BinaryDebDescription]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceDebDescription
 -> Const [BinaryDebDescription] SourceDebDescription)
-> DebInfo -> Const [BinaryDebDescription] DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription
  -> Const [BinaryDebDescription] SourceDebDescription)
 -> DebInfo -> Const [BinaryDebDescription] DebInfo)
-> (([BinaryDebDescription]
     -> Const [BinaryDebDescription] [BinaryDebDescription])
    -> SourceDebDescription
    -> Const [BinaryDebDescription] SourceDebDescription)
-> Getting [BinaryDebDescription] DebInfo [BinaryDebDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BinaryDebDescription]
 -> Const [BinaryDebDescription] [BinaryDebDescription])
-> SourceDebDescription
-> Const [BinaryDebDescription] SourceDebDescription
Lens' SourceDebDescription [BinaryDebDescription]
S.binaryPackages) DebInfo
old
      newPackages :: [BinPkgName]
newPackages = (BinaryDebDescription -> BinPkgName)
-> [BinaryDebDescription] -> [BinPkgName]
forall a b. (a -> b) -> [a] -> [b]
map (Getting BinPkgName BinaryDebDescription BinPkgName
-> BinaryDebDescription -> BinPkgName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BinPkgName BinaryDebDescription BinPkgName
Lens' BinaryDebDescription BinPkgName
B.package) ([BinaryDebDescription] -> [BinPkgName])
-> [BinaryDebDescription] -> [BinPkgName]
forall a b. (a -> b) -> a -> b
$ Getting [BinaryDebDescription] DebInfo [BinaryDebDescription]
-> DebInfo -> [BinaryDebDescription]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SourceDebDescription
 -> Const [BinaryDebDescription] SourceDebDescription)
-> DebInfo -> Const [BinaryDebDescription] DebInfo
Lens' DebInfo SourceDebDescription
D.control ((SourceDebDescription
  -> Const [BinaryDebDescription] SourceDebDescription)
 -> DebInfo -> Const [BinaryDebDescription] DebInfo)
-> (([BinaryDebDescription]
     -> Const [BinaryDebDescription] [BinaryDebDescription])
    -> SourceDebDescription
    -> Const [BinaryDebDescription] SourceDebDescription)
-> Getting [BinaryDebDescription] DebInfo [BinaryDebDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([BinaryDebDescription]
 -> Const [BinaryDebDescription] [BinaryDebDescription])
-> SourceDebDescription
-> Const [BinaryDebDescription] SourceDebDescription
Lens' SourceDebDescription [BinaryDebDescription]
S.binaryPackages) DebInfo
new
      unChangeLog :: ChangeLog -> [ChangeLogEntry]
      unChangeLog :: ChangeLog -> [ChangeLogEntry]
unChangeLog (ChangeLog [ChangeLogEntry]
x) = [ChangeLogEntry]
x