Commit e16f93c1 authored by bjorn@bringert.net's avatar bjorn@bringert.net
Browse files

Actually write some fields to the config file.

parent 56b5e9bf
......@@ -181,7 +181,8 @@ loadConfig configFile =
minp <- readFileIfExists configFile
case minp of
Nothing -> do hPutStrLn stderr $ "Config file " ++ configFile ++ " not found."
writeDefaultConfigFile configFile
hPutStrLn stderr $ "Writing default configuration to " ++ configFile ++ "."
writeDefaultConfigFile configFile defaultConf
return defaultConf
Just inp -> case parseBasicStanza configFieldDescrs defaultConf inp of
ParseOk ws dummyConf ->
......@@ -200,12 +201,20 @@ loadConfig configFile =
return defaultConf
-- FIXME: finish this
writeDefaultConfigFile :: FilePath -> IO ()
writeDefaultConfigFile file =
do writeFile file ""
writeDefaultConfigFile :: FilePath -> ConfigFlags -> IO ()
writeDefaultConfigFile file cfg =
writeFile file $ showFields configWriteFieldDescrs cfg
-- | All config file fields.
configFieldDescrs :: [FieldDescr ConfigFlags]
configFieldDescrs =
[
] ++ configWriteFieldDescrs
-- | The subset of the config file fields that we write out
-- if the config file is missing.
configWriteFieldDescrs :: [FieldDescr ConfigFlags]
configWriteFieldDescrs =
[ simpleField "compiler"
(text . show) parseCompilerFlavor
configCompiler (\c cfg -> cfg { configCompiler = c })
......@@ -215,7 +224,7 @@ configFieldDescrs =
, simpleField "prefix"
(text . show) (readS_to_P reads)
(prefixDirTemplate . configInstallDirs) (\d -> setInstallDir (\ds -> ds { prefixDirTemplate = d }))
]
]
setInstallDir :: (InstallDirTemplates -> InstallDirTemplates) -> ConfigFlags -> ConfigFlags
setInstallDir f cfg = cfg { configInstallDirs = f (configInstallDirs cfg) }
......
......@@ -10,6 +10,7 @@ import Control.Monad (foldM, guard)
import Data.Char (isSpace)
import Data.Maybe (listToMaybe)
import System.IO.Error (isDoesNotExistError)
import Text.PrettyPrint.HughesPJ
isVerbose cfg = configVerbose cfg >= verbose
......@@ -59,3 +60,7 @@ setField _ x s =
lookupFieldDescr :: [FieldDescr a] -> String -> Maybe (FieldDescr a)
lookupFieldDescr fs n = listToMaybe [f | f@(FieldDescr name _ _) <- fs, name == n]
showFields :: [FieldDescr a] -> a -> String
showFields fs x = render $ vcat [ text name <> text ":" <+> get x | FieldDescr name get _ <- fs]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment