I'm using the GHC API to parse a module. If the module contains syntax errors the GHC API writes them to stdout. This interferes with my program, which has another way to report errors. Example session:
$ prog ../stack/src/Stack/Package.hs
../stack/src/Stack/Package.hs:669:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs:783:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs
error: 1:1 argon: phase `C pre-processor' failed (exitcode = 1)
Only the last one should be outputted. How can I make sure the GHC API does not output anything? I'd like to avoid libraries like silently which solve the problem by redirecting stdout to a temporary file.
I already tried to use GHC.defaultErrorHandler, but while I can catch the exception, GHC API still writes to stdout. Relevant code:
-- | Parse a module with specific instructions for the C pre-processor.
parseModuleWithCpp :: CppOptions
-> FilePath
-> IO (Either (Span, String) LModule)
parseModuleWithCpp cppOptions file =
GHC.defaultErrorHandler GHC.defaultFatalMessager (GHC.FlushOut $ return ()) $
GHC.runGhc (Just libdir) $ do
dflags <- initDynFlags file
let useCpp = GHC.xopt GHC.Opt_Cpp dflags
fileContents <-
if useCpp
then getPreprocessedSrcDirect cppOptions file
else GHC.liftIO $ readFile file
return $
case parseFile dflags file fileContents of
GHC.PFailed ss m -> Left (srcSpanToSpan ss, GHC.showSDoc dflags m)
GHC.POk _ pmod -> Right pmod
Moreover, with this approach I cannot catch the error message (I just get ExitFailure). Removing the line with GHC.defaultErrorHandler gives me the output shown above.
Many thanks to #adamse for pointing me in the right direction! I have found the answer in Hint's code.
It suffices to override logging in the dynamic flags:
initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags file = do
dflags0 <- GHC.getSessionDynFlags
src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file
(dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts
let dflags2 = dflags1 { GHC.log_action = customLogAction }
void $ GHC.setSessionDynFlags dflags2
return dflags2
customLogAction :: GHC.LogAction
customLogAction dflags severity _ _ msg =
case severity of
GHC.SevFatal -> fail $ GHC.showSDoc dflags msg
_ -> return () -- do nothing in the other cases (debug, info, etc.)
The default implementation of GHC.log_action can be found here:
http://haddock.stackage.org/lts-3.10/ghc-7.10.2/src/DynFlags.html#defaultLogAction
The code for parsing remains the same in my question, after having removed the line about GHC.defaultErrorHandler, which is no longer needed, assuming one catches exceptions himself.
I have seen this question before and then the answer was to temporarily redirect stdout and stderr.
To redirect stdout to a file as an example:
import GHC.IO.Handle
import System.IO
main = do file <- openFile "stdout" WriteMode
stdout' <- hDuplicate stdout -- you might want to keep track
-- of the original stdout
hDuplicateTo file stdout -- makes the second Handle a
-- duplicate of the first
putStrLn "hi"
hClose file
Related
I'm trying to create a process, and communicate with it via a handle that I provide outside the createProcess function:
stdOutH <- openFile (logDir </> "stdout.log") ReadWriteMode
hSetBuffering stdOutH LineBuffering
(_, _, _, ph) <- createProcess $
(proc "someproc" []) { std_out = UseHandle stdOutH
, std_err = UseHandle stdErrH
}
line <- hGetLine stdOutH
putStrLn $ "Got " ++ line
The "someproc" process spits a line out to the standard output, and I want to read it from the process that spawned it. However if I try to do this I get the following error:
hGetLine: illegal operation (handle is closed)
What I don't understand is why the handle is closed while the created process is running. This works if I use CreatePipe instead of UseHandle, the problem is that I only want to read the first line. But doing this requires to keep on reading from the pipe, otherwise it gets full after a certain amount of output by "someproc".
So, is there a way to use system.process to communicate two processes via stdOutH in the way described above?
This behavior of createProcess is documented:
Note that Handles provided for std_in, std_out, or std_err via the
UseHandle constructor will be closed by calling this function.
Documentation suggests to use createProcess_ function instead.
In Haskell, is there a way to exit a program with a specified error code? The resources I've been reading typically point to the error function for exiting a program with an error, but it seems to always terminate the program with an error code of 1.
[martin#localhost Haskell]$ cat error.hs
main = do
error "My English language error message"
[martin#localhost Haskell]$ ghc error.hs
[1 of 1] Compiling Main ( error.hs, error.o )
Linking error ...
[martin#localhost Haskell]$ ./error
error: My English language error message
[martin#localhost Haskell]$ echo $?
1
Use exitWith from System.Exit:
main = exitWith (ExitFailure 2)
I would add some helpers for convenience:
exitWithErrorMessage :: String -> ExitCode -> IO a
exitWithErrorMessage str e = hPutStrLn stderr str >> exitWith e
exitResourceMissing :: IO a
exitResourceMissing = exitWithErrorMessage "Resource missing" (ExitFailure 2)
An alternative that allows an error message only is die
import System.Exit
tests = ... -- some value from the program
testsResult = ... -- Bool value overall status
main :: IO ()
main = do
if testsResult then
print "Tests passed"
else
die (show tests)
The accepted answer allows setting the exit error code though, so it's closer to the exact phrasing of the question.
I am currently attempting to play audio files in Haskell using OpenAl. In order to do so, I am trying to get the example code at the ALUT git repository (https://github.com/haskell-openal/ALUT/blob/master/examples/Basic/PlayFile.hs) to work. However, it refuses to produce any sound. What am I missing here?
{-
PlayFile.hs (adapted from playfile.c in freealut)
Copyright (c) Sven Panne 2005-2016
This file is part of the ALUT package & distributed under a BSD-style license.
See the file LICENSE.
-}
import Control.Monad ( when, unless )
import Data.List ( intersperse )
import Sound.ALUT
import System.Exit ( exitFailure )
import System.IO ( hPutStrLn, stderr )
-- This program loads and plays a variety of files.
playFile :: FilePath -> IO ()
playFile fileName = do
-- Create an AL buffer from the given sound file.
buf <- createBuffer (File fileName)
-- Generate a single source, attach the buffer to it and start playing.
source <- genObjectName
buffer source $= Just buf
play [source]
-- Normally nothing should go wrong above, but one never knows...
errs <- get alErrors
unless (null errs) $ do
hPutStrLn stderr (concat (intersperse "," [ d | ALError _ d <- errs ]))
exitFailure
-- Check every 0.1 seconds if the sound is still playing.
let waitWhilePlaying = do
sleep 0.1
state <- get (sourceState source)
when (state == Playing) $
waitWhilePlaying
waitWhilePlaying
main :: IO ()
main = do
-- Initialise ALUT and eat any ALUT-specific commandline flags.
withProgNameAndArgs runALUT $ \progName args -> do
-- Check for correct usage.
unless (length args == 1) $ do
hPutStrLn stderr ("usage: " ++ progName ++ " <fileName>")
exitFailure
-- If everything is OK, play the sound file and exit when finished.
playFile (head args)
Unfortunately, while I don't get any errors, I also can\t hear any sound. Pavucontrol also does not seem to detect anything (no extra streams appear under the Playback tab).
Their HelloWorld example on the same git repository also gave neither errors nor sound.
I also tried the OpenALInfo function on the same git repository (https://github.com/haskell-openal/ALUT/blob/master/examples/Basic/OpenALInfo.hs), which further proves that I'm actually connecting to OpenAL, and gives some information about the versions which may or may not be useful:
ALC version: 1.1
ALC extensions:
ALC_ENUMERATE_ALL_EXT, ALC_ENUMERATION_EXT, ALC_EXT_CAPTURE,
ALC_EXT_DEDICATED, ALC_EXT_disconnect, ALC_EXT_EFX,
ALC_EXT_thread_local_context, ALC_SOFTX_device_clock,
ALC_SOFT_HRTF, ALC_SOFT_loopback, ALC_SOFT_pause_device
AL version: 1.1 ALSOFT 1.17.2
AL renderer: OpenAL Soft
AL vendor: OpenAL Community
AL extensions:
AL_EXT_ALAW, AL_EXT_BFORMAT, AL_EXT_DOUBLE,
AL_EXT_EXPONENT_DISTANCE, AL_EXT_FLOAT32, AL_EXT_IMA4,
AL_EXT_LINEAR_DISTANCE, AL_EXT_MCFORMATS, AL_EXT_MULAW,
AL_EXT_MULAW_BFORMAT, AL_EXT_MULAW_MCFORMATS, AL_EXT_OFFSET,
AL_EXT_source_distance_model, AL_LOKI_quadriphonic,
AL_SOFT_block_alignment, AL_SOFT_buffer_samples,
AL_SOFT_buffer_sub_data, AL_SOFT_deferred_updates,
AL_SOFT_direct_channels, AL_SOFT_loop_points, AL_SOFT_MSADPCM,
AL_SOFT_source_latency, AL_SOFT_source_length
Well, it turns out I posted here a bit too quickly. There was no problem with my code, but rather with my OpenAl settings. By adding
drivers=pulse,alsa
to /etc/openal/alsoft.conf OpenAl works. This is described in https://wiki.archlinux.org/index.php/PulseAudio#OpenAL.
I would like to stream stdin over an HTTP connection using text/event-stream. The Network.Wai.EventSource thing looks like a good candidate.
I tried using this code:
import Network.Wai
import Network.Wai.EventSource
import Network.Wai.Middleware.AddHeaders
import Network.Wai.Handler.Warp (run)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import Blaze.ByteString.Builder.ByteString
toEvent :: [L.ByteString] -> ServerEvent
toEvent s = ServerEvent {
eventName = Nothing,
eventId = Nothing,
eventData = map fromLazyByteString s
}
createWaiApp :: IO L.ByteString -> Application
createWaiApp input = eventSourceAppIO $ fmap (toEvent . C.lines) input
main :: IO ()
main = run 1337 $ createWaiApp L.getContents
Which (I think) does:
Reads stdin as a Lazy ByteStream
Splits the ByteStream into lines
Produces one ServerEvent for all the lines (this feels wrong - there should presumably be multiple events?)
Builds a WAI Application from the IO ServerEvent
Binds the Application to port 1337
When I run this (e.g. using ping -c 5 example.com | stack exec test-exe) it doesn't respond until the whole of stdin has been read.
How do I build a Wai application that flushes out the HTTP connection every time it reads a line from stdin?
L.getContents is a single IO action, so only one event will be created.
Here is an example of eventSourcEventAppIO where multiple events are created:
import Blaze.ByteString.Builder.Char8 (fromString)
...same imports as above...
nextEvent :: IO ServerEvent
nextEvent = do
s <- getLine
let event = if s == ""
then CloseEvent
else ServerEvent
{ eventName = Nothing
, eventId = Nothing
, eventData = [ fromString s ]
}
case event of
CloseEvent -> putStrLn "<close event>"
ServerEvent _ _ _ -> putStrLn "<server event>"
return event
main :: IO ()
main = run 1337 $ eventSourceAppIO nextEvent
To test, in one window start up the server and in another run the command curl -v http://localhost:1337. For each line you enter in the server window you will get a data frame from curl. Entering a blank line will close the HTTP connection but the server will remain running allowing you to connect to it again.
I am trying to cach exception caused by read function:
run :: CurrentData -> IO ()
run current = do
{
x <- (getCommandFromUser) `E.catch` handler;
updated <- executeCommand x current;
run updated;
} where handler :: E.IOException -> IO Command
handler e = do putStrLn "wrong command format" >> return (DoNothing);
In this code function getCommandfrom user gets some string from user and then tries to read some data from this string using "read" function
If read fails there is exception thrown:
*** Exception : prelude.read : no parse
and program exits...
I can't catch this exception - what is type of this exception???
I tried also E.SomeException instead of E.IOException...
E is from import Control.Exception As E
"what is type of this exception?" The type is ErrorCall, also available from Control.Exception. An ErrorCall is what is thrown when the error function is called.
Just change the type of handler and it will work. A last resort to get things working is to catch E.SomeException, but that's almost always the wrong thing to do.