{-# LANGUAGE FlexibleContexts, FlexibleInstances, Rank2Types, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module Debian.Debianize.Prelude
( curry3
, DebMap
, buildDebVersionMap
, (!)
, strip
, stripWith
, strictReadF
, replaceFile
, modifyFile
, diffFile
, removeIfExists
, dpkgFileMap
, debOfFile
, cond
, readFile'
, readFileMaybe
, showDeps
, showDeps'
, withCurrentDirectory
, getDirectoryContents'
, setMapMaybe
, zipMaps
, foldEmpty
, maybeL
, indent
, maybeRead
, read'
, modifyM
, intToVerbosity'
, listElemLens
, maybeLens
, fromEmpty
, fromSingleton
, (.?=)
, escapeDebianWildcards
, module Distribution.Version
, module Distribution.Package
) where
import Control.Exception as E (bracket, catch, throw, try)
import Control.Lens
import Control.Monad (when)
import Control.Monad.Reader (ask, ReaderT)
import Control.Monad.State (get, MonadState, StateT, put)
import Data.Char (isSpace)
import Data.List as List (dropWhileEnd, intersperse, lines, map)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe, listToMaybe, mapMaybe)
import Data.Set as Set (Set, toList)
import qualified Data.Set as Set (findMin, fromList, null, size)
import Data.Text as Text (Text, unpack)
import Data.Text.IO (hGetContents)
import Debian.Control (stripWS)
import Debian.Orphans ()
import Debian.Pretty (PP(PP))
import qualified Debian.Relation as D (BinPkgName(..), Relations)
import Debian.Relation.Common ()
import Debian.Version (DebianVersion, parseDebianVersion', prettyDebianVersion)
import Distribution.Package (PackageIdentifier(..), PackageName, mkPackageName, unPackageName)
import Distribution.Version
import Distribution.Pretty (Pretty(pretty))
import Distribution.Verbosity (intToVerbosity, Verbosity)
import GHC.IO.Exception (ExitCode(ExitFailure, ExitSuccess), IOErrorType(InappropriateType, NoSuchThing), IOException(IOError, ioe_description, ioe_type))
import Prelude hiding (map)
import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, getDirectoryContents, removeDirectory, removeFile, renameFile, setCurrentDirectory)
import System.FilePath ((</>))
import System.IO (hSetBinaryMode, IOMode(ReadMode), openFile, withFile)
import System.IO.Error (catchIOError, isDoesNotExistError)
import System.Process (readProcess, readProcessWithExitCode, showCommandForUser)
import Text.PrettyPrint.HughesPJClass as PP (text)
curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
curry3 :: forall a b c d. ((a, b, c) -> d) -> a -> b -> c -> d
curry3 (a, b, c) -> d
f a
a b
b c
c = (a, b, c) -> d
f (a
a, b
b, c
c)
type DebMap = Map D.BinPkgName (Maybe DebianVersion)
buildDebVersionMap :: IO DebMap
buildDebVersionMap :: IO DebMap
buildDebVersionMap =
[(BinPkgName, Maybe DebianVersion)] -> DebMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(BinPkgName, Maybe DebianVersion)] -> DebMap)
-> (FilePath -> [(BinPkgName, Maybe DebianVersion)])
-> FilePath
-> DebMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> (BinPkgName, Maybe DebianVersion))
-> [FilePath] -> [(BinPkgName, Maybe DebianVersion)]
forall a b. (a -> b) -> [a] -> [b]
List.map FilePath -> (BinPkgName, Maybe DebianVersion)
lineToKV ([FilePath] -> [(BinPkgName, Maybe DebianVersion)])
-> (FilePath -> [FilePath])
-> FilePath
-> [(BinPkgName, Maybe DebianVersion)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
Prelude.lines (FilePath -> DebMap) -> IO FilePath -> IO DebMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
"dpkg-query" [FilePath
"--showformat", FilePath
"${Package}\\t${Version}\\n"] FilePath
""
where
lineToKV :: FilePath -> (BinPkgName, Maybe DebianVersion)
lineToKV = (FilePath -> BinPkgName)
-> (FilePath -> Maybe DebianVersion)
-> (FilePath, FilePath)
-> (BinPkgName, Maybe DebianVersion)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (FilePath -> BinPkgName
D.BinPkgName (FilePath -> BinPkgName)
-> (FilePath -> FilePath) -> FilePath -> BinPkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. ControlFunctions a => a -> a
stripWS) (DebianVersion -> Maybe DebianVersion
forall a. a -> Maybe a
Just (DebianVersion -> Maybe DebianVersion)
-> (FilePath -> DebianVersion) -> FilePath -> Maybe DebianVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' (FilePath -> DebianVersion)
-> (FilePath -> FilePath) -> FilePath -> DebianVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. ControlFunctions a => a -> a
stripWS) ((FilePath, FilePath) -> (BinPkgName, Maybe DebianVersion))
-> (FilePath -> (FilePath, FilePath))
-> FilePath
-> (BinPkgName, Maybe DebianVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t')
(!) :: DebMap -> D.BinPkgName -> DebianVersion
DebMap
m ! :: DebMap -> BinPkgName -> DebianVersion
! BinPkgName
k = DebianVersion
-> (DebianVersion -> DebianVersion)
-> Maybe DebianVersion
-> DebianVersion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> DebianVersion
forall a. HasCallStack => FilePath -> a
error (FilePath
"No version number for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> (BinPkgName -> Doc) -> BinPkgName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP BinPkgName -> Doc
forall a. Pretty a => a -> Doc
pretty (PP BinPkgName -> Doc)
-> (BinPkgName -> PP BinPkgName) -> BinPkgName -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> PP BinPkgName
forall a. a -> PP a
PP (BinPkgName -> FilePath) -> BinPkgName -> FilePath
forall a b. (a -> b) -> a -> b
$ BinPkgName
k) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Map BinPkgName (Maybe Doc) -> FilePath
forall a. Show a => a -> FilePath
show ((Maybe DebianVersion -> Maybe Doc)
-> DebMap -> Map BinPkgName (Maybe Doc)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Maybe Doc
-> (DebianVersion -> Maybe Doc) -> Maybe DebianVersion -> Maybe Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Doc
forall a. Maybe a
Nothing (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc)
-> (DebianVersion -> Doc) -> DebianVersion -> Maybe Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebianVersion -> Doc
prettyDebianVersion)) DebMap
m))) DebianVersion -> DebianVersion
forall a. a -> a
id (Maybe DebianVersion -> BinPkgName -> DebMap -> Maybe DebianVersion
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Maybe DebianVersion
forall a. Maybe a
Nothing BinPkgName
k DebMap
m)
strip :: String -> String
strip :: FilePath -> FilePath
strip = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
stripWith Char -> Bool
isSpace
stripWith :: (a -> Bool) -> [a] -> [a]
stripWith :: forall a. (a -> Bool) -> [a] -> [a]
stripWith a -> Bool
f = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd a -> Bool
f
strictReadF :: (Text -> r) -> FilePath -> IO r
strictReadF :: forall r. (Text -> r) -> FilePath -> IO r
strictReadF Text -> r
f FilePath
path = FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
ReadMode (\Handle
h -> Handle -> IO Text
hGetContents Handle
h IO Text -> (Text -> IO r) -> IO r
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Text
x -> r -> IO r
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (r -> IO r) -> r -> IO r
forall a b. (a -> b) -> a -> b
$! Text -> r
f Text
x))
replaceFile :: FilePath -> String -> IO ()
replaceFile :: FilePath -> FilePath -> IO ()
replaceFile FilePath
path FilePath
s =
do FilePath -> IO ()
removeFile FilePath
back IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ (IOException
e :: IOException) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (IOException -> Bool
isDoesNotExistError IOException
e)) (IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e))
FilePath -> FilePath -> IO ()
renameFile FilePath
path FilePath
back IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ (IOException
e :: IOException) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (IOException -> Bool
isDoesNotExistError IOException
e)) (IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e))
FilePath -> FilePath -> IO ()
writeFile FilePath
path FilePath
s
where
back :: FilePath
back = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"~"
modifyFile :: FilePath -> (String -> IO (Maybe String)) -> IO ()
modifyFile :: FilePath -> (FilePath -> IO (Maybe FilePath)) -> IO ()
modifyFile FilePath
path FilePath -> IO (Maybe FilePath)
f =
do FilePath -> IO ()
removeFile FilePath
back IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ (IOException
e :: IOException) -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (IOException -> Bool
isDoesNotExistError IOException
e)) (IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e))
IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> FilePath -> IO ()
renameFile FilePath
path FilePath
back) IO (Either IOException ())
-> (Either IOException () -> 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
>>=
(IOException -> IO ())
-> (() -> IO ()) -> Either IOException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\ (IOException
e :: IOException) -> if Bool -> Bool
not (IOException -> Bool
isDoesNotExistError IOException
e)
then IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e
else FilePath -> IO (Maybe FilePath)
f FilePath
"" IO (Maybe FilePath) -> (Maybe FilePath -> 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
>>= IO () -> (FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> FilePath -> IO ()
writeFile FilePath
path))
(\ () -> FilePath -> IO FilePath
readFile FilePath
back IO FilePath
-> (FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (Maybe FilePath)
f IO (Maybe FilePath) -> (Maybe FilePath -> 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
>>= IO () -> (FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> FilePath -> IO ()
writeFile FilePath
path))
where
back :: FilePath
back = FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"~"
diffFile :: FilePath -> Text -> IO (Maybe String)
diffFile :: FilePath -> Text -> IO (Maybe FilePath)
diffFile FilePath
path Text
s =
FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
cmd [FilePath]
args (Text -> FilePath
unpack Text
s) IO (ExitCode, FilePath, FilePath)
-> ((ExitCode, FilePath, FilePath) -> IO (Maybe FilePath))
-> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (ExitCode
code, FilePath
out, FilePath
_err) ->
case ExitCode
code of
ExitCode
ExitSuccess -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
ExitFailure Int
1 -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
out)
ExitCode
_ -> FilePath -> IO (Maybe FilePath)
forall a. HasCallStack => FilePath -> a
error (FilePath -> [FilePath] -> FilePath
showCommandForUser FilePath
cmd [FilePath]
args FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" -> " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
show ExitCode
code)
where
cmd :: FilePath
cmd = FilePath
"diff"
args :: [FilePath]
args = [FilePath
"-ruw", FilePath
path, FilePath
"-"]
removeFileIfExists :: FilePath -> IO ()
removeFileIfExists :: FilePath -> IO ()
removeFileIfExists FilePath
x = FilePath -> IO Bool
doesFileExist FilePath
x IO Bool -> (Bool -> 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
>>= (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` (FilePath -> IO ()
removeFile FilePath
x))
removeDirectoryIfExists :: FilePath -> IO ()
removeDirectoryIfExists :: FilePath -> IO ()
removeDirectoryIfExists FilePath
x = FilePath -> IO Bool
doesDirectoryExist FilePath
x IO Bool -> (Bool -> 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
>>= (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`when` (FilePath -> IO ()
removeDirectory FilePath
x))
removeIfExists :: FilePath -> IO ()
removeIfExists :: FilePath -> IO ()
removeIfExists FilePath
x = FilePath -> IO ()
removeFileIfExists FilePath
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO ()
removeDirectoryIfExists FilePath
x
dpkgFileMap :: IO (Map FilePath (Set D.BinPkgName))
dpkgFileMap :: IO (Map FilePath (Set BinPkgName))
dpkgFileMap =
do
[BinPkgName]
installedPackages <- DebMap -> [BinPkgName]
forall k a. Map k a -> [k]
Map.keys (DebMap -> [BinPkgName]) -> IO DebMap -> IO [BinPkgName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DebMap
buildDebVersionMap
[[FilePath]]
files <- (BinPkgName -> IO [FilePath]) -> [BinPkgName] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (FilePath -> IO [FilePath]
listFiles (FilePath -> IO [FilePath])
-> (BinPkgName -> FilePath) -> BinPkgName -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> FilePath
D.unBinPkgName) [BinPkgName]
installedPackages
Map FilePath (Set BinPkgName) -> IO (Map FilePath (Set BinPkgName))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath (Set BinPkgName)
-> IO (Map FilePath (Set BinPkgName)))
-> Map FilePath (Set BinPkgName)
-> IO (Map FilePath (Set BinPkgName))
forall a b. (a -> b) -> a -> b
$ [(FilePath, Set BinPkgName)] -> Map FilePath (Set BinPkgName)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(FilePath, Set BinPkgName)] -> Map FilePath (Set BinPkgName))
-> [(FilePath, Set BinPkgName)] -> Map FilePath (Set BinPkgName)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [Set BinPkgName] -> [(FilePath, Set BinPkgName)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((BinPkgName -> FilePath) -> [BinPkgName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
List.map BinPkgName -> FilePath
D.unBinPkgName [BinPkgName]
installedPackages) (([FilePath] -> Set BinPkgName) -> [[FilePath]] -> [Set BinPkgName]
forall a b. (a -> b) -> [a] -> [b]
List.map ([BinPkgName] -> Set BinPkgName
forall a. Ord a => [a] -> Set a
Set.fromList ([BinPkgName] -> Set BinPkgName)
-> ([FilePath] -> [BinPkgName]) -> [FilePath] -> Set BinPkgName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> BinPkgName) -> [FilePath] -> [BinPkgName]
forall a b. (a -> b) -> [a] -> [b]
List.map FilePath -> BinPkgName
D.BinPkgName) ([[FilePath]] -> [Set BinPkgName])
-> [[FilePath]] -> [Set BinPkgName]
forall a b. (a -> b) -> a -> b
$ [[FilePath]]
files)
where
listFiles :: FilePath -> IO [FilePath]
listFiles FilePath
pkg = FilePath -> [FilePath]
Prelude.lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
"dpkg-query" [FilePath
"--listfiles", FilePath
pkg] FilePath
""
debOfFile :: FilePath -> ReaderT (Map FilePath (Set D.BinPkgName)) IO (Maybe D.BinPkgName)
debOfFile :: FilePath
-> ReaderT (Map FilePath (Set BinPkgName)) IO (Maybe BinPkgName)
debOfFile FilePath
path =
do Map FilePath (Set BinPkgName)
mp <- ReaderT
(Map FilePath (Set BinPkgName)) IO (Map FilePath (Set BinPkgName))
forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe BinPkgName
-> ReaderT (Map FilePath (Set BinPkgName)) IO (Maybe BinPkgName)
forall a. a -> ReaderT (Map FilePath (Set BinPkgName)) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe BinPkgName
-> ReaderT (Map FilePath (Set BinPkgName)) IO (Maybe BinPkgName))
-> Maybe BinPkgName
-> ReaderT (Map FilePath (Set BinPkgName)) IO (Maybe BinPkgName)
forall a b. (a -> b) -> a -> b
$ Maybe (Set BinPkgName) -> Maybe BinPkgName
forall {a}. Maybe (Set a) -> Maybe a
testPath (FilePath -> Map FilePath (Set BinPkgName) -> Maybe (Set BinPkgName)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
path Map FilePath (Set BinPkgName)
mp)
where
testPath :: Maybe (Set a) -> Maybe a
testPath Maybe (Set a)
Nothing = Maybe a
forall a. Maybe a
Nothing
testPath (Just Set a
s) =
case Set a -> Int
forall a. Set a -> Int
Set.size Set a
s of
Int
1 -> a -> Maybe a
forall a. a -> Maybe a
Just (Set a -> a
forall a. Set a -> a
Set.findMin Set a
s)
Int
_ -> Maybe a
forall a. Maybe a
Nothing
cond :: t -> t -> Bool -> t
cond :: forall t. t -> t -> Bool -> t
cond t
ifF t
_ifT Bool
False = t
ifF
cond t
_ifF t
ifT Bool
True = t
ifT
readFile' :: FilePath -> IO Text
readFile' :: FilePath -> IO Text
readFile' FilePath
path =
do Handle
file <- FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
ReadMode
Handle -> Bool -> IO ()
hSetBinaryMode Handle
file Bool
True
Handle -> IO Text
hGetContents Handle
file
readFileMaybe :: FilePath -> IO (Maybe Text)
readFileMaybe :: FilePath -> IO (Maybe Text)
readFileMaybe FilePath
path = (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readFile' FilePath
path) IO (Maybe Text)
-> (IOException -> IO (Maybe Text)) -> IO (Maybe Text)
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIOError` (\ IOException
_ -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing)
showDeps :: D.Relations -> String
showDeps :: Relations -> FilePath
showDeps = Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> (Relations -> Doc) -> Relations -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP Relations -> Doc
forall a. Pretty a => a -> Doc
pretty (PP Relations -> Doc)
-> (Relations -> PP Relations) -> Relations -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relations -> PP Relations
forall a. a -> PP a
PP
showDeps' :: D.Relations -> String
showDeps' :: Relations -> FilePath
showDeps' Relations
xss = Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> Doc -> FilePath
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (FilePath -> Doc
text FilePath
"\n ") ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
[PP OrRelation -> Doc
forall a. Pretty a => a -> Doc
pretty (OrRelation -> PP OrRelation
forall a. a -> PP a
PP OrRelation
xs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text FilePath
"," | OrRelation
xs <- Relations
xss ]
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory :: forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
path IO a
m =
IO FilePath -> (FilePath -> IO ()) -> (FilePath -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket
(do FilePath
oldwd <- IO FilePath
getCurrentDirectory
let newwd :: FilePath
newwd = FilePath
oldwd FilePath -> FilePath -> FilePath
</> FilePath
path
FilePath -> IO ()
setCurrentDirectory' FilePath
newwd
FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
oldwd)
(\FilePath
oldwd -> FilePath -> IO ()
setCurrentDirectory' FilePath
oldwd )
(\FilePath
_oldwd -> IO a
m)
setCurrentDirectory' :: FilePath -> IO ()
setCurrentDirectory' :: FilePath -> IO ()
setCurrentDirectory' FilePath
dir =
IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> IO ()
setCurrentDirectory FilePath
dir) IO (Either IOException ())
-> (Either IOException () -> 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
>>= (IOException -> IO ())
-> (() -> IO ()) -> Either IOException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOException -> IO ()
forall {a}. IOException -> a
handle () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
where
handle :: IOException -> a
handle e :: IOException
e@(IOError {ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
NoSuchThing}) = IOException -> a
forall a e. Exception e => e -> a
throw (IOException -> a) -> IOException -> a
forall a b. (a -> b) -> a -> b
$ IOException
e {ioe_description = ioe_description e ++ ": " ++ show dir}
handle e :: IOException
e@(IOError {ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
InappropriateType}) = IOException -> a
forall a e. Exception e => e -> a
throw (IOException -> a) -> IOException -> a
forall a b. (a -> b) -> a -> b
$ IOException
e {ioe_description = ioe_description e ++ ": " ++ show dir}
handle e :: IOException
e@(IOError {ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
typ}) = IOException -> a
forall a e. Exception e => e -> a
throw (IOException -> a) -> IOException -> a
forall a b. (a -> b) -> a -> b
$ IOException
e {ioe_description = ioe_description e ++ " unexpected ioe_type: " ++ show typ}
getDirectoryContents' :: FilePath -> IO [FilePath]
getDirectoryContents' :: FilePath -> IO [FilePath]
getDirectoryContents' FilePath
dir =
FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> IO [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
dotFile)
where
dotFile :: FilePath -> Bool
dotFile FilePath
"." = Bool
True
dotFile FilePath
".." = Bool
True
dotFile FilePath
_ = Bool
False
setMapMaybe :: ( Ord b) => (a -> Maybe b) -> Set a -> Set b
setMapMaybe :: forall b a. Ord b => (a -> Maybe b) -> Set a -> Set b
setMapMaybe a -> Maybe b
p = [b] -> Set b
forall a. Ord a => [a] -> Set a
Set.fromList ([b] -> Set b) -> (Set a -> [b]) -> Set a -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
p ([a] -> [b]) -> (Set a -> [a]) -> Set a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
toList
zipMaps :: Ord k => (k -> Maybe a -> Maybe b -> Maybe c) -> Map k a -> Map k b -> Map k c
zipMaps :: forall k a b c.
Ord k =>
(k -> Maybe a -> Maybe b -> Maybe c)
-> Map k a -> Map k b -> Map k c
zipMaps k -> Maybe a -> Maybe b -> Maybe c
f Map k a
m Map k b
n =
(k -> b -> Map k c -> Map k c) -> Map k c -> Map k b -> Map k c
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey k -> b -> Map k c -> Map k c
h ((k -> a -> Map k c -> Map k c) -> Map k c -> Map k a -> Map k c
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey k -> a -> Map k c -> Map k c
g Map k c
forall k a. Map k a
Map.empty Map k a
m) Map k b
n
where
g :: k -> a -> Map k c -> Map k c
g k
k a
a Map k c
r = case k -> Maybe a -> Maybe b -> Maybe c
f k
k (a -> Maybe a
forall a. a -> Maybe a
Just a
a) (k -> Map k b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k b
n) of
Just c
c -> k -> c -> Map k c -> Map k c
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k c
c Map k c
r
Maybe c
Nothing -> Map k c
r
h :: k -> b -> Map k c -> Map k c
h k
k b
b Map k c
r = case k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k a
m of
Maybe a
Nothing -> case k -> Maybe a -> Maybe b -> Maybe c
f k
k Maybe a
forall a. Maybe a
Nothing (b -> Maybe b
forall a. a -> Maybe a
Just b
b) of
Just c
c -> k -> c -> Map k c -> Map k c
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k c
c Map k c
r
Maybe c
Nothing -> Map k c
r
Just a
_ -> Map k c
r
foldEmpty :: r -> ([a] -> r) -> [a] -> r
foldEmpty :: forall r a. r -> ([a] -> r) -> [a] -> r
foldEmpty r
r [a] -> r
_ [] = r
r
foldEmpty r
_ [a] -> r
f [a]
l = [a] -> r
f [a]
l
maybeL :: Lens' a (Maybe b) -> Maybe b -> a -> a
maybeL :: forall a b. Lens' a (Maybe b) -> Maybe b -> a -> a
maybeL Lens' a (Maybe b)
l Maybe b
mb a
x = ASetter a a (Maybe b) (Maybe b) -> (Maybe b -> Maybe b) -> a -> a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter a a (Maybe b) (Maybe b)
Lens' a (Maybe b)
l (Maybe b -> (b -> Maybe b) -> Maybe b -> Maybe b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe b
mb b -> Maybe b
forall a. a -> Maybe a
Just) a
x
indent :: [Char] -> String -> String
indent :: FilePath -> FilePath -> FilePath
indent FilePath
prefix FilePath
s = [FilePath] -> FilePath
unlines ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
List.map (FilePath
prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> [FilePath]
List.lines FilePath
s))
maybeRead :: Read a => String -> Maybe a
maybeRead :: forall a. Read a => FilePath -> Maybe a
maybeRead = ((a, FilePath) -> a) -> Maybe (a, FilePath) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, FilePath) -> a
forall a b. (a, b) -> a
fst (Maybe (a, FilePath) -> Maybe a)
-> (FilePath -> Maybe (a, FilePath)) -> FilePath -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, FilePath)] -> Maybe (a, FilePath)
forall a. [a] -> Maybe a
listToMaybe ([(a, FilePath)] -> Maybe (a, FilePath))
-> (FilePath -> [(a, FilePath)]) -> FilePath -> Maybe (a, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [(a, FilePath)]
forall a. Read a => ReadS a
reads
read' :: Read a => (String -> a) -> String -> a
read' :: forall a. Read a => (FilePath -> a) -> FilePath -> a
read' FilePath -> a
f FilePath
s = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> a
f FilePath
s) (FilePath -> Maybe a
forall a. Read a => FilePath -> Maybe a
maybeRead FilePath
s)
modifyM :: MonadState a m => (a -> m a) -> m ()
modifyM :: forall a (m :: * -> *). MonadState a m => (a -> m a) -> m ()
modifyM a -> m a
f = m a
forall s (m :: * -> *). MonadState s m => m s
get m a -> (a -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
f m a -> (a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
intToVerbosity' :: Int -> Verbosity
intToVerbosity' :: Int -> Verbosity
intToVerbosity' Int
n = Maybe Verbosity -> Verbosity
forall a. HasCallStack => Maybe a -> a
fromJust (Int -> Maybe Verbosity
intToVerbosity (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
3 Int
n)))
listElemLens :: (a -> Bool) -> Lens' [a] (Maybe a)
listElemLens :: forall a. (a -> Bool) -> Lens' [a] (Maybe a)
listElemLens a -> Bool
p =
([a] -> Maybe a)
-> ([a] -> Maybe a -> [a]) -> Lens [a] [a] (Maybe a) (Maybe a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens [a] -> Maybe a
lensGet [a] -> Maybe a -> [a]
lensPut
where
lensGet :: [a] -> Maybe a
lensGet [a]
xs =
case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) [a]
xs of
([a]
_, a
x : [a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
([a], [a])
_ -> Maybe a
forall a. Maybe a
Nothing
lensPut :: [a] -> Maybe a -> [a]
lensPut [a]
xs Maybe a
Nothing =
case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) [a]
xs of
([a]
before, a
_ : [a]
after) -> [a]
before [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
after
([a], [a])
_ -> [a]
xs
lensPut [a]
xs (Just a
x) =
case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) [a]
xs of
([a]
before, a
_ : [a]
after) -> [a]
before [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
after)
([a], [a])
_ -> [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]
maybeLens :: a -> Lens' a b -> Lens' (Maybe a) b
maybeLens :: forall a b. a -> Lens' a b -> Lens' (Maybe a) b
maybeLens a
def Lens' a b
l =
(Maybe a -> b)
-> (Maybe a -> b -> Maybe a) -> Lens (Maybe a) (Maybe a) b b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ Maybe a
x -> (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
def Maybe a
x) a -> Getting b a b -> b
forall s a. s -> Getting a s a -> a
^. Getting b a b
Lens' a b
l)
(\ Maybe a
b b
a -> case (b
a, Maybe a
b) of
(b
_, Maybe a
Nothing) -> a -> Maybe a
forall a. a -> Maybe a
Just ((b -> Identity b) -> a -> Identity a
Lens' a b
l ((b -> Identity b) -> a -> Identity a) -> b -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
a (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
def)
(b
_, Just a
b') -> a -> Maybe a
forall a. a -> Maybe a
Just ((b -> Identity b) -> a -> Identity a
Lens' a b
l ((b -> Identity b) -> a -> Identity a) -> b -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
a (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
b'))
fromEmpty :: Set a -> Set a -> Set a
fromEmpty :: forall a. Set a -> Set a -> Set a
fromEmpty Set a
d Set a
s | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s = Set a
d
fromEmpty Set a
_ Set a
s = Set a
s
fromSingleton :: a -> ([a] -> a) -> Set a -> a
fromSingleton :: forall a. a -> ([a] -> a) -> Set a -> a
fromSingleton a
e [a] -> a
multiple Set a
s =
case Set a -> [a]
forall a. Set a -> [a]
toList Set a
s of
[a
x] -> a
x
[] -> a
e
[a]
xs -> [a] -> a
multiple [a]
xs
instance Pretty (PP PackageIdentifier) where
pretty :: PP PackageIdentifier -> Doc
pretty (PP PackageIdentifier
p) = PP PackageName -> Doc
forall a. Pretty a => a -> Doc
pretty (PackageName -> PP PackageName
forall a. a -> PP a
PP (PackageIdentifier -> PackageName
pkgName PackageIdentifier
p)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text FilePath
"-" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PP Version -> Doc
forall a. Pretty a => a -> Doc
pretty (Version -> PP Version
forall a. a -> PP a
PP (PackageIdentifier -> Version
pkgVersion PackageIdentifier
p))
instance Pretty (PP PackageName) where
pretty :: PP PackageName -> Doc
pretty (PP PackageName
p) = FilePath -> Doc
text (PackageName -> FilePath
unPackageName PackageName
p)
(.?=) :: Monad m => Lens' a (Maybe b) -> Maybe b -> StateT a m ()
Lens' a (Maybe b)
l .?= :: forall (m :: * -> *) a b.
Monad m =>
Lens' a (Maybe b) -> Maybe b -> StateT a m ()
.?= Maybe b
mx = Getting (Maybe b) a (Maybe b) -> StateT a m (Maybe b)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe b) a (Maybe b)
Lens' a (Maybe b)
l StateT a m (Maybe b) -> (Maybe b -> StateT a m ()) -> StateT a m ()
forall a b. StateT a m a -> (a -> StateT a m b) -> StateT a m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ASetter a a (Maybe b) (Maybe b) -> Maybe b -> StateT a m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign ASetter a a (Maybe b) (Maybe b)
Lens' a (Maybe b)
l (Maybe b -> StateT a m ())
-> (Maybe b -> Maybe b) -> Maybe b -> StateT a m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> (b -> Maybe b) -> Maybe b -> Maybe b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe b
mx b -> Maybe b
forall a. a -> Maybe a
Just
escapeDebianWildcards :: String -> String
escapeDebianWildcards :: FilePath -> FilePath
escapeDebianWildcards (Char
c : FilePath
more) | Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c FilePath
"[]" = Char
'\\' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escapeDebianWildcards FilePath
more
escapeDebianWildcards (Char
c : FilePath
more) = Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
escapeDebianWildcards FilePath
more
escapeDebianWildcards FilePath
"" = FilePath
""