finished where indentation changes

Utility/Base64.hs

@@ -15,4 +15,4 @@ toB64 = encode . s2w8
 
 fromB64 :: String -> String
 fromB64 s = maybe bad w82s $ decode s
-	where bad = error "bad base64 encoded data"
+  where bad = error "bad base64 encoded data"

Utility/CopyFile.hs

@@ -17,9 +17,9 @@ copyFileExternal src dest = do
 	whenM (doesFileExist dest) $
 		removeFile dest
 	boolSystem "cp" $ params ++ [File src, File dest]
-	where
-		params = map snd $ filter fst
-			[ (SysConfig.cp_reflink_auto, Param "--reflink=auto")
-			, (SysConfig.cp_a, Param "-a")
-			, (SysConfig.cp_p && not SysConfig.cp_a, Param "-p")
-			]
+  where
+	params = map snd $ filter fst
+		[ (SysConfig.cp_reflink_auto, Param "--reflink=auto")
+		, (SysConfig.cp_a, Param "-a")
+		, (SysConfig.cp_p && not SysConfig.cp_a, Param "-p")
+		]

Utility/DBus.hs

@@ -57,10 +57,10 @@ runClient getaddr clientaction = do
 			e <- takeMVar mv
 			disconnect client
 			throw e
-	where
-		threadrunner storeerr io = loop
-			where
-				loop = catchClientError (io >> loop) storeerr
+  where
+	threadrunner storeerr io = loop
+	  where
+		loop = catchClientError (io >> loop) storeerr
 
 {- Connects to the bus, and runs the client action.
  -
@@ -73,10 +73,10 @@ persistentClient getaddr v onretry clientaction =
 	{- runClient can fail with not just ClientError, but also other
 	 - things, if dbus is not running. Let async exceptions through. -}
 	runClient getaddr clientaction `catchNonAsync` retry
-	where
-		retry e = do
-			v' <- onretry e v
-			persistentClient getaddr v' onretry clientaction
+  where
+	retry e = do
+		v' <- onretry e v
+		persistentClient getaddr v' onretry clientaction
 
 {- Catches only ClientError -}
 catchClientError :: IO () -> (ClientError -> IO ()) -> IO ()

Utility/Daemon.hs

@@ -22,27 +22,27 @@ daemonize logfd pidfile changedirectory a = do
 	maybe noop checkalreadyrunning pidfile
 	_ <- forkProcess child1
 	out
-	where
-		checkalreadyrunning f = maybe noop (const $ alreadyRunning) 
-			=<< checkDaemon f
-		child1 = do
-			_ <- createSession
-			_ <- forkProcess child2
-			out
-		child2 = do
-			maybe noop lockPidFile pidfile 
-			when changedirectory $
-				setCurrentDirectory "/"
-			nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
-			_ <- redir nullfd stdInput
-			mapM_ (redir logfd) [stdOutput, stdError]
-			closeFd logfd
-			a
-			out
-		redir newh h = do
-			closeFd h
-			dupTo newh h
-		out = exitImmediately ExitSuccess
+  where
+	checkalreadyrunning f = maybe noop (const $ alreadyRunning) 
+		=<< checkDaemon f
+	child1 = do
+		_ <- createSession
+		_ <- forkProcess child2
+		out
+	child2 = do
+		maybe noop lockPidFile pidfile 
+		when changedirectory $
+			setCurrentDirectory "/"
+		nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
+		_ <- redir nullfd stdInput
+		mapM_ (redir logfd) [stdOutput, stdError]
+		closeFd logfd
+		a
+		out
+	redir newh h = do
+		closeFd h
+		dupTo newh h
+	out = exitImmediately ExitSuccess
 
 {- Locks the pid file, with an exclusive, non-blocking lock.
  - Writes the pid to the file, fully atomically.
@@ -62,8 +62,8 @@ lockPidFile file = do
 			_ <- fdWrite fd' =<< show <$> getProcessID
 			renameFile newfile file
 			closeFd fd
-	where
-		newfile = file ++ ".new"
+  where
+	newfile = file ++ ".new"
 
 alreadyRunning :: IO ()
 alreadyRunning = error "Daemon is already running."
@@ -82,19 +82,19 @@ checkDaemon pidfile = do
 			p <- readish <$> readFile pidfile
 			return $ check locked p
 		Nothing -> return Nothing
-	where
-		check Nothing _ = Nothing
-		check _ Nothing = Nothing
-		check (Just (pid, _)) (Just pid')
-			| pid == pid' = Just pid
-			| otherwise = error $
-				"stale pid in " ++ pidfile ++ 
-				" (got " ++ show pid' ++ 
-				"; expected " ++ show pid ++ " )"
+  where
+	check Nothing _ = Nothing
+	check _ Nothing = Nothing
+	check (Just (pid, _)) (Just pid')
+		| pid == pid' = Just pid
+		| otherwise = error $
+			"stale pid in " ++ pidfile ++ 
+			" (got " ++ show pid' ++ 
+			"; expected " ++ show pid ++ " )"
 
 {- Stops the daemon, safely. -}
 stopDaemon :: FilePath -> IO ()
 stopDaemon pidfile = go =<< checkDaemon pidfile
-	where
-		go Nothing = noop
-		go (Just pid) = signalProcess sigTERM pid
+  where
+	go Nothing = noop
+	go (Just pid) = signalProcess sigTERM pid

Utility/DataUnits.hs

@@ -72,9 +72,9 @@ storageUnits =
 	, Unit (p 1) "kB" "kilobyte" -- weird capitalization thanks to committe
 	, Unit (p 0) "B" "byte"
 	]
-	where
-		p :: Integer -> Integer
-		p n = 1000^n
+  where
+	p :: Integer -> Integer
+	p n = 1000^n
 
 {- Memory units are (stupidly named) powers of 2. -}
 memoryUnits :: [Unit]
@@ -89,9 +89,9 @@ memoryUnits =
 	, Unit (p 1) "KiB" "kibibyte"
 	, Unit (p 0) "B" "byte"
 	]
-	where
-		p :: Integer -> Integer
-		p n = 2^(n*10)
+  where
+	p :: Integer -> Integer
+	p n = 2^(n*10)
 
 {- Bandwidth units are only measured in bits if you're some crazy telco. -}
 bandwidthUnits :: [Unit]
@@ -100,32 +100,32 @@ bandwidthUnits = error "stop trying to rip people off"
 {- Do you yearn for the days when men were men and megabytes were megabytes? -}
 oldSchoolUnits :: [Unit]
 oldSchoolUnits = zipWith (curry mingle) storageUnits memoryUnits
-	where
-		mingle (Unit _ a n, Unit s' _ _) = Unit s' a n
+  where
+	mingle (Unit _ a n, Unit s' _ _) = Unit s' a n
 
 {- approximate display of a particular number of bytes -}
 roughSize :: [Unit] -> Bool -> ByteSize -> String
 roughSize units abbrev i
 	| i < 0 = '-' : findUnit units' (negate i)
 	| otherwise = findUnit units' i
-	where
-		units' = reverse $ sort units -- largest first
+  where
+	units' = reverse $ sort units -- largest first
 
-		findUnit (u@(Unit s _ _):us) i'
-			| i' >= s = showUnit i' u
-			| otherwise = findUnit us i'
-		findUnit [] i' = showUnit i' (last units') -- bytes
+	findUnit (u@(Unit s _ _):us) i'
+		| i' >= s = showUnit i' u
+		| otherwise = findUnit us i'
+	findUnit [] i' = showUnit i' (last units') -- bytes
 
-		showUnit i' (Unit s a n) = let num = chop i' s in
-			show num ++ " " ++
-			(if abbrev then a else plural num n)
+	showUnit i' (Unit s a n) = let num = chop i' s in
+		show num ++ " " ++
+		(if abbrev then a else plural num n)
 
-		chop :: Integer -> Integer -> Integer
-		chop i' d = round $ (fromInteger i' :: Double) / fromInteger d
+	chop :: Integer -> Integer -> Integer
+	chop i' d = round $ (fromInteger i' :: Double) / fromInteger d
 
-		plural n u
-			| n == 1 = u
-			| otherwise = u ++ "s"
+	plural n u
+		| n == 1 = u
+		| otherwise = u ++ "s"
 
 {- displays comparison of two sizes -}
 compareSizes :: [Unit] -> Bool -> ByteSize -> ByteSize -> String
@@ -139,22 +139,22 @@ readSize :: [Unit] -> String -> Maybe ByteSize
 readSize units input
 	| null parsednum || null parsedunit = Nothing
 	| otherwise = Just $ round $ number * fromIntegral multiplier
-	where
-		(number, rest) = head parsednum
-		multiplier = head parsedunit
-		unitname = takeWhile isAlpha $ dropWhile isSpace rest
+  where
+	(number, rest) = head parsednum
+	multiplier = head parsedunit
+	unitname = takeWhile isAlpha $ dropWhile isSpace rest
 
-		parsednum = reads input :: [(Double, String)]
-		parsedunit = lookupUnit units unitname
+	parsednum = reads input :: [(Double, String)]
+	parsedunit = lookupUnit units unitname
 
-		lookupUnit _ [] = [1] -- no unit given, assume bytes
-		lookupUnit [] _ = []
-		lookupUnit (Unit s a n:us) v
-			| a ~~ v || n ~~ v = [s]
-			| plural n ~~ v || a ~~ byteabbrev v = [s]
-			| otherwise = lookupUnit us v
+	lookupUnit _ [] = [1] -- no unit given, assume bytes
+	lookupUnit [] _ = []
+	lookupUnit (Unit s a n:us) v
+		| a ~~ v || n ~~ v = [s]
+		| plural n ~~ v || a ~~ byteabbrev v = [s]
+		| otherwise = lookupUnit us v
 		
-		a ~~ b = map toLower a == map toLower b
+	a ~~ b = map toLower a == map toLower b
 		
-		plural n = n ++ "s"
-		byteabbrev a = a ++ "b"
+	plural n = n ++ "s"
+	byteabbrev a = a ++ "b"

Utility/Directory.hs

@@ -44,46 +44,46 @@ dirContentsRecursive' (dir:dirs) = unsafeInterleaveIO $ do
 	(files, dirs') <- collect [] [] =<< catchDefaultIO [] (dirContents dir)
 	files' <- dirContentsRecursive' (dirs' ++ dirs)
 	return (files ++ files')
-	where
-		collect files dirs' [] = return (reverse files, reverse dirs')
-		collect files dirs' (entry:entries)
-			| dirCruft entry = collect files dirs' entries
-			| otherwise = do
-				ifM (doesDirectoryExist entry)
-					( collect files (entry:dirs') entries
-					, collect (entry:files) dirs' entries
-					)			
+  where
+	collect files dirs' [] = return (reverse files, reverse dirs')
+	collect files dirs' (entry:entries)
+		| dirCruft entry = collect files dirs' entries
+		| otherwise = do
+			ifM (doesDirectoryExist entry)
+				( collect files (entry:dirs') entries
+				, collect (entry:files) dirs' entries
+				)			
 
 {- Moves one filename to another.
  - First tries a rename, but falls back to moving across devices if needed. -}
 moveFile :: FilePath -> FilePath -> IO ()
 moveFile src dest = tryIO (rename src dest) >>= onrename
-	where
-		onrename (Right _) = noop
-		onrename (Left e)
-			| isPermissionError e = rethrow
-			| isDoesNotExistError e = rethrow
-			| otherwise = do
-				-- copyFile is likely not as optimised as
-				-- the mv command, so we'll use the latter.
-				-- But, mv will move into a directory if
-				-- dest is one, which is not desired.
-				whenM (isdir dest) rethrow
-				viaTmp mv dest undefined
-			where
-				rethrow = throw e
-				mv tmp _ = do
-					ok <- boolSystem "mv" [Param "-f",
-						Param src, Param tmp]
-					unless ok $ do
-						-- delete any partial
-						_ <- tryIO $ removeFile tmp
-						rethrow
-		isdir f = do
-			r <- tryIO $ getFileStatus f
-			case r of
-				(Left _) -> return False
-				(Right s) -> return $ isDirectory s
+  where
+	onrename (Right _) = noop
+	onrename (Left e)
+		| isPermissionError e = rethrow
+		| isDoesNotExistError e = rethrow
+		| otherwise = do
+			-- copyFile is likely not as optimised as
+			-- the mv command, so we'll use the latter.
+			-- But, mv will move into a directory if
+			-- dest is one, which is not desired.
+			whenM (isdir dest) rethrow
+			viaTmp mv dest undefined
+	  where
+		rethrow = throw e
+		mv tmp _ = do
+			ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
+			unless ok $ do
+				-- delete any partial
+				_ <- tryIO $ removeFile tmp
+				rethrow
+
+	isdir f = do
+		r <- tryIO $ getFileStatus f
+		case r of
+			(Left _) -> return False
+			(Right s) -> return $ isDirectory s
 
 {- Removes a file, which may or may not exist.
  -

Utility/DiskFree.hs

@@ -25,5 +25,5 @@ getDiskFree path = withFilePath path $ \c_path -> do
 		( return $ Just $ toInteger free
 		, return Nothing
 		)
-	where
-		safeErrno (Errno v) = v == 0
+  where
+	safeErrno (Errno v) = v == 0

Utility/Dot.hs

@@ -10,9 +10,9 @@ module Utility.Dot where -- import qualified
 {- generates a graph description from a list of lines -}
 graph :: [String] -> String
 graph s = unlines $ [header] ++ map indent s ++ [footer]
-	where
-		header = "digraph map {"
-		footer= "}"
+  where
+	header = "digraph map {"
+	footer= "}"
 
 {- a node in the graph -}
 graphNode :: String -> String -> String
@@ -21,8 +21,8 @@ graphNode nodeid desc = label desc $ quote nodeid
 {- an edge between two nodes -}
 graphEdge :: String -> String -> Maybe String -> String
 graphEdge fromid toid desc = indent $ maybe edge (`label` edge) desc
-	where
-		edge = quote fromid ++ " -> " ++ quote toid
+  where
+	edge = quote fromid ++ " -> " ++ quote toid
 
 {- adds a label to a node or edge -}
 label :: String -> String -> String
@@ -46,18 +46,18 @@ subGraph subid l color s =
 		ii setcolor ++
 		ii s ++
 		indent "}"
-	where
-		-- the "cluster_" makes dot draw a box
-		name = quote ("cluster_" ++ subid)
-		setlabel = "label=" ++ quote l
-		setfilled = "style=" ++ quote "filled"
-		setcolor = "fillcolor=" ++ quote color
-		ii x = indent (indent x) ++ "\n"
+  where
+	-- the "cluster_" makes dot draw a box
+	name = quote ("cluster_" ++ subid)
+	setlabel = "label=" ++ quote l
+	setfilled = "style=" ++ quote "filled"
+	setcolor = "fillcolor=" ++ quote color
+	ii x = indent (indent x) ++ "\n"
 
 indent ::String -> String
 indent s = '\t' : s
 
 quote :: String -> String
 quote s = "\"" ++ s' ++ "\""
-	where
-		s' = filter (/= '"') s
+  where
+	s' = filter (/= '"') s

Utility/FileMode.hs

@@ -37,10 +37,10 @@ removeModes ms m = m `intersectFileModes` complement (combineModes ms)
 {- Runs an action after changing a file's mode, then restores the old mode. -}
 withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a
 withModifiedFileMode file convert a = bracket setup cleanup go
-	where
-		setup = modifyFileMode' file convert
-		cleanup oldmode = modifyFileMode file (const oldmode)
-		go _ = a
+  where
+	setup = modifyFileMode' file convert
+	cleanup oldmode = modifyFileMode file (const oldmode)
+	go _ = a
 
 writeModes :: [FileMode]
 writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode]
@@ -83,10 +83,10 @@ noUmask :: FileMode -> IO a -> IO a
 noUmask mode a
 	| mode == stdFileMode = a
 	| otherwise = bracket setup cleanup go
-	where
-		setup = setFileCreationMask nullFileMode
-		cleanup = setFileCreationMask
-		go _ = a
+  where
+	setup = setFileCreationMask nullFileMode
+	cleanup = setFileCreationMask
+	go _ = a
 
 combineModes :: [FileMode] -> FileMode
 combineModes [] = undefined

Utility/Format.hs

@@ -43,19 +43,19 @@ type Variables = M.Map String String
  - This can be repeatedly called, efficiently. -}
 format :: Format -> Variables -> String
 format f vars = concatMap expand f
-	where
-		expand (Const s) = s
-		expand (Var name j)
-			| "escaped_" `isPrefixOf` name =
-				justify j $ encode_c_strict $
-					getvar $ drop (length "escaped_") name
-			| otherwise = justify j $ getvar name
-		getvar name = fromMaybe "" $ M.lookup name vars
-		justify UnJustified s        = s
-		justify (LeftJustified i) s  = s ++ pad i s
-		justify (RightJustified i) s = pad i s ++ s
-		pad i s = take (i - length s) spaces
-		spaces = repeat ' '
+  where
+	expand (Const s) = s
+	expand (Var name j)
+		| "escaped_" `isPrefixOf` name =
+			justify j $ encode_c_strict $
+				getvar $ drop (length "escaped_") name
+		| otherwise = justify j $ getvar name
+	getvar name = fromMaybe "" $ M.lookup name vars
+	justify UnJustified s        = s
+	justify (LeftJustified i) s  = s ++ pad i s
+	justify (RightJustified i) s = pad i s ++ s
+	pad i s = take (i - length s) spaces
+	spaces = repeat ' '
 
 {- Generates a Format that can be used to expand variables in a
  - format string, such as "${foo} ${bar;10} ${baz;-10}\n"
@@ -64,37 +64,37 @@ format f vars = concatMap expand f
  -}
 gen :: FormatString -> Format
 gen = filter (not . empty) . fuse [] . scan [] . decode_c
-	where
-		-- The Format is built up in reverse, for efficiency,
-		-- and can have many adjacent Consts. Fusing it fixes both
-		-- problems.
-		fuse f [] = f
-		fuse f (Const c1:Const c2:vs) = fuse f $ Const (c2++c1) : vs
-		fuse f (v:vs) = fuse (v:f) vs
+  where
+	-- The Format is built up in reverse, for efficiency,
+	-- and can have many adjacent Consts. Fusing it fixes both
+	-- problems.
+	fuse f [] = f
+	fuse f (Const c1:Const c2:vs) = fuse f $ Const (c2++c1) : vs
+	fuse f (v:vs) = fuse (v:f) vs
 
-		scan f (a:b:cs)
-			| a == '$' && b == '{' = invar f [] cs
-			| otherwise = scan (Const [a] : f ) (b:cs)
-		scan f v = Const v : f
+	scan f (a:b:cs)
+		| a == '$' && b == '{' = invar f [] cs
+		| otherwise = scan (Const [a] : f ) (b:cs)
+	scan f v = Const v : f
 
-		invar f var [] = Const (novar var) : f
-		invar f var (c:cs)
-			| c == '}' = foundvar f var UnJustified cs
-			| isAlphaNum c || c == '_' = invar f (c:var) cs
-			| c == ';' = inpad "" f var cs
-			| otherwise = scan ((Const $ novar $ c:var):f) cs
+	invar f var [] = Const (novar var) : f
+	invar f var (c:cs)
+		| c == '}' = foundvar f var UnJustified cs
+		| isAlphaNum c || c == '_' = invar f (c:var) cs
+		| c == ';' = inpad "" f var cs
+		| otherwise = scan ((Const $ novar $ c:var):f) cs
 
-		inpad p f var (c:cs)
-			| c == '}' = foundvar f var (readjustify $ reverse p) cs
-			| otherwise = inpad (c:p) f var cs
-		inpad p f var [] = Const (novar $ p++";"++var) : f
-		readjustify = getjustify . fromMaybe 0 . readish
-		getjustify i
-			| i == 0 = UnJustified
-			| i < 0 = LeftJustified (-1 * i)
-			| otherwise = RightJustified i
-		novar v = "${" ++ reverse v
-		foundvar f v p = scan (Var (reverse v) p : f)
+	inpad p f var (c:cs)
+		| c == '}' = foundvar f var (readjustify $ reverse p) cs
+		| otherwise = inpad (c:p) f var cs
+	inpad p f var [] = Const (novar $ p++";"++var) : f
+	readjustify = getjustify . fromMaybe 0 . readish
+	getjustify i
+		| i == 0 = UnJustified
+		| i < 0 = LeftJustified (-1 * i)
+		| otherwise = RightJustified i
+	novar v = "${" ++ reverse v
+	foundvar f v p = scan (Var (reverse v) p : f)
 
 empty :: Frag -> Bool
 empty (Const "") = True
@@ -106,36 +106,34 @@ empty _ = False
 decode_c :: FormatString -> FormatString
 decode_c [] = []
 decode_c s = unescape ("", s)
-	where
-		e = '\\'
-		unescape (b, []) = b
-		-- look for escapes starting with '\'
-		unescape (b, v) = b ++ fst pair ++ unescape (handle $ snd pair)
-			where
-				pair = span (/= e) v
-		isescape x = x == e
-		-- \NNN is an octal encoded character
-		handle (x:n1:n2:n3:rest)
-			| isescape x && alloctal = (fromoctal, rest)
-				where
-					alloctal = isOctDigit n1 &&
-						isOctDigit n2 &&
-						isOctDigit n3
-					fromoctal = [chr $ readoctal [n1, n2, n3]]
-					readoctal o = Prelude.read $ "0o" ++ o :: Int
-		-- \C is used for a few special characters
-		handle (x:nc:rest)
-			| isescape x = ([echar nc], rest)
-			where
-				echar 'a' = '\a'
-				echar 'b' = '\b'
-				echar 'f' = '\f'
-				echar 'n' = '\n'
-				echar 'r' = '\r'
-				echar 't' = '\t'
-				echar 'v' = '\v'
-				echar a = a
-		handle n = ("", n)
+  where
+	e = '\\'
+	unescape (b, []) = b
+	-- look for escapes starting with '\'
+	unescape (b, v) = b ++ fst pair ++ unescape (handle $ snd pair)
+	  where
+		pair = span (/= e) v
+	isescape x = x == e
+	-- \NNN is an octal encoded character
+	handle (x:n1:n2:n3:rest)
+		| isescape x && alloctal = (fromoctal, rest)
+	  where
+		alloctal = isOctDigit n1 && isOctDigit n2 && isOctDigit n3
+		fromoctal = [chr $ readoctal [n1, n2, n3]]
+		readoctal o = Prelude.read $ "0o" ++ o :: Int
+	-- \C is used for a few special characters
+	handle (x:nc:rest)
+		| isescape x = ([echar nc], rest)
+	  where
+		echar 'a' = '\a'
+		echar 'b' = '\b'
+		echar 'f' = '\f'
+		echar 'n' = '\n'
+		echar 'r' = '\r'
+		echar 't' = '\t'
+		echar 'v' = '\v'
+		echar a = a
+	handle n = ("", n)
 
 {- Inverse of decode_c. -}
 encode_c :: FormatString -> FormatString
@@ -147,28 +145,28 @@ encode_c_strict = encode_c' isSpace
 
 encode_c' :: (Char -> Bool) -> FormatString -> FormatString
 encode_c' p = concatMap echar
-	where
-		e c = '\\' : [c]
-		echar '\a' = e 'a'
-		echar '\b' = e 'b'
-		echar '\f' = e 'f'
-		echar '\n' = e 'n'
-		echar '\r' = e 'r'
-		echar '\t' = e 't'
-		echar '\v' = e 'v'
-		echar '\\' = e '\\'
-		echar '"'  = e '"'
-		echar c
-			| ord c < 0x20 = e_asc c -- low ascii
-			| ord c >= 256 = e_utf c -- unicode
-			| ord c > 0x7E = e_asc c -- high ascii
-			| p c          = e_asc c -- unprintable ascii
-			| otherwise    = [c]     -- printable ascii
-		-- unicode character is decomposed to individual Word8s,
-		-- and each is shown in octal
-		e_utf c = showoctal =<< (Codec.Binary.UTF8.String.encode [c] :: [Word8])
-		e_asc c = showoctal $ ord c
-		showoctal i = '\\' : printf "%03o" i
+  where
+	e c = '\\' : [c]
+	echar '\a' = e 'a'
+	echar '\b' = e 'b'
+	echar '\f' = e 'f'
+	echar '\n' = e 'n'
+	echar '\r' = e 'r'
+	echar '\t' = e 't'
+	echar '\v' = e 'v'
+	echar '\\' = e '\\'
+	echar '"'  = e '"'
+	echar c
+		| ord c < 0x20 = e_asc c -- low ascii
+		| ord c >= 256 = e_utf c -- unicode
+		| ord c > 0x7E = e_asc c -- high ascii
+		| p c          = e_asc c -- unprintable ascii
+		| otherwise    = [c]     -- printable ascii
+	-- unicode character is decomposed to individual Word8s,
+	-- and each is shown in octal
+	e_utf c = showoctal =<< (Codec.Binary.UTF8.String.encode [c] :: [Word8])
+	e_asc c = showoctal $ ord c
+	showoctal i = '\\' : printf "%03o" i
 
 {- for quickcheck -}
 prop_idempotent_deencode :: String -> Bool

Utility/FreeDesktop.hs

@@ -51,8 +51,8 @@ toString(NumericV f) = show f
 toString (ListV l)
 	| null l = ""
 	| otherwise = (intercalate ";" $ map (escapesemi . toString) l) ++ ";"
-	where
-		escapesemi = join "\\;" . split ";"
+  where
+	escapesemi = join "\\;" . split ";"
 
 genDesktopEntry :: String -> String -> Bool -> FilePath -> [String] -> DesktopEntry
 genDesktopEntry name comment terminal program categories =
@@ -64,13 +64,13 @@ genDesktopEntry name comment terminal program categories =
 	, item "Exec" StringV program
 	, item "Categories" ListV (map StringV categories)
 	]
-	where
-		item x c y = (x, c y)
+  where
+	item x c y = (x, c y)
 
 buildDesktopMenuFile :: DesktopEntry -> String
 buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
-	where
-		keyvalue (k, v) = k ++ "=" ++ toString v
+  where
+	keyvalue (k, v) = k ++ "=" ++ toString v
 
 writeDesktopMenuFile :: DesktopEntry -> String -> IO ()
 writeDesktopMenuFile d file = do
@@ -115,11 +115,10 @@ userConfigDir = xdgEnvHome "CONFIG_HOME" ".config"
  - to ~/Desktop. -}
 userDesktopDir :: IO FilePath
 userDesktopDir = maybe fallback return =<< (parse <$> xdg_user_dir)
-	where
-		parse = maybe Nothing (headMaybe . lines)
-		xdg_user_dir = catchMaybeIO $
-			readProcess "xdg-user-dir" ["DESKTOP"]
-		fallback = xdgEnvHome "DESKTOP_DIR" "Desktop"
+  where
+	parse = maybe Nothing (headMaybe . lines)
+	xdg_user_dir = catchMaybeIO $ readProcess "xdg-user-dir" ["DESKTOP"]
+	fallback = xdgEnvHome "DESKTOP_DIR" "Desktop"
 
 xdgEnvHome :: String -> String -> IO String
 xdgEnvHome envbase homedef = do

Utility/Gpg.hs

@@ -29,9 +29,9 @@ stdParams params = do
 		then []
 		else ["--batch", "--no-tty", "--use-agent"]
 	return $ batch ++ defaults ++ toCommand params
-	where
-		-- be quiet, even about checking the trustdb
-		defaults = ["--quiet", "--trust-model", "always"]
+  where
+	-- be quiet, even about checking the trustdb
+	defaults = ["--quiet", "--trust-model", "always"]
 
 {- Runs gpg with some params and returns its stdout, strictly. -}
 readStrict :: [CommandParam] -> IO String
@@ -74,22 +74,22 @@ feedRead params passphrase feeder reader = do
 	params' <- stdParams $ passphrasefd ++ params
 	closeFd frompipe `after`
 		withBothHandles createProcessSuccess (proc "gpg" params') go
-	where
-		go (to, from) = do
-			void $ forkIO $ do
-				feeder to
-				hClose to
-			reader from
+  where
+	go (to, from) = do
+		void $ forkIO $ do
+			feeder to
+			hClose to
+		reader from
 
 {- Finds gpg public keys matching some string. (Could be an email address,
  - a key id, or a name. -}
 findPubKeys :: String -> IO KeyIds
 findPubKeys for = KeyIds . parse <$> readStrict params
-	where
-		params = [Params "--with-colons --list-public-keys", Param for]
-		parse = catMaybes . map (keyIdField . split ":") . lines
-		keyIdField ("pub":_:_:_:f:_) = Just f
-		keyIdField _ = Nothing
+  where
+	params = [Params "--with-colons --list-public-keys", Param for]
+	parse = catMaybes . map (keyIdField . split ":") . lines
+	keyIdField ("pub":_:_:_:f:_) = Just f
+	keyIdField _ = Nothing
 
 {- Creates a block of high-quality random data suitable to use as a cipher.
  - It is armored, to avoid newlines, since gpg only reads ciphers up to the
@@ -100,9 +100,9 @@ genRandom size = readStrict
 	, Param $ show randomquality
 	, Param $ show size
 	]
-	where
-		-- 1 is /dev/urandom; 2 is /dev/random
-		randomquality = 1 :: Int
+  where
+	-- 1 is /dev/urandom; 2 is /dev/random
+	randomquality = 1 :: Int
 
 {- A test key. This is provided pre-generated since generating a new gpg
  - key is too much work (requires too much entropy) for a test suite to
@@ -173,10 +173,10 @@ keyBlock public ls = unlines
 	, unlines ls
 	, "-----END PGP "++t++" KEY BLOCK-----"
 	]
-	where
-		t
-			| public = "PUBLIC"
-			| otherwise = "PRIVATE"
+  where
+	t
+		| public = "PUBLIC"
+		| otherwise = "PRIVATE"
 
 {- Runs an action using gpg in a test harness, in which gpg does
  - not use ~/.gpg/, but a directory with the test key set up to be used. -}
@@ -184,20 +184,20 @@ testHarness :: IO a -> IO a
 testHarness a = do
 	orig <- getEnv var
 	bracket setup (cleanup orig) (const a)
-	where
-		var = "GNUPGHOME"		
+  where
+	var = "GNUPGHOME"		
 
-		setup = do
-			base <- getTemporaryDirectory
-			dir <- mktmpdir $ base </> "gpgtmpXXXXXX"
-			setEnv var dir True
-			_ <- pipeStrict [Params "--import -q"] $ unlines
-				[testSecretKey, testKey]
-			return dir
+	setup = do
+		base <- getTemporaryDirectory
+		dir <- mktmpdir $ base </> "gpgtmpXXXXXX"
+		setEnv var dir True
+		_ <- pipeStrict [Params "--import -q"] $ unlines
+			[testSecretKey, testKey]
+		return dir
 		
-		cleanup orig tmpdir = removeDirectoryRecursive tmpdir >> reset orig
-                reset (Just v) = setEnv var v True
-                reset _ = unsetEnv var
+	cleanup orig tmpdir = removeDirectoryRecursive tmpdir >> reset orig
+	reset (Just v) = setEnv var v True
+	reset _ = unsetEnv var
 
 {- Tests the test harness. -}
 testTestHarness :: IO Bool

Utility/HumanTime.hs

@@ -17,10 +17,10 @@ parseDuration s = do
 	num <- readish s :: Maybe Integer
 	units <- findUnits =<< lastMaybe s
 	return $ fromIntegral num * units
-	where
-		findUnits 's' = Just 1
-		findUnits 'm' = Just 60
-		findUnits 'h' = Just $ 60 * 60
-		findUnits 'd' = Just $ 60 * 60 * 24
-		findUnits 'y' = Just $ 60 * 60 * 24 * 365
-		findUnits _ = Nothing
+  where
+	findUnits 's' = Just 1
+	findUnits 'm' = Just 60
+	findUnits 'h' = Just $ 60 * 60
+	findUnits 'd' = Just $ 60 * 60 * 24
+	findUnits 'y' = Just $ 60 * 60 * 24 * 365
+	findUnits _ = Nothing

Utility/INotify.hs

@@ -59,116 +59,116 @@ watchDir i dir ignored hooks
 		withLock lock $
 			mapM_ scan =<< filter (not . dirCruft) <$>
 				getDirectoryContents dir
-	where
-		recurse d = watchDir i d ignored hooks
+  where
+	recurse d = watchDir i d ignored hooks
 
-		-- Select only inotify events required by the enabled
-		-- hooks, but always include Create so new directories can
-		-- be scanned.
-		watchevents = Create : addevents ++ delevents ++ modifyevents
-		addevents
-			| hashook addHook || hashook addSymlinkHook = [MoveIn, CloseWrite]
-			| otherwise = []
-		delevents
-			| hashook delHook || hashook delDirHook = [MoveOut, Delete]
-			| otherwise = []
-		modifyevents
-			| hashook modifyHook = [Modify]
-			| otherwise = []
+	-- Select only inotify events required by the enabled
+	-- hooks, but always include Create so new directories can
+	-- be scanned.
+	watchevents = Create : addevents ++ delevents ++ modifyevents
+	addevents
+		| hashook addHook || hashook addSymlinkHook = [MoveIn, CloseWrite]
+		| otherwise = []
+	delevents
+		| hashook delHook || hashook delDirHook = [MoveOut, Delete]
+		| otherwise = []
+	modifyevents
+		| hashook modifyHook = [Modify]
+		| otherwise = []
 
-		scan f = unless (ignored f) $ do
-			ms <- getstatus f
-			case ms of
-				Nothing -> return ()
-				Just s
-					| Files.isDirectory s ->
-						recurse $ indir f
-					| Files.isSymbolicLink s ->
-						runhook addSymlinkHook f ms
-					| Files.isRegularFile s ->
-						runhook addHook f ms
-					| otherwise ->
-						noop
+	scan f = unless (ignored f) $ do
+		ms <- getstatus f
+		case ms of
+			Nothing -> return ()
+			Just s
+				| Files.isDirectory s ->
+					recurse $ indir f
+				| Files.isSymbolicLink s ->
+					runhook addSymlinkHook f ms
+				| Files.isRegularFile s ->
+					runhook addHook f ms
+				| otherwise ->
+					noop
 
-		-- Ignore creation events for regular files, which won't be
-		-- done being written when initially created, but handle for
-		-- directories and symlinks.
-		go (Created { isDirectory = isd, filePath = f })
-			| isd = recurse $ indir f
-			| hashook addSymlinkHook =
-				checkfiletype Files.isSymbolicLink addSymlinkHook f
-			| otherwise = noop
-		-- Closing a file is assumed to mean it's done being written.
-		go (Closed { isDirectory = False, maybeFilePath = Just f }) =
-				checkfiletype Files.isRegularFile addHook f
-		-- When a file or directory is moved in, scan it to add new
-		-- stuff.
-		go (MovedIn { filePath = f }) = scan f
-		go (MovedOut { isDirectory = isd, filePath = f })
-			| isd = runhook delDirHook f Nothing
-			| otherwise = runhook delHook f Nothing
-		-- Verify that the deleted item really doesn't exist,
-		-- since there can be spurious deletion events for items
-		-- in a directory that has been moved out, but is still
-		-- being watched.
-		go (Deleted { isDirectory = isd, filePath = f })
-			| isd = guarded $ runhook delDirHook f Nothing
-			| otherwise = guarded $ runhook delHook f Nothing
-			where
-				guarded = unlessM (filetype (const True) f)
-		go (Modified { isDirectory = isd, maybeFilePath = Just f })
-			| isd = noop
-			| otherwise = runhook modifyHook f Nothing
-		go _ = noop
+	-- Ignore creation events for regular files, which won't be
+	-- done being written when initially created, but handle for
+	-- directories and symlinks.
+	go (Created { isDirectory = isd, filePath = f })
+		| isd = recurse $ indir f
+		| hashook addSymlinkHook =
+			checkfiletype Files.isSymbolicLink addSymlinkHook f
+		| otherwise = noop
+	-- Closing a file is assumed to mean it's done being written.
+	go (Closed { isDirectory = False, maybeFilePath = Just f }) =
+			checkfiletype Files.isRegularFile addHook f
+	-- When a file or directory is moved in, scan it to add new
+	-- stuff.
+	go (MovedIn { filePath = f }) = scan f
+	go (MovedOut { isDirectory = isd, filePath = f })
+		| isd = runhook delDirHook f Nothing
+		| otherwise = runhook delHook f Nothing
+	-- Verify that the deleted item really doesn't exist,
+	-- since there can be spurious deletion events for items
+	-- in a directory that has been moved out, but is still
+	-- being watched.
+	go (Deleted { isDirectory = isd, filePath = f })
+		| isd = guarded $ runhook delDirHook f Nothing
+		| otherwise = guarded $ runhook delHook f Nothing
+	  where
+		guarded = unlessM (filetype (const True) f)
+	go (Modified { isDirectory = isd, maybeFilePath = Just f })
+		| isd = noop
+		| otherwise = runhook modifyHook f Nothing
+	go _ = noop
 
-		hashook h = isJust $ h hooks
+	hashook h = isJust $ h hooks
 
-		runhook h f s
-			| ignored f = noop
-			| otherwise = maybe noop (\a -> a (indir f) s) (h hooks)
+	runhook h f s
+		| ignored f = noop
+		| otherwise = maybe noop (\a -> a (indir f) s) (h hooks)
 
-		indir f = dir </> f
+	indir f = dir </> f
 
-		getstatus f = catchMaybeIO $ getSymbolicLinkStatus $ indir f
-		checkfiletype check h f = do
-			ms <- getstatus f
-			case ms of
-				Just s
-					| check s -> runhook h f ms
-				_ -> noop
-		filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f)
+	getstatus f = catchMaybeIO $ getSymbolicLinkStatus $ indir f
+	checkfiletype check h f = do
+		ms <- getstatus f
+		case ms of
+			Just s
+				| check s -> runhook h f ms
+			_ -> noop
+	filetype t f = catchBoolIO $ t <$> getSymbolicLinkStatus (indir f)
 
-		-- Inotify fails when there are too many watches with a
-		-- disk full error.
-		failedaddwatch e
-			| isFullError e =
-				case errHook hooks of
-					Nothing -> throw e
-					Just hook -> tooManyWatches hook dir
-			| otherwise = throw e
+	-- Inotify fails when there are too many watches with a
+	-- disk full error.
+	failedaddwatch e
+		| isFullError e =
+			case errHook hooks of
+				Nothing -> throw e
+				Just hook -> tooManyWatches hook dir
+		| otherwise = throw e
 
 tooManyWatches :: (String -> Maybe FileStatus -> IO ()) -> FilePath -> IO ()
 tooManyWatches hook dir = do
 	sysctlval <- querySysctl [Param maxwatches] :: IO (Maybe Integer)
 	hook (unlines $ basewarning : maybe withoutsysctl withsysctl sysctlval) Nothing
-	where
-		maxwatches = "fs.inotify.max_user_watches"
-		basewarning = "Too many directories to watch! (Not watching " ++ dir ++")"
-		withoutsysctl = ["Increase the value in /proc/sys/fs/inotify/max_user_watches"]
-		withsysctl n = let new = n * 10 in
-			[ "Increase the limit permanently by running:"
-			, "  echo " ++ maxwatches ++ "=" ++ show new ++
-			  " | sudo tee -a /etc/sysctl.conf; sudo sysctl -p"
-			, "Or temporarily by running:"
-			, "  sudo sysctl -w " ++ maxwatches ++ "=" ++ show new
-			]
+  where
+	maxwatches = "fs.inotify.max_user_watches"
+	basewarning = "Too many directories to watch! (Not watching " ++ dir ++")"
+	withoutsysctl = ["Increase the value in /proc/sys/fs/inotify/max_user_watches"]
+	withsysctl n = let new = n * 10 in
+		[ "Increase the limit permanently by running:"
+		, "  echo " ++ maxwatches ++ "=" ++ show new ++
+		  " | sudo tee -a /etc/sysctl.conf; sudo sysctl -p"
+		, "Or temporarily by running:"
+		, "  sudo sysctl -w " ++ maxwatches ++ "=" ++ show new
+		]
 
 querySysctl :: Read a => [CommandParam] -> IO (Maybe a)
 querySysctl ps = getM go ["sysctl", "/sbin/sysctl", "/usr/sbin/sysctl"]
-	where
-		go p = do
-			v <- catchMaybeIO $ readProcess p (toCommand ps)
-			case v of
-				Nothing -> return Nothing
-				Just s -> return $ parsesysctl s
-		parsesysctl s = readish =<< lastMaybe (words s)
+  where
+	go p = do
+		v <- catchMaybeIO $ readProcess p (toCommand ps)
+		case v of
+			Nothing -> return Nothing
+			Just s -> return $ parsesysctl s
+	parsesysctl s = readish =<< lastMaybe (words s)

Utility/JSONStream.hs

@@ -21,15 +21,15 @@ start :: JSON a => [(String, a)] -> String
 start l
 	| last s == endchar = init s
 	| otherwise = bad s
-	where
-		s = encodeStrict $ toJSObject l
+  where
+	s = encodeStrict $ toJSObject l
 
 add :: JSON a => [(String, a)] -> String
 add l
 	| head s == startchar = ',' : drop 1 s
 	| otherwise = bad s
-	where
-		s = start l
+  where
+	s = start l
 
 end :: String
 end = [endchar, '\n']

Utility/Kqueue.hs

@@ -78,44 +78,44 @@ getDirInfo dir = do
 	l <- filter (not . dirCruft) <$> getDirectoryContents dir
 	contents <- S.fromList . catMaybes <$> mapM getDirEnt l
 	return $ DirInfo dir contents
-	where
-		getDirEnt f = catchMaybeIO $ do
-			s <- getFileStatus (dir </> f)
-			return $ DirEnt f (fileID s) (isDirectory s)
+  where
+	getDirEnt f = catchMaybeIO $ do
+		s <- getFileStatus (dir </> f)
+		return $ DirEnt f (fileID s) (isDirectory s)
 
 {- Difference between the dirCaches of two DirInfos. -}
 (//) :: DirInfo -> DirInfo -> [Change]
 oldc // newc = deleted ++ added
-	where
-		deleted = calc gendel oldc newc
-		added   = calc genadd newc oldc
-		gendel x = (if isSubDir x then DeletedDir else Deleted) $
-			dirName oldc </> dirEnt x
-		genadd x = Added $ dirName newc </> dirEnt x
-		calc a x y = map a $ S.toList $
-			S.difference (dirCache x) (dirCache y)
+  where
+	deleted = calc gendel oldc newc
+	added   = calc genadd newc oldc
+	gendel x = (if isSubDir x then DeletedDir else Deleted) $
+		dirName oldc </> dirEnt x
+	genadd x = Added $ dirName newc </> dirEnt x
+	calc a x y = map a $ S.toList $
+		S.difference (dirCache x) (dirCache y)
 
 {- Builds a map of directories in a tree, possibly pruning some.
  - Opens each directory in the tree, and records its current contents. -}
 scanRecursive :: FilePath -> Pruner -> IO DirMap
 scanRecursive topdir prune = M.fromList <$> walk [] [topdir]
-	where
-		walk c [] = return c
-		walk c (dir:rest)
-			| prune dir = walk c rest
-			| otherwise = do
-				minfo <- catchMaybeIO $ getDirInfo dir
-				case minfo of
-					Nothing -> walk c rest
-					Just info -> do
-						mfd <- catchMaybeIO $
-							openFd dir ReadOnly Nothing defaultFileFlags
-						case mfd of
-							Nothing -> walk c rest
-							Just fd -> do
-								let subdirs = map (dir </>) . map dirEnt $
-									S.toList $ dirCache info
-								walk ((fd, info):c) (subdirs ++ rest)
+  where
+	walk c [] = return c
+	walk c (dir:rest)
+		| prune dir = walk c rest
+		| otherwise = do
+			minfo <- catchMaybeIO $ getDirInfo dir
+			case minfo of
+				Nothing -> walk c rest
+				Just info -> do
+					mfd <- catchMaybeIO $
+						openFd dir ReadOnly Nothing defaultFileFlags
+					case mfd of
+						Nothing -> walk c rest
+						Just fd -> do
+							let subdirs = map (dir </>) . map dirEnt $
+								S.toList $ dirCache info
+							walk ((fd, info):c) (subdirs ++ rest)
 
 {- Adds a list of subdirectories (and all their children), unless pruned to a
  - directory map. Adding a subdirectory that's already in the map will
@@ -131,16 +131,16 @@ removeSubDir :: DirMap -> FilePath -> IO DirMap
 removeSubDir dirmap dir = do
 	mapM_ closeFd $ M.keys toremove
 	return rest
-	where
-		(toremove, rest) = M.partition (dirContains dir . dirName) dirmap
+  where
+	(toremove, rest) = M.partition (dirContains dir . dirName) dirmap
 
 findDirContents :: DirMap -> FilePath -> [FilePath]
 findDirContents dirmap dir = concatMap absolutecontents $ search
-	where
-		absolutecontents i = map (dirName i </>)
-			(map dirEnt $ S.toList $ dirCache i)
-		search = map snd $ M.toList $
-			M.filter (\i -> dirName i == dir) dirmap
+  where
+	absolutecontents i = map (dirName i </>)
+		(map dirEnt $ S.toList $ dirCache i)
+	search = map snd $ M.toList $
+		M.filter (\i -> dirName i == dir) dirmap
 
 foreign import ccall safe "libkqueue.h init_kqueue" c_init_kqueue
 	:: IO Fd
@@ -181,8 +181,8 @@ waitChange kq@(Kqueue h _ dirmap _) = do
 		else case M.lookup changedfd dirmap of
 			Nothing -> nochange
 			Just info -> handleChange kq changedfd info
-	where
-		nochange = return (kq, [])
+  where
+	nochange = return (kq, [])
 
 {- The kqueue interface does not tell what type of change took place in
  - the directory; it could be an added file, a deleted file, a renamed
@@ -196,36 +196,36 @@ waitChange kq@(Kqueue h _ dirmap _) = do
 handleChange :: Kqueue -> Fd -> DirInfo -> IO (Kqueue, [Change])
 handleChange kq@(Kqueue _ _ dirmap pruner) fd olddirinfo =
 	go =<< catchMaybeIO (getDirInfo $ dirName olddirinfo)
-	where
-		go (Just newdirinfo) = do
-			let changes = filter (not . pruner . changedFile) $
-				 olddirinfo // newdirinfo
-			let (added, deleted) = partition isAdd changes
+  where
+	go (Just newdirinfo) = do
+		let changes = filter (not . pruner . changedFile) $
+			 olddirinfo // newdirinfo
+		let (added, deleted) = partition isAdd changes
 
-			-- Scan newly added directories to add to the map.
-			-- (Newly added files will fail getDirInfo.)
-			newdirinfos <- catMaybes <$>
-				mapM (catchMaybeIO . getDirInfo . changedFile) added
-			newmap <- addSubDirs dirmap pruner $ map dirName newdirinfos
+		-- Scan newly added directories to add to the map.
+		-- (Newly added files will fail getDirInfo.)
+		newdirinfos <- catMaybes <$>
+			mapM (catchMaybeIO . getDirInfo . changedFile) added
+		newmap <- addSubDirs dirmap pruner $ map dirName newdirinfos
 
-			-- Remove deleted directories from the map.
-			newmap' <- foldM removeSubDir newmap (map changedFile deleted)
+		-- Remove deleted directories from the map.
+		newmap' <- foldM removeSubDir newmap (map changedFile deleted)
 
-			-- Update the cached dirinfo just looked up.
-			let newmap'' = M.insertWith' const fd newdirinfo newmap'
+		-- Update the cached dirinfo just looked up.
+		let newmap'' = M.insertWith' const fd newdirinfo newmap'
 
-			-- When new directories were added, need to update
-			-- the kqueue to watch them.
-			let kq' = kq { kqueueMap = newmap'' }
-			unless (null newdirinfos) $
-				updateKqueue kq'
+		-- When new directories were added, need to update
+		-- the kqueue to watch them.
+		let kq' = kq { kqueueMap = newmap'' }
+		unless (null newdirinfos) $
+			updateKqueue kq'
 
-			return (kq', changes)
-		go Nothing = do
-			-- The directory has been moved or deleted, so
-			-- remove it from our map.
-			newmap <- removeSubDir dirmap (dirName olddirinfo)
-			return (kq { kqueueMap = newmap }, [])
+		return (kq', changes)
+	go Nothing = do
+		-- The directory has been moved or deleted, so
+		-- remove it from our map.
+		newmap <- removeSubDir dirmap (dirName olddirinfo)
+		return (kq { kqueueMap = newmap }, [])
 
 {- Processes changes on the Kqueue, calling the hooks as appropriate.
  - Never returns. -}
@@ -235,35 +235,33 @@ runHooks kq hooks = do
 	-- to catch any files created beforehand.
 	recursiveadd (kqueueMap kq) (Added $ kqueueTop kq)
 	loop kq
-	where
-		loop q = do
-			(q', changes) <- waitChange q
-			forM_ changes $ dispatch (kqueueMap q')
-			loop q'
+  where
+	loop q = do
+		(q', changes) <- waitChange q
+		forM_ changes $ dispatch (kqueueMap q')
+		loop q'
 
-		dispatch _ change@(Deleted _) = 
-			callhook delHook Nothing change
-		dispatch _ change@(DeletedDir _) =
-			callhook delDirHook Nothing change
-		dispatch dirmap change@(Added _) =
-			withstatus change $ dispatchadd dirmap
+	dispatch _ change@(Deleted _) = 
+		callhook delHook Nothing change
+	dispatch _ change@(DeletedDir _) =
+		callhook delDirHook Nothing change
+	dispatch dirmap change@(Added _) =
+		withstatus change $ dispatchadd dirmap
 		
-		dispatchadd dirmap change s
-			| Files.isSymbolicLink s =
-				callhook addSymlinkHook (Just s) change
-			| Files.isDirectory s = recursiveadd dirmap change
-			| Files.isRegularFile s =
-				callhook addHook (Just s) change
-			| otherwise = noop
+	dispatchadd dirmap change s
+		| Files.isSymbolicLink s = callhook addSymlinkHook (Just s) change
+		| Files.isDirectory s = recursiveadd dirmap change
+		| Files.isRegularFile s = callhook addHook (Just s) change
+		| otherwise = noop
 
-		recursiveadd dirmap change = do
-			let contents = findDirContents dirmap $ changedFile change
-			forM_ contents $ \f ->
-				withstatus (Added f) $ dispatchadd dirmap
+	recursiveadd dirmap change = do
+		let contents = findDirContents dirmap $ changedFile change
+		forM_ contents $ \f ->
+			withstatus (Added f) $ dispatchadd dirmap
 
-		callhook h s change = case h hooks of
-			Nothing -> noop
-			Just a -> a (changedFile change) s
+	callhook h s change = case h hooks of
+		Nothing -> noop
+		Just a -> a (changedFile change) s
 
-		withstatus change a = maybe noop (a change) =<<
-			(catchMaybeIO (getSymbolicLinkStatus (changedFile change)))
+	withstatus change a = maybe noop (a change) =<<
+		(catchMaybeIO (getSymbolicLinkStatus (changedFile change)))

Utility/LogFile.hs

@@ -23,9 +23,9 @@ rotateLog logfile num
 	| otherwise = whenM (doesFileExist currfile) $ do
 		rotateLog logfile (num + 1)
 		renameFile currfile nextfile
-	where
-		currfile = filename num
-		nextfile = filename (num + 1)
-		filename n
-			| n == 0 = logfile
-			| otherwise = logfile ++ "." ++ show n
+  where
+	currfile = filename num
+	nextfile = filename (num + 1)
+	filename n
+		| n == 0 = logfile
+		| otherwise = logfile ++ "." ++ show n

Utility/Lsof.hs

@@ -36,8 +36,8 @@ query :: [String] -> IO [(FilePath, LsofOpenMode, ProcessInfo)]
 query opts =
 	withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $ \h -> do
 		parse <$> hGetContentsStrict h
-	where
-		p = proc "lsof" ("-F0can" : opts)
+  where
+	p = proc "lsof" ("-F0can" : opts)
 
 {- Parsing null-delimited output like:
  -
@@ -51,38 +51,36 @@ query opts =
  -}
 parse :: String -> [(FilePath, LsofOpenMode, ProcessInfo)]
 parse s = bundle $ go [] $ lines s
-	where
-		bundle = concatMap (\(fs, p) -> map (\(f, m) -> (f, m, p)) fs)
+  where
+	bundle = concatMap (\(fs, p) -> map (\(f, m) -> (f, m, p)) fs)
 
-		go c [] = c
-		go c ((t:r):ls)
-			| t == 'p' =
-				let (fs, ls') = parsefiles [] ls
-				in go ((fs, parseprocess r):c) ls'
-			| otherwise = parsefail
-		go _ _ = parsefail
+	go c [] = c
+	go c ((t:r):ls)
+		| t == 'p' =
+			let (fs, ls') = parsefiles [] ls
+			in go ((fs, parseprocess r):c) ls'
+		| otherwise = parsefail
+	go _ _ = parsefail
 
-		parseprocess l =
-			case splitnull l of
-				[pid, 'c':cmdline, ""] ->
-					case readish pid of
-						(Just n) -> ProcessInfo n cmdline
-						Nothing -> parsefail
-				_ -> parsefail
+	parseprocess l = case splitnull l of
+		[pid, 'c':cmdline, ""] ->
+			case readish pid of
+				(Just n) -> ProcessInfo n cmdline
+				Nothing -> parsefail
+		_ -> parsefail
 
-		parsefiles c [] = (c, [])
-		parsefiles c (l:ls) = 
-			case splitnull l of
-				['a':mode, 'n':file, ""] ->
-					parsefiles ((file, parsemode mode):c) ls
-				(('p':_):_) -> (c, l:ls)
-				_ -> parsefail
+	parsefiles c [] = (c, [])
+	parsefiles c (l:ls) = case splitnull l of
+		['a':mode, 'n':file, ""] ->
+			parsefiles ((file, parsemode mode):c) ls
+		(('p':_):_) -> (c, l:ls)
+		_ -> parsefail
 
-		parsemode ('r':_) = OpenReadOnly
-		parsemode ('w':_) = OpenWriteOnly
-		parsemode ('u':_) = OpenReadWrite
-		parsemode _ = OpenUnknown
+	parsemode ('r':_) = OpenReadOnly
+	parsemode ('w':_) = OpenWriteOnly
+	parsemode ('u':_) = OpenReadWrite
+	parsemode _ = OpenUnknown
 
-		splitnull = split "\0"
+	splitnull = split "\0"
 
-		parsefail = error $ "failed to parse lsof output: " ++ show s
+	parsefail = error $ "failed to parse lsof output: " ++ show s

Utility/Matcher.hs

@@ -58,36 +58,36 @@ tokens = words "and or not ( )"
 {- Converts a list of Tokens into a Matcher. -}
 generate :: [Token op] -> Matcher op
 generate = go MAny
-	where
-		go m [] = m
-		go m ts = uncurry go $ consume m ts
+  where
+	go m [] = m
+	go m ts = uncurry go $ consume m ts
 
 {- Consumes one or more Tokens, constructs a new Matcher,
  - and returns unconsumed Tokens. -}
 consume :: Matcher op -> [Token op] -> (Matcher op, [Token op])
 consume m [] = (m, [])
 consume m (t:ts) = go t
-	where
-		go And = cont $ m `MAnd` next
-		go Or = cont $ m `MOr` next
-		go Not = cont $ m `MAnd` MNot next
-		go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
-		go Close = (m, ts)
-		go (Operation o) = (m `MAnd` MOp o, ts)
+  where
+	go And = cont $ m `MAnd` next
+	go Or = cont $ m `MOr` next
+	go Not = cont $ m `MAnd` MNot next
+	go Open = let (n, r) = consume next rest in (m `MAnd` n, r)
+	go Close = (m, ts)
+	go (Operation o) = (m `MAnd` MOp o, ts)
 
-		(next, rest) = consume MAny ts
-		cont v = (v, rest)
+	(next, rest) = consume MAny ts
+	cont v = (v, rest)
 
 {- Checks if a Matcher matches, using a supplied function to check
  - the value of Operations. -}
 match :: (op -> v -> Bool) -> Matcher op -> v -> Bool
 match a m v = go m
-	where
-		go MAny = True
-		go (MAnd m1 m2) = go m1 && go m2
-		go (MOr m1 m2) =  go m1 || go m2
-		go (MNot m1) = not $ go m1
-		go (MOp o) = a o v
+  where
+	go MAny = True
+	go (MAnd m1 m2) = go m1 && go m2
+	go (MOr m1 m2) =  go m1 || go m2
+	go (MNot m1) = not $ go m1
+	go (MOp o) = a o v
 
 {- Runs a monadic Matcher, where Operations are actions in the monad. -}
 matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
@@ -98,12 +98,12 @@ matchM m v = matchMrun m $ \o -> o v
  - parameter. -}
 matchMrun :: forall o (m :: * -> *). Monad m => Matcher o -> (o -> m Bool) -> m Bool
 matchMrun m run = go m
-	where
-		go MAny = return True
-		go (MAnd m1 m2) = go m1 <&&> go m2
-		go (MOr m1 m2) =  go m1 <||> go m2
-		go (MNot m1) = liftM not (go m1)
-		go (MOp o) = run o
+  where
+	go MAny = return True
+	go (MAnd m1 m2) = go m1 <&&> go m2
+	go (MOr m1 m2) =  go m1 <||> go m2
+	go (MNot m1) = liftM not (go m1)
+	go (MOp o) = run o
 
 {- Checks if a matcher contains no limits. -}
 isEmpty :: Matcher a -> Bool

Utility/Misc.hs

@@ -33,10 +33,10 @@ readFileStrict = readFile >=> \s -> length s `seq` return s
  -}
 separate :: (a -> Bool) -> [a] -> ([a], [a])
 separate c l = unbreak $ break c l
-	where
-		unbreak r@(a, b)
-			| null b = r
-			| otherwise = (a, tail b)
+  where
+	unbreak r@(a, b)
+		| null b = r
+		| otherwise = (a, tail b)
 
 {- Breaks out the first line. -}
 firstLine :: String -> String
@@ -47,11 +47,11 @@ firstLine = takeWhile (/= '\n')
  - Segments may be empty. -}
 segment :: (a -> Bool) -> [a] -> [[a]]
 segment p l = map reverse $ go [] [] l
-	where
-		go c r [] = reverse $ c:r
-		go c r (i:is)
-			| p i = go [] (c:r) is
-			| otherwise = go (i:c) r is
+  where
+	go c r [] = reverse $ c:r
+	go c r (i:is)
+		| p i = go [] (c:r) is
+		| otherwise = go (i:c) r is
 
 prop_segment_regressionTest :: Bool
 prop_segment_regressionTest = all id
@@ -64,11 +64,11 @@ prop_segment_regressionTest = all id
 {- Includes the delimiters as segments of their own. -}
 segmentDelim :: (a -> Bool) -> [a] -> [[a]]
 segmentDelim p l = map reverse $ go [] [] l
-	where
-		go c r [] = reverse $ c:r
-		go c r (i:is)
-			| p i = go [] ([i]:c:r) is
-			| otherwise = go (i:c) r is
+  where
+	go c r [] = reverse $ c:r
+	go c r (i:is)
+		| p i = go [] ([i]:c:r) is
+		| otherwise = go (i:c) r is
 
 {- Given two orderings, returns the second if the first is EQ and returns
  - the first otherwise.
@@ -96,9 +96,9 @@ hGetSomeString h sz = do
 	fp <- mallocForeignPtrBytes sz
 	len <- withForeignPtr fp $ \buf -> hGetBufSome h buf sz
 	map (chr . fromIntegral) <$> withForeignPtr fp (peekbytes len)
-	where
-		peekbytes :: Int -> Ptr Word8 -> IO [Word8]
-		peekbytes len buf = mapM (peekElemOff buf) [0..pred len]
+  where
+	peekbytes :: Int -> Ptr Word8 -> IO [Word8]
+	peekbytes len buf = mapM (peekElemOff buf) [0..pred len]
 
 {- Reaps any zombie git processes. 
  -

Utility/Mounts.hsc

@@ -41,21 +41,21 @@ getMounts = do
 	_ <- c_mounts_end h
 	return mntent
 
-	where
-		getmntent h c = do
-			ptr <- c_mounts_next h
-			if (ptr == nullPtr)
-				then return $ reverse c
-				else do
-					mnt_fsname_str <- #{peek struct mntent, mnt_fsname} ptr >>= peekCString
-					mnt_dir_str <- #{peek struct mntent, mnt_dir} ptr >>= peekCString
-					mnt_type_str <- #{peek struct mntent, mnt_type} ptr >>= peekCString
-					let ent = Mntent
-						{ mnt_fsname = mnt_fsname_str
-						, mnt_dir = mnt_dir_str
-						, mnt_type = mnt_type_str
-						}
-					getmntent h (ent:c)
+  where
+	getmntent h c = do
+		ptr <- c_mounts_next h
+		if (ptr == nullPtr)
+			then return $ reverse c
+			else do
+				mnt_fsname_str <- #{peek struct mntent, mnt_fsname} ptr >>= peekCString
+				mnt_dir_str <- #{peek struct mntent, mnt_dir} ptr >>= peekCString
+				mnt_type_str <- #{peek struct mntent, mnt_type} ptr >>= peekCString
+				let ent = Mntent
+					{ mnt_fsname = mnt_fsname_str
+					, mnt_dir = mnt_dir_str
+					, mnt_type = mnt_type_str
+					}
+				getmntent h (ent:c)
 
 {- Using unsafe imports because the C functions are belived to never block.
  - Note that getmntinfo is called with MNT_NOWAIT to avoid possibly blocking;

Utility/Network.hs

@@ -17,6 +17,5 @@ import Control.Applicative
  - use uname -n when available. -}
 getHostname :: IO (Maybe String)
 getHostname = catchMaybeIO uname_node
-	where
-		uname_node = takeWhile (/= '\n') <$>
-			readProcess "uname" ["-n"]	
+  where
+	uname_node = takeWhile (/= '\n') <$> readProcess "uname" ["-n"]

Utility/NotificationBroadcaster.hs

@@ -45,13 +45,13 @@ newNotificationHandle :: NotificationBroadcaster -> IO NotificationHandle
 newNotificationHandle b = NotificationHandle
 	<$> pure b
 	<*> addclient
-	where
-		addclient = do
-			s <- newEmptySV
-			atomically $ do
-				l <- takeTMVar b
-				putTMVar b $ l ++ [s]
-				return $ NotificationId $ length l
+  where
+	addclient = do
+		s <- newEmptySV
+		atomically $ do
+			l <- takeTMVar b
+			putTMVar b $ l ++ [s]
+			return $ NotificationId $ length l
 
 {- Extracts the identifier from a notification handle.
  - This can be used to eg, pass the identifier through to a WebApp. -}
@@ -66,8 +66,8 @@ sendNotification :: NotificationBroadcaster -> IO ()
 sendNotification b = do
 	l <- atomically $ readTMVar b
 	mapM_ notify l
-	where
-		notify s = writeSV s ()
+  where
+	notify s = writeSV s ()
 
 {- Used by a client to block until a new notification is available since
  - the last time it tried. -}

Utility/Parallel.hs

@@ -23,13 +23,13 @@ inParallel a l = do
 	mvars <- mapM thread l
 	statuses <- mapM takeMVar mvars
 	return $ reduce $ partition snd $ zip l statuses
-	where
-		reduce (x,y) = (map fst x, map fst y)
-		thread v = do
-			mvar <- newEmptyMVar
-			_ <- forkIO $ do
-				r <- try (a v) :: IO (Either SomeException Bool)
-				case r of
-					Left _ -> putMVar mvar False
-					Right b -> putMVar mvar b
-			return mvar
+  where
+	reduce (x,y) = (map fst x, map fst y)
+	thread v = do
+		mvar <- newEmptyMVar
+		_ <- forkIO $ do
+			r <- try (a v) :: IO (Either SomeException Bool)
+			case r of
+				Left _ -> putMVar mvar False
+				Right b -> putMVar mvar b
+		return mvar

Utility/Path.hs

@@ -23,18 +23,18 @@ parentDir :: FilePath -> FilePath
 parentDir dir
 	| not $ null dirs = slash ++ join s (init dirs)
 	| otherwise = ""
-		where
-			dirs = filter (not . null) $ split s dir
-			slash = if isAbsolute dir then s else ""
-			s = [pathSeparator]
+  where
+	dirs = filter (not . null) $ split s dir
+	slash = if isAbsolute dir then s else ""
+	s = [pathSeparator]
 
 prop_parentDir_basics :: FilePath -> Bool
 prop_parentDir_basics dir
 	| null dir = True
 	| dir == "/" = parentDir dir == ""
 	| otherwise = p /= dir
-	where
-		p = parentDir dir
+  where
+	p = parentDir dir
 
 {- Checks if the first FilePath is, or could be said to contain the second.
  - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
@@ -42,10 +42,10 @@ prop_parentDir_basics dir
  -}
 dirContains :: FilePath -> FilePath -> Bool
 dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
-	where
-		norm p = fromMaybe "" $ absNormPath p "."
-		a' = norm a
-		b' = norm b
+  where
+	norm p = fromMaybe "" $ absNormPath p "."
+	a' = norm a
+	b' = norm b
 
 {- Converts a filename into a normalized, absolute path.
  -
@@ -60,8 +60,8 @@ absPath file = do
  - from the specified cwd. -}
 absPathFrom :: FilePath -> FilePath -> FilePath
 absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
-	where
-		bad = error $ "unable to normalize " ++ file
+  where
+	bad = error $ "unable to normalize " ++ file
 
 {- Constructs a relative path from the CWD to a file.
  -
@@ -78,31 +78,31 @@ relPathCwdToFile f = relPathDirToFile <$> getCurrentDirectory <*> absPath f
  -}
 relPathDirToFile :: FilePath -> FilePath -> FilePath
 relPathDirToFile from to = join s $ dotdots ++ uncommon
-	where
-		s = [pathSeparator]
-		pfrom = split s from
-		pto = split s to
-		common = map fst $ takeWhile same $ zip pfrom pto
-		same (c,d) = c == d
-		uncommon = drop numcommon pto
-		dotdots = replicate (length pfrom - numcommon) ".."
-		numcommon = length common
+  where
+	s = [pathSeparator]
+	pfrom = split s from
+	pto = split s to
+	common = map fst $ takeWhile same $ zip pfrom pto
+	same (c,d) = c == d
+	uncommon = drop numcommon pto
+	dotdots = replicate (length pfrom - numcommon) ".."
+	numcommon = length common
 
 prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
 prop_relPathDirToFile_basics from to
 	| from == to = null r
 	| otherwise = not (null r)
-	where
-		r = relPathDirToFile from to 
+  where
+	r = relPathDirToFile from to 
 
 prop_relPathDirToFile_regressionTest :: Bool
 prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference
-	where
-		{- Two paths have the same directory component at the same
-		 - location, but it's not really the same directory.
-		 - Code used to get this wrong. -}
-		same_dir_shortcurcuits_at_difference =
-			relPathDirToFile "/tmp/r/lll/xxx/yyy/18" "/tmp/r/.git/annex/objects/18/gk/SHA256-foo/SHA256-foo" == "../../../../.git/annex/objects/18/gk/SHA256-foo/SHA256-foo"
+  where
+	{- Two paths have the same directory component at the same
+	 - location, but it's not really the same directory.
+	 - Code used to get this wrong. -}
+	same_dir_shortcurcuits_at_difference =
+		relPathDirToFile "/tmp/r/lll/xxx/yyy/18" "/tmp/r/.git/annex/objects/18/gk/SHA256-foo/SHA256-foo" == "../../../../.git/annex/objects/18/gk/SHA256-foo/SHA256-foo"
 
 {- Given an original list of paths, and an expanded list derived from it,
  - generates a list of lists, where each sublist corresponds to one of the
@@ -114,8 +114,8 @@ segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
 segmentPaths [] new = [new]
 segmentPaths [_] new = [new] -- optimisation
 segmentPaths (l:ls) new = [found] ++ segmentPaths ls rest
-	where
-		(found, rest)=partition (l `dirContains`) new
+  where
+	(found, rest)=partition (l `dirContains`) new
 
 {- This assumes that it's cheaper to call segmentPaths on the result,
  - than it would be to run the action separately with each path. In
@@ -135,8 +135,8 @@ relHome path = do
 {- Checks if a command is available in PATH. -}
 inPath :: String -> IO Bool
 inPath command = getSearchPath >>= anyM indir
-	where
-		indir d = doesFileExist $ d </> command
+  where
+	indir d = doesFileExist $ d </> command
 
 {- Checks if a filename is a unix dotfile. All files inside dotdirs
  - count as dotfiles. -}
@@ -146,5 +146,5 @@ dotfile file
 	| f == ".." = False
 	| f == "" = False
 	| otherwise = "." `isPrefixOf` f || dotfile (takeDirectory file)
-	where
-		f = takeFileName file
+  where
+	f = takeFileName file

Utility/Percentage.hs

@@ -28,11 +28,11 @@ showPercentage :: Int -> Percentage -> String
 showPercentage precision (Percentage p)
 	| precision == 0 || remainder == 0 = go $ show int
 	| otherwise = go $ show int ++ "." ++ strip0s (show remainder)
-	where
-		go v = v ++ "%"
-		int :: Integer
-		(int, frac) = properFraction (fromRational p)
-		remainder = floor (frac * multiplier) :: Integer
-		strip0s = reverse . dropWhile (== '0') . reverse
-		multiplier :: Float
-		multiplier = 10 ** (fromIntegral precision)
+  where
+	go v = v ++ "%"
+	int :: Integer
+	(int, frac) = properFraction (fromRational p)
+	remainder = floor (frac * multiplier) :: Integer
+	strip0s = reverse . dropWhile (== '0') . reverse
+	multiplier :: Float
+	multiplier = 10 ** (fromIntegral precision)

Utility/Process.hs

@@ -59,11 +59,11 @@ readProcessEnv cmd args environ =
 		output  <- hGetContentsStrict h
 		hClose h
 		return output
-	where
-		p = (proc cmd args)
-			{ std_out = CreatePipe
-			, env = environ
-			}
+  where
+	p = (proc cmd args)
+		{ std_out = CreatePipe
+		, env = environ
+		}
 
 {- Writes a string to a process on its stdin, 
  - returns its output, and also allows specifying the environment.
@@ -99,13 +99,13 @@ writeReadProcessEnv cmd args environ input adjusthandle = do
 
 	return output
 
-	where
-		p = (proc cmd args)
-			{ std_in = CreatePipe
-			, std_out = CreatePipe
-			, std_err = Inherit
-			, env = environ
-			}
+  where
+	p = (proc cmd args)
+		{ std_in = CreatePipe
+		, std_out = CreatePipe
+		, std_err = Inherit
+		, env = environ
+		}
 
 {- Waits for a ProcessHandle, and throws an IOError if the process
  - did not exit successfully. -}
@@ -156,19 +156,19 @@ withHandle
 	-> (Handle -> IO a)
 	-> IO a
 withHandle h creator p a = creator p' $ a . select
-	where
-		base = p
-			{ std_in = Inherit
-			, std_out = Inherit
-			, std_err = Inherit
-			}
-		(select, p')
-			| h == StdinHandle  =
-				(stdinHandle, base { std_in = CreatePipe })
-			| h == StdoutHandle =
-				(stdoutHandle, base { std_out = CreatePipe })
-			| h == StderrHandle =
-				(stderrHandle, base { std_err = CreatePipe })
+  where
+	base = p
+		{ std_in = Inherit
+		, std_out = Inherit
+		, std_err = Inherit
+		}
+	(select, p')
+		| h == StdinHandle  =
+			(stdinHandle, base { std_in = CreatePipe })
+		| h == StdoutHandle =
+			(stdoutHandle, base { std_out = CreatePipe })
+		| h == StderrHandle =
+			(stderrHandle, base { std_err = CreatePipe })
 
 {- Like withHandle, but passes (stdin, stdout) handles to the action. -}
 withBothHandles
@@ -177,12 +177,12 @@ withBothHandles
 	-> ((Handle, Handle) -> IO a)
 	-> IO a
 withBothHandles creator p a = creator p' $ a . bothHandles
-	where
-		p' = p
-			{ std_in = CreatePipe
-			, std_out = CreatePipe
-			, std_err = Inherit
-			}
+  where
+	p' = p
+		{ std_in = CreatePipe
+		, std_out = CreatePipe
+		, std_err = Inherit
+		}
 
 {- Forces the CreateProcessRunner to run quietly;
  - both stdout and stderr are discarded. -}
@@ -223,21 +223,21 @@ debugProcess p = do
 		[ action ++ ":"
 		, showCmd p
 		]
-	where
-		action
-			| piped (std_in p) && piped (std_out p) = "chat"
-			| piped (std_in p)                      = "feed"
-			| piped (std_out p)                     = "read"
-			| otherwise                             = "call"
-		piped Inherit = False
-		piped _ = True
+  where
+	action
+		| piped (std_in p) && piped (std_out p) = "chat"
+		| piped (std_in p)                      = "feed"
+		| piped (std_out p)                     = "read"
+		| otherwise                             = "call"
+	piped Inherit = False
+	piped _ = True
 
 {- Shows the command that a CreateProcess will run. -}
 showCmd :: CreateProcess -> String
 showCmd = go . cmdspec
-	where
-		go (ShellCommand s) = s
-		go (RawCommand c ps) = c ++ " " ++ show ps
+  where
+	go (ShellCommand s) = s
+	go (RawCommand c ps) = c ++ " " ++ show ps
 
 {- Wrappers for System.Process functions that do debug logging.
  - 

Utility/Rsync.hs

@@ -15,11 +15,11 @@ import Data.Char
  - shell. -}
 rsyncShell :: [CommandParam] -> [CommandParam]
 rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand command)]
-	where
-		{- rsync requires some weird, non-shell like quoting in
-                 - here. A doubled single quote inside the single quoted
-                 - string is a single quote. -}
-		escape s = "'" ++  join "''" (split "'" s) ++ "'"
+  where
+	{- rsync requires some weird, non-shell like quoting in
+	- here. A doubled single quote inside the single quoted
+	- string is a single quote. -}
+	escape s = "'" ++  join "''" (split "'" s) ++ "'"
 
 {- Runs rsync in server mode to send a file. -}
 rsyncServerSend :: FilePath -> IO Bool
@@ -60,22 +60,22 @@ rsyncProgress callback params = do
 	 - on. Reap the resulting zombie. -}
 	reapZombies
 	return r
-	where
-		p = proc "rsync" (toCommand params)
-		feedprogress prev buf h = do
-			s <- hGetSomeString h 80
-			if null s
-				then return True
-				else do
-					putStr s
-					hFlush stdout
-					let (mbytes, buf') = parseRsyncProgress (buf++s)
-					case mbytes of
-						Nothing -> feedprogress prev buf' h
-						(Just bytes) -> do
-							when (bytes /= prev) $
-								callback bytes
-							feedprogress bytes buf' h
+  where
+	p = proc "rsync" (toCommand params)
+	feedprogress prev buf h = do
+		s <- hGetSomeString h 80
+		if null s
+			then return True
+			else do
+				putStr s
+				hFlush stdout
+				let (mbytes, buf') = parseRsyncProgress (buf++s)
+				case mbytes of
+					Nothing -> feedprogress prev buf' h
+					(Just bytes) -> do
+						when (bytes /= prev) $
+							callback bytes
+						feedprogress bytes buf' h
 
 {- Checks if an rsync url involves the remote shell (ssh or rsh).
  - Use of such urls with rsync requires additional shell
@@ -84,13 +84,13 @@ rsyncUrlIsShell :: String -> Bool
 rsyncUrlIsShell s
 	| "rsync://" `isPrefixOf` s = False
 	| otherwise = go s
-	where
-		-- host::dir is rsync protocol, while host:dir is ssh/rsh
-		go [] = False
-		go (c:cs)
-			| c == '/' = False -- got to directory with no colon
-			| c == ':' = not $ ":" `isPrefixOf` cs
-			| otherwise = go cs
+  where
+	-- host::dir is rsync protocol, while host:dir is ssh/rsh
+	go [] = False
+	go (c:cs)
+		| c == '/' = False -- got to directory with no colon
+		| c == ':' = not $ ":" `isPrefixOf` cs
+		| otherwise = go cs
 
 {- Checks if a rsync url is really just a local path. -}
 rsyncUrlIsPath :: String -> Bool
@@ -113,19 +113,19 @@ rsyncUrlIsPath s
  -}
 parseRsyncProgress :: String -> (Maybe Integer, String)
 parseRsyncProgress = go [] . reverse . progresschunks
-	where
-		go remainder [] = (Nothing, remainder)
-		go remainder (x:xs) = case parsebytes (findbytesstart x) of
-			Nothing -> go (delim:x++remainder) xs
-			Just b -> (Just b, remainder)
+  where
+	go remainder [] = (Nothing, remainder)
+	go remainder (x:xs) = case parsebytes (findbytesstart x) of
+		Nothing -> go (delim:x++remainder) xs
+		Just b -> (Just b, remainder)
 
-		delim = '\r'
-		{- Find chunks that each start with delim.
-		 - The first chunk doesn't start with it
-		 - (it's empty when delim is at the start of the string). -}
-		progresschunks = drop 1 . split [delim]
-		findbytesstart s = dropWhile isSpace s
-		parsebytes s = case break isSpace s of
-			([], _) -> Nothing
-			(_, []) -> Nothing
-			(b, _) -> readish b
+	delim = '\r'
+	{- Find chunks that each start with delim.
+	 - The first chunk doesn't start with it
+	 - (it's empty when delim is at the start of the string). -}
+	progresschunks = drop 1 . split [delim]
+	findbytesstart s = dropWhile isSpace s
+	parsebytes s = case break isSpace s of
+		([], _) -> Nothing
+		(_, []) -> Nothing
+		(b, _) -> readish b

Utility/SRV.hs

@@ -74,11 +74,11 @@ lookupSRV (SRV srv) = do
 	r <- withResolver seed $ flip DNS.lookupSRV $ B8.fromString srv
 	print r
 	return $ maybe [] (orderHosts . map tohosts) r
-	where
-		tohosts (priority, weight, port, hostname) =
-			( (priority, weight)
-			, (B8.toString hostname, PortNumber $ fromIntegral port)
-			)
+  where
+	tohosts (priority, weight, port, hostname) =
+		( (priority, weight)
+		, (B8.toString hostname, PortNumber $ fromIntegral port)
+		)
 #else
 lookupSRV = lookupSRVHost
 #endif
@@ -93,21 +93,21 @@ lookupSRVHost (SRV srv) = catchDefaultIO [] $
 
 parseSrvHost :: String -> [HostPort]
 parseSrvHost = orderHosts . catMaybes . map parse . lines
-	where
-		parse l = case words l of
-			[_, _, _, _, spriority, sweight, sport, hostname] -> do
-				let v = 
-					( readish sport :: Maybe Int
-					, readish spriority :: Maybe Int
-					, readish sweight :: Maybe Int
+  where
+	parse l = case words l of
+		[_, _, _, _, spriority, sweight, sport, hostname] -> do
+			let v = 
+				( readish sport :: Maybe Int
+				, readish spriority :: Maybe Int
+				, readish sweight :: Maybe Int
+				)
+			case v of
+				(Just port, Just priority, Just weight) -> Just
+					( (priority, weight)
+					, (hostname, PortNumber $ fromIntegral port)
 					)
-				case v of
-					(Just port, Just priority, Just weight) -> Just
-						( (priority, weight)
-						, (hostname, PortNumber $ fromIntegral port)
-						)
-					_ -> Nothing
-			_ -> Nothing
+				_ -> Nothing
+		_ -> Nothing
 
 orderHosts :: [(PriorityWeight, HostPort)] -> [HostPort]
 orderHosts = map snd . sortBy (compare `on` fst)

Utility/SafeCommand.hs

@@ -25,13 +25,13 @@ data CommandParam = Params String | Param String | File FilePath
  - a command and expects Strings. -}
 toCommand :: [CommandParam] -> [String]
 toCommand = (>>= unwrap)
-	where
-		unwrap (Param s) = [s]
-		unwrap (Params s) = filter (not . null) (split " " s)
-		-- Files that start with a dash are modified to avoid
-		-- the command interpreting them as options.
-		unwrap (File s@('-':_)) = ["./" ++ s]
-		unwrap (File s) = [s]
+  where
+	unwrap (Param s) = [s]
+	unwrap (Params s) = filter (not . null) (split " " s)
+	-- Files that start with a dash are modified to avoid
+	-- the command interpreting them as options.
+	unwrap (File s@('-':_)) = ["./" ++ s]
+	unwrap (File s) = [s]
 
 {- Run a system command, and returns True or False
  - if it succeeded or failed.
@@ -41,9 +41,9 @@ boolSystem command params = boolSystemEnv command params Nothing
 
 boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
 boolSystemEnv command params environ = dispatch <$> safeSystemEnv command params environ
-	where
-		dispatch ExitSuccess = True
-		dispatch _ = False
+  where
+	dispatch ExitSuccess = True
+	dispatch _ = False
 
 {- Runs a system command, returning the exit status. -}
 safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
@@ -59,26 +59,26 @@ safeSystemEnv command params environ = do
  - the shell. -}
 shellEscape :: String -> String
 shellEscape f = "'" ++ escaped ++ "'"
-	where
-		-- replace ' with '"'"'
-		escaped = join "'\"'\"'" $ split "'" f
+  where
+	-- replace ' with '"'"'
+	escaped = join "'\"'\"'" $ split "'" f
 
 {- Unescapes a set of shellEscaped words or filenames. -}
 shellUnEscape :: String -> [String]
 shellUnEscape [] = []
 shellUnEscape s = word : shellUnEscape rest
-	where
-		(word, rest) = findword "" s
-		findword w [] = (w, "")
-		findword w (c:cs)
-			| c == ' ' = (w, cs)
-			| c == '\'' = inquote c w cs
-			| c == '"' = inquote c w cs
-			| otherwise = findword (w++[c]) cs
-		inquote _ w [] = (w, "")
-		inquote q w (c:cs)
-			| c == q = findword w cs
-			| otherwise = inquote q (w++[c]) cs
+  where
+	(word, rest) = findword "" s
+	findword w [] = (w, "")
+	findword w (c:cs)
+		| c == ' ' = (w, cs)
+		| c == '\'' = inquote c w cs
+		| c == '"' = inquote c w cs
+		| otherwise = findword (w++[c]) cs
+	inquote _ w [] = (w, "")
+	inquote q w (c:cs)
+		| c == q = findword w cs
+		| otherwise = inquote q (w++[c]) cs
 
 {- For quickcheck. -}
 prop_idempotent_shellEscape :: String -> Bool

Utility/TSet.hs

@@ -23,12 +23,12 @@ getTSet :: TSet a -> IO [a]
 getTSet tset = runTSet $ do
 	c <- readTChan tset
 	go [c]
-	where
-		go l = do
-			v <- tryReadTChan tset
-			case v of
-				Nothing -> return l
-				Just c -> go (c:l)
+  where
+	go l = do
+		v <- tryReadTChan tset
+		case v of
+			Nothing -> return l
+			Just c -> go (c:l)
 
 {- Puts items into a TSet. -}
 putTSet :: TSet a -> [a] -> IO ()

Utility/Tense.hs

@@ -32,11 +32,11 @@ instance IsString TenseText where
 
 renderTense :: Tense -> TenseText -> Text
 renderTense tense (TenseText chunks) = T.concat $ map render chunks
-	where
-		render (Tensed present past)
-			| tense == Present = present
-			| otherwise = past
-		render (UnTensed s) = s
+  where
+	render (Tensed present past)
+		| tense == Present = present
+		| otherwise = past
+	render (UnTensed s) = s
 
 {- Builds up a TenseText, separating chunks with spaces.
  -
@@ -45,13 +45,13 @@ renderTense tense (TenseText chunks) = T.concat $ map render chunks
  -}
 tenseWords :: [TenseChunk] -> TenseText
 tenseWords = TenseText . go []
-	where
-		go c [] = reverse c
-		go c (w:[]) = reverse (w:c)
-		go c ((UnTensed w):ws) = go (UnTensed (addspace w) : c) ws
-		go c ((Tensed w1 w2):ws) =
-			go (Tensed (addspace w1) (addspace w2) : c) ws
-		addspace w = T.append w " "
+  where
+	go c [] = reverse c
+	go c (w:[]) = reverse (w:c)
+	go c ((UnTensed w):ws) = go (UnTensed (addspace w) : c) ws
+	go c ((Tensed w1 w2):ws) =
+		go (Tensed (addspace w1) (addspace w2) : c) ws
+	addspace w = T.append w " "
 
 unTensed :: Text -> TenseText
 unTensed t = TenseText [UnTensed t]

Utility/ThreadScheduler.hs

@@ -26,8 +26,8 @@ runEvery n a = forever $ do
 
 threadDelaySeconds :: Seconds -> IO ()
 threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond)
-	where
-		oneSecond = 1000000 -- microseconds
+  where
+	oneSecond = 1000000 -- microseconds
 
 {- Like threadDelay, but not bounded by an Int.
  -
@@ -52,6 +52,6 @@ waitForTermination = do
 	whenM (queryTerminal stdInput) $
 		check keyboardSignal lock
 	takeMVar lock
-	where
-		check sig lock = void $
-			installHandler sig (CatchOnce $ putMVar lock ()) Nothing
+  where
+	check sig lock = void $
+		installHandler sig (CatchOnce $ putMVar lock ()) Nothing

Utility/Touch.hsc

@@ -48,9 +48,9 @@ at_symlink_nofollow = #const AT_SYMLINK_NOFOLLOW
 instance Storable TimeSpec where
 	-- use the larger alignment of the two types in the struct
 	alignment _ = max sec_alignment nsec_alignment
-		where
-			sec_alignment = alignment (undefined::CTime)
-			nsec_alignment = alignment (undefined::CLong)
+	  where
+		sec_alignment = alignment (undefined::CTime)
+		nsec_alignment = alignment (undefined::CLong)
 	sizeOf _ = #{size struct timespec}
 	peek ptr = do
 		sec <- #{peek struct timespec, tv_sec} ptr
@@ -70,10 +70,10 @@ touchBoth file atime mtime follow =
 		pokeArray ptr [atime, mtime]
 		r <- c_utimensat at_fdcwd f ptr flags
 		when (r /= 0) $ throwErrno "touchBoth"
-	where
-		flags = if follow
-			then 0
-			else at_symlink_nofollow 
+  where
+	flags
+       		| follow = 0
+		| otherwise = at_symlink_nofollow 
 
 #else
 #if 0
@@ -108,10 +108,10 @@ touchBoth file atime mtime follow =
 		r <- syscall f ptr
 		when (r /= 0) $
 			throwErrno "touchBoth"
-	where
-		syscall = if follow
-			then c_lutimes
-			else c_utimes
+  where
+	syscall
+       		| follow = c_lutimes
+		| otherwise = c_utimes
 
 #else
 #warning "utimensat and lutimes not available; building without symlink timestamp preservation support"

Utility/Url.hs

@@ -29,10 +29,10 @@ type Headers = [String]
  - also checking that its size, if available, matches a specified size. -}
 check :: URLString -> Headers -> Maybe Integer -> IO Bool
 check url headers expected_size = handle <$> exists url headers
-	where
-		handle (False, _) = False
-		handle (True, Nothing) = True
-		handle (True, s) = expected_size == s
+  where
+	handle (False, _) = False
+	handle (True, Nothing) = True
+	handle (True, s) = expected_size == s
 
 {- Checks that an url exists and could be successfully downloaded,
  - also returning its size if available. -}
@@ -50,8 +50,8 @@ exists url headers = case parseURI url of
 			case rspCode r of
 				(2,_,_) -> return (True, size r)
 				_ -> return (False, Nothing)
-	where
-		size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders
+  where
+	size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders
 
 {- Used to download large files, such as the contents of keys.
  -
@@ -66,17 +66,17 @@ download :: URLString -> Headers -> [CommandParam] -> FilePath -> IO Bool
 download url headers options file
 	| "file://" `isPrefixOf` url = curl
 	| otherwise = ifM (inPath "wget") (wget , curl)
-	where
-		headerparams = map (\h -> Param $ "--header=" ++ h) headers
-		wget = go "wget" $ headerparams ++ [Params "-c -O"]
-		{- Uses the -# progress display, because the normal
-		 - one is very confusing when resuming, showing
-		 - the remainder to download as the whole file,
-		 - and not indicating how much percent was
-		 - downloaded before the resume. -}
-		curl = go "curl" $ headerparams ++ [Params "-L -C - -# -o"]
-		go cmd opts = boolSystem cmd $
-			options++opts++[File file, File url]
+  where
+	headerparams = map (\h -> Param $ "--header=" ++ h) headers
+	wget = go "wget" $ headerparams ++ [Params "-c -O"]
+	{- Uses the -# progress display, because the normal
+	 - one is very confusing when resuming, showing
+	 - the remainder to download as the whole file,
+	 - and not indicating how much percent was
+	 - downloaded before the resume. -}
+	curl = go "curl" $ headerparams ++ [Params "-L -C - -# -o"]
+	go cmd opts = boolSystem cmd $
+		options++opts++[File file, File url]
 
 {- Downloads a small file. -}
 get :: URLString -> Headers -> IO String
@@ -98,36 +98,36 @@ get url headers =
  -}
 request :: URI -> Headers -> RequestMethod -> IO (Response String)
 request url headers requesttype = go 5 url
-	where
-		go :: Int -> URI -> IO (Response String)
-		go 0 _ = error "Too many redirects "
-		go n u = do
-			rsp <- Browser.browse $ do
-				Browser.setErrHandler ignore
-				Browser.setOutHandler ignore
-				Browser.setAllowRedirects False
-				let req = mkRequest requesttype u :: Request_String
-				snd <$> Browser.request (addheaders req)
-			case rspCode rsp of
-				(3,0,x) | x /= 5 -> redir (n - 1) u rsp
-				_ -> return rsp
-		ignore = const noop
-		redir n u rsp = case retrieveHeaders HdrLocation rsp of
-			[] -> return rsp
-			(Header _ newu:_) ->
-				case parseURIReference newu of
-					Nothing -> return rsp
-					Just newURI -> go n newURI_abs
-						where
+  where
+	go :: Int -> URI -> IO (Response String)
+	go 0 _ = error "Too many redirects "
+	go n u = do
+		rsp <- Browser.browse $ do
+			Browser.setErrHandler ignore
+			Browser.setOutHandler ignore
+			Browser.setAllowRedirects False
+			let req = mkRequest requesttype u :: Request_String
+			snd <$> Browser.request (addheaders req)
+		case rspCode rsp of
+			(3,0,x) | x /= 5 -> redir (n - 1) u rsp
+			_ -> return rsp
+	ignore = const noop
+	redir n u rsp = case retrieveHeaders HdrLocation rsp of
+		[] -> return rsp
+		(Header _ newu:_) ->
+			case parseURIReference newu of
+				Nothing -> return rsp
+				Just newURI -> go n newURI_abs
+				  where
 #if defined VERSION_network
 #if ! MIN_VERSION_network(2,4,0)
 #define WITH_OLD_URI
 #endif
 #endif
 #ifdef WITH_OLD_URI
-							newURI_abs = fromMaybe newURI (newURI `relativeTo` u)
+					newURI_abs = fromMaybe newURI (newURI `relativeTo` u)
 #else
-							newURI_abs = newURI `relativeTo` u
+					newURI_abs = newURI `relativeTo` u
 #endif
-		addheaders req = setHeaders req (rqHeaders req ++ userheaders)
-		userheaders = rights $ map parseHeader headers
+	addheaders req = setHeaders req (rqHeaders req ++ userheaders)
+	userheaders = rights $ map parseHeader headers

Utility/UserInfo.hs

@@ -26,7 +26,7 @@ myUserName = myVal ["USER", "LOGNAME"] userName
 
 myVal :: [String] -> (UserEntry -> String) -> IO String
 myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars
-	where
-		check [] = return Nothing
-		check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v
-		getpwent = getUserEntryForID =<< getEffectiveUserID
+  where
+	check [] = return Nothing
+	check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v
+	getpwent = getUserEntryForID =<< getEffectiveUserID

Utility/Verifiable.hs

@@ -33,5 +33,5 @@ calcDigest v secret = showDigest $ hmacSha1 secret $ fromString v
 {- for quickcheck -}
 prop_verifiable_sane :: String -> String -> Bool
 prop_verifiable_sane a s = verify (mkVerifiable a secret) secret
-	where
-		secret = fromString s
+  where
+	secret = fromString s

Utility/WebApp.hs

@@ -43,11 +43,11 @@ localhost = "localhost"
  - Note: The url *will* be visible to an attacker. -}
 runBrowser :: String -> (Maybe [(String, String)]) -> IO Bool
 runBrowser url env = boolSystemEnv cmd [Param url] env
-	where
+  where
 #ifdef darwin_HOST_OS
-		cmd = "open"
+	cmd = "open"
 #else
-		cmd = "xdg-open"
+	cmd = "xdg-open"
 #endif
 
 {- Binds to a socket on localhost, and runs a webapp on it.
@@ -75,25 +75,25 @@ localSocket = do
 		(v4addr:_, _) -> go v4addr
 		(_, v6addr:_) -> go v6addr
 		_ -> error "unable to bind to a local socket"
-	where
-		hints = defaultHints
-			{ addrFlags = [AI_ADDRCONFIG]
-			, addrSocketType = Stream
-			}
-		{- Repeated attempts because bind sometimes fails for an
-		 - unknown reason on OSX. -} 
-		go addr = go' 100 addr
-		go' :: Int -> AddrInfo -> IO Socket
-		go' 0 _ = error "unable to bind to local socket"
-		go' n addr = do
-			r <- tryIO $ bracketOnError (open addr) sClose (use addr)
-			either (const $ go' (pred n) addr) return r
-		open addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
-		use addr sock = do
-			setSocketOption sock ReuseAddr 1
-			bindSocket sock (addrAddress addr)
-			listen sock maxListenQueue
-			return sock
+  where
+	hints = defaultHints
+		{ addrFlags = [AI_ADDRCONFIG]
+		, addrSocketType = Stream
+		}
+	{- Repeated attempts because bind sometimes fails for an
+	 - unknown reason on OSX. -} 
+	go addr = go' 100 addr
+	go' :: Int -> AddrInfo -> IO Socket
+	go' 0 _ = error "unable to bind to local socket"
+	go' n addr = do
+		r <- tryIO $ bracketOnError (open addr) sClose (use addr)
+		either (const $ go' (pred n) addr) return r
+	open addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+	use addr sock = do
+		setSocketOption sock ReuseAddr 1
+		bindSocket sock (addrAddress addr)
+		listen sock maxListenQueue
+		return sock
 
 {- Checks if debugging is actually enabled. -}
 debugEnabled :: IO Bool
@@ -121,8 +121,8 @@ logRequest req = do
 		--, frombs $ lookupRequestField "referer" req
 		, frombs $ lookupRequestField "user-agent" req
 		]
-	where
-		frombs v = toString $ L.fromChunks [v]
+  where
+	frombs v = toString $ L.fromChunks [v]
 
 lookupRequestField :: CI.CI B.ByteString -> Wai.Request -> B.ByteString
 lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
@@ -179,12 +179,12 @@ insertAuthToken :: forall y. (y -> T.Text)
 	-> Builder
 insertAuthToken extractToken predicate webapp root pathbits params =
 	fromText root `mappend` encodePath pathbits' encodedparams
-	where
-		pathbits' = if null pathbits then [T.empty] else pathbits
-		encodedparams = map (TE.encodeUtf8 *** go) params'
-		go "" = Nothing
-		go x = Just $ TE.encodeUtf8 x
-		authparam = (T.pack "auth", extractToken webapp)
-		params'
-			| predicate pathbits = authparam:params
-			| otherwise = params
+  where
+	pathbits' = if null pathbits then [T.empty] else pathbits
+	encodedparams = map (TE.encodeUtf8 *** go) params'
+	go "" = Nothing
+	go x = Just $ TE.encodeUtf8 x
+	authparam = (T.pack "auth", extractToken webapp)
+	params'
+		| predicate pathbits = authparam:params
+		| otherwise = params