hscurses 1.4.1.2 → 1.4.2.0

raw patch · 10 files changed

+111/−180 lines, 10 filesdep +exceptionsdep ~basedep ~unixPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: exceptions

Dependency ranges changed: base, unix

API changes (from Hackage documentation)

Files

• ChangeLog +13/−0
• UI/HSCurses/Curses.hsc +46/−14
• UI/HSCurses/CursesHelper.hs +13/−8
• UI/HSCurses/IConv.hsc +5/−0
• UI/HSCurses/Logging.hs +4/−2
• UI/HSCurses/MonadException.hs +0/−137
• UI/HSCurses/Widgets.hs +19/−14
• cbits/HSCurses.h +5/−0
• example/ContactManager.hs +1/−0
• hscurses.cabal +5/−5

@@ -1,3 +1,16 @@+1.4.2.0 (2015-02-12_+  - support for werase and winsch (thanks to Ryan Newton)+  - add wnoutrefresh for more efficient updates of multiple windows (Ryan Newton)+  - use getmaxyx for scrSize,  remove non-recommended approach of reading+    LINES and COLS global variables (Ryan Newton)+  - fixed findNextActiveCell (Matthew Hague)+  - support for GHC 7.8 (Miëtek Bak)++1.4.1.2 (2012-09-12)+  - support for GHC 7.6++1.4.1.1 ?+ 1.4.1.0 (2011-09-11)   - support for GHC 7.2 (thanks to thoughtpolice)   - support for windows (thanks to José Romildo Malaquias)

@@ -52,7 +52,7 @@     Window,             -- data Window deriving Eq     Border(..),         -- data Border     touchWin,-    newPad, pRefresh, delWin, newWin, wRefresh, wBorder, defaultBorder,+    newPad, pRefresh, delWin, newWin, wRefresh, wnoutRefresh, wBorder, defaultBorder,       -- * Refresh Routines@@ -86,10 +86,12 @@     bkgrndSet,     -- :: Attr -> Pair -> IO ()     erase,         -- :: IO ()     wclear,        -- :: Window -> IO ()+    werase,     clrToEol,      -- :: IO ()     wClrToEol,     beep,     waddch,+    winsch,     waddchnstr,    -- :: Window -> CString -> CInt -> IO CInt      -- * Output Options@@ -199,7 +201,11 @@ import Control.Monad.Trans import Control.Concurrent +#if !MIN_VERSION_base(4,7,0) import Foreign hiding ( unsafePerformIO, void )+#else+import Foreign hiding ( void )+#endif import Foreign.C.String import Foreign.C.Types import Foreign.C.Error@@ -273,7 +279,7 @@ type ChType = #type chtype type NBool = #type bool -+{-# NOINLINE stdScr #-} -- -- | The standard screen --@@ -452,16 +458,26 @@ ------------------------------------------------------------------------  ----- | get the dimensions of the screen+-- | get the dimensions of the screen (lines,cols) -- scrSize :: IO (Int, Int)+-- Note, per the documentation:+--    http://invisible-island.net/ncurses/ncurses-intro.html#caution+-- It is not recommended to peek at the LINES and COLS global variables.  This code+-- was previously doing exactly that, but now it is fixed to use getmaxyx.+--   -Ryan Newton [2013.03.31]   scrSize = do-    lnes <- peek linesPtr-    cols <- peek colsPtr-    return (fromIntegral lnes, fromIntegral cols)--foreign import ccall "HSCurses.h &LINES" linesPtr :: Ptr CInt-foreign import ccall "HSCurses.h &COLS"  colsPtr  :: Ptr CInt+    yfp <- mallocForeignPtr +    xfp <- mallocForeignPtr +    withForeignPtr yfp $ \yp -> +     withForeignPtr xfp $ \xp -> do+       getMaxYX stdScr yp xp+       y <- peek yp+       x <- peek xp+       return (fromIntegral y, fromIntegral x)+    +foreign import ccall "HSCurses.h getmaxyx_fun" getMaxYX+    :: Window -> Ptr CInt -> Ptr CInt -> IO ()  -- -- | refresh curses windows and lines. curs_refresh(3)@@ -482,7 +498,16 @@ foreign import ccall unsafe "HSCurses.h wrefresh"     wrefresh_c :: Window -> IO CInt +-- | Stage an update to a window, but don't actually do the refresh until update is+-- called.  This allows multiple windows to be updated together more smoothly. --+wnoutRefresh :: Window -> IO ()+wnoutRefresh w = throwIfErr_ "wnoutrefresh" $ wnoutrefresh_c w++foreign import ccall safe "HSCurses.h wnoutrefresh"+  wnoutrefresh_c :: Window -> IO CInt++-- -- | Do an actual update. Used after endWin on linux to restore the terminal -- update :: IO ()@@ -774,10 +799,16 @@  ------------------------------------------------------------------------ +-- | Raw NCurses routine. foreign import ccall safe     waddch :: Window -> ChType -> IO CInt +-- | Raw NCurses routine. foreign import ccall safe+    winsch :: Window -> ChType -> IO CInt++-- | Raw NCurses routine.+foreign import ccall safe     waddchnstr :: Window -> CString -> CInt -> IO CInt  foreign import ccall safe "static curses.h mvaddch" mvaddch_c :: CInt -> CInt -> ChType -> IO ()@@ -891,10 +922,16 @@  foreign import ccall unsafe bkgdset :: ChType -> IO () +-- | Copy blanks to every position in the screen. erase :: IO () erase = throwIfErr_ "erase" $ werase_c  stdScr foreign import ccall unsafe "werase" werase_c :: Window -> IO CInt +-- | Copy blanks to every position in a window.+werase :: Window -> IO ()+werase w = throwIfErr_ "werase" $ werase_c w++-- | Copy blanks to a window and set clearOk for that window. wclear :: Window -> IO () wclear w = throwIfErr_ "wclear" $ wclear_c  w foreign import ccall unsafe "wclear" wclear_c :: Window -> IO CInt@@ -1456,11 +1493,6 @@ nEqual   = chr 0x2260 sterling = chr 0x00A3 -{---- haddock doesn't like these commented out with ---   #if defined(__STDC_ISO_10646__)  && defined(HAVE_WADDNWSTR)-   #else--}  recognize :: Char -> IO a -> (ChType -> IO a) -> IO a recognize _ch noConvert _convert = noConvert -- Handle the most common case first.

@@ -63,11 +63,16 @@  import UI.HSCurses.Curses hiding ( refresh, Window ) import UI.HSCurses.Logging-import UI.HSCurses.MonadException import qualified UI.HSCurses.Curses as Curses  import Data.Char import Data.Maybe+#if MIN_VERSION_exceptions(0,6,0)+import Control.Monad.Catch (MonadMask, bracket, bracket_)+#else+import Control.Monad.Catch (MonadCatch, bracket, bracket_)+#define MonadMask MonadCatch+#endif import Control.Monad.Trans  #ifndef mingw32_HOST_OS@@ -397,12 +402,12 @@     do (_, p) <- Curses.wAttrGet window        Curses.wAttrSet window (a, p) -withStyle :: MonadExcIO m => CursesStyle -> m a -> m a+withStyle :: (MonadIO m, MonadMask m) => CursesStyle -> m a -> m a withStyle = wWithStyle Curses.stdScr -wWithStyle :: MonadExcIO m => Curses.Window -> CursesStyle -> m a -> m a+wWithStyle :: (MonadIO m, MonadMask m) => Curses.Window -> CursesStyle -> m a -> m a wWithStyle window style action =-    bracketM+    bracket         (liftIO $ do old <- Curses.wAttrGet window    -- before                      wSetStyle window style                      return old)@@ -480,13 +485,13 @@ -- -- | set the cursor, and do action ---withCursor :: MonadExcIO m => CursorVisibility -> m a -> m a+withCursor :: (MonadIO m, MonadMask m) => CursorVisibility -> m a -> m a withCursor nv action =-    bracketM+    bracket         (liftIO $ Curses.cursSet nv)             -- before         (\vis -> liftIO $ Curses.cursSet vis)    -- after         (\_ -> action)                           -- do this -withProgram :: MonadExcIO m => m a -> m a+withProgram :: (MonadIO m, MonadMask m) => m a -> m a withProgram action = withCursor CursorVisible $-    bracketM_ (liftIO endWin) (liftIO flushinp) action+    bracket_ (liftIO endWin) (liftIO flushinp) action

@@ -41,7 +41,12 @@  import System.IO.Unsafe ( unsafePerformIO ) +#if !MIN_VERSION_base(4,7,0) import Foreign hiding ( unsafePerformIO )+#else+import Foreign+#endif+ import Foreign.C import Control.Exception    ( Exception, try, bracket ) 

@@ -20,8 +20,10 @@  import Control.Monad.Trans -#ifdef __DEBUG__+#define __DEBUG__ 0 +#if __DEBUG__+ import Data.IORef import System.IO import System.IO.Unsafe (unsafePerformIO)@@ -34,7 +36,7 @@ trace :: String -> a -> a debug :: MonadIO m => String -> m () -#ifdef __DEBUG__+#if __DEBUG__  logFile :: Handle logFile = unsafePerformIO $ do h <- openFile ".hscurses.log" AppendMode

@@ -1,137 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--- Copyright (c) 2005-2011 Stefan Wehr - http://www.stefanwehr.de------ This library is free software; you can redistribute it and/or--- modify it under the terms of the GNU Lesser General Public--- License as published by the Free Software Foundation; either--- version 2.1 of the License, or (at your option) any later version.------ This library is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU--- Lesser General Public License for more details.------ You should have received a copy of the GNU Lesser General Public--- License along with this library; if not, write to the Free Software--- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA--module UI.HSCurses.MonadException where--#if !MIN_VERSION_base(4,6,0)-import Prelude hiding (catch)-#endif--import Control.Exception-import Control.Monad.State--class Monad m => MonadExc m where-    catchM      :: Exception e => m a -> (e -> m a) -> m a-    blockM      :: m a -> m a-    unblockM    :: m a -> m a---class (MonadIO m, MonadExc m) => MonadExcIO m------- Operations implemented in term of catchM, blockM and unblockM--- (taken from Control.Exception).-----catchJustM :: (Exception e, MonadExc m) =>-       (e -> Maybe b) -- ^ Predicate to select exceptions-    -> m a                    -- ^ Computation to run-    -> (b -> m a)             -- ^ Handler-    -> m a-catchJustM p a handler = catchM a handler'-  where handler' e = case p e of-            Nothing -> throw e-            Just b  -> handler b--handleM :: (Exception e, MonadExc m) => (e -> m a) -> m a -> m a-handleM = flip catchM--handleJustM :: (Exception e,MonadExc m) =>-              (e -> Maybe b) -> (b -> m a) -> m a -> m a-handleJustM p = flip (catchJustM p)--tryM :: (Exception e, MonadExc m) => m a -> m (Either e a)-tryM a = catchM (a >>= \ v -> return (Right v)) (\e -> return (Left e))--tryJustM :: (Exception e, MonadExc m) => (e -> Maybe b) -> m a -> m (Either b a)-tryJustM p a = do-  r <- tryM a-  case r of-    Right v -> return (Right v)-    Left  e -> case p e of-            Nothing -> throw e-            Just b  -> return (Left b)--bracketM :: MonadExc m =>-       m a         -- ^ computation to run first (\"acquire resource\")-    -> (a -> m b)  -- ^ computation to run last (\"release resource\")-    -> (a -> m c)  -- ^ computation to run in-between-    -> m c         -- returns the value from the in-between computation-bracketM before after thing =-  blockM (do-    a <- before-    r <- catchM-       (unblockM (thing a))-       (\(e::SomeException) -> do { after a; throw e })-    after a-    return r-  )--bracketM_ :: MonadExc m => m a -> m b -> m c -> m c-bracketM_ before after thing = bracketM before (const after) (const thing)--finally :: IO a -- ^ computation to run first-    -> IO b     -- ^ computation to run afterward (even if an exception-                --   was raised)-    -> IO a     -- returns the value from the first computation-a `finally` sequel =-  blockM (do-    r <- catchM-         (unblockM a)-         (\(e::SomeException) -> do { sequel; throw e })-    sequel-    return r-  )-------- Instance declarations-----instance MonadExc IO where-    catchM       = catch-    blockM       = block-    unblockM     = unblock--instance MonadExcIO IO--instance MonadExc m => MonadExc (StateT s m) where-    catchM   = catchState-    blockM   = blockState-    unblockM = unblockState--instance (MonadExc m, MonadIO m) => MonadExcIO (StateT s m)--modifyState :: MonadExc m => (s -> m (a, s)) -> StateT s m a-modifyState f =-    do oldState <- get-       (x, newState) <- lift $ f oldState-       put newState-       return x--catchState :: (Exception e, MonadExc m)-           => StateT s m a -> (e -> StateT s m a) -> StateT s m a-catchState run handler =-    modifyState (\oldState -> runStateT run oldState `catchM`-                              (\e -> runStateT (handler e) oldState))--blockState, unblockState :: (MonadExc m) => StateT s m a -> StateT s m a-blockState run =-    modifyState (\oldState -> blockM (runStateT run oldState))--unblockState run =-    modifyState (\oldState -> unblockM (runStateT run oldState))

@@ -1,5 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification #-}--- glasgow-exts needed for existentials and multi-parameter type classes.+{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, CPP #-}  -- Copyright (c) 2005-2011 Stefan Wehr - http://www.stefanwehr.de --@@ -20,13 +19,18 @@ module UI.HSCurses.Widgets where  import Control.Exception (assert)+#if MIN_VERSION_exceptions(0,6,0)+import Control.Monad.Catch (MonadMask)+#else+import Control.Monad.Catch (MonadCatch)+#define MonadMask MonadCatch+#endif import Control.Monad.Trans import Data.Char import Data.List import Data.Maybe  import UI.HSCurses.Logging-import UI.HSCurses.MonadException import qualified UI.HSCurses.Curses as Curses import qualified UI.HSCurses.CursesHelper as CursesH @@ -68,7 +72,8 @@     minSize   :: a -> Size  class Widget a => ActiveWidget a where-    activate  :: MonadExcIO m => m () -> Pos -> Size -> a -> m (a, String)+    activate  :: (MonadIO m, MonadMask m) => m () -> Pos -> Size -> a ->+                 m (a, String)  type KeyHandler a = Pos -> Size -> a -> IO (Cont a) @@ -307,7 +312,7 @@        CursesH.drawLine width (drop (ew_xoffset ew) $ ew_content ew)        Curses.refresh -activateEditWidget :: MonadExcIO m => m () -> Pos -> Size+activateEditWidget :: (MonadIO m, MonadMask m) => m () -> Pos -> Size                    -> EditWidget -> m (EditWidget, String) activateEditWidget refresh pos@(y, x) sz@(_, width) ew =     CursesH.withCursor Curses.CursorVisible $ processKey ew@@ -555,7 +560,7 @@     minSize (TableCell w) = minSize w     minSize (ActiveTableCell w) = minSize w -_activateTableCell :: MonadExcIO m => m () -> Pos -> Size+_activateTableCell :: (MonadIO m, MonadMask m) => m () -> Pos -> Size                    -> TableCell -> m (TableCell, String) _activateTableCell _ _ _ (TableCell _) =     error "_activateTableCell: cannot activate non-active cell!"@@ -759,7 +764,7 @@              Just (y,x) ->                  newTbw { tbw_pos = Just (min newLastVis y, x) } -tableWidgetActivateCurrent :: MonadExcIO m => m () -> Pos -> Size+tableWidgetActivateCurrent :: (MonadIO m, MonadMask m) => m () -> Pos -> Size                            -> DrawingHint -> TableWidget                            -> m (TableWidget, Maybe String) tableWidgetActivateCurrent refresh (y, x) sz _ tbw =@@ -799,9 +804,9 @@ tableWidgetGoDown =  tableWidgetMove DirDown  tableWidgetMove :: Direction-                                               -> (Int, Int)-                                               -> TableWidget-                                               -> TableWidget+                -> (Int, Int)+                -> TableWidget+                -> TableWidget tableWidgetMove dir sz tbw =     let pos = tbw_pos tbw         opts = tbw_options tbw@@ -814,9 +819,9 @@                              tableWidgetMakeVisible (tbw {tbw_pos=newP}) sz y  tableWidgetMakeVisible :: TableWidget-                                                      -> (Int, Int)-                                                      -> Int-                                                      -> TableWidget+                       -> (Int, Int)+                       -> Int+                       -> TableWidget tableWidgetMakeVisible tbw sz@(_,_) y =     let info = tableWidgetDisplayInfo sz tbw         firstVis = tbwdisp_firstVis info@@ -850,7 +855,7 @@                     Just z -> Just (y, z)         vert f = case f rows y cols x of                    Nothing -> Nothing-                   Just z -> Just (y, z)+                   Just z -> Just (z, x)         res = case dir of                 DirLeft-> horiz goLeft                 DirRight -> horiz goRight

@@ -55,4 +55,9 @@ #undef wattr_get #endif +// Accessing macros from Haskell is problematic, this is a wrapper:+void getmaxyx_fun(WINDOW* win, int* y, int* x) {+  getmaxyx(win,(*y),(*x));+}+ #endif  // HSCURSES_H

@@ -417,6 +417,7 @@  eventloop w =     do k <- CursesH.getKey (resize mkMainWidget)+       debug ("Got key " ++ show k)        case k of          Curses.KeyChar 'q' -> return ()          Curses.KeyChar 'd' -> process $ delete w

@@ -1,5 +1,5 @@ Name:           hscurses-Version:        1.4.1.2+Version:        1.4.2.0 License:        LGPL License-file:   LICENSE Author:         John Meacham <john at repetae dot net>@@ -22,7 +22,7 @@ Homepage:       https://github.com/skogsbaer/hscurses Cabal-version: >= 1.6 Build-Type:     Configure-Tested-with:    GHC==7.0.4, GHC==7.2.1, GHC==7.4.2, GHC==7.6.1+Tested-with:    GHC==7.6.1, GHC==7.8 Data-files:     README, TODO, ChangeLog,     example/contacts2, example/Setup.hs, example/ContactManager.hs,@@ -35,13 +35,13 @@   Location:       git://github.com/skogsbaer/hscurses.git  Library-  Build-depends:  base == 4.*, mtl,+  Build-depends:  base == 4.*, exceptions, mtl,                   old-time < 1.2, old-locale == 1.0.*   if !os(windows)-    Build-depends: unix >= 2.4 && < 2.7+    Build-depends: unix >= 2.4   Exposed-modules:       UI.HSCurses.Curses, UI.HSCurses.CursesHelper, UI.HSCurses.Widgets,-      UI.HSCurses.MonadException, UI.HSCurses.Logging+      UI.HSCurses.Logging   Other-modules:       UI.HSCurses.CWString, UI.HSCurses.IConv   C-sources: