Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Fredrik Wieczerkowski
curry-tools
Commits
9889e859
Commit
9889e859
authored
Jan 13, 2018
by
Michael Hanus
Browse files
CPM updated
parent
6d0c57c4
Changes
3
Hide whitespace changes
Inline
Side-by-side
cpm/src/CPM/ErrorLogger.curry
View file @
9889e859
...
...
@@ -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.
...
...
cpm/src/CPM/Main.curry
View file @
9889e859
...
...
@@ -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"
...
...
cpm/src/CPM/Repository.curry
View file @
9889e859
...
...
@@ -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:"
map
IO putStrLn
repoErrors
else do
errorMessage
"Problems while reading the package index:"
map
M_ 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."
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment