Use stderr for diagnostic and error messages (#172)

src/Monomer/Graphics/FontManager.hs

@@ -28,6 +28,7 @@ import qualified Data.Text as T
 import Monomer.Common.BasicTypes
 import Monomer.Graphics.FFI
 import Monomer.Graphics.Types
+import Monomer.Helper (putStrLnErr)
 
 -- | Creates a font manager instance.
 makeFontManager
@@ -40,7 +41,7 @@ makeFontManager fonts dpr = do
   validFonts <- foldM (loadFont ctx) [] fonts
 
   when (null validFonts) $
-    putStrLn "Could not find any valid fonts. Text size calculations will fail."
+    putStrLnErr "Could not find any valid fonts. Text size calculations will fail."
 
   return $ newManager ctx
 
@@ -104,7 +105,7 @@ loadFont ctx fonts (FontDef name path) = do
   res <- fmCreateFont ctx name path
   if res >= 0
     then return $ path : fonts
-    else putStrLn ("Failed to load font: " ++ T.unpack name) >> return fonts
+    else putStrLnErr ("Failed to load font: " ++ T.unpack name) >> return fonts
 
 setFont :: FMContext -> Double -> Font -> FontSize -> FontSpace -> IO ()
 setFont ctx scale (Font name) (FontSize size) (FontSpace spaceH) = do

src/Monomer/Graphics/NanoVGRenderer.hs

@@ -42,6 +42,7 @@ import qualified NanoVG.Internal.Image as VGI
 
 import Monomer.Common
 import Monomer.Graphics.Types
+import Monomer.Helper (putStrLnErr)
 
 import qualified Monomer.Common.Lens as L
 import qualified Monomer.Graphics.Lens as L
@@ -99,7 +100,7 @@ makeRenderer fonts dpr = do
   validFonts <- foldM (loadFont c) Set.empty fonts
 
   when (null validFonts) $
-    putStrLn "Could not find any valid fonts. Text will fail to be displayed."
+    putStrLnErr "Could not find any valid fonts. Text will fail to be displayed."
 
   envRef <- newIORef $ Env {
     overlays = Seq.empty,
@@ -356,7 +357,7 @@ loadFont c fonts (FontDef name path) = do
   res <- VG.createFont c name (VG.FileName path)
   case res of
     Just{} -> return $ Set.insert name fonts
-    _ -> putStrLn ("Failed to load font: " ++ T.unpack name) >> return fonts
+    _ -> putStrLnErr ("Failed to load font: " ++ T.unpack name) >> return fonts
 
 setFont
   :: VG.Context
@@ -483,7 +484,7 @@ imgDelete name imagesMap = newImageMap where
 
 clearImagesMap :: VG.Context -> ImagesMap -> IO ()
 clearImagesMap c imagesMap = do
-  putStrLn "Clearing images map"
+  putStrLnErr "Clearing images map"
   forM_ (M.elems imagesMap) $ \image ->
     VG.deleteImage c (_imNvImage image)
 

src/Monomer/Helper.hs

@@ -16,6 +16,7 @@ module Monomer.Helper where
 import Control.Exception (SomeException, catch)
 import Control.Monad.IO.Class (MonadIO)
 import Data.Sequence (Seq(..))
+import System.IO (hPutStrLn, stderr)
 
 import qualified Data.Sequence as Seq
 
@@ -76,3 +77,6 @@ catchAny = catch
 headMay :: [a] -> Maybe a
 headMay [] = Nothing
 headMay (x : _) = Just x
+
+putStrLnErr :: String -> IO ()
+putStrLnErr msg = hPutStrLn stderr msg

src/Monomer/Main/Core.hs

@@ -50,7 +50,7 @@ import Monomer.Main.Types
 import Monomer.Main.Util
 import Monomer.Main.WidgetTask
 import Monomer.Graphics
-import Monomer.Helper (catchAny)
+import Monomer.Helper (catchAny, putStrLnErr)
 import Monomer.Widgets.Composite
 
 import qualified Monomer.Lens as L
@@ -200,8 +200,8 @@ runAppLoop window glCtx channel widgetRoot config = do
 
       case setupRes of
         RenderSetupMakeCurrentFailed msg -> do
-          liftIO . putStrLn $ "Setup of the rendering thread failed: " ++ msg
-          liftIO . putStrLn $ "Falling back to rendering in the main thread. "
+          liftIO . putStrLnErr $ "Setup of the rendering thread failed: " ++ msg
+          liftIO . putStrLnErr $ "Falling back to rendering in the main thread. "
             ++ "The content may not be updated while resizing the window."
 
           makeMainThreadRenderer
@@ -283,7 +283,7 @@ mainLoop window fontManager config loopArgs = do
   let baseSystemEvents = convertEvents convertCfg mousePos eventsPayload
 
 --  when newSecond $
---    liftIO . putStrLn $ "Frames: " ++ show _mlFrameCount
+--    liftIO . putStrLnErr $ "Frames: " ++ show _mlFrameCount
 
   when quit $
     L.exitApplication .= True

src/Monomer/Main/Handlers.hs

@@ -52,7 +52,7 @@ import qualified SDL.Raw.Types as SDLT
 import Monomer.Core
 import Monomer.Event
 import Monomer.Graphics
-import Monomer.Helper (headMay, seqStartsWith)
+import Monomer.Helper (headMay, putStrLnErr, seqStartsWith)
 import Monomer.Main.Types
 import Monomer.Main.Util
 
@@ -436,7 +436,7 @@ handleSetCursorIcon wid icon previousStep = do
   cursor <- Map.lookup icon <$> use L.cursorIcons
 
   when (isNothing cursor) $
-    liftIO . putStrLn $ "Invalid handleSetCursorIcon: " ++ show icon
+    liftIO . putStrLnErr $ "Invalid handleSetCursorIcon: " ++ show icon
 
   forM_ cursor SDLE.setCursor
 
@@ -601,7 +601,6 @@ handleRaiseEvent
   -> HandlerStep s e
   -> m (HandlerStep s e)
 handleRaiseEvent message step = do
-  --liftIO . putStrLn $ message ++ show (typeOf message)
   return step
   where
     message = "Invalid state. RaiseEvent reached main handler. Type: "
@@ -891,7 +890,7 @@ restoreCursorOnWindowEnter = do
   let sdlCursor = cursorPair >>= (`Map.lookup` cursorIcons) . snd
 
   when (isNothing sdlCursor && isJust cursorPair) $
-    liftIO. putStrLn $ "Invalid restoreCursorOnWindowEnter: " ++ show cursorPair
+    liftIO. putStrLnErr $ "Invalid restoreCursorOnWindowEnter: " ++ show cursorPair
 
   when (not prevInside && currInside && isJust sdlCursor) $ do
     SDLE.setCursor (fromJust sdlCursor)

src/Monomer/Main/Platform.hs

@@ -43,7 +43,7 @@ import qualified SDL.Internal.Types as SIT
 import qualified SDL.Video.Renderer as SVR
 
 import Monomer.Common
-import Monomer.Helper (catchAny)
+import Monomer.Helper (catchAny, putStrLnErr)
 import Monomer.Main.Types
 
 foreign import ccall unsafe "initGlew" glewInit :: IO CInt
@@ -60,9 +60,10 @@ initSDLWindow config = do
   SDL.HintRenderScaleQuality $= SDL.ScaleLinear
   setDisableCompositorHint compositingFlag
 
-  do renderQuality <- SDL.get SDL.HintRenderScaleQuality
-     when (renderQuality /= SDL.ScaleLinear) $
-       putStrLn "Warning: Linear texture filtering not enabled!"
+  renderQuality <- SDL.get SDL.HintRenderScaleQuality
+
+  when (renderQuality /= SDL.ScaleLinear) $
+    putStrLnErr "Warning: Linear texture filtering not enabled!"
 
   platform <- getPlatform
   initDpiAwareness
@@ -110,7 +111,7 @@ initSDLWindow config = do
 
   err <- SRE.getError
   err <- STR.peekCString err
-  putStrLn err
+  putStrLnErr err
 
   ctxRender <- SDL.glCreateContext window
 
@@ -155,13 +156,12 @@ setWindowIcon (SIT.Window winPtr) config =
         (Raw.setWindowIcon winPtr iconSurfacePtr)
         (SVR.freeSurface iconSurface)
   where
-    handleException err = putStrLn $
+    handleException err = putStrLnErr $
       "Failed to set window icon. Does the file exist?\n\t" ++ show err ++ "\n"
 
 -- | Destroys the provided window, shutdowns the video subsystem and SDL.
 detroySDLWindow :: SDL.Window -> IO ()
 detroySDLWindow window = do
-  putStrLn "About to destroyWindow"
   SDL.destroyWindow window
   Raw.quitSubSystem Raw.SDL_INIT_VIDEO
   SDL.quit

src/Monomer/Main/WidgetTask.hs

@@ -28,7 +28,7 @@ import Data.Typeable
 import qualified Data.Sequence as Seq
 
 import Monomer.Core
-import Monomer.Helper (collectJustM)
+import Monomer.Helper (collectJustM, putStrLnErr)
 import Monomer.Main.Handlers
 import Monomer.Main.Lens
 import Monomer.Main.Util
@@ -90,7 +90,7 @@ processTaskResult
   -> Either SomeException i
   -> m (HandlerStep s e)
 processTaskResult wenv widgetRoot _ (Left ex) = do
-  liftIO . putStrLn $ "Error processing Widget task result: " ++ show ex
+  liftIO . putStrLnErr $ "Error processing Widget task result: " ++ show ex
   return (wenv, widgetRoot, Seq.empty)
 processTaskResult wenv widgetRoot widgetId (Right taskResult)
   = processTaskEvent wenv widgetRoot widgetId taskResult