Commit 74ffcfd1 authored by EyalLotem's avatar EyalLotem

hlint police

parent 3744251c
......@@ -72,10 +72,10 @@ check verbosity = do
isDistError _ = True
errors = filter isDistError packageChecks
unless (null errors) $ do
unless (null errors) $
putStrLn "Hackage would reject this package."
when (null packageChecks) $ do
when (null packageChecks) $
putStrLn "No errors or warnings could be found in the package."
return (null packageChecks)
......
......@@ -85,7 +85,7 @@ import Data.Maybe
import Data.Monoid
( Monoid(..) )
import Control.Monad
( when, foldM, liftM )
( unless, foldM, liftM )
import qualified Distribution.Compat.ReadP as Parse
( option )
import qualified Text.PrettyPrint as Disp
......@@ -281,15 +281,15 @@ loadConfig verbosity configFileFlag userInstallFlag = addBaseConf $ do
writeConfigFile configFile commentConf initialConf
return initialConf
Just (ParseOk ws conf) -> do
when (not $ null ws) $ warn verbosity $
unless (null ws) $ warn verbosity $
unlines (map (showPWarning configFile) ws)
return conf
Just (ParseFailed err) -> do
let (line, msg) = locatedErrorMsg err
warn verbosity $
"Error parsing config file " ++ configFile
++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
warn verbosity $ "Using default configuration."
++ maybe "" (\n -> ':' : show n) line ++ ":\n" ++ msg
warn verbosity "Using default configuration."
initialSavedConfig
where
......
......@@ -167,10 +167,9 @@ planLocalPackage verbosity comp configFlags configExFlags installedPkgIndex
. addConstraints
-- '--enable-tests' and '--enable-benchmarks' constraints from
-- command line
[ PackageConstraintStanzas (packageName pkg) $ concat
[ if testsEnabled then [TestStanzas] else []
, if benchmarksEnabled then [BenchStanzas] else []
]
[ PackageConstraintStanzas (packageName pkg) $
[ TestStanzas | testsEnabled ] ++
[ BenchStanzas | benchmarksEnabled ]
]
$ standardInstallPolicy
......
......@@ -72,7 +72,7 @@ combine var ((k, ( d, v)) : xs) c = (\ ~(e, ys) -> (e, (k, v) : ys)) $
-- | Naive backtracking exploration of the search tree. This will yield correct
-- assignments only once the tree itself is validated.
explore :: Alternative m => Tree a -> (Assignment -> m (Assignment, RevDepMap))
explore :: Alternative m => Tree a -> Assignment -> m (Assignment, RevDepMap)
explore = cata go
where
go (FailF _ _) _ = A.empty
......@@ -80,24 +80,25 @@ explore = cata go
go (PChoiceF qpn _ ts) (A pa fa sa) =
asum $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r -> r (A (M.insert qpn k pa) fa sa)) $ -- record the pkg choice
(\ k r -> r (A (M.insert qpn k pa) fa sa)) -- record the pkg choice
ts
go (FChoiceF qfn _ _ _ ts) (A pa fa sa) =
asum $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r -> r (A pa (M.insert qfn k fa) sa)) $ -- record the flag choice
(\ k r -> r (A pa (M.insert qfn k fa) sa)) -- record the flag choice
ts
go (SChoiceF qsn _ _ ts) (A pa fa sa) =
asum $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r -> r (A pa fa (M.insert qsn k sa))) $ -- record the flag choice
(\ k r -> r (A pa fa (M.insert qsn k sa))) -- record the flag choice
ts
go (GoalChoiceF ts) a =
casePSQ ts A.empty -- empty goal choice is an internal error
(\ _k v _xs -> v a) -- commit to the first goal choice
-- | Version of 'explore' that returns a 'Log'.
exploreLog :: Tree (Maybe (ConflictSet QPN)) -> (Assignment -> Log Message (Assignment, RevDepMap))
exploreLog :: Tree (Maybe (ConflictSet QPN))
-> Assignment -> Log Message (Assignment, RevDepMap)
exploreLog = cata go
where
go (FailF c fr) _ = failWith (Failure c fr)
......
......@@ -114,10 +114,10 @@ convGPD os arch cid pi
PInfo
(maybe [] (convCondTree os arch cid pi fds (const True) ) libs ++
concatMap (convCondTree os arch cid pi fds (const True) . snd) exes ++
(prefix (Stanza (SN pi TestStanzas))
(L.map (convCondTree os arch cid pi fds (const True) . snd) tests)) ++
(prefix (Stanza (SN pi BenchStanzas))
(L.map (convCondTree os arch cid pi fds (const True) . snd) benchs)))
prefix (Stanza (SN pi TestStanzas))
(L.map (convCondTree os arch cid pi fds (const True) . snd) tests) ++
prefix (Stanza (SN pi BenchStanzas))
(L.map (convCondTree os arch cid pi fds (const True) . snd) benchs))
fds
[] -- TODO: add encaps
Nothing
......
......@@ -2,6 +2,7 @@ module Distribution.Client.Dependency.Modular.Package
(module Distribution.Client.Dependency.Modular.Package,
module Distribution.Package) where
import Control.Arrow (first)
import Data.List as L
import Data.Map as M
......@@ -45,7 +46,7 @@ showI (I v (Inst (InstalledPackageId i))) = showVer v ++ "/installed" ++ shortId
where
-- A hack to extract the beginning of the package ABI hash
shortId = snip (splitAt 4) (++ "...") .
snip ((\ (x, y) -> (reverse x, y)) . break (=='-') . reverse) ('-':)
snip (first reverse . break (=='-') . reverse) ('-':)
snip p f xs = case p xs of
(ys, zs) -> (if L.null zs then id else f) ys
......@@ -82,7 +83,7 @@ data Q a = Q PP a
deriving (Eq, Ord, Show)
-- | Standard string representation of a qualified entity.
showQ :: (a -> String) -> (Q a -> String)
showQ :: (a -> String) -> Q a -> String
showQ showa (Q [] x) = showa x
showQ showa (Q pp x) = showPP pp ++ "." ++ showa x
......
......@@ -62,18 +62,18 @@ index verbosity indexFlags path' = do
let runRemoveSource = not . null $ refsToRemove
let runList = fromFlagOrDefault False (indexList indexFlags)
unless (or [runInit, runLinkSource, runRemoveSource, runList]) $ do
unless (or [runInit, runLinkSource, runRemoveSource, runList]) $
die "no arguments passed to the 'index' command"
path <- validateIndexPath path'
when runInit $ do
when runInit $
createEmpty verbosity path
when runLinkSource $ do
when runLinkSource $
addBuildTreeRefs verbosity path refsToAdd
when runRemoveSource $ do
when runRemoveSource $
removeBuildTreeRefs verbosity path refsToRemove
when runList $ do
......@@ -84,7 +84,7 @@ index verbosity indexFlags path' = do
buildTreeRefFromPath :: FilePath -> IO (Maybe BuildTreeRef)
buildTreeRefFromPath dir = do
dirExists <- doesDirectoryExist dir
when (not dirExists) $ do
unless dirExists $
die $ "directory '" ++ dir ++ "' does not exist"
_ <- findPackageDesc dir
return . Just $ BuildTreeRef { buildTreePath = dir }
......@@ -103,7 +103,7 @@ readBuildTreePath entry = case Tar.entryContent entry of
readBuildTreePaths :: Tar.Entries -> [FilePath]
readBuildTreePaths =
catMaybes
. Tar.foldrEntries (\e r -> (readBuildTreePath e):r)
. Tar.foldrEntries (\e r -> readBuildTreePath e : r)
[] error
-- | Given a path to a tar archive, extract all references to local build trees.
......@@ -135,7 +135,7 @@ validateIndexPath path' = do
if (== ".tar") . takeExtension $ path
then return path
else do dirExists <- doesDirectoryExist path
unless dirExists $ do
unless dirExists $
die $ "directory does not exist: '" ++ path ++ "'"
return $ path </> defaultIndexFileName
......@@ -163,7 +163,7 @@ addBuildTreeRefs verbosity path l' = do
-- Add only those paths that aren't already in the index.
treesToAdd <- mapM buildTreeRefFromPath (l \\ treesInIndex)
let entries = map writeBuildTreeRef (catMaybes treesToAdd)
when (not . null $ entries) $ do
unless (null entries) $ do
offset <-
fmap (Tar.foldrEntries (\e acc -> Tar.entrySizeInBytes e + acc) 0 error
. Tar.read) $ BS.readFile path
......@@ -194,7 +194,7 @@ removeBuildTreeRefs verbosity path l' = do
where
p l entry = case readBuildTreePath entry of
Nothing -> True
(Just pth) -> not $ any (== pth) l
(Just pth) -> pth `notElem` l
-- | List the local build trees that are referred to from the index.
listBuildTreeRefs :: Verbosity -> FilePath -> IO [FilePath]
......@@ -205,7 +205,7 @@ listBuildTreeRefs verbosity path = do
pkgIndex <- fmap packageIndex . getSourcePackages verbosity $ [repo]
let buildTreeRefs = [ pkgPath | (LocalUnpackedPackage pkgPath) <-
map packageSource . allPackages $ pkgIndex ]
when (null buildTreeRefs) $ do
when (null buildTreeRefs) $
notice verbosity $ "Index file '" ++ path
++ "' has no references to local build trees."
return buildTreeRefs
......@@ -214,5 +214,5 @@ listBuildTreeRefs verbosity path = do
checkIndexExists :: FilePath -> IO ()
checkIndexExists path = do
indexExists <- doesFileExist path
when (not indexExists) $ do
unless indexExists $
die $ "index does not exist: '" ++ path ++ "'"
......@@ -55,7 +55,7 @@ import Distribution.Simple.Utils
( die, warn, info, fromUTF8, findPackageDesc )
import Data.Char (isAlphaNum)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Maybe (mapMaybe, fromMaybe)
import Data.List (isPrefixOf)
import Data.Monoid (Monoid(..))
import qualified Data.Map as Map
......@@ -165,7 +165,7 @@ readRepoIndex verbosity repo =
in handleNotFound $ do
warnIfIndexIsOld indexFile
whenCacheOutOfDate indexFile cacheFile $ do
info verbosity $ "Updating the index cache file..."
info verbosity "Updating the index cache file..."
updatePackageIndexCacheFile indexFile cacheFile
readPackageIndexCacheFile mkAvailablePackage indexFile cacheFile
......@@ -212,7 +212,7 @@ readRepoIndex verbosity repo =
updateRepoIndexCache :: Verbosity -> Repo -> IO ()
updateRepoIndexCache verbosity repo =
whenCacheOutOfDate indexFile cacheFile $ do
info verbosity $ "Updating the index cache file..."
info verbosity "Updating the index cache file..."
updatePackageIndexCacheFile indexFile cacheFile
where
indexFile = repoLocalDir repo </> "00-index.tar"
......@@ -338,8 +338,7 @@ extractPrefs entry = case Tar.entryContent entry of
_ -> Nothing
parsePreferredVersions :: String -> [Dependency]
parsePreferredVersions = catMaybes
. map simpleParse
parsePreferredVersions = mapMaybe simpleParse
. filter (not . isPrefixOf "--")
. lines
......@@ -507,7 +506,7 @@ showIndexCacheEntry entry = case entry of
CachePreference dep -> "pref-ver: " ++ display dep
readIndexCache :: BSS.ByteString -> [IndexCacheEntry]
readIndexCache = catMaybes . map readIndexCacheEntry . BSS.lines
readIndexCache = mapMaybe readIndexCacheEntry . BSS.lines
showIndexCache :: [IndexCacheEntry] -> String
showIndexCache = unlines . map showIndexCacheEntry
......@@ -48,7 +48,7 @@ import Control.Monad
( (>=>), join )
#endif
import Control.Arrow
( (&&&) )
( (&&&), (***) )
import Text.PrettyPrint hiding (mode, cat)
......@@ -59,7 +59,7 @@ import Distribution.Version
import Distribution.Verbosity
( Verbosity )
import Distribution.ModuleName
( ModuleName, fromString )
( ModuleName, fromString ) -- And for the Text instance
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, sourcePackageId, exposed )
import qualified Distribution.Package as P
......@@ -74,8 +74,6 @@ import Distribution.Client.Init.Heuristics
import Distribution.License
( License(..), knownLicenses )
import Distribution.ModuleName
( ) -- for the Text instance
import Distribution.ReadE
( runReadE, readP_to_E )
......@@ -186,7 +184,8 @@ getLicense flags = do
-- darcs repo.
getAuthorInfo :: InitFlags -> IO InitFlags
getAuthorInfo flags = do
(authorName, authorEmail) <- (\(a,e) -> (flagToMaybe a, flagToMaybe e)) `fmap` guessAuthorNameMail
(authorName, authorEmail) <-
(flagToMaybe *** flagToMaybe) `fmap` guessAuthorNameMail
authorName' <- return (flagToMaybe $ author flags)
?>> maybePrompt flags (promptStr "Author name" authorName)
?>> return authorName
......@@ -237,9 +236,9 @@ getLibOrExec :: InitFlags -> IO InitFlags
getLibOrExec flags = do
isLib <- return (flagToMaybe $ packageType flags)
?>> maybePrompt flags (either (const Library) id `fmap`
(promptList "What does the package build"
[Library, Executable]
Nothing display False))
promptList "What does the package build"
[Library, Executable]
Nothing display False)
?>> return (Just Library)
return $ flags { packageType = maybeToFlag isLib }
......@@ -250,13 +249,9 @@ getLanguage flags = do
lang <- return (flagToMaybe $ language flags)
?>> maybePrompt flags
(either UnknownLanguage id `fmap`
(promptList "What base language is the package written in"
[Haskell2010, Haskell98]
(Just Haskell2010)
display
True
)
)
promptList "What base language is the package written in"
[Haskell2010, Haskell98]
(Just Haskell2010) display True)
?>> return (Just Haskell2010)
return $ flags { language = maybeToFlag lang }
......@@ -264,7 +259,7 @@ getLanguage flags = do
-- | Ask whether to generate explanatory comments.
getGenComments :: InitFlags -> IO InitFlags
getGenComments flags = do
genComments <- return (not <$> (flagToMaybe $ noComments flags))
genComments <- return (not <$> flagToMaybe (noComments flags))
?>> maybePrompt flags (promptYesNo promptMsg (Just False))
?>> return (Just False)
return $ flags { noComments = maybeToFlag (fmap not genComments) }
......@@ -275,7 +270,7 @@ getGenComments flags = do
getSrcDir :: InitFlags -> IO InitFlags
getSrcDir flags = do
srcDirs <- return (sourceDirs flags)
?>> Just `fmap` (guessSourceDirs flags)
?>> Just `fmap` guessSourceDirs flags
return $ flags { sourceDirs = srcDirs }
......@@ -283,8 +278,8 @@ getSrcDir flags = do
-- moment just looks to see whether there is a directory called 'src'.
guessSourceDirs :: InitFlags -> IO [String]
guessSourceDirs flags = do
dir <- fromMaybe getCurrentDirectory
(fmap return . flagToMaybe $ packageDir flags)
dir <-
maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
srcIsDir <- doesDirectoryExist (dir </> "src")
if srcIsDir
then return ["src"]
......@@ -293,8 +288,7 @@ guessSourceDirs flags = do
-- | Get the list of exposed modules and extra tools needed to build them.
getModulesBuildToolsAndDeps :: PackageIndex -> InitFlags -> IO InitFlags
getModulesBuildToolsAndDeps pkgIx flags = do
dir <- fromMaybe getCurrentDirectory
(fmap return . flagToMaybe $ packageDir flags)
dir <- maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
-- XXX really should use guessed source roots.
sourceFiles <- scanForModules dir
......@@ -359,7 +353,7 @@ chooseDep flags (m, Just ps)
grps -> do message flags ("\nWarning: multiple packages found providing "
++ display m
++ ": " ++ intercalate ", " (map (display . P.pkgName . head) grps))
message flags ("You will need to pick one and manually add it to the Build-depends: field.")
message flags "You will need to pick one and manually add it to the Build-depends: field."
return Nothing
where
pkgGroups = groupBy ((==) `on` P.pkgName) (map sourcePackageId ps)
......@@ -447,7 +441,7 @@ promptListOptional pr choices =
$ promptList pr (Nothing : map Just choices) (Just Nothing)
(maybe "(none)" display) True
where
rearrange = either (Just . Left) (maybe Nothing (Just . Right))
rearrange = either (Just . Left) (fmap Right)
-- | Create a prompt from a list of items.
promptList :: Eq t
......@@ -461,8 +455,7 @@ promptList pr choices def displayItem other = do
putStrLn $ pr ++ ":"
let options1 = map (\c -> (Just c == def, displayItem c)) choices
options2 = zip ([1..]::[Int])
(options1 ++ if other then [(False, "Other (specify)")]
else [])
(options1 ++ [(False, "Other (specify)") | other])
mapM_ (putStrLn . \(n,(i,s)) -> showOption n i ++ s) options2
promptList' displayItem (length options2) choices def other
where showOption n i | n < 10 = " " ++ star i ++ " " ++ rest
......@@ -598,7 +591,7 @@ findNewName oldName = findNewName' 0
generateCabalFile :: String -> InitFlags -> String
generateCabalFile fileName c =
renderStyle style { lineLength = 79, ribbonsPerLine = 1.1 } $
(if (minimal c /= Flag True)
(if minimal c /= Flag True
then showComment (Just $ "Initial " ++ fileName ++ " generated by cabal "
++ "init. For further documentation, see "
++ "http://haskell.org/cabal/users-guide/")
......@@ -670,12 +663,12 @@ generateCabalFile fileName c =
, case packageType c of
Flag Executable ->
text "\nexecutable" <+> text (fromMaybe "" . flagToMaybe $ packageName c) $$ (nest 2 $ vcat
text "\nexecutable" <+> text (fromMaybe "" . flagToMaybe $ packageName c) $$ nest 2 (vcat
[ fieldS "main-is" NoFlag (Just ".hs or .lhs file containing the Main module.") True
, generateBuildInfo Executable c
])
Flag Library -> text "\nlibrary" $$ (nest 2 $ vcat
Flag Library -> text "\nlibrary" $$ nest 2 (vcat
[ fieldS "exposed-modules" (listField (exposedModules c))
(Just "Modules exported by the library.")
True
......@@ -733,15 +726,15 @@ generateCabalFile fileName c =
(False, _, _) -> ($$ text "")
$
comment f <> text s <> colon
<> text (take (20 - length s) (repeat ' '))
<> text (replicate (20 - length s) ' ')
<> text (fromMaybe "" . flagToMaybe $ f)
comment NoFlag = text "-- "
comment (Flag "") = text "-- "
comment _ = text ""
showComment :: Maybe String -> Doc
showComment (Just t) = vcat . map text
. map ("-- "++) . lines
showComment (Just t) = vcat
. map (text . ("-- "++)) . lines
. renderStyle style {
lineLength = 76,
ribbonsPerLine = 1.05
......@@ -774,6 +767,6 @@ message _ s = putStrLn s
#if MIN_VERSION_base(3,0,0)
#else
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
f >=> g = \x -> f x >>= g
#endif
......@@ -37,7 +37,7 @@ import Data.Char ( isUpper, isLower, isSpace )
import Data.Either ( partitionEithers )
#endif
import Data.List ( isPrefixOf )
import Data.Maybe ( catMaybes )
import Data.Maybe ( mapMaybe, catMaybes, maybeToList )
import Data.Monoid ( mempty, mappend )
import qualified Data.Set as Set ( fromList, toList )
import System.Directory ( getDirectoryContents, doesDirectoryExist, doesFileExist,
......@@ -104,13 +104,13 @@ findImports :: FilePath -> SourceFileEntry -> IO SourceFileEntry
findImports projectRoot sf = do
s <- readFile (sfToFileName projectRoot sf)
let modules = catMaybes
. map ( getModName
. drop 1
. filter (not . null)
. dropWhile (/= "import")
. words
)
let modules = mapMaybe
( getModName
. drop 1
. filter (not . null)
. dropWhile (/= "import")
. words
)
. filter (not . ("--" `isPrefixOf`)) -- poor man's comment filtering
. lines
$ s
......@@ -148,7 +148,7 @@ neededBuildPrograms :: [SourceFileEntry] -> [String]
neededBuildPrograms entries =
[ handler
| ext <- nubSet (map fileExtension entries)
, handler <- maybe [] (:[]) (lookup ext knownSuffixHandlers)
, handler <- maybeToList (lookup ext knownSuffixHandlers)
]
-- |Guess author and email
......@@ -173,7 +173,7 @@ guessAuthorNameMail =
-- |Get list of categories used in hackage. NOTE: Very slow, needs to be cached
knownCategories :: SourcePackageDb -> [String]
knownCategories (SourcePackageDb sourcePkgIndex _) = nubSet $
knownCategories (SourcePackageDb sourcePkgIndex _) = nubSet
[ cat | pkg <- map head (allPackagesByName sourcePkgIndex)
, let catList = (PD.category . PD.packageDescription . packageDescription) pkg
, cat <- splitString ',' catList
......
......@@ -234,6 +234,6 @@ makeRelative a b = assert (isAbsolute a && isAbsolute b) $
bs = splitPath b
commonLen = length $ takeWhile id $ zipWith (==) as bs
in joinPath $ [ ".." | _ <- drop commonLen as ]
++ [ b' | b' <- drop commonLen bs ]
++ drop commonLen bs
#endif
......@@ -63,7 +63,7 @@ import qualified Data.Array as Array
import Data.Array ((!))
import Data.List (groupBy, sortBy, nub, isInfixOf)
import Data.Monoid (Monoid(..))
import Data.Maybe (isJust, isNothing, fromMaybe)
import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes)
import Distribution.Package
( PackageName(..), PackageIdentifier(..)
......@@ -90,7 +90,7 @@ newtype PackageIndex pkg = PackageIndex
deriving (Show, Read)
instance Package pkg => Monoid (PackageIndex pkg) where
mempty = PackageIndex (Map.empty)
mempty = PackageIndex Map.empty
mappend = merge
--save one mappend with empty in the common case:
mconcat [] = mempty
......@@ -466,9 +466,8 @@ dependencyGraph :: PackageFixedDeps pkg
PackageIdentifier -> Maybe Graph.Vertex)
dependencyGraph index = (graph, vertexToPkg, pkgIdToVertex)
where
graph = Array.listArray bounds
[ [ v | Just v <- map pkgIdToVertex (depends pkg) ]
| pkg <- pkgs ]
graph = Array.listArray bounds $
map (catMaybes . map pkgIdToVertex . depends) pkgs
vertexToPkg vertex = pkgTable ! vertex
pkgIdToVertex = binarySearch 0 topBound
......
......@@ -23,7 +23,7 @@ import qualified Text.PrettyPrint as Disp
--FIXME: replace this with something better
parseFields :: [FieldDescr a] -> a -> [ParseUtils.Field] -> ParseResult a
parseFields fields initial = foldM setField initial
parseFields fields = foldM setField
where
fieldMap = Map.fromList
[ (name, f) | f@(FieldDescr name _ _) <- fields ]
......
......@@ -56,12 +56,9 @@ import Distribution.Simple.Program
( defaultProgramConfiguration )
import Distribution.Simple.Command hiding (boolOpt)
import qualified Distribution.Simple.Setup as Cabal
( configureCommand, buildCommand, sdistCommand, haddockCommand
, buildOptions, defaultBuildFlags )
import Distribution.Simple.Setup
( ConfigFlags(..), BuildFlags(..), SDistFlags(..), HaddockFlags(..) )
import Distribution.Simple.Setup
( Flag(..), toFlag, fromFlag, flagToMaybe, flagToList
( ConfigFlags(..), BuildFlags(..), SDistFlags(..), HaddockFlags(..)
, Flag(..), toFlag, fromFlag, flagToMaybe, flagToList
, optionVerbosity, boolOpt, trueArg, falseArg )
import Distribution.Simple.InstallDirs
( PathTemplate, toPathTemplate, fromPathTemplate )
......@@ -826,11 +823,10 @@ installOptions showOrParseArgs =
(map (fmap show) . flagToList))
] ++ case showOrParseArgs of -- TODO: remove when "cabal install" avoids
ParseArgs ->
option [] ["only"]
[ option [] ["only"]
"Only installs the package in the current directory."
installOnly (\v flags -> flags { installOnly = v })
trueArg
: []
trueArg ]
_ -> []
instance Monoid InstallFlags where
......@@ -1422,7 +1418,7 @@ liftOptions :: (b -> a) -> (a -> b -> b)
-> [OptionField a] -> [OptionField b]
liftOptions get set = map (liftOption get set)
yesNoOpt :: ShowOrParseArgs -> MkOptDescr (b -> Flag Bool) (Flag Bool -> (b -> b)) b
yesNoOpt :: ShowOrParseArgs -> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
yesNoOpt ShowArgs sf lf = trueArg sf lf
yesNoOpt _ sf lf = boolOpt' flagToMaybe Flag (sf, lf) ([], map ("no-" ++) lf) sf lf
......
......@@ -114,7 +114,7 @@ extractTarGzFile :: FilePath -- ^ Destination directory
-> FilePath -- ^ Expected subdir (to check for tarbombs)
-> FilePath -- ^ Tarball
-> IO ()
extractTarGzFile dir expected tar = do
extractTarGzFile dir expected tar =
unpack dir . checkTarbomb expected . read . GZipUtils.maybeDecompress =<< BS.readFile tar
--
......@@ -363,7 +363,7 @@ splitLongPath path =
Right (name, []) -> Right (TarPath name "")
Right (name, first:rest) -> case packName prefixMax remainder of