Add quote function

src/Base.hs

@@ -19,7 +19,7 @@ module Base (
 
     -- * Miscellaneous utilities
     minusOrd, intersectOrd, lookupAll, replaceEq, replaceSeparators, unifyPath,
-    (-/-), matchVersionedFilePath, putColoured
+    quote, (-/-), matchVersionedFilePath, putColoured
     ) where
 
 import Control.Applicative
@@ -71,6 +71,10 @@ replaceSeparators = replaceWhen isPathSeparator
 replaceWhen :: (a -> Bool) -> a -> [a] -> [a]
 replaceWhen p to = map (\from -> if p from then to else from)
 
+-- | Add single quotes around a String.
+quote :: String -> String
+quote s = "'" ++ s ++ "'"
+
 -- | Normalise a path and convert all path separators to @/@, even on Windows.
 unifyPath :: FilePath -> FilePath
 unifyPath = toStandard . normaliseEx

src/Builder.hs

@@ -121,13 +121,13 @@ builderPath builder = case builderProvenance builder of
         _ -> error $ "Cannot determine builderPath for " ++ show builder
   where
     fromKey key = do
-        path <- askConfigWithDefault key . error $ "\nCannot find path to '"
-            ++ key ++ "' in system.config file. Did you forget to run configure?"
+        path <- askConfigWithDefault key . error $ "\nCannot find path to "
+            ++ quote key ++ " in system.config file. Did you skip configure?"
         if null path
         then do
             if isOptional builder
             then return ""
-            else error $ "Builder '" ++ key ++ "' is not specified in"
+            else error $ "Builder " ++ quote key ++ " is not specified in"
                 ++ " system.config file. Cannot proceed without it."
         else fixAbsolutePathOnWindows =<< lookupInPath path
 

src/Oracles/Config.hs

@@ -11,7 +11,7 @@ newtype ConfigKey = ConfigKey String
 
 askConfig :: String -> Action String
 askConfig key = askConfigWithDefault key . error
-    $ "Cannot find key '" ++ key ++ "' in configuration files."
+    $ "Cannot find key " ++ quote key ++ " in configuration files."
 
 askConfigWithDefault :: String -> Action String -> Action String
 askConfigWithDefault key defaultAction = do

src/Oracles/Config/Flag.hs

@@ -39,10 +39,10 @@ flag f = do
         WithLibdw          -> "with-libdw"
         UseSystemFfi       -> "use-system-ffi"
     value <- askConfigWithDefault key . error
-        $ "\nFlag '" ++ key ++ "' not set in configuration files."
+        $ "\nFlag " ++ quote key ++ " not set in configuration files."
     unless (value == "YES" || value == "NO" || value == "") . error
-        $ "\nFlag '" ++ key ++ "' is set to '" ++ value
-        ++ "' instead of 'YES' or 'NO'."
+        $ "\nFlag " ++ quote key ++ " is set to " ++ quote value
+        ++ " instead of 'YES' or 'NO'."
     return $ value == "YES"
 
 getFlag :: Flag -> ReaderT a Action Bool

src/Oracles/Dependencies.hs

@@ -23,8 +23,8 @@ dependencies path obj = do
            $ map (\obj' -> MaybeT $ askOracle $ DependenciesKey (depFile, obj'))
                  [obj, obj -<.> "o"]
     case res of
-        Nothing -> error $ "No dependencies found for '" ++ obj ++ "'."
-        Just [] -> error $ "Empty dependency list for '" ++ obj ++ "'."
+        Nothing -> error $ "No dependencies found for " ++ obj
+        Just [] -> error $ "Empty dependency list for " ++ obj
         Just (src:depFiles) -> return (src, depFiles)
 
 -- Oracle for 'path/dist/.dependencies' files

src/Rules/Actions.hs

@@ -161,7 +161,7 @@ runBuilder builder args = do
 
 makeExecutable :: FilePath -> Action ()
 makeExecutable file = do
-    putBuild $ "| Make '" ++ file ++ "' executable."
+    putBuild $ "| Make " ++ quote file ++ " executable."
     quietly $ cmd "chmod +x " [file]
 
 -- | Print out information about the command being executed.

src/Rules/Data.hs

@@ -68,7 +68,7 @@ buildPackageData context@Context {..} = do
                     , "DEP_EXTRA_LIBS = m"
                     , "CC_OPTS = " ++ unwords includes ]
             writeFileChanged mk contents
-            putSuccess $ "| Successfully generated '" ++ mk ++ "'."
+            putSuccess $ "| Successfully generated " ++ mk
 
         when (package == unlit) $ dataFile %> \mk -> do
             orderOnly $ generatedDependencies stage package
