-- | Functions and instances used by but not related to cabal-debian.
-- These could conceivably be moved into more general libraries.
{-# 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)

-- | Query versions of installed packages
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))
-- strictRead = strictReadF id

-- | Write a file which we might still be reading from in
-- order to compute the text argument.
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
"~"

-- | Compute the new file contents from the old.  If f returns Nothing
-- do not write.
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 {- ++ " < " ++ show s -} 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

-- |Create a map from pathname to the names of the packages that contains that pathname using the
-- contents of the debian package info directory @/var/lib/dpkg/info@.
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
""

-- |Given a path, return the name of the package that owns it.
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 FilePath) -> Maybe FilePath
      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 ]

-- | From Darcs.Utils - set the working directory and run an IO operation.
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 {- `catchall` return () -})
        (\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}

{-
catchall :: IO a -> IO a -> IO a
a `catchall` b = a `catchNonSignal` (\_ -> b)

-- catchNonSignal is a drop-in replacement for Control.Exception.catch, which allows
-- us to catch anything but a signal.  Useful for situations where we want
-- don't want to inhibit ctrl-C.

catchNonSignal :: IO a -> (E.SomeException -> IO a) -> IO a
catchNonSignal comp handler = catch comp handler'
    where handler' se =
           case fromException se :: Maybe SignalException of
             Nothing -> handler se
             Just _ -> E.throw se

newtype SignalException = SignalException Signal deriving (Show, Typeable)

instance Exception SignalException where
   toException e = SomeException e
   fromException (SomeException e) = cast e
-}

-- | Get directory contents minus dot files.
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 a,-} 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              -- Both m and n have entries for k
                  Maybe c
Nothing -> Map k c
r                            -- Only m has an entry for k
      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 -- Only n has an entry for k
                               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

-- | If the current value of view x is Nothing, replace it with f.
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 :: (Monad m, MonadTrans t, MonadState a (t m)) => (a -> m a) -> t m ()
-- modifyM f = get >>= lift . f >>= put

-- modifyM :: (Monad m, MonadTrans t, MonadState a (t m)) => (a -> m a) -> t m ()
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

-- read' :: Read a => String -> a
-- read' s = trace ("read " ++ show s) (read s)

-- | Version of 'Distribution.Verbosity.intToVerbosity' that first
-- clamps its argument to the acceptable range (0-3).
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)

-- | Set @b@ if it currently isNothing and the argument isJust, that is
--  1. Nothing happens if the argument isNothing
--  2. Nothing happens if the current value isJust
(.?=) :: 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

-- | This should probably be used in a lot of places.
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
""