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