Commit 9889e859 authored by Michael Hanus 's avatar Michael Hanus
Browse files

CPM updated

parent 6d0c57c4
......@@ -17,13 +17,14 @@ module CPM.ErrorLogger
, failIO
, log
, showLogEntry
, infoMessage, debugMessage, fromErrorLogger
, infoMessage, debugMessage, errorMessage, fromErrorLogger
, showExecCmd, execQuietCmd
) where
import Global
import IO ( hPutStrLn, stderr )
import Profile -- for show run-time
import System (exitWith, system)
import System ( exitWith, system )
import Text.Pretty
......@@ -135,12 +136,13 @@ foldEL f z (x:xs) = do
Right v -> foldEL f v xs
Left m -> return $ ([], Left m)
--- Renders a log entry.
--- Renders a log entry to stderr.
showLogEntry :: LogEntry -> IO ()
showLogEntry (LogEntry lvl msg) = do
minLevel <- getLogLevel
if levelGte lvl minLevel
then putStrLn $ pPrint lvlText ++ msg
then mapM_ (\l -> hPutStrLn stderr $ pPrint $ lvlText <+> text l)
(lines msg)
else return ()
where
lvlText = case lvl of
......@@ -215,6 +217,10 @@ infoMessage msg = (log Info msg |> succeedIO ()) >> done
debugMessage :: String -> IO ()
debugMessage msg = (log Debug msg |> succeedIO ()) >> done
--- Prints an error message in the standard IO monad.
errorMessage :: String -> IO ()
errorMessage msg = (log Error msg |> succeedIO ()) >> done
--- Transforms an error logger actions into a standard IO action.
--- It shows all messages and, if the result is not available,
--- exits with a non-zero code.
......
......@@ -79,7 +79,7 @@ runWithArgs opts = do
debugMessage "Reading CPM configuration..."
config <- readConfigurationWith (optDefConfig opts) >>= \c ->
case c of
Left err -> do putStrLn $ "Error reading .cpmrc settings: " ++ err
Left err -> do errorMessage $ "Error reading .cpmrc settings: " ++ err
exitWith 1
Right c' -> return c'
debugMessage ("Current configuration:\n" ++ showConfiguration config)
......@@ -688,10 +688,10 @@ checkRequiredExecutables = do
debugMessage "Checking whether all required executables can be found..."
missingExecutables <- checkExecutables listOfExecutables
unless (null missingExecutables) $ do
putStrLn $ "The following programs could not be found on the PATH " ++
"(they are required for CPM to work):\n" ++
intercalate ", " missingExecutables
exitWith 1
errorMessage $ "The following programs could not be found on the PATH " ++
"(they are required for CPM to work):\n" ++
intercalate ", " missingExecutables
exitWith 1
debugMessage "All required executables found."
where
listOfExecutables =
......@@ -1191,7 +1191,7 @@ genDocForPrograms opts cfg docdir specDir pkg = do
(\ms -> return (ms,True))
(docModules opts)
if null docmods
then putStrLn "No modules to be documented!" >> succeedIO ()
then log Info "No modules to be documented!"
else
loadCurryPathFromCache cfg specDir |>=
maybe (computePackageLoadPath cfg specDir)
......@@ -1251,7 +1251,7 @@ testCmd opts cfg =
mainprogs <- curryModulesInDir (aspecDir </> "src")
let tests = testsuites pkg mainprogs
if null tests
then putStrLn "No modules to be tested!" >> succeedIO ()
then log Info "No modules to be tested!"
else foldEL (\_ -> execTest aspecDir) () tests
where
currycheck = curryExec cfg ++ " check"
......@@ -1418,8 +1418,8 @@ newPackage :: NewOptions -> IO (ErrorLogger ())
newPackage (NewOptions pname) = do
exists <- doesDirectoryExist pname
when exists $ do
putStrLn $ "There is already a directory with the new project name. " ++
"I cannot create new project!"
errorMessage $ "There is already a directory with the new project name.\n"
++ "I cannot create new project!"
exitWith 1
let emptyAuthor = "YOUR NAME <YOUR EMAIL ADDRESS>"
emptySynopsis = "PLEASE PROVIDE A ONE-LINE SUMMARY ABOUT THE PACKAGE"
......
......@@ -142,8 +142,8 @@ readRepository cfg large = do
(repo, repoErrors) <- readRepositoryFrom (repositoryDir cfg)
if null repoErrors
then writeRepositoryCache cfg large repo >> return repo
else do putStrLn "Problems while reading the package index:"
mapIO putStrLn repoErrors
else do errorMessage "Problems while reading the package index:"
mapM_ errorMessage repoErrors
exitWith 1
Just repo -> return repo
......@@ -162,9 +162,8 @@ warnOldRepo cfg = do
-- We assume that clock time is measured in seconds (as in PAKCS or KiCS2)
let timediff = clockTimeToInt ctime - clockTimeToInt utime
days = timediff `div` (60*60*24)
putStrLn $ "Warning: your repository index is older than " ++
show days ++ " days."
putStrLn useUpdateHelp
infoMessage $ "Warning: your repository index is older than " ++
show days ++ " days.\n" ++ useUpdateHelp
useUpdateHelp :: String
useUpdateHelp = "Use 'cypm update' to download the newest package index."
......
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