From b84c9bbb7c9db688118ad756c1c43ef034fd98fb Mon Sep 17 00:00:00 2001 From: Mario Lang Date: Sun, 13 Sep 2015 00:46:49 +0200 Subject: Follow some hlint suggestions. --- src/Propellor/Property/Apt.hs | 6 +++--- src/Propellor/Property/ConfFile.hs | 3 +-- src/Propellor/Property/Debootstrap.hs | 4 ++-- src/Propellor/Property/DiskImage.hs | 12 +++++------- src/Propellor/Property/Dns.hs | 6 +++--- src/Propellor/Property/Docker.hs | 9 ++++----- src/Propellor/Property/File.hs | 2 +- 7 files changed, 19 insertions(+), 23 deletions(-) (limited to 'src/Propellor/Property') diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs index 81005f1a..e89ea6a2 100644 --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -80,7 +80,7 @@ securityUpdates suite -- Since the CDN is sometimes unreliable, also adds backup lines using -- kernel.org. stdSourcesList :: Property NoInfo -stdSourcesList = withOS ("standard sources.list") $ \o -> +stdSourcesList = withOS "standard sources.list" $ \o -> case o of (Just (System (Debian suite) _)) -> ensureProperty $ stdSourcesListFor suite @@ -187,7 +187,7 @@ robustly p = adjustPropertySatisfy p $ \satisfy -> do isInstallable :: [Package] -> IO Bool isInstallable ps = do l <- isInstalled' ps - return $ any (== False) l && not (null l) + return $ elem False l && not (null l) isInstalled :: Package -> IO Bool isInstalled p = (== [True]) <$> isInstalled' [p] @@ -197,7 +197,7 @@ isInstalled p = (== [True]) <$> isInstalled' [p] -- even vary. If apt does not know about a package at all, it will not -- be included in the result list. isInstalled' :: [Package] -> IO [Bool] -isInstalled' ps = catMaybes . map parse . lines <$> policy +isInstalled' ps = (mapMaybe parse . lines) <$> policy where parse l | "Installed: (none)" `isInfixOf` l = Just False diff --git a/src/Propellor/Property/ConfFile.hs b/src/Propellor/Property/ConfFile.hs index 066848bb..0bc1b76d 100644 --- a/src/Propellor/Property/ConfFile.hs +++ b/src/Propellor/Property/ConfFile.hs @@ -38,8 +38,7 @@ adjustSection -> InsertSection -> FilePath -> Property NoInfo -adjustSection desc start past adjust insert f = - fileProperty desc go f +adjustSection desc start past adjust insert = fileProperty desc go where go ls = let (pre, wanted, post) = foldl' find ([], [], []) ls in if null wanted diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index a46451ef..74da68b4 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -158,10 +158,10 @@ sourceInstall' = withTmpDir "debootstrap" $ \tmpd -> do let indexfile = tmpd "index.html" unlessM (download baseurl indexfile) $ errorMessage $ "Failed to download " ++ baseurl - urls <- reverse . sort -- highest version first + urls <- (sortBy (flip compare) -- highest version first . filter ("debootstrap_" `isInfixOf`) . filter (".tar." `isInfixOf`) - . extractUrls baseurl <$> + . extractUrls baseurl) <$> readFileStrictAnyEncoding indexfile nukeFile indexfile diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 35082eec..8d35991e 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -119,7 +119,7 @@ imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg liftIO $ unmountBelow chrootdir szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize <$> liftIO (dirSizes chrootdir) - let calcsz = \mnts -> maybe defSz fudge . getMountSz szm mnts + let calcsz mnts = maybe defSz fudge . getMountSz szm mnts -- tie the knot! let (mnts, t) = fitChrootSize tabletype partspec (map (calcsz mnts) mnts) ensureProperty $ @@ -131,8 +131,7 @@ imageBuiltFrom img chrootdir tabletype partspec final = mkimg rmimg rmimg = File.notPresent img partitionsPopulated :: FilePath -> [MountPoint] -> [FilePath] -> Property NoInfo -partitionsPopulated chrootdir mnts devs = property desc $ - mconcat $ map (uncurry go) (zip mnts devs) +partitionsPopulated chrootdir mnts devs = property desc $ mconcat $ zipWith go mnts devs where desc = "partitions populated from " ++ chrootdir @@ -200,8 +199,7 @@ getMountSz _ _ Nothing = Nothing getMountSz szm l (Just mntpt) = fmap (`reducePartSize` childsz) (M.lookup mntpt szm) where - childsz = mconcat $ catMaybes $ - map (getMountSz szm l) (filter (isChild mntpt) l) + childsz = mconcat $ mapMaybe (getMountSz szm l) (filter (isChild mntpt) l) isChild :: FilePath -> MountPoint -> Bool isChild mntpt (Just d) @@ -274,7 +272,7 @@ extended :: PartSpec -> PartSpec extended s = adjustp s $ \p -> p { partType = Extended } adjustp :: PartSpec -> (Partition -> Partition) -> PartSpec -adjustp (mp, p) f = (mp, \sz -> f (p sz)) +adjustp (mp, p) f = (mp, f . p) -- | The constructor for each Partition is passed the size of the files -- from the chroot that will be put in that partition. @@ -282,7 +280,7 @@ fitChrootSize :: TableType -> [PartSpec] -> [PartSize] -> ([MountPoint], PartTab fitChrootSize tt l basesizes = (mounts, parttable) where (mounts, sizers) = unzip l - parttable = PartTable tt (map (uncurry id) (zip sizers basesizes)) + parttable = PartTable tt (zipWith id sizers basesizes) -- | A pair of properties. The first property is satisfied within the -- chroot, and is typically used to download the boot loader. diff --git a/src/Propellor/Property/Dns.hs b/src/Propellor/Property/Dns.hs index 6051ba63..d854ec52 100644 --- a/src/Propellor/Property/Dns.hs +++ b/src/Propellor/Property/Dns.hs @@ -97,7 +97,7 @@ setupPrimary zonefile mknamedconffile hosts domain soa rs = , confFile = mknamedconffile zonefile , confMasters = [] , confAllowTransfer = nub $ - concatMap (\h -> hostAddresses h hosts) $ + concatMap (`hostAddresses` hosts) $ secondaries ++ nssecondaries , confLines = [] } @@ -199,7 +199,7 @@ secondaryFor masters hosts domain = setup cleanup { confDomain = domain , confDnsServerType = Secondary , confFile = "db." ++ domain - , confMasters = concatMap (\m -> hostAddresses m hosts) masters + , confMasters = concatMap (`hostAddresses` hosts) masters , confAllowTransfer = [] , confLines = [] } @@ -425,7 +425,7 @@ type WarningMessage = String -- Does not include SSHFP records. genZone :: [Host] -> M.Map HostName Host -> Domain -> SOA -> (Zone, [WarningMessage]) genZone inzdomain hostmap zdomain soa = - let (warnings, zhosts) = partitionEithers $ concat $ map concat + let (warnings, zhosts) = partitionEithers $ concatMap concat [ map hostips inzdomain , map hostrecords inzdomain , map addcnames (M.elems hostmap) diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index e24d58d4..fc12cf8c 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -213,7 +213,7 @@ garbageCollected = propertyList "docker garbage collected" where gccontainers = property "docker containers garbage collected" $ liftIO $ report <$> (mapM removeContainer =<< listContainers AllContainers) - gcimages = property "docker images garbage collected" $ do + gcimages = property "docker images garbage collected" $ liftIO $ report <$> (mapM removeImage =<< listImages) -- | Tweaks a container to work well with docker. @@ -471,8 +471,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope restartcontainer = do oldimage <- liftIO $ - fromMaybe (toImageID image) . fmap toImageID <$> - commitContainer cid + maybe (toImageID image) toImageID <$> commitContainer cid void $ liftIO $ removeContainer cid go oldimage @@ -631,8 +630,8 @@ data ContainerFilter = RunningContainers | AllContainers -- | Only lists propellor managed containers. listContainers :: ContainerFilter -> IO [ContainerId] listContainers status = - catMaybes . map toContainerId . concat . map (split ",") - . catMaybes . map (lastMaybe . words) . lines + (mapMaybe toContainerId . concatMap (split ",") + . mapMaybe (lastMaybe . words) . lines) <$> readProcess dockercmd ps where ps diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index adced166..4e074eee 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -103,5 +103,5 @@ ownerGroup f (User owner) (Group group) = property (f ++ " owner " ++ og) $ do -- | Ensures that a file/dir has the specfied mode. mode :: FilePath -> FileMode -> Property NoInfo mode f v = property (f ++ " mode " ++ show v) $ do - liftIO $ modifyFileMode f (\_old -> v) + liftIO $ modifyFileMode f (const v) noChange -- cgit v1.2.3