summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Propellor/Info.hs2
-rw-r--r--src/Propellor/Message.hs3
-rw-r--r--src/Propellor/PrivData.hs6
-rw-r--r--src/Propellor/PropAccum.hs2
-rw-r--r--src/Propellor/Property.hs3
-rw-r--r--src/Propellor/Property/Apt.hs6
-rw-r--r--src/Propellor/Property/ConfFile.hs3
-rw-r--r--src/Propellor/Property/Debootstrap.hs4
-rw-r--r--src/Propellor/Property/DiskImage.hs12
-rw-r--r--src/Propellor/Property/Dns.hs6
-rw-r--r--src/Propellor/Property/Docker.hs9
-rw-r--r--src/Propellor/Property/File.hs2
-rw-r--r--src/Propellor/Shim.hs2
-rw-r--r--src/Propellor/Spin.hs6
-rw-r--r--src/Propellor/Types.hs2
-rw-r--r--src/Propellor/Types/Container.hs4
-rw-r--r--src/Utility/Exception.hs5
-rw-r--r--src/Utility/Misc.hs2
-rw-r--r--src/Utility/Process.hs8
-rw-r--r--src/Utility/Scheduled.hs2
-rw-r--r--src/Utility/Table.hs2
21 files changed, 39 insertions, 52 deletions
diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs
index b9436e58..74614a1b 100644
--- a/src/Propellor/Info.hs
+++ b/src/Propellor/Info.hs
@@ -87,7 +87,7 @@ aliasMap = M.fromList . concat .
map (\h -> map (\aka -> (aka, h)) $ fromAliasesInfo $ getInfo $ hostInfo h)
findHost :: [Host] -> HostName -> Maybe Host
-findHost l hn = maybe (findAlias l hn) Just (findHostNoAlias l hn)
+findHost l hn = (findHostNoAlias l hn) <|> (findAlias l hn)
findHostNoAlias :: [Host] -> HostName -> Maybe Host
findHostNoAlias l hn = M.lookup hn (hostMap l)
diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs
index f62d3cd9..94892da8 100644
--- a/src/Propellor/Message.hs
+++ b/src/Propellor/Message.hs
@@ -112,8 +112,7 @@ checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
go (Just "1") = enableDebugMode
go (Just _) = noop
go Nothing = whenM (doesDirectoryExist ".git") $
- whenM (any (== "1") . lines <$> getgitconfig) $
- enableDebugMode
+ whenM (elem "1" . lines <$> getgitconfig) enableDebugMode
getgitconfig = catchDefaultIO "" $
readProcess "git" ["config", "propellor.debug"]
diff --git a/src/Propellor/PrivData.hs b/src/Propellor/PrivData.hs
index 9aa6f380..cbb296ce 100644
--- a/src/Propellor/PrivData.hs
+++ b/src/Propellor/PrivData.hs
@@ -187,16 +187,16 @@ listPrivDataFields hosts = do
showSet $ map (\(f, c) -> (f, c, join $ M.lookup (f, c) descmap)) missing
where
header = ["Field", "Context", "Used by"]
- mkrow k@(field, (Context context)) =
+ mkrow k@(field, Context context) =
[ shellEscape $ show field
, shellEscape context
, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby
]
mkhostmap host mkv = M.fromList $ map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d)) $
S.toList $ fromPrivInfo $ getInfo $ hostInfo host
- usedby = M.unionsWith (++) $ map (\h -> mkhostmap h $ const $ [hostName h]) hosts
+ usedby = M.unionsWith (++) $ map (\h -> mkhostmap h $ const [hostName h]) hosts
wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")
- descmap = M.unions $ map (\h -> mkhostmap h id) hosts
+ descmap = M.unions $ map (`mkhostmap` id) hosts
section desc = putStrLn $ "\n" ++ desc
showtable rows = do
putStr $ unlines $ formatTable $ tableWithHeader header rows
diff --git a/src/Propellor/PropAccum.hs b/src/Propellor/PropAccum.hs
index d2736b50..4b2a5ddb 100644
--- a/src/Propellor/PropAccum.hs
+++ b/src/Propellor/PropAccum.hs
@@ -48,7 +48,7 @@ class PropAccum h where
instance PropAccum Host where
(Host hn ps is) & p = Host hn (ps ++ [toProp p])
(is <> getInfoRecursive p)
- (Host hn ps is) &^ p = Host hn ([toProp p] ++ ps)
+ (Host hn ps is) &^ p = Host hn (toProp p : ps)
(getInfoRecursive p <> is)
getProperties = hostProperties
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index b90d5b86..e8d70a80 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -67,8 +67,7 @@ onChangeFlagOnFail
-> Property x
-> Property y
-> CombinedType (Property x) (Property y)
-onChangeFlagOnFail flagfile p1 p2 =
- combineWith go p1 p2
+onChangeFlagOnFail flagfile = combineWith go
where
go s1 s2 = do
r1 <- s1
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
diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs
index a3c8e701..e2941420 100644
--- a/src/Propellor/Shim.hs
+++ b/src/Propellor/Shim.hs
@@ -77,7 +77,7 @@ installFile :: FilePath -> FilePath -> IO ()
installFile top f = do
createDirectoryIfMissing True destdir
nukeFile dest
- createLink f dest `catchIO` (const copy)
+ createLink f dest `catchIO` const copy
where
copy = void $ boolSystem "cp" [Param "-a", Param f, Param dest]
destdir = inTop top $ takeDirectory f
diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs
index cce754ca..c5b31cef 100644
--- a/src/Propellor/Spin.hs
+++ b/src/Propellor/Spin.hs
@@ -59,7 +59,7 @@ spin target relay hst = do
-- And now we can run it.
unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $
- error $ "remote propellor failed"
+ error "remote propellor failed"
where
hn = fromMaybe target relay
@@ -184,7 +184,7 @@ updateServer target relay hst connect haveprecompiled =
let loop = go (toh, fromh)
let restart = updateServer hn relay hst connect haveprecompiled
let done = return ()
- v <- (maybe Nothing readish <$> getMarked fromh statusMarker)
+ v <- maybe Nothing readish <$> getMarked fromh statusMarker
case v of
(Just NeedRepoUrl) -> do
sendRepoUrl toh
@@ -263,7 +263,7 @@ sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
-- This should be reasonably portable, as long as the remote host has the
-- same architecture as the build host.
sendPrecompiled :: HostName -> IO ()
-sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor as a last resort") $ do
+sendPrecompiled hn = void $ actionMessage "Uploading locally compiled propellor as a last resort" $
bracket getWorkingDirectory changeWorkingDirectory $ \_ ->
withTmpDir "propellor" go
where
diff --git a/src/Propellor/Types.hs b/src/Propellor/Types.hs
index 1fc26892..ce93e144 100644
--- a/src/Propellor/Types.hs
+++ b/src/Propellor/Types.hs
@@ -219,7 +219,7 @@ class Combines x y where
-- that ensures the first, and if the first succeeds, ensures the second.
-- The property uses the description of the first property.
before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x
-before x y = (y `requires` x) `describe` (getDesc x)
+before x y = (y `requires` x) `describe` getDesc x
-- | Combines together two properties, yielding a property that
-- has the description and info of the first, and that has the second
diff --git a/src/Propellor/Types/Container.hs b/src/Propellor/Types/Container.hs
index d21bada7..ecff5118 100644
--- a/src/Propellor/Types/Container.hs
+++ b/src/Propellor/Types/Container.hs
@@ -17,12 +17,12 @@ data Bound v = Bound
-- For example, @Port 8080 -<- Port 80@ means that port 8080 on the host
-- is bound to port 80 from the container.
(-<-) :: (hostv ~ v, containerv ~ v) => hostv -> containerv -> Bound v
-(-<-) hostv containerv = Bound hostv containerv
+(-<-) = Bound
-- | Flipped version of -<- with the container value first and host value
-- second.
(->-) :: (containerv ~ v, hostv ~ v) => hostv -> containerv -> Bound v
-(->-) containerv hostv = Bound hostv containerv
+(->-) = flip (-<-)
-- | Create a Bound value, that is the same on both the host and container.
same :: v -> Bound v
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index 9d4236c4..a1f96615 100644
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -36,10 +36,7 @@ catchBoolIO = catchDefaultIO False
{- Catches IO errors and returns a Maybe -}
catchMaybeIO :: MonadCatch m => m a -> m (Maybe a)
-catchMaybeIO a = do
- catchDefaultIO Nothing $ do
- v <- a
- return (Just v)
+catchMaybeIO a = catchDefaultIO Nothing $ a >>= (return . Just)
{- Catches IO errors and returns a default value. -}
catchDefaultIO :: MonadCatch m => a -> m a -> m a
diff --git a/src/Utility/Misc.hs b/src/Utility/Misc.hs
index 45d5a063..ebb42576 100644
--- a/src/Utility/Misc.hs
+++ b/src/Utility/Misc.hs
@@ -136,7 +136,7 @@ hGetSomeString h sz = do
- if this reap gets there first. -}
reapZombies :: IO ()
#ifndef mingw32_HOST_OS
-reapZombies = do
+reapZombies =
-- throws an exception when there are no child processes
catchDefaultIO Nothing (getAnyProcessStatus False True)
>>= maybe (return ()) (const reapZombies)
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index 469f7659..bd179d09 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -171,7 +171,7 @@ createBackgroundProcess p a = a =<< createProcess p
-- returns a transcript combining its stdout and stderr, and
-- whether it succeeded or failed.
processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)
-processTranscript cmd opts input = processTranscript' cmd opts Nothing input
+processTranscript cmd opts = processTranscript' cmd opts Nothing
processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)
processTranscript' cmd opts environ input = do
@@ -347,11 +347,7 @@ processHandle (_, _, _, pid) = pid
-- | Debugging trace for a CreateProcess.
debugProcess :: CreateProcess -> IO ()
-debugProcess p = do
- debugM "Utility.Process" $ unwords
- [ action ++ ":"
- , showCmd p
- ]
+debugProcess p = debugM "Utility.Process" $ unwords [action ++ ":", showCmd p]
where
action
| piped (std_in p) && piped (std_out p) = "chat"
diff --git a/src/Utility/Scheduled.hs b/src/Utility/Scheduled.hs
index b3813323..5e813d4a 100644
--- a/src/Utility/Scheduled.hs
+++ b/src/Utility/Scheduled.hs
@@ -286,7 +286,7 @@ fromScheduledTime AnyTime = "any time"
fromScheduledTime (SpecificTime h m) =
show h' ++ (if m > 0 then ":" ++ pad 2 (show m) else "") ++ " " ++ ampm
where
- pad n s = take (n - length s) (repeat '0') ++ s
+ pad n s = replicate (n - length s) '0' ++ s
(h', ampm)
| h == 0 = (12, "AM")
| h < 12 = (h, "AM")
diff --git a/src/Utility/Table.hs b/src/Utility/Table.hs
index 20adf40d..6d4c045b 100644
--- a/src/Utility/Table.hs
+++ b/src/Utility/Table.hs
@@ -26,4 +26,4 @@ formatTable table = map (\r -> unwords (map pad (zip r colsizes))) table
sumcols (map (map length) table)
sumcols [] = repeat 0
sumcols [r] = r
- sumcols (r1:r2:rs) = sumcols $ map (uncurry max) (zip r1 r2) : rs
+ sumcols (r1:r2:rs) = sumcols $ zipWith max r1 r2 : rs