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