I am experimenting with wxHaskell. I wasn't able to run the app under ghci, so I have to use application to test it. I wanted to test the program with println debugging. However, it seems that putStrLn doesn't work in GUI:
{-# LANGUAGE Haskell2010 #-}
module Main where
import Graphics.UI.WX
drawUI dc view = do
circle dc (point 10 10) 5 [penKind := PenSolid, color := red]
putStrLn "painted"
helloGui :: IO ()
helloGui = do
f <- frame [
text := "Example",
resizeable := False,
bgcolor := white,
layout := space 400 300,
on paint := drawUI]
return ()
main :: IO ()
main = do
putStrLn "Started"
start helloGui
If I comment out start helloGui, everything is printed well. However, if I return it, nothing is printed but the window is displayed. What's wrong here?
This is probably output buffering; the output is not written until the program exits.
Either flush explicitly:
putStrLn "Started"
hFlush stdout
Or turn on line buffering:
hSetBuffering stdout LineBuffering -- or even NoBuffering
putStrLn "Started"
Related
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'm experimenting with the sample program at https://github.com/gtk2hs/gtk2hs/blob/master/gtk/demo/hello/World.hs, reproduced below:
-- A simple program to demonstrate Gtk2Hs.
module Main (Main.main) where
import Graphics.UI.Gtk
main :: IO ()
main = do
initGUI
-- Create a new window
window <- windowNew
-- Here we connect the "destroy" event to a signal handler.
-- This event occurs when we call widgetDestroy on the window
-- or if the user closes the window.
on window objectDestroy mainQuit
-- Sets the border width and tile of the window. Note that border width
-- attribute is in 'Container' from which 'Window' is derived.
set window [ containerBorderWidth := 10, windowTitle := "Hello World" ]
-- Creates a new button with the label "Hello World".
button <- buttonNew
set button [ buttonLabel := "Hello World" ]
-- When the button receives the "clicked" signal, it will call the
-- function given as the second argument.
on button buttonActivated (putStrLn "Hello World")
-- Gtk+ allows several callbacks for the same event.
-- This one will cause the window to be destroyed by calling
-- widgetDestroy. The callbacks are called in the sequence they were added.
on button buttonActivated $ do
putStrLn "A \"clicked\"-handler to say \"destroy\""
widgetDestroy window
-- Insert the hello-world button into the window.
set window [ containerChild := button ]
-- The final step is to display this newly created widget. Note that this
-- also allocates the right amount of space to the windows and the button.
widgetShowAll window
-- All Gtk+ applications must have a main loop. Control ends here
-- and waits for an event to occur (like a key press or mouse event).
-- This function returns if the program should finish.
mainGUI
If I build and run this on Mac OS X, Cmd-Q or the Quit command from the app's menu does not close the application. How do I trap this event and cause it to close the app?
Update
I've added a gtk3-mac-integration dependency to my project, an import Graphics.UI.Gtk.OSX to my source file and the following immediately after calling initGUI:
app <- applicationNew
on app willTerminate (return ())
I'm definitely missing something as this doesn't seem to do anything (see https://github.com/rcook/gtkapp/commit/8531509d0648ddb657633a33773c09bc5a576014).
Update no. 2
Thanks to #Jack Henahan and OSXDemo.hs, I now have a working solution:
-- A simple program to demonstrate Gtk2Hs.
module Main (Main.main) where
import Control.Exception
import Control.Monad
import Graphics.UI.Gtk
import Graphics.UI.Gtk.OSX
showDialog :: Window -> String -> String -> IO ()
showDialog window title message = bracket
(messageDialogNew (Just window) [] MessageInfo ButtonsOk message)
widgetDestroy
(\d -> do
set d [ windowTitle := title ]
void $ dialogRun d)
main :: IO ()
main = do
void initGUI
-- Create a new window
window <- windowNew
-- Here we connect the "destroy" event to a signal handler.
-- This event occurs when we call widgetDestroy on the window
-- or if the user closes the window.
void $ on window objectDestroy mainQuit
-- Sets the border width and tile of the window. Note that border width
-- attribute is in 'Container' from which 'Window' is derived.
set window [ containerBorderWidth := 10, windowTitle := "Hello World" ]
-- Creates a new button with the label "Hello World".
button <- buttonNew
set button [ buttonLabel := "Hello World" ]
-- When the button receives the "clicked" signal, it will call the
-- function given as the second argument.
void $ on button buttonActivated (putStrLn "Hello World")
void $ on button buttonActivated $ showDialog window "THE-TITLE" "THE-MESSAGE"
-- Gtk+ allows several callbacks for the same event.
-- This one will cause the window to be destroyed by calling
-- widgetDestroy. The callbacks are called in the sequence they were added.
void $ on button buttonActivated $ do
putStrLn "A \"clicked\"-handler to say \"destroy\""
widgetDestroy window
-- Insert the hello-world button into the window.
set window [ containerChild := button ]
-- The final step is to display this newly created widget. Note that this
-- also allocates the right amount of space to the windows and the button.
widgetShowAll window
app <- applicationNew
-- blockTermination: return True to prevent quit, False to allow
on app blockTermination $ do
putStrLn "blockTermination"
return False
-- willTerminate: handle clean-up etc.
on app willTerminate $ do
putStrLn "willTerminate"
menuBar <- menuBarNew
applicationSetMenuBar app menuBar
applicationReady app
-- All Gtk+ applications must have a main loop. Control ends here
-- and waits for an event to occur (like a key press or mouse event).
-- This function returns if the program should finish.
mainGUI
You need to send an NSApplicationWillTerminate signal.
willTerminate :: ApplicationClass self => Signal self (IO ())
willTerminate = Signal (connect_NONE__NONE "NSApplicationWillTerminate")
is how it's handled in gtk-mac-integration.
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
I need to do some action while button is pressed. How can I do it?
I have version 0.12.4.
P. S.:
For some reason, onButtonActivate in
import Graphics.UI.Gtk
import Control.Concurrent
main = do
initGUI
window <- windowNew
but <-buttonNewWithLabel "Write A"
onButtonActivate but $ do
putStr "A"
threadDelay 1000000
return()
containerAdd window but
widgetShowAll window
onDestroy window mainQuit
mainGUI
do not do anything.
Also, it's good to go, if action will be done repeatedly while pressed some key on keyboard.
According to the docs onButtonActivate is depreciated so you probably shouldn't use it. Im having trouble finding the correct way though, there probably are some generics signals somewhere that you should use. You can try my solution that uses onPressed and onRelease (these are also noted as depreciated). You could do as suggested in the comment and fork a thread:
import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Monad (void, when)
whilePressed button action = do
onPressed button $ do
threadId <- forkIO go
onReleased button (killThread threadId)
where
go = do
action
threadDelay 1000000
go
Then rewrite your main to do:
whilePressed but (putStr "A")
Im not sure if this is safe though, as it seems it could be possible for the buttonReleased event to be fired before killThread is registered. It might be safer to use an IORef:
import Data.IORef
whilePressed button action = do
isPressed <- newIORef False
onPressed button $ do
writeIORef isPressed True
void $ forkIO $ go isPressed
onReleased button (writeIORef isPressed False)
where
go isPressed = do
c <- readIORef isPressed
when c $ do
action
threadDelay 1000000
void $ forkIO $ go isPressed
Unfortunately I haven't compiled or tested the code sine I cannot install GTK on this computer, but let me know if you have any issues.
This uses a ToggleButton, a "timeout" object (see timeoutAdd in the module System.Glib.MainLoop in the docs) and an IORef. A timer is started when the ToggleButton is pressed down, but only if no other timer is currently running (that's the purpose of the IORef). If the button is released, the timer is stopped. The timer's callback function returns IO False to stop and destroy the timer object.
import Graphics.UI.Gtk
import Data.IORef
import Control.Monad(void, when)
action but idle = do
butDown <- get but toggleButtonActive
if butDown
then do
putStrLn "A"
writeIORef idle False
return True
else do
writeIORef idle True
return False
main = do
initGUI
window <- windowNew
but <-toggleButtonNewWithLabel "Write A"
idle <- newIORef True
on but toggled $ do
butDown <- get but toggleButtonActive
isIdle <- readIORef idle
when (butDown && isIdle) $ void $ timeoutAdd (action but idle) 1000
containerAdd window but
widgetShowAll window
on window objectDestroy mainQuit
mainGUI
The preferred way of registering signal callbacks is using "on". Also note that "on window objectDestroy mainQuit" correctly destroys the window and stops the Gtk main loop (you version didn't destroy the timers in GHCi, they kept running after calling "main" again).