-- | 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 :: [String] -> IO Bool
runDebianizeScript [String]
args =
    IO String
getCurrentDirectory IO String -> (String -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
here ->
    String -> IO Bool
doesFileExist String
"debian/Debianize.hs" IO Bool -> (Bool -> IO Bool) -> IO Bool
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 (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' :: [String]
args' = [String
"-i.:src", String
"debian/Debianize.hs"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"running external debianization script in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
here String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showCommandForUser String
"runhaskell" [String]
args')
        (ExitCode, String, String)
result <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"runhaskell" [String]
args' String
""
        case (ExitCode, String, String)
result of
          (ExitCode
ExitSuccess, String
_, String
_) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          (ExitCode
code, String
out, String
err) -> String -> IO Bool
forall a. HasCallStack => String -> a
error (String
" external debianization script failed:\n  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
showCommandForUser String
"runhaskell" [String]
args' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExitCode -> String
forall a. Show a => a -> String
show ExitCode
code String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                     String
"\n stdout: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
out String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n stderr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CommandLineOptions {Flags
BehaviorAdjustment
_adjustment :: CommandLineOptions -> BehaviorAdjustment
_flags :: CommandLineOptions -> Flags
_adjustment :: BehaviorAdjustment
_flags :: Flags
..} -> do
    -- _ <- try (readProcessWithExitCode "apt-get" ["install", "-y", "--force-yes", hcDeb (view compilerFlavor _flags)] "")
    Flags -> IO (Either String CabalInfo)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Flags -> m (Either String CabalInfo)
newCabalInfo Flags
_flags IO (Either String CabalInfo)
-> (Either String CabalInfo -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO ())
-> (CabalInfo -> IO ()) -> Either String CabalInfo -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                               (String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"peformDebianization - " String -> String -> String
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 :: StateT CabalInfo m ()
finishDebianization = LensLike' (Zoomed (StateT DebInfo m) ()) CabalInfo DebInfo
-> StateT DebInfo m () -> StateT CabalInfo m ()
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom 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 (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 :: [String]
diff = DebInfo -> DebInfo -> [String]
compareDebianization DebInfo
old DebInfo
new
                  IO () -> StateT DebInfo m ()
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
$ String -> IO ()
putStrLn (String
"Debianization (dry run):\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
diff then String
"  No changes\n" else [String] -> String
forall a. Show a => a -> String
show [String]
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 :: DebianT m ()
writeDebianization =
    do Map String Text
files <- DebianT m (Map String Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map String Text)
debianizationFileMap
       IO () -> DebianT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DebianT m ()) -> IO () -> DebianT m ()
forall a b. (a -> b) -> a -> b
$ ((String, Text) -> IO ()) -> [(String, Text)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> Text -> IO ()) -> (String, Text) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Text -> IO ()
doFile) (Map String Text -> [(String, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String Text
files)
       IO () -> DebianT m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DebianT m ()) -> IO () -> DebianT m ()
forall a b. (a -> b) -> a -> b
$ String -> IO Permissions
getPermissions String
"debian/rules" IO Permissions -> (Permissions -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Permissions -> IO ()
setPermissions String
"debian/rules" (Permissions -> IO ())
-> (Permissions -> Permissions) -> Permissions -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ Permissions
p -> Permissions
p {executable :: Bool
executable = Bool
True})
    where
      doFile :: String -> Text -> IO ()
doFile String
path Text
text =
          do Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
path)
             String -> String -> IO ()
replaceFile String
path (Text -> String
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 :: DebianT m String
describeDebianization =
    DebianT m (Map String Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map String Text)
debianizationFileMap DebianT m (Map String Text)
-> (Map String Text -> DebianT m String) -> DebianT m String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> DebianT m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> DebianT m String)
-> (Map String Text -> String)
-> Map String Text
-> DebianT m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Text) -> String) -> [(String, Text)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ (String
path, Text
text) -> String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
indent String
" > " (Text -> String
unpack Text
text)) ([(String, Text)] -> String)
-> (Map String Text -> [(String, Text)])
-> Map String Text
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String Text -> [(String, 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 :: 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 -> [String]
compareDebianization DebInfo
old DebInfo
new =
    let ~(Just Map String Text
oldFiles) = DebianT Maybe (Map String Text)
-> DebInfo -> Maybe (Map String Text)
forall (m :: * -> *) a. Monad m => DebianT m a -> DebInfo -> m a
evalDebianT DebianT Maybe (Map String Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map String Text)
debianizationFileMap (DebInfo -> DebInfo
forall a. Canonical a => a -> a
canonical DebInfo
old)
        ~(Just Map String Text
newFiles) = DebianT Maybe (Map String Text)
-> DebInfo -> Maybe (Map String Text)
forall (m :: * -> *) a. Monad m => DebianT m a -> DebInfo -> m a
evalDebianT DebianT Maybe (Map String Text)
forall (m :: * -> *). MonadFail m => DebianT m (Map String Text)
debianizationFileMap (DebInfo -> DebInfo
forall a. Canonical a => a -> a
canonical DebInfo
new) in
    Map String String -> [String]
forall k a. Map k a -> [a]
elems (Map String String -> [String]) -> Map String String -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Text -> Maybe Text -> Maybe String)
-> Map String Text -> Map String Text -> Map String String
forall k a b c.
Ord k =>
(k -> Maybe a -> Maybe b -> Maybe c)
-> Map k a -> Map k b -> Map k c
zipMaps String -> Maybe Text -> Maybe Text -> Maybe String
doFile Map String Text
oldFiles Map String Text
newFiles
    where
      doFile :: FilePath -> Maybe Text -> Maybe Text -> Maybe String
      doFile :: String -> Maybe Text -> Maybe Text -> Maybe String
doFile String
path (Just Text
_) Maybe Text
Nothing = String -> Maybe String
forall a. a -> Maybe a
Just (String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Deleted\n")
      doFile String
path Maybe Text
Nothing (Just Text
n) = String -> Maybe String
forall a. a -> Maybe a
Just (String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Created\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> String
indent String
" | " (Text -> String
unpack Text
n))
      doFile String
path (Just Text
o) (Just Text
n) =
          if Text
o Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n
          then Maybe String
forall a. Maybe a
Nothing -- Just (path ++ ": Unchanged\n")
          else String -> Maybe String
forall a. a -> Maybe a
Just (Doc -> String
forall a. Show a => a -> String
show (Doc -> Doc -> (Text -> Doc) -> ContextDiff Text -> Doc
forall c. Doc -> Doc -> (c -> Doc) -> ContextDiff c -> Doc
prettyContextDiff (String -> Doc
text (String
"old" String -> String -> String
</> String
path)) (String -> Doc
text (String
"new" String -> String -> String
</> String
path)) (String -> Doc
text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
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 String
_path Maybe Text
Nothing Maybe Text
Nothing = String -> Maybe String
forall a. HasCallStack => String -> a
error String
"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 (String -> IOError
userError (String
"Version mismatch, expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DebianVersion -> String
forall a. Pretty (PP a) => a -> String
ppShow DebianVersion
oldVersion String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DebianVersion -> String
forall a. Pretty (PP a) => a -> String
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 (String -> IOError
userError (String
"Source mismatch, expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe SrcPkgName -> String
forall a. Pretty (PP a) => a -> String
ppShow Maybe SrcPkgName
oldSource String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe SrcPkgName -> String
forall a. Pretty (PP a) => a -> String
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 (String -> IOError
userError (String
"Package mismatch, expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Doc] -> String
forall a. Show a => a -> String
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) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Doc] -> String
forall a. Show a => a -> String
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. [a] -> a
head (ChangeLog -> [ChangeLogEntry]
unChangeLog (ChangeLog -> Maybe ChangeLog -> ChangeLog
forall a. a -> Maybe a -> a
fromMaybe (String -> ChangeLog
forall a. HasCallStack => String -> a
error String
"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. [a] -> a
head (ChangeLog -> [ChangeLogEntry]
unChangeLog (ChangeLog -> Maybe ChangeLog -> ChangeLog
forall a. a -> Maybe a -> a
fromMaybe (String -> ChangeLog
forall a. HasCallStack => String -> a
error String
"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