[commit: haskeline] master: Win32: Don't pass invalid arguments to SetPosition for long input lines. (747436e)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/haskeline

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/747436ec983977007bb4559585424da153b2599f

>---------------------------------------------------------------

commit 747436ec983977007bb4559585424da153b2599f
Author: Judah Jacobson <judah.jacobson at gmail.com>
Date:   Wed Jul 18 20:36:23 2012 +0000

    Win32: Don't pass invalid arguments to SetPosition for long input lines.

>---------------------------------------------------------------

 System/Console/Haskeline/Backend/Win32.hsc |   10 ++++++++--
 1 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc
index 8b84d83..e11cbc0 100644
--- a/System/Console/Haskeline/Backend/Win32.hsc
+++ b/System/Console/Haskeline/Backend/Win32.hsc
@@ -262,10 +262,16 @@ instance MonadTrans Draw where
 getPos :: MonadIO m => Draw m Coord
 getPos = asks hOut >>= liftIO . getPosition
     
-setPos :: MonadIO m => Coord -> Draw m ()
+setPos :: Coord -> DrawM ()
 setPos c = do
     h <- asks hOut
-    liftIO (setPosition h c)
+    -- SetPosition will fail if you give it something out of bounds of
+    -- the window buffer (i.e., the input line doesn't fit in the window).
+    -- So we do a simple guard against that uncommon case.
+    -- However, we don't throw away the x coord since it produces sensible
+    -- results for some cases.
+    maxY <- liftM (subtract 1) $ asks height
+    liftIO $ setPosition h c { coordY = max 0 $ min maxY $ coordY c }
 
 printText :: MonadIO m => String -> Draw m ()
 printText txt = do