@@ -78,7 +78,7 @@ buildPackageData context@Context {..} = do
                     , "C_SRCS = unlit.c"
                     , "SYNOPSIS = Literate script filter." ]
             writeFileChanged mk contents
-            putSuccess $ "| Successfully generated '" ++ mk ++ "'."
+            putSuccess $ "| Successfully generated " ++ mk
 
         when (package == touchy) $ dataFile %> \mk -> do
             orderOnly $ generatedDependencies stage package
@@ -87,7 +87,7 @@ buildPackageData context@Context {..} = do
                     [ "PROGNAME = touchy"
                     , "C_SRCS = touchy.c" ]
             writeFileChanged mk contents
-            putSuccess $ "| Successfully generated '" ++ mk ++ "'."
+            putSuccess $ "| Successfully generated " ++ mk
 
         -- Bootstrapping `ghcCabal`: although `ghcCabal` is a proper cabal
         -- package, we cannot generate the corresponding `package-data.mk` file
@@ -101,7 +101,7 @@ buildPackageData context@Context {..} = do
                     , "SYNOPSIS = Bootstrapped ghc-cabal utility."
                     , "HS_SRC_DIRS = ." ]
             writeFileChanged mk contents
-            putSuccess $ "| Successfully generated '" ++ mk ++ "'."
+            putSuccess $ "| Successfully generated " ++ mk
 
         when (package == rts && stage == Stage1) $ do
             dataFile %> \mk -> do
@@ -128,7 +128,7 @@ buildPackageData context@Context {..} = do
                         , "CC_OPTS = " ++ unwords includes
                         , "COMPONENT_ID = rts" ]
                 writeFileChanged mk contents
-                putSuccess $ "| Successfully generated '" ++ mk ++ "'."
+                putSuccess $ "| Successfully generated " ++ mk
 
 -- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
 -- 1) Drop lines containing '$'

src/Rules/Generate.hs

@@ -98,7 +98,7 @@ generate :: FilePath -> Context -> Expr String -> Action ()
 generate file context expr = do
     contents <- interpretInContext context expr
     writeFileChanged file contents
-    putSuccess $ "| Successfully generated '" ++ file ++ "'."
+    putSuccess $ "| Successfully generated " ++ file ++ "."
 
 generatePackageCode :: Context -> Rules ()
 generatePackageCode context@(Context stage pkg _) =
@@ -157,7 +157,7 @@ generatePackageCode context@(Context stage pkg _) =
 
             when (pkg == runGhc) $ path -/- "Main.hs" %> \file -> do
                 copyFileChanged (pkgPath pkg -/- "runghc.hs") file
-                putSuccess $ "| Successfully generated '" ++ file ++ "'."
+                putSuccess $ "| Successfully generated " ++ file ++ "."
 
 copyRules :: Rules ()
 copyRules = do

src/Rules/Library.hs

@@ -53,7 +53,7 @@ buildPackageLibrary context@Context {..} = do
 
         synopsis <- interpretInContext context $ getPkgData Synopsis
         unless isLib0 . putSuccess $ renderLibrary
-            ("'" ++ pkgNameString package ++ "' (" ++ show stage ++ ", way "++ show way ++ ").")
+            (quote (pkgNameString package) ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
             a
             (dropWhileEnd isPunctuation synopsis)
 

src/Rules/Program.hs

@@ -64,8 +64,8 @@ buildWrapper context@Context {..} wrapper wrapperPath binPath = do
     contents <- interpretInContext context $ wrapper binPath
     writeFileChanged wrapperPath contents
     makeExecutable wrapperPath
-    putSuccess $ "| Successfully created wrapper for '" ++ pkgNameString package
-               ++ "' (" ++ show stage ++ ")."
+    putSuccess $ "| Successfully created wrapper for " ++
+        quote (pkgNameString package) ++ " (" ++ show stage ++ ")."
 
 -- TODO: Get rid of the Paths_hsc2hs.o hack.
 -- TODO: Do we need to consider other ways when building programs?
@@ -102,6 +102,6 @@ buildBinary rs context@(Context stage package _) bin = do
     buildWithResources rs $ Target context (Ghc Link stage) binDeps [bin]
     synopsis <- interpretInContext context $ getPkgData Synopsis
     putSuccess $ renderProgram
-        ("'" ++ pkgNameString package ++ "' (" ++ show stage ++ ").")
+        (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
         bin
         (dropWhileEnd isPunctuation synopsis)