summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/Data.hs2
-rw-r--r--src/Utility/Directory.hs2
-rw-r--r--src/Utility/Env.hs2
-rw-r--r--src/Utility/Exception.hs1
-rw-r--r--src/Utility/FileMode.hs13
-rw-r--r--src/Utility/FileSystemEncoding.hs1
-rw-r--r--src/Utility/LinuxMkLibs.hs15
-rw-r--r--src/Utility/Misc.hs10
-rw-r--r--src/Utility/Monad.hs2
-rw-r--r--src/Utility/PartialPrelude.hs2
-rw-r--r--src/Utility/Path.hs2
-rw-r--r--src/Utility/PosixFiles.hs1
-rw-r--r--src/Utility/Process.hs82
-rw-r--r--src/Utility/QuickCheck.hs1
-rw-r--r--src/Utility/SafeCommand.hs64
-rw-r--r--src/Utility/Scheduled.hs3
-rw-r--r--src/Utility/Tmp.hs1
-rw-r--r--src/Utility/UserInfo.hs6
18 files changed, 112 insertions, 98 deletions
diff --git a/src/Utility/Data.hs b/src/Utility/Data.hs
index 5ecd218f..27c0a824 100644
--- a/src/Utility/Data.hs
+++ b/src/Utility/Data.hs
@@ -5,6 +5,8 @@
- License: BSD-2-clause
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.Data where
{- First item in the list that is not Nothing. -}
diff --git a/src/Utility/Directory.hs b/src/Utility/Directory.hs
index 2e037fdd..7322cd85 100644
--- a/src/Utility/Directory.hs
+++ b/src/Utility/Directory.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Directory where
@@ -18,6 +19,7 @@ import Control.Applicative
import Control.Concurrent
import System.IO.Unsafe (unsafeInterleaveIO)
import Data.Maybe
+import Prelude
#ifdef mingw32_HOST_OS
import qualified System.Win32 as Win32
diff --git a/src/Utility/Env.hs b/src/Utility/Env.hs
index fdf06d80..c56f4ec2 100644
--- a/src/Utility/Env.hs
+++ b/src/Utility/Env.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Env where
@@ -13,6 +14,7 @@ module Utility.Env where
import Utility.Exception
import Control.Applicative
import Data.Maybe
+import Prelude
import qualified System.Environment as E
import qualified System.SetEnv
#else
diff --git a/src/Utility/Exception.hs b/src/Utility/Exception.hs
index ab47ae95..9d4236c4 100644
--- a/src/Utility/Exception.hs
+++ b/src/Utility/Exception.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Exception (
module X,
diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs
index 201b8451..fdf1b56b 100644
--- a/src/Utility/FileMode.hs
+++ b/src/Utility/FileMode.hs
@@ -22,15 +22,12 @@ import Utility.Exception
{- Applies a conversion function to a file's mode. -}
modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO ()
-modifyFileMode f convert = void $ modifyFileMode' f convert
-modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode
-modifyFileMode' f convert = do
+modifyFileMode f convert = do
s <- getFileStatus f
let old = fileMode s
let new = convert old
when (new /= old) $
setFileMode f new
- return old
{- Adds the specified FileModes to the input mode, leaving the rest
- unchanged. -}
@@ -41,14 +38,6 @@ addModes ms m = combineModes (m:ms)
removeModes :: [FileMode] -> FileMode -> FileMode
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
-
writeModes :: [FileMode]
writeModes = [ownerWriteMode, groupWriteMode, otherWriteMode]
diff --git a/src/Utility/FileSystemEncoding.hs b/src/Utility/FileSystemEncoding.hs
index 139b74fe..41c5972a 100644
--- a/src/Utility/FileSystemEncoding.hs
+++ b/src/Utility/FileSystemEncoding.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.FileSystemEncoding (
fileEncoding,
diff --git a/src/Utility/LinuxMkLibs.hs b/src/Utility/LinuxMkLibs.hs
index db64d123..fdeb7795 100644
--- a/src/Utility/LinuxMkLibs.hs
+++ b/src/Utility/LinuxMkLibs.hs
@@ -7,7 +7,12 @@
module Utility.LinuxMkLibs where
-import Control.Applicative
+import Utility.PartialPrelude
+import Utility.Directory
+import Utility.Process
+import Utility.Monad
+import Utility.Path
+
import Data.Maybe
import System.Directory
import System.FilePath
@@ -15,12 +20,8 @@ import Data.List.Utils
import System.Posix.Files
import Data.Char
import Control.Monad.IfElse
-
-import Utility.PartialPrelude
-import Utility.Directory
-import Utility.Process
-import Utility.Monad
-import Utility.Path
+import Control.Applicative
+import Prelude
{- Installs a library. If the library is a symlink to another file,
- install the file it links to, and update the symlink to be relative. -}
diff --git a/src/Utility/Misc.hs b/src/Utility/Misc.hs
index e4eccac4..45d5a063 100644
--- a/src/Utility/Misc.hs
+++ b/src/Utility/Misc.hs
@@ -6,23 +6,25 @@
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Misc where
+import Utility.FileSystemEncoding
+import Utility.Monad
+
import System.IO
import Control.Monad
import Foreign
import Data.Char
import Data.List
-import Control.Applicative
import System.Exit
#ifndef mingw32_HOST_OS
import System.Posix.Process (getAnyProcessStatus)
import Utility.Exception
#endif
-
-import Utility.FileSystemEncoding
-import Utility.Monad
+import Control.Applicative
+import Prelude
{- A version of hgetContents that is not lazy. Ensures file is
- all read before it gets closed. -}
diff --git a/src/Utility/Monad.hs b/src/Utility/Monad.hs
index 878e0da6..ac751043 100644
--- a/src/Utility/Monad.hs
+++ b/src/Utility/Monad.hs
@@ -5,6 +5,8 @@
- License: BSD-2-clause
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.Monad where
import Data.Maybe
diff --git a/src/Utility/PartialPrelude.hs b/src/Utility/PartialPrelude.hs
index 6efa093f..55795563 100644
--- a/src/Utility/PartialPrelude.hs
+++ b/src/Utility/PartialPrelude.hs
@@ -5,6 +5,8 @@
- them being accidentially used.
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.PartialPrelude where
import qualified Data.Maybe
diff --git a/src/Utility/Path.hs b/src/Utility/Path.hs
index 9f0737fe..8e3c2bdd 100644
--- a/src/Utility/Path.hs
+++ b/src/Utility/Path.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE PackageImports, CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Path where
@@ -16,6 +17,7 @@ import Data.List
import Data.Maybe
import Data.Char
import Control.Applicative
+import Prelude
#ifdef mingw32_HOST_OS
import qualified System.FilePath.Posix as Posix
diff --git a/src/Utility/PosixFiles.hs b/src/Utility/PosixFiles.hs
index 5a94ead0..4550bebd 100644
--- a/src/Utility/PosixFiles.hs
+++ b/src/Utility/PosixFiles.hs
@@ -8,6 +8,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.PosixFiles (
module X,
diff --git a/src/Utility/Process.hs b/src/Utility/Process.hs
index cbbe8a81..469f7659 100644
--- a/src/Utility/Process.hs
+++ b/src/Utility/Process.hs
@@ -1,12 +1,13 @@
{- System.Process enhancements, including additional ways of running
- processes, and logging.
-
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
{-# LANGUAGE CPP, Rank2Types #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Process (
module X,
@@ -54,6 +55,7 @@ import qualified System.Posix.IO
import Control.Applicative
#endif
import Data.Maybe
+import Prelude
import Utility.Misc
import Utility.Exception
@@ -63,8 +65,8 @@ type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Hand
data StdHandle = StdinHandle | StdoutHandle | StderrHandle
deriving (Eq)
-{- Normally, when reading from a process, it does not need to be fed any
- - standard input. -}
+-- | Normally, when reading from a process, it does not need to be fed any
+-- standard input.
readProcess :: FilePath -> [String] -> IO String
readProcess cmd args = readProcessEnv cmd args Nothing
@@ -82,9 +84,8 @@ readProcess' p = withHandle StdoutHandle createProcessSuccess p $ \h -> do
hClose h
return output
-{- Runs an action to write to a process on its stdin,
- - returns its output, and also allows specifying the environment.
- -}
+-- | Runs an action to write to a process on its stdin,
+-- returns its output, and also allows specifying the environment.
writeReadProcessEnv
:: FilePath
-> [String]
@@ -124,8 +125,8 @@ writeReadProcessEnv cmd args environ writestdin adjusthandle = do
, env = environ
}
-{- Waits for a ProcessHandle, and throws an IOError if the process
- - did not exit successfully. -}
+-- | Waits for a ProcessHandle, and throws an IOError if the process
+-- did not exit successfully.
forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()
forceSuccessProcess p pid = do
code <- waitForProcess pid
@@ -133,10 +134,10 @@ forceSuccessProcess p pid = do
ExitSuccess -> return ()
ExitFailure n -> fail $ showCmd p ++ " exited " ++ show n
-{- Waits for a ProcessHandle and returns True if it exited successfully.
- - Note that using this with createProcessChecked will throw away
- - the Bool, and is only useful to ignore the exit code of a process,
- - while still waiting for it. -}
+-- | Waits for a ProcessHandle and returns True if it exited successfully.
+-- Note that using this with createProcessChecked will throw away
+-- the Bool, and is only useful to ignore the exit code of a process,
+-- while still waiting for it. -}
checkSuccessProcess :: ProcessHandle -> IO Bool
checkSuccessProcess pid = do
code <- waitForProcess pid
@@ -147,13 +148,13 @@ ignoreFailureProcess pid = do
void $ waitForProcess pid
return True
-{- Runs createProcess, then an action on its handles, and then
- - forceSuccessProcess. -}
+-- | Runs createProcess, then an action on its handles, and then
+-- forceSuccessProcess.
createProcessSuccess :: CreateProcessRunner
createProcessSuccess p a = createProcessChecked (forceSuccessProcess p) p a
-{- Runs createProcess, then an action on its handles, and then
- - a checker action on its exit code, which must wait for the process. -}
+-- | Runs createProcess, then an action on its handles, and then
+-- a checker action on its exit code, which must wait for the process.
createProcessChecked :: (ProcessHandle -> IO b) -> CreateProcessRunner
createProcessChecked checker p a = do
t@(_, _, _, pid) <- createProcess p
@@ -161,14 +162,14 @@ createProcessChecked checker p a = do
_ <- checker pid
either E.throw return r
-{- Leaves the process running, suitable for lazy streaming.
- - Note: Zombies will result, and must be waited on. -}
+-- | Leaves the process running, suitable for lazy streaming.
+-- Note: Zombies will result, and must be waited on.
createBackgroundProcess :: CreateProcessRunner
createBackgroundProcess p a = a =<< createProcess p
-{- Runs a process, optionally feeding it some input, and
- - returns a transcript combining its stdout and stderr, and
- - whether it succeeded or failed. -}
+-- | Runs a process, optionally feeding it some input, and
+-- 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
@@ -232,9 +233,9 @@ processTranscript' cmd opts environ input = do
hClose inh
writeinput Nothing _ = return ()
-{- Runs a CreateProcessRunner, on a CreateProcess structure, that
- - is adjusted to pipe only from/to a single StdHandle, and passes
- - the resulting Handle to an action. -}
+-- | Runs a CreateProcessRunner, on a CreateProcess structure, that
+-- is adjusted to pipe only from/to a single StdHandle, and passes
+-- the resulting Handle to an action.
withHandle
:: StdHandle
-> CreateProcessRunner
@@ -256,7 +257,7 @@ withHandle h creator p a = creator p' $ a . select
| h == StderrHandle =
(stderrHandle, base { std_err = CreatePipe })
-{- Like withHandle, but passes (stdin, stdout) handles to the action. -}
+-- | Like withHandle, but passes (stdin, stdout) handles to the action.
withIOHandles
:: CreateProcessRunner
-> CreateProcess
@@ -270,7 +271,7 @@ withIOHandles creator p a = creator p' $ a . ioHandles
, std_err = Inherit
}
-{- Like withHandle, but passes (stdout, stderr) handles to the action. -}
+-- | Like withHandle, but passes (stdout, stderr) handles to the action.
withOEHandles
:: CreateProcessRunner
-> CreateProcess
@@ -284,8 +285,8 @@ withOEHandles creator p a = creator p' $ a . oeHandles
, std_err = CreatePipe
}
-{- Forces the CreateProcessRunner to run quietly;
- - both stdout and stderr are discarded. -}
+-- | Forces the CreateProcessRunner to run quietly;
+-- both stdout and stderr are discarded.
withQuietOutput
:: CreateProcessRunner
-> CreateProcess
@@ -297,8 +298,8 @@ withQuietOutput creator p = withFile devNull WriteMode $ \nullh -> do
}
creator p' $ const $ return ()
-{- Stdout and stderr are discarded, while the process is fed stdin
- - from the handle. -}
+-- | Stdout and stderr are discarded, while the process is fed stdin
+-- from the handle.
feedWithQuietOutput
:: CreateProcessRunner
-> CreateProcess
@@ -319,11 +320,11 @@ devNull = "/dev/null"
devNull = "NUL"
#endif
-{- Extract a desired handle from createProcess's tuple.
- - These partial functions are safe as long as createProcess is run
- - with appropriate parameters to set up the desired handle.
- - Get it wrong and the runtime crash will always happen, so should be
- - easily noticed. -}
+-- | Extract a desired handle from createProcess's tuple.
+-- These partial functions are safe as long as createProcess is run
+-- with appropriate parameters to set up the desired handle.
+-- Get it wrong and the runtime crash will always happen, so should be
+-- easily noticed.
type HandleExtractor = (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> Handle
stdinHandle :: HandleExtractor
stdinHandle (Just h, _, _, _) = h
@@ -344,7 +345,7 @@ oeHandles _ = error "expected oeHandles"
processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle
processHandle (_, _, _, pid) = pid
-{- Debugging trace for a CreateProcess. -}
+-- | Debugging trace for a CreateProcess.
debugProcess :: CreateProcess -> IO ()
debugProcess p = do
debugM "Utility.Process" $ unwords
@@ -360,15 +361,15 @@ debugProcess p = do
piped Inherit = False
piped _ = True
-{- Shows the command that a CreateProcess will run. -}
+-- | 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
-{- Starts an interactive process. Unlike runInteractiveProcess in
- - System.Process, stderr is inherited. -}
+-- | Starts an interactive process. Unlike runInteractiveProcess in
+-- System.Process, stderr is inherited.
startInteractiveProcess
:: FilePath
-> [String]
@@ -384,7 +385,8 @@ startInteractiveProcess cmd args environ = do
(Just from, Just to, _, pid) <- createProcess p
return (pid, to, from)
-{- Wrapper around System.Process function that does debug logging. -}
+-- | Wrapper around 'System.Process.createProcess' from System.Process,
+-- that does debug logging.
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess p = do
debugProcess p
diff --git a/src/Utility/QuickCheck.hs b/src/Utility/QuickCheck.hs
index 54200d3f..cd408ddc 100644
--- a/src/Utility/QuickCheck.hs
+++ b/src/Utility/QuickCheck.hs
@@ -19,6 +19,7 @@ import System.Posix.Types
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Applicative
+import Prelude
instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where
arbitrary = M.fromList <$> arbitrary
diff --git a/src/Utility/SafeCommand.hs b/src/Utility/SafeCommand.hs
index 9eaa5308..9102b726 100644
--- a/src/Utility/SafeCommand.hs
+++ b/src/Utility/SafeCommand.hs
@@ -5,44 +5,45 @@
- License: BSD-2-clause
-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
module Utility.SafeCommand where
import System.Exit
import Utility.Process
import Data.String.Utils
-import Control.Applicative
import System.FilePath
import Data.Char
+import Control.Applicative
+import Prelude
-{- A type for parameters passed to a shell command. A command can
- - be passed either some Params (multiple parameters can be included,
- - whitespace-separated, or a single Param (for when parameters contain
- - whitespace), or a File.
- -}
-data CommandParam = Params String | Param String | File FilePath
+-- | Parameters that can be passed to a shell command.
+data CommandParam
+ = Param String -- ^ A parameter
+ | File FilePath -- ^ The name of a file
deriving (Eq, Show, Ord)
-{- Used to pass a list of CommandParams to a function that runs
- - a command and expects Strings. -}
+-- | Used to pass a list of CommandParams to a function that runs
+-- a command and expects Strings. -}
toCommand :: [CommandParam] -> [String]
-toCommand = concatMap unwrap
+toCommand = map unwrap
where
- unwrap (Param s) = [s]
- unwrap (Params s) = filter (not . null) (split " " s)
+ unwrap (Param s) = s
-- Files that start with a non-alphanumeric that is not a path
-- separator are modified to avoid the command interpreting them as
-- options or other special constructs.
unwrap (File s@(h:_))
- | isAlphaNum h || h `elem` pathseps = [s]
- | otherwise = ["./" ++ s]
- unwrap (File s) = [s]
+ | isAlphaNum h || h `elem` pathseps = s
+ | otherwise = "./" ++ s
+ unwrap (File s) = s
-- '/' is explicitly included because it's an alternative
-- path separator on Windows.
pathseps = pathSeparator:"./"
-{- Run a system command, and returns True or False
- - if it succeeded or failed.
- -}
+-- | Run a system command, and returns True or False if it succeeded or failed.
+--
+-- This and other command running functions in this module log the commands
+-- run at debug level, using System.Log.Logger.
boolSystem :: FilePath -> [CommandParam] -> IO Bool
boolSystem command params = boolSystem' command params id
@@ -56,7 +57,7 @@ boolSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bo
boolSystemEnv command params environ = boolSystem' command params $
\p -> p { env = environ }
-{- Runs a system command, returning the exit status. -}
+-- | Runs a system command, returning the exit status.
safeSystem :: FilePath -> [CommandParam] -> IO ExitCode
safeSystem command params = safeSystem' command params id
@@ -71,23 +72,22 @@ safeSystemEnv :: FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Ex
safeSystemEnv command params environ = safeSystem' command params $
\p -> p { env = environ }
-{- Wraps a shell command line inside sh -c, allowing it to be run in a
- - login shell that may not support POSIX shell, eg csh. -}
+-- | Wraps a shell command line inside sh -c, allowing it to be run in a
+-- login shell that may not support POSIX shell, eg csh.
shellWrap :: String -> String
shellWrap cmdline = "sh -c " ++ shellEscape cmdline
-{- Escapes a filename or other parameter to be safely able to be exposed to
- - the shell.
- -
- - This method works for POSIX shells, as well as other shells like csh.
- -}
+-- | Escapes a filename or other parameter to be safely able to be exposed to
+-- the shell.
+--
+-- This method works for POSIX shells, as well as other shells like csh.
shellEscape :: String -> String
shellEscape f = "'" ++ escaped ++ "'"
where
-- replace ' with '"'"'
escaped = join "'\"'\"'" $ split "'" f
-{- Unescapes a set of shellEscaped words or filenames. -}
+-- | Unescapes a set of shellEscaped words or filenames.
shellUnEscape :: String -> [String]
shellUnEscape [] = []
shellUnEscape s = word : shellUnEscape rest
@@ -104,19 +104,19 @@ shellUnEscape s = word : shellUnEscape rest
| c == q = findword w cs
| otherwise = inquote q (w++[c]) cs
-{- For quickcheck. -}
+-- | For quickcheck.
prop_idempotent_shellEscape :: String -> Bool
prop_idempotent_shellEscape s = [s] == (shellUnEscape . shellEscape) s
prop_idempotent_shellEscape_multiword :: [String] -> Bool
prop_idempotent_shellEscape_multiword s = s == (shellUnEscape . unwords . map shellEscape) s
-{- Segments a list of filenames into groups that are all below the maximum
- - command-line length limit. -}
+-- | Segments a list of filenames into groups that are all below the maximum
+-- command-line length limit.
segmentXargsOrdered :: [FilePath] -> [[FilePath]]
segmentXargsOrdered = reverse . map reverse . segmentXargsUnordered
-{- Not preserving data is a little faster, and streams better when
- - there are a great many filesnames. -}
+-- | Not preserving order is a little faster, and streams better when
+-- there are a great many filenames.
segmentXargsUnordered :: [FilePath] -> [[FilePath]]
segmentXargsUnordered l = go l [] 0 []
where
diff --git a/src/Utility/Scheduled.hs b/src/Utility/Scheduled.hs
index e077a1fe..b3813323 100644
--- a/src/Utility/Scheduled.hs
+++ b/src/Utility/Scheduled.hs
@@ -32,7 +32,6 @@ import Utility.QuickCheck
import Utility.PartialPrelude
import Utility.Misc
-import Control.Applicative
import Data.List
import Data.Time.Clock
import Data.Time.LocalTime
@@ -41,6 +40,8 @@ import Data.Time.Calendar.WeekDate
import Data.Time.Calendar.OrdinalDate
import Data.Tuple.Utils
import Data.Char
+import Control.Applicative
+import Prelude
{- Some sort of scheduled event. -}
data Schedule = Schedule Recurrance ScheduledTime
diff --git a/src/Utility/Tmp.hs b/src/Utility/Tmp.hs
index dc559813..de970fe5 100644
--- a/src/Utility/Tmp.hs
+++ b/src/Utility/Tmp.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.Tmp where
diff --git a/src/Utility/UserInfo.hs b/src/Utility/UserInfo.hs
index 5bf8d5c0..7e94cafa 100644
--- a/src/Utility/UserInfo.hs
+++ b/src/Utility/UserInfo.hs
@@ -6,6 +6,7 @@
-}
{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.UserInfo (
myHomeDir,
@@ -13,12 +14,13 @@ module Utility.UserInfo (
myUserGecos,
) where
+import Utility.Env
+
import System.PosixCompat
#ifndef mingw32_HOST_OS
import Control.Applicative
#endif
-
-import Utility.Env
+import Prelude
{- Current user's home directory.
-