{-# 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 =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map FilePath -> (BinPkgName, Maybe DebianVersion)
lineToKV forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
Prelude.lines 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (FilePath -> BinPkgName
D.BinPkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ControlFunctions a => a -> a
stripWS) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ControlFunctions a => a -> a
stripWS) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'\t')
(!) :: DebMap -> D.BinPkgName -> DebianVersion
DebMap
m ! :: DebMap -> BinPkgName -> DebianVersion
! BinPkgName
k = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => FilePath -> a
error (FilePath
"No version number for " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP forall a b. (a -> b) -> a -> b
$ BinPkgName
k) forall a. [a] -> [a] -> [a]
++ FilePath
" in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebianVersion -> Doc
prettyDebianVersion)) DebMap
m))) forall a. a -> a
id (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Maybe a
Nothing BinPkgName
k DebMap
m)
strip :: String -> String
strip :: FilePath -> FilePath
strip = 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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
ReadMode (\Handle
h -> Handle -> IO Text
hGetContents Handle
h forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Text
x -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ (IOException
e :: IOException) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (IOException -> Bool
isDoesNotExistError IOException
e)) (forall a. IOException -> IO a
ioError IOException
e))
FilePath -> FilePath -> IO ()
renameFile FilePath
path FilePath
back forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ (IOException
e :: IOException) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (IOException -> Bool
isDoesNotExistError IOException
e)) (forall a. IOException -> IO a
ioError IOException
e))
FilePath -> FilePath -> IO ()
writeFile FilePath
path FilePath
s
where
back :: FilePath
back = FilePath
path 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 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` (\ (IOException
e :: IOException) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (IOException -> Bool
isDoesNotExistError IOException
e)) (forall a. IOException -> IO a
ioError IOException
e))
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> FilePath -> IO ()
renameFile FilePath
path FilePath
back) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
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 forall a. IOException -> IO a
ioError IOException
e
else FilePath -> IO (Maybe FilePath)
f FilePath
"" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> FilePath -> IO ()
writeFile FilePath
path))
(\ () -> FilePath -> IO FilePath
readFile FilePath
back forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO (Maybe FilePath)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> FilePath -> IO ()
writeFile FilePath
path))
where
back :: FilePath
back = FilePath
path 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) 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
ExitFailure Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FilePath
out)
ExitCode
_ -> forall a. HasCallStack => FilePath -> a
error (FilePath -> [FilePath] -> FilePath
showCommandForUser FilePath
cmd [FilePath]
args forall a. [a] -> [a] -> [a]
++ FilePath
" -> " forall a. [a] -> [a] -> [a]
++ 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (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 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 <- forall k a. Map k a -> [k]
Map.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO DebMap
buildDebVersionMap
[[FilePath]]
files <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> IO [FilePath]
listFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinPkgName -> FilePath
D.unBinPkgName) [BinPkgName]
installedPackages
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
List.map BinPkgName -> FilePath
D.unBinPkgName [BinPkgName]
installedPackages) (forall a b. (a -> b) -> [a] -> [b]
List.map (forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
List.map FilePath -> BinPkgName
D.BinPkgName) forall a b. (a -> b) -> a -> b
$ [[FilePath]]
files)
where
listFiles :: FilePath -> IO [FilePath]
listFiles FilePath
pkg = FilePath -> [FilePath]
Prelude.lines 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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a}. Maybe (Set a) -> Maybe a
testPath (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 = forall a. Maybe a
Nothing
testPath (Just Set a
s) =
case forall a. Set a -> Int
Set.size Set a
s of
Int
1 -> forall a. a -> Maybe a
Just (forall a. Set a -> a
Set.findMin Set a
s)
Int
_ -> 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 = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Text
readFile' FilePath
path) forall a. IO a -> (IOException -> IO a) -> IO a
`catchIOError` (\ IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
showDeps :: D.Relations -> String
showDeps :: Relations -> FilePath
showDeps = forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> PP a
PP
showDeps' :: D.Relations -> String
showDeps' :: Relations -> FilePath
showDeps' Relations
xss = forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (FilePath -> Doc
text FilePath
"\n ") forall a b. (a -> b) -> a -> b
$
[forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP OrRelation
xs) 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 =
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
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 =
forall e a. Exception e => IO a -> IO (Either e a)
try (FilePath -> IO ()
setCurrentDirectory FilePath
dir) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. IOException -> a
handle 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}) = forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ IOException
e {ioe_description :: FilePath
ioe_description = IOException -> FilePath
ioe_description IOException
e forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
dir}
handle e :: IOException
e@(IOError {ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
InappropriateType}) = forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ IOException
e {ioe_description :: FilePath
ioe_description = IOException -> FilePath
ioe_description IOException
e forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show FilePath
dir}
handle e :: IOException
e@(IOError {ioe_type :: IOException -> IOErrorType
ioe_type = IOErrorType
typ}) = forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ IOException
e {ioe_description :: FilePath
ioe_description = IOException -> FilePath
ioe_description IOException
e forall a. [a] -> [a] -> [a]
++ FilePath
" unexpected ioe_type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show IOErrorType
typ}
getDirectoryContents' :: FilePath -> IO [FilePath]
getDirectoryContents' :: FilePath -> IO [FilePath]
getDirectoryContents' FilePath
dir =
FilePath -> IO [FilePath]
getDirectoryContents FilePath
dir forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not 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 = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe a -> Maybe b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey k -> b -> Map k c -> Map k c
h (forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey k -> a -> Map k c -> Map k c
g 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 (forall a. a -> Maybe a
Just a
a) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k b
n) of
Just c
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 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 forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just b
b) of
Just c
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 = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' a (Maybe b)
l (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe b
mb forall a. a -> Maybe a
Just) a
x
indent :: [Char] -> String -> String
indent :: FilePath -> FilePath -> FilePath
indent FilePath
prefix FilePath
s = [FilePath] -> FilePath
unlines (forall a b. (a -> b) -> [a] -> [b]
List.map (FilePath
prefix 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> Maybe a -> a
fromMaybe (FilePath -> a
f FilePath
s) (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 = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => s -> m ()
put
intToVerbosity' :: Int -> Verbosity
intToVerbosity' :: Int -> Verbosity
intToVerbosity' Int
n = forall a. HasCallStack => Maybe a -> a
fromJust (Int -> Maybe Verbosity
intToVerbosity (forall a. Ord a => a -> a -> a
max Int
0 (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 =
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 forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) [a]
xs of
([a]
_, a
x : [a]
_) -> forall a. a -> Maybe a
Just a
x
([a], [a])
_ -> forall a. Maybe a
Nothing
lensPut :: [a] -> Maybe a -> [a]
lensPut [a]
xs Maybe a
Nothing =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) [a]
xs of
([a]
before, a
_ : [a]
after) -> [a]
before forall a. [a] -> [a] -> [a]
++ [a]
after
([a], [a])
_ -> [a]
xs
lensPut [a]
xs (Just a
x) =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) [a]
xs of
([a]
before, a
_ : [a]
after) -> [a]
before forall a. [a] -> [a] -> [a]
++ (a
x forall a. a -> [a] -> [a]
: [a]
after)
([a], [a])
_ -> [a]
xs 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 =
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ Maybe a
x -> (forall a. a -> Maybe a -> a
fromMaybe a
def Maybe a
x) forall s a. s -> Getting a s a -> a
^. Lens' a b
l)
(\ Maybe a
b b
a -> case (b
a, Maybe a
b) of
(b
_, Maybe a
Nothing) -> forall a. a -> Maybe a
Just (Lens' a b
l forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
a forall a b. (a -> b) -> a -> b
$ a
def)
(b
_, Just a
b') -> forall a. a -> Maybe a
Just (Lens' a b
l forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
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 | 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 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) = forall a. Pretty a => a -> Doc
pretty (forall a. a -> PP a
PP (PackageIdentifier -> PackageName
pkgName PackageIdentifier
p)) forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc
text FilePath
"-" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Doc
pretty (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 = forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' a (Maybe b)
l forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign Lens' a (Maybe b)
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe b
mx forall a. a -> Maybe a
Just
escapeDebianWildcards :: String -> String
escapeDebianWildcards :: FilePath -> FilePath
escapeDebianWildcards (Char
c : FilePath
more) | forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c FilePath
"[]" = Char
'\\' forall a. a -> [a] -> [a]
: Char
c forall a. a -> [a] -> [a]
: FilePath -> FilePath
escapeDebianWildcards FilePath
more
escapeDebianWildcards (Char
c : FilePath
more) = Char
c forall a. a -> [a] -> [a]
: FilePath -> FilePath
escapeDebianWildcards FilePath
more
escapeDebianWildcards FilePath
"" = FilePath
""