vty-ui 1.0.1 → 1.1

raw patch · 37 files changed

+532/−454 lines, 37 filesdep ~containersdep ~directorydep ~filepathPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, directory, filepath, time

API changes (from Hackage documentation)

Files

• doc/ch1/api_notes.tex +0/−8
• doc/ch2/collections.tex +9/−10
• doc/ch2/event_loop.tex +18/−23
• doc/ch3/deferring_to_children.tex +1/−1
• doc/ch3/implementing_composite_widgets.tex +3/−3
• doc/ch3/implementing_event_handlers.tex +4/−4
• doc/ch3/new_widget_type.tex +3/−3
• doc/ch4/Fixed.tex +1/−1
• doc/ch4/List.tex +30/−18
• doc/macros.tex +1/−1
• src/ComplexDemo.hs +11/−8
• src/DialogDemo.hs +4/−4
• src/Graphics/Vty/Widgets/All.hs +0/−0
• src/Graphics/Vty/Widgets/Borders.hs +9/−10
• src/Graphics/Vty/Widgets/Box.hs +20/−13
• src/Graphics/Vty/Widgets/Button.hs +4/−5
• src/Graphics/Vty/Widgets/Centering.hs +3/−4
• src/Graphics/Vty/Widgets/CheckBox.hs +25/−26
• src/Graphics/Vty/Widgets/Core.hs +75/−77
• src/Graphics/Vty/Widgets/Dialog.hs +5/−6
• src/Graphics/Vty/Widgets/DirBrowser.hs +42/−44
• src/Graphics/Vty/Widgets/Edit.hs +15/−24
• src/Graphics/Vty/Widgets/EventLoop.hs +34/−28
• src/Graphics/Vty/Widgets/Events.hs +7/−8
• src/Graphics/Vty/Widgets/Fills.hs +2/−3
• src/Graphics/Vty/Widgets/Fixed.hs +10/−11
• src/Graphics/Vty/Widgets/Limits.hs +10/−11
• src/Graphics/Vty/Widgets/List.hs +136/−63
• src/Graphics/Vty/Widgets/Padding.hs +2/−3
• src/Graphics/Vty/Widgets/ProgressBar.hs +5/−5
• src/Graphics/Vty/Widgets/Table.hs +12/−13
• src/Graphics/Vty/Widgets/Text.hs +4/−4
• src/Graphics/Vty/Widgets/Util.hs +16/−2
• src/ListDemo.hs +3/−1
• src/PhoneInputDemo.hs +3/−4
• test/src/Tests/FormattedText.hs +0/−0
• vty-ui.cabal +5/−5

@@ -15,14 +15,6 @@ \fw{Widget a} whenever you need to refer to a widget; this makes it possible to mutate widget state when events occur in your application. -All widget constructors must ultimately be run in the \fw{IO} monad,-so all API functions must be run in an instance of \fw{MonadIO}.  In-this manual we will use \fw{IO} to simplify type signatures, but keep-in mind that the actual type is likely to be \fw{(MonadIO m) => m}.-Although \fw{MonadIO} is by far the more common constraint, be sure to-check the API documentation to be sure; some functions, such as event-handlers, are \fw{IO} actions.- Regarding return values, even if a function is of type \fw{...\ -> IO   a}, we say it is ``in the \fw{IO} monad'' and \textit{returns} \fw{a}.  We won't bother saying that a function \textit{returns \fw{IO

@@ -50,13 +50,12 @@  changeToW <- addToCollection c ui fg \end{haskellcode} -As a convenience, \fw{addToCollection} returns a \fw{MonadIO} action-which, when run, will switch to the specified interface.  In the-example above, \fw{changeToW} is an action which will switch to the-interface with \fw{ui} as its top-level widget and \fw{fg} as its-focus group.  You can use this action in event handlers that change-your interface state.  If you prefer, you can use the-\fw{setCurrentEntry} function instead, which allows you to set the-\fw{Collection}'s interface by number.  Use of \fw{setCurrentEntry} is-not recommended, however, since a bad index can cause an exception to-be thrown.+As a convenience, \fw{addToCollection} returns a \fw{IO} action which,+when run, will switch to the specified interface.  In the example+above, \fw{changeToW} is an action which will switch to the interface+with \fw{ui} as its top-level widget and \fw{fg} as its focus group.+You can use this action in event handlers that change your interface+state.  If you prefer, you can use the \fw{setCurrentEntry} function+instead, which allows you to set the \fw{Collection}'s interface by+number.  Use of \fw{setCurrentEntry} is not recommended, however,+since a bad index can cause an exception to be thrown.

@@ -22,6 +22,24 @@ \item The current ``override'' attribute \end{itemize} +The event loop will run until one of two conditions occurs:++\begin{itemize}+\item An exception of any kind is thrown; if an exception is thrown,+  the event loop will shut down Vty cleanly and re-throw the+  exception.+\item An event handler or thread calls \fw{shutdownUi}; the+  \fw{shutdownUi} function sends a signal to stop the event loop, at+  which point control will be returned to your program.  The shutdown+  signal goes into a queue with all of the other signals processed by+  the event loop, such as key input events and scheduled actions (see+  Section \ref{sec:concurrency}), but it will preempt them.  Note that+  there is no \textit{guarantee} that there won't be some other signal+  placed into the queue before you run \fw{shutdownUi}, such as when+  another thread is running in parallel with an event handler which+  calls \fw{shutdownUi}.+\end{itemize}+ \subsection{Skinning} \label{sec:skinning} @@ -164,26 +182,3 @@ Some built-in widgets will almost always be used in this way; for an example, take a look at the \fw{ProgressBar} widget in the \fw{ProgressBar} module (see Section \ref{sec:progress_bars}).--\subsection{Managing Your Own State}--If your applications have their own state management needs, then that-state management can be done in parallel with the \vtyui\ event loop-with proper use of \fw{schedule}.--A typical design for applications using \vtyui\ is:--\begin{itemize}-\item The application defines its own state type, call it-  \fw{AppState}.-\item The \fw{AppState} type has fields for the various widgets that-  need to be mutated over the course of the application's execution;-  for example, lists, progress bars, radio buttons, check boxes, edit-  widgets, etc.-\item Various event handlers are set up on these and other widgets.-\item The application spawns one or more threads to manage events from-  external sources, and when these events occur, actions are scheduled-  with \fw{schedule} to update the interface state accordingly.-\item The main event loop is executed and control is passed to the-  library.-\end{itemize}

@@ -22,7 +22,7 @@   Section \ref{sec:containers_and_input}.}  \begin{haskellcode}- newWrapper :: (MonadIO m) => Widget a -> m (Widget (Wrapper a))+ newWrapper :: Widget a -> IO (Widget (Wrapper a))  newWrapper child = do    wRef <- newWidget $ \w ->      w { state = Wrapper child

@@ -65,7 +65,7 @@ % Let this block span a page boundary since it's so big that it's % likely, and we don't want to bump it down unless it looks good. :) \begin{haskellcode*}{samepage=false}- newPhoneInput :: (MonadIO m) => m (PhoneInput, Widget FocusGroup)+ newPhoneInput :: IO (PhoneInput, Widget FocusGroup)  newPhoneInput = do    ahs <- newHandlers    e1 <- editWidget@@ -108,8 +108,8 @@ Then we provide a function to register phone number handlers:  \begin{haskellcode}- onPhoneInputActivate :: (MonadIO m) => PhoneInput-                      -> (PhoneNumber -> IO ()) -> m ()+ onPhoneInputActivate :: PhoneInput+                      -> (PhoneNumber -> IO ()) -> IO ()  onPhoneInputActivate input handler =    addHandler (return . activateHandlers) input handler \end{haskellcode}

@@ -41,7 +41,7 @@ constructor to construct a \fw{Handlers} list:  \begin{haskellcode}- newTempMonitor :: (MonadIO m) => m (Widget TempMonitor)+ newTempMonitor :: IO (Widget TempMonitor)  newTempMonitor = do    handlers <- newHandlers    wRef <- newWidget $ \w ->@@ -61,9 +61,9 @@ monitor case, we might write something like this:  \begin{haskellcode}- onTemperatureChange :: (MonadIO m) => Widget TempMonitor+ onTemperatureChange :: Widget TempMonitor                      -> (TemperatureEvent -> IO ())-                     -> m ()+                     -> IO ()  onTemperatureChange wRef handler =    addHandler (tempChangeHandlers <~~) wRef handler \end{haskellcode}@@ -94,7 +94,7 @@ invoke the handlers as follows:  \begin{haskellcode}- setTemperature :: (MonadIO m) => Widget TempMonitor -> Int -> m ()+ setTemperature :: Widget TempMonitor -> Int -> IO ()  setTemperature wRef newTemp = do    -- Set the internal widget state.    -- ...

@@ -24,7 +24,7 @@ Here's what the function will look like in full:  \begin{haskellcode}- newCounter :: (MonadIO m) => Int -> m (Widget Counter)+ newCounter :: Int -> IO (Widget Counter)  newCounter initialValue = do    wRef <- newWidget $ \w ->      w { state = Counter initialValue@@ -141,11 +141,11 @@ its state:  \begin{haskellcode}- setCounterValue :: (MonadIO m) => Widget Counter -> Int -> m ()+ setCounterValue :: Widget Counter -> Int -> IO ()  setCounterValue wRef val =     updateWidgetState wRef $ const $ Counter val - getCounterValue :: (MonadIO m) => Widget Counter -> m Int+ getCounterValue :: Widget Counter -> IO Int  getCounterValue wRef = do     Counter val <- getState wRef     return val

@@ -51,7 +51,7 @@ guarantee that the specified space is consumed.  \begin{haskellcode}- lst <- newList (green `on` black) plainText+ lst <- newList (green `on` black)  ui <- vFixed 5 lst \end{haskellcode} 

@@ -36,40 +36,42 @@ Lists are created with the \fw{newList} function:  \begin{haskellcode}- lst <- newList attr plainText+ lst <- newList attr \end{haskellcode} -\fw{newList} takes two parameters: the attribute of the+\fw{newList} takes one parameter: the attribute of the currently-selected item to be used when the list is \textit{not}-focused, and the \textit{constructor function} to be used to create-widgets when new items are added to the list.  The \fw{List} uses its-own focus attribute (Section \ref{sec:attributes}) as the attribute of-the currently-selected item when it has the focus.+focused.  The \fw{List} uses its own focus attribute (Section+\ref{sec:attributes}) as the attribute of the currently-selected item+when it has the focus.  The widget type of the list (\fw{b} above)+won't be chosen by the type system until you actually add something to+the list.  Items may be added to a \fw{List} with the \fw{addToList} function,-which takes an internal value (e.g., \fw{String}) and uses it to-construct a widget with the appropriate type (e.g., \fw{Widget-  FormattedText}):+which takes an internal value (e.g., \fw{String}) and a widget of the+appropriate type:  \begin{haskellcode}- addToList lst "foobar"+ let s = "foobar"+ addToList lst s =<< plainText s \end{haskellcode} -The constructor function passed to \fw{newList} is essentially a-specification of how list items should be represented.  For a \fw{List-  a b}, it must take a value of type \fw{a} and return a \fw{Widget-  b}.  There are two restrictions on the constructor's return value:+In addition, items may be inserted into a \fw{List} at any position with+the \fw{insertIntoList} function. +There are two restrictions on the widget type that can be used with+\fw{List}s:+ \begin{itemize} \item The \fw{Widget b} type \textit{must not grow vertically}.  This   is because all \fw{List} item widgets must take up a fixed amount of   vertical space so the \fw{List} can manage scrolling.  If the widget   grows vertically, \fw{addToList} will throw a \fw{ListError}   exception.-\item All widgets returned \textit{must have the same height}.  This-  is because the list uses the item height to calculate how many items-  can be displayed, given the space available to the rendered-  \fw{List}.  If the constructor creates a widget whose rendered size+\item All widgets added to the \fw{List} \textit{must have the same+  height}.  This is because the list uses the item height to calculate+  how many items can be displayed, given the space available to the+  rendered \fw{List}.  If you specify a widget whose rendered size   doesn't match that of the rest of the wigets of the list, layout   problems are likely to ensue. \end{itemize}@@ -91,6 +93,12 @@ \fw{clearList} function.  \fw{clearList} does \textit{not} invoke any event handlers for the removed items. +In addition to \fw{addToList}, the \fw{List} API provides the+\fw{setSelected} function.  This function takes a \fw{List} widget and+an index and scrolls the list so that the item at the specified+position is selected.  If the position is out of bounds, the \fw{List}+is scrolled as much as possible.+ \subsection{\fw{List} Inspection}  The \fw{List} module provides some functions to get information about@@ -103,6 +111,10 @@   \fw{Nothing} if the \fw{List} is empty or returns \fw{Just (pos,     (val, widget))} corresponding to the list index, internal item   value, and widget of the currently-selected list item.+\item \fw{getListItem} -- takes a \fw{Widget (List a b)} and an index+  and returns \fw{Nothing} if the \fw{List} has no item at the+  specified index item or returns \fw{Just (pos, (val, widget))}+  corresponding to the list index. \end{itemize}  \subsection{Scrolling a \fw{List}}

@@ -1,6 +1,6 @@ % Custom macros. -\newcommand{\vtyuiversion}{1.0}+\newcommand{\vtyuiversion}{1.1}  \newcommand{\fw}[1]{\texttt{#1}} \newcommand{\vtyui}{\fw{vty-ui}}

@@ -66,7 +66,7 @@   edit1Header <- textWidget wrap "" >>= withNormalAttribute headerAttr   edit2Header <- textWidget wrap "" >>= withNormalAttribute headerAttr -  lst <- newList (fgColor bright_green) plainText+  lst <- newList (fgColor bright_green)    selector <- vLimit 3 lst   listHeader <- plainText ""@@ -126,13 +126,16 @@            KEsc -> exitSuccess            _ -> return False -  mapM_ (addToList lst) [ "Cookies"-                        , "Cupcakes"-                        , "Twinkies"-                        , "M&Ms"-                        , "Fritos"-                        , "Cheetos"-                        ]+  let strs = [ "Cookies"+             , "Cupcakes"+             , "Twinkies"+             , "M&Ms"+             , "Fritos"+             , "Cheetos"+             ]++  forM_ strs $ \s ->+      (addToList lst s =<< plainText s)    addToFocusGroup fgr r1   addToFocusGroup fgr r2

@@ -1,8 +1,6 @@ {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}-{-# LANGUAGE MultiParamTypeClasses #-} module Main where -import System.Exit import Graphics.Vty hiding (Button) import Graphics.Vty.Widgets.All @@ -29,10 +27,12 @@   e `onActivate` (const $ acceptDialog d)    -- Exit either way.-  d `onDialogAccept` const exitSuccess-  d `onDialogCancel` const exitSuccess+  d `onDialogAccept` const shutdownUi+  d `onDialogCancel` const shutdownUi    coll <- newCollection   _ <- addToCollection coll c =<< (mergeFocusGroups fg dFg)    runUi coll $ defaultContext { focusAttr = black `on` yellow }++  (putStrLn . ("You entered: " ++)) =<< getEditText e

@@ -20,7 +20,6 @@     ) where -import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Box@@ -31,7 +30,7 @@ -- |The class of types with a border attribute, which differs from the -- |normal and focused attributes. class HasBorderAttr a where-    setBorderAttribute :: (MonadIO m) => a -> Attr -> m ()+    setBorderAttribute :: a -> Attr -> IO ()  data HBorder = HBorder Attr String                deriving (Show)@@ -40,26 +39,26 @@     setBorderAttribute t a =         updateWidgetState t $ \(HBorder a' s) -> HBorder (mergeAttr a a') s -withBorderAttribute :: (MonadIO m, HasBorderAttr a) => Attr -> a -> m a+withBorderAttribute :: (HasBorderAttr a) => Attr -> a -> IO a withBorderAttribute att w = setBorderAttribute w att >> return w -withHBorderLabel :: (MonadIO m) => String -> Widget HBorder -> m (Widget HBorder)+withHBorderLabel :: String -> Widget HBorder -> IO (Widget HBorder) withHBorderLabel label w = setHBorderLabel w label >> return w -setHBorderLabel :: (MonadIO m) => Widget HBorder -> String -> m ()+setHBorderLabel :: Widget HBorder -> String -> IO () setHBorderLabel w label =     updateWidgetState w $ \(HBorder a _) -> HBorder a label -withBorderedLabel :: (MonadIO m) => String -> Widget (Bordered a) -> m (Widget (Bordered a))+withBorderedLabel :: String -> Widget (Bordered a) -> IO (Widget (Bordered a)) withBorderedLabel label w = setBorderedLabel w label >> return w -setBorderedLabel :: (MonadIO m) => Widget (Bordered a) -> String -> m ()+setBorderedLabel :: Widget (Bordered a) -> String -> IO () setBorderedLabel w label =     updateWidgetState w $ \(Bordered a ch _) -> Bordered a ch label  -- |Create a single-row horizontal border using the specified -- attribute and character.-hBorder :: (MonadIO m) => m (Widget HBorder)+hBorder :: IO (Widget HBorder) hBorder = do   wRef <- newWidget $ \w ->       w { state = HBorder def_attr ""@@ -102,7 +101,7 @@  -- |Create a single-column vertical border using the specified -- attribute and character.-vBorder :: (MonadIO m) => m (Widget VBorder)+vBorder :: IO (Widget VBorder) vBorder = do   wRef <- newWidget $ \w ->       w { state = VBorder def_attr@@ -132,7 +131,7 @@         updateWidgetState t $ \(Bordered a' ch s) -> Bordered (mergeAttr a a') ch s  -- |Wrap a widget in a bordering box.-bordered :: (MonadIO m, Show a) => Widget a -> m (Widget (Bordered a))+bordered :: (Show a) => Widget a -> IO (Widget (Bordered a)) bordered child = do   wRef <- newWidget $ \w ->       w { state = Bordered def_attr child ""

@@ -32,7 +32,6 @@ import Data.Typeable import Control.Exception import Control.Monad-import Control.Monad.Trans import Graphics.Vty.Widgets.Core import Graphics.Vty import Graphics.Vty.Widgets.Util@@ -101,24 +100,24 @@ -- |Create a horizontal box widget containing two widgets side by -- side.  Space consumed by the box will depend on its contents, -- available space, and the box child size policy.-hBox :: (MonadIO m, Show a, Show b) => Widget a -> Widget b -> m (Widget (Box a b))+hBox :: (Show a, Show b) => Widget a -> Widget b -> IO (Widget (Box a b)) hBox = box Horizontal 0  -- |Create a vertical box widget containing two widgets, one above the -- other.  Space consumed by the box will depend on its contents, -- available space, and the box child size policy.-vBox :: (MonadIO m, Show a, Show b) => Widget a -> Widget b -> m (Widget (Box a b))+vBox :: (Show a, Show b) => Widget a -> Widget b -> IO (Widget (Box a b)) vBox = box Vertical 0  -- |Create a vertical box widget using monadic widget constructors.-(<-->) :: (MonadIO m, Show a, Show b) => m (Widget a) -> m (Widget b) -> m (Widget (Box a b))+(<-->) :: (Show a, Show b) => IO (Widget a) -> IO (Widget b) -> IO (Widget (Box a b)) (<-->) act1 act2 = do   ch1 <- act1   ch2 <- act2   vBox ch1 ch2  -- |Create a horizontal box widget using monadic widget constructors.-(<++>) :: (MonadIO m, Show a, Show b) => m (Widget a) -> m (Widget b) -> m (Widget (Box a b))+(<++>) :: (Show a, Show b) => IO (Widget a) -> IO (Widget b) -> IO (Widget (Box a b)) (<++>) act1 act2 = do   ch1 <- act1   ch2 <- act2@@ -132,8 +131,8 @@ defaultChildSizePolicy :: ChildSizePolicy defaultChildSizePolicy = PerChild BoxAuto BoxAuto -box :: (MonadIO m, Show a, Show b) =>-       Orientation -> Int -> Widget a -> Widget b -> m (Widget (Box a b))+box :: (Show a, Show b) =>+       Orientation -> Int -> Widget a -> Widget b -> IO (Widget (Box a b)) box o spacing wa wb = do   wRef <- newWidget $ \w ->       w { state = Box { boxChildSizePolicy = defaultChildSizePolicy@@ -194,6 +193,14 @@                       b <- getState this                       renderBox s ctx b +        , getCursorPosition_ =+            \this -> do+              b <- getState this+              ch1_pos <- getCursorPosition $ boxFirst b+              case ch1_pos of+                Just v -> return $ Just v+                Nothing -> getCursorPosition $ boxSecond b+         , setCurrentPosition_ =             \this pos -> do               b <- getState this@@ -211,30 +218,30 @@    return wRef -getFirstChild :: (MonadIO m) => Widget (Box a b) -> m (Widget a)+getFirstChild :: Widget (Box a b) -> IO (Widget a) getFirstChild = (boxFirst <~~) -getSecondChild :: (MonadIO m) => Widget (Box a b) -> m (Widget b)+getSecondChild :: Widget (Box a b) -> IO (Widget b) getSecondChild = (boxSecond <~~)  -- |Set the spacing in between a box's child widgets in rows or -- columns, depending on the box type.-setBoxSpacing :: (MonadIO m) => Widget (Box a b) -> Int -> m ()+setBoxSpacing :: Widget (Box a b) -> Int -> IO () setBoxSpacing wRef spacing =     updateWidgetState wRef $ \b -> b { boxSpacing = spacing } -withBoxSpacing :: (MonadIO m) => Int -> Widget (Box a b) -> m (Widget (Box a b))+withBoxSpacing :: Int -> Widget (Box a b) -> IO (Widget (Box a b)) withBoxSpacing spacing wRef = do   setBoxSpacing wRef spacing   return wRef -getBoxChildSizePolicy :: (MonadIO m) => Widget (Box a b) -> m ChildSizePolicy+getBoxChildSizePolicy :: Widget (Box a b) -> IO ChildSizePolicy getBoxChildSizePolicy = (boxChildSizePolicy <~~)  -- |Set the box child size policy.  Throws 'BadPercentage' if the size -- |policy uses an invalid percentage value, which must be between 0 -- |and 100 inclusive.-setBoxChildSizePolicy :: (MonadIO m) => Widget (Box a b) -> ChildSizePolicy -> m ()+setBoxChildSizePolicy :: Widget (Box a b) -> ChildSizePolicy -> IO () setBoxChildSizePolicy b spol = do   case spol of     Percentage v -> when (v < 0 || v > 100) $ throw BadPercentage

@@ -11,7 +11,6 @@     ) where -import Control.Monad.Trans import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Text import Graphics.Vty.Widgets.Padding@@ -27,15 +26,15 @@                      }  -- |Register a handler for the button press event.-onButtonPressed :: (MonadIO m) => Button -> (Button -> IO ()) -> m ()+onButtonPressed :: Button -> (Button -> IO ()) -> IO () onButtonPressed = addHandler (return . buttonPressedHandlers)  -- |Programmatically press a button to trigger its event handlers.-pressButton :: (MonadIO m) => Button -> m ()+pressButton :: Button -> IO () pressButton b = fireEvent b (return . buttonPressedHandlers) b  -- |Set the text label on a button.-setButtonText :: (MonadIO m) => Button -> String -> m ()+setButtonText :: Button -> String -> IO () setButtonText b s = setText (buttonText b) s  instance HasNormalAttr Button where@@ -45,7 +44,7 @@     setFocusAttribute b a = setFocusAttribute (buttonWidget b) a  -- |Create a button.  Get its underlying widget with 'buttonWidget'.-newButton :: (MonadIO m) => String -> m Button+newButton :: String -> IO Button newButton msg = do   t <- plainText msg 

@@ -12,7 +12,6 @@ where  import GHC.Word ( Word )-import Control.Monad.Trans import Graphics.Vty.Widgets.Core import Graphics.Vty import Graphics.Vty.Widgets.Util@@ -23,7 +22,7 @@     show (HCentered _) = "HCentered { ... }"  -- |Wrap another widget to center it horizontally.-hCentered :: (MonadIO m, Show a) => Widget a -> m (Widget (HCentered a))+hCentered :: (Show a) => Widget a -> IO (Widget (HCentered a)) hCentered ch = do   wRef <- newWidget $ \w ->       w { state = HCentered ch@@ -64,7 +63,7 @@     show (VCentered _) = "VCentered { ... }"  -- |Wrap another widget to center it vertically.-vCentered :: (MonadIO m, Show a) => Widget a -> m (Widget (VCentered a))+vCentered :: (Show a) => Widget a -> IO (Widget (VCentered a)) vCentered ch = do   wRef <- newWidget $ \w ->       w { state = VCentered ch@@ -99,7 +98,7 @@   return wRef  -- |Wrap another widget to center it both vertically and horizontally.-centered :: (MonadIO m, Show a) => Widget a -> m (Widget (VCentered (HCentered a)))+centered :: (Show a) => Widget a -> IO (Widget (VCentered (HCentered a))) centered wRef = vCentered =<< hCentered wRef  centered_halves :: (DisplayRegion -> Word) -> DisplayRegion -> Word -> (Word, Word)

@@ -41,7 +41,6 @@ import Data.List ( findIndex ) import Data.Maybe import Control.Monad-import Control.Monad.Trans import Control.Exception import Data.Typeable import Graphics.Vty@@ -58,26 +57,26 @@ -- |Create a new radio button group.  This is used to guarantee -- exclusivity among the check boxes in the group so that they behave -- like radio buttons.-newRadioGroup :: (MonadIO m) => m RadioGroup+newRadioGroup :: IO RadioGroup newRadioGroup = do   hs <- newHandlers-  liftIO $ newIORef $ RadioGroupData Nothing hs+  newIORef $ RadioGroupData Nothing hs  -- |Register a handler to be notified when the currently-selected -- check box in a radio group changes.-onRadioChange :: (MonadIO m) => RadioGroup -> (Widget (CheckBox Bool) -> IO ())-              -> m ()+onRadioChange :: RadioGroup -> (Widget (CheckBox Bool) -> IO ())+              -> IO () onRadioChange rg act = do-  rd <- liftIO $ readIORef rg+  rd <- readIORef rg   addHandler (return . changeHandlers) rd act  -- |Get the currently-selected checkbox in a radio group, if any.-getCurrentRadio :: (MonadIO m) => RadioGroup -> m (Maybe (Widget (CheckBox Bool)))+getCurrentRadio :: RadioGroup -> IO (Maybe (Widget (CheckBox Bool))) getCurrentRadio = (currentlySelected <~)  -- |Add a check box to a radio group.  The check box's apperance will -- be changed so that it resembles a radio button.-addToRadioGroup :: (MonadIO m) => RadioGroup -> Widget (CheckBox Bool) -> m ()+addToRadioGroup :: RadioGroup -> Widget (CheckBox Bool) -> IO () addToRadioGroup rg wRef = do   setStateChar wRef True '*'   setBracketChars wRef '(' ')'@@ -93,7 +92,7 @@         -- Uncheck the old currently-selected checkbox in the radio         -- group, if any, before updating the radiogroup state. -        rgData <- liftIO $ readIORef rg+        rgData <- readIORef rg          -- If the radio group has a currently-selected checkbox,         -- uncheck it (but only if it's a different widget: it could@@ -142,17 +141,17 @@                      ]  -- |Create a new checkbox with the specified text label.-newCheckbox :: (MonadIO m) => String -> m (Widget (CheckBox Bool))+newCheckbox :: String -> IO (Widget (CheckBox Bool)) newCheckbox label = newMultiStateCheckbox label [(False, ' '), (True, 'x')]  -- |Create a new multi-state checkbox.-newMultiStateCheckbox :: (Eq a, MonadIO m) =>+newMultiStateCheckbox :: (Eq a) =>                          String -- ^The checkbox label.                       -> [(a, Char)] -- ^The list of valid states that                                      -- the checkbox can be in, along                                      -- with the visual representation                                      -- ('Char') for each state.-                      -> m (Widget (CheckBox a))+                      -> IO (Widget (CheckBox a)) newMultiStateCheckbox _ [] = throw EmptyCheckboxStates newMultiStateCheckbox label states = do   cchs <- newHandlers@@ -202,7 +201,7 @@  -- |Set the visual representation for a state in a checkbox.  May -- throw 'BadStateArgument'.-setStateChar :: (Eq a, MonadIO m) => Widget (CheckBox a) -> a -> Char -> m ()+setStateChar :: (Eq a) => Widget (CheckBox a) -> a -> Char -> IO () setStateChar wRef v ch = do   states <- checkboxStates <~~ wRef @@ -216,14 +215,14 @@  -- |Set the checkbox's bracketing characters for the left and right -- brackets around the state character.-setBracketChars :: (MonadIO m) => Widget (CheckBox a) -> Char -> Char -> m ()+setBracketChars :: Widget (CheckBox a) -> Char -> Char -> IO () setBracketChars wRef chL chR =     updateWidgetState wRef $ \s -> s { leftBracketChar = chL                                      , rightBracketChar = chR                                      }  -- |Get a checkbox's text label.-getCheckboxLabel :: (MonadIO m) => Widget (CheckBox a) -> m String+getCheckboxLabel :: Widget (CheckBox a) -> IO String getCheckboxLabel = (checkboxLabel <~~)  radioKeyEvent :: (Eq a) => Widget (CheckBox a) -> Key -> [Modifier] -> IO Bool@@ -232,29 +231,29 @@ radioKeyEvent _ _ _ = return False  -- |Set the state of a checkbox.  May throw 'BadCheckboxState'.-setCheckboxState :: (Eq a, MonadIO m) => Widget (CheckBox a) -> a -> m ()+setCheckboxState :: (Eq a) => Widget (CheckBox a) -> a -> IO () setCheckboxState = setChecked_  -- |Set a binary checkbox to unchecked.-setCheckboxUnchecked :: (MonadIO m) => Widget (CheckBox Bool) -> m ()+setCheckboxUnchecked :: Widget (CheckBox Bool) -> IO () setCheckboxUnchecked wRef = setCheckboxState wRef False  -- |Set a binary checkbox to checked.-setCheckboxChecked :: (MonadIO m) => Widget (CheckBox Bool) -> m ()+setCheckboxChecked :: Widget (CheckBox Bool) -> IO () setCheckboxChecked wRef = setCheckboxState wRef True  -- |Toggle a binary checkbox.-toggleCheckbox :: (MonadIO m) => Widget (CheckBox Bool) -> m ()+toggleCheckbox :: Widget (CheckBox Bool) -> IO () toggleCheckbox wRef = do   v <- currentState <~~ wRef   setCheckboxState wRef (not v)  -- |Get a checkbox's current state value.-getCheckboxState :: (MonadIO m) => Widget (CheckBox a) -> m a+getCheckboxState :: Widget (CheckBox a) -> IO a getCheckboxState = (currentState <~~)  -- |Cycle a checkbox's state to the next value in its state list.-cycleCheckbox :: (Eq a, MonadIO m) => Widget (CheckBox a) -> m ()+cycleCheckbox :: (Eq a) => Widget (CheckBox a) -> IO () cycleCheckbox wRef = do   v <- currentState <~~ wRef   states <- checkboxStates <~~ wRef@@ -262,7 +261,7 @@       nextI = (curI + 1) `mod` length states   setChecked_ wRef $ fst $ states !! nextI -setChecked_ :: (Eq a, MonadIO m) => Widget (CheckBox a) -> a -> m ()+setChecked_ :: (Eq a) => Widget (CheckBox a) -> a -> IO () setChecked_ wRef v = do   f <- checkboxFrozen <~~ wRef @@ -278,18 +277,18 @@            updateWidgetState wRef $ \s -> s { currentState = v }            notifyChangeHandlers wRef -notifyChangeHandlers :: (MonadIO m) => Widget (CheckBox a) -> m ()+notifyChangeHandlers :: Widget (CheckBox a) -> IO () notifyChangeHandlers wRef = do   v <- currentState <~~ wRef   fireEvent wRef (checkboxChangeHandlers <~~) v  -- |Register a handler for a checkbox state change.  The handler will -- be passed the new state value.-onCheckboxChange :: (MonadIO m) => Widget (CheckBox a) -> (a -> IO ()) -> m ()+onCheckboxChange :: Widget (CheckBox a) -> (a -> IO ()) -> IO () onCheckboxChange = addHandler (checkboxChangeHandlers <~~) -thaw :: (MonadIO m) => Widget (CheckBox a) -> m ()+thaw :: Widget (CheckBox a) -> IO () thaw wRef = updateWidgetState wRef $ \s -> s { checkboxFrozen = False } -freeze :: (MonadIO m) => Widget (CheckBox a) -> m ()+freeze :: Widget (CheckBox a) -> IO () freeze wRef = updateWidgetState wRef $ \s -> s { checkboxFrozen = True }

@@ -74,7 +74,6 @@ import Data.IORef import Control.Applicative import Control.Monad-import Control.Monad.Trans import Control.Exception import Graphics.Vty import Graphics.Vty.Widgets.Util@@ -82,10 +81,10 @@ import Graphics.Vty.Widgets.Events  class HasNormalAttr w where-    setNormalAttribute :: (MonadIO m) => w -> Attr -> m ()+    setNormalAttribute :: w -> Attr -> IO ()  class HasFocusAttr w where-    setFocusAttribute :: (MonadIO m) => w -> Attr -> m ()+    setFocusAttribute :: w -> Attr -> IO ()  instance HasNormalAttr (Widget a) where     setNormalAttribute wRef a =@@ -95,12 +94,12 @@     setFocusAttribute wRef a =         updateWidget wRef $ \w -> w { focusAttribute = mergeAttr a (focusAttribute w) } -withNormalAttribute :: (HasNormalAttr w, MonadIO m) => Attr -> w -> m w+withNormalAttribute :: (HasNormalAttr w) => Attr -> w -> IO w withNormalAttribute att w = do   setNormalAttribute w att   return w -withFocusAttribute :: (HasFocusAttr w, MonadIO m) => Attr -> w -> m w+withFocusAttribute :: (HasFocusAttr w) => Attr -> w -> IO w withFocusAttribute att w = do   setFocusAttribute w att   return w@@ -141,8 +140,8 @@  type Widget a = IORef (WidgetImpl a) -showWidget :: (Functor m, MonadIO m, Show a) => Widget a -> m String-showWidget wRef = show <$> (liftIO $ readIORef wRef)+showWidget :: (Show a) => Widget a -> IO String+showWidget wRef = show <$> readIORef wRef  instance (Show a) => Show (WidgetImpl a) where     show w = concat [ "WidgetImpl { "@@ -156,70 +155,70 @@                     , " }"                     ] -growHorizontal :: (MonadIO m) => Widget a -> m Bool+growHorizontal :: Widget a -> IO Bool growHorizontal w = do   act <- growHorizontal_ <~ w   st <- state <~ w-  liftIO $ act st+  act st -growVertical :: (MonadIO m) => Widget a -> m Bool+growVertical :: Widget a -> IO Bool growVertical w = do   act <- growVertical_ <~ w   st <- state <~ w-  liftIO $ act st+  act st -render :: (MonadIO m, Show a) => Widget a -> DisplayRegion -> RenderContext -> m Image-render wRef sz ctx =-    liftIO $ do-      impl <- readIORef wRef+render :: (Show a) => Widget a -> DisplayRegion -> RenderContext -> IO Image+render wRef sz ctx = do+  impl <- readIORef wRef -      -- Merge the override attributes with the context.  If the-      -- overrides haven't been set (still def_attr), they will have-      -- no effect on the context attributes.-      norm <- normalAttribute <~ wRef-      foc <- focusAttribute <~ wRef-      let newCtx = ctx { normalAttr = mergeAttr norm $ normalAttr ctx-                       , focusAttr = mergeAttr foc $ focusAttr ctx-                       }+  -- Merge the override attributes with the context.  If the overrides+  -- haven't been set (still def_attr), they will have no effect on+  -- the context attributes.+  norm <- normalAttribute <~ wRef+  foc <- focusAttribute <~ wRef+  let newCtx = ctx { normalAttr = mergeAttr norm $ normalAttr ctx+                   , focusAttr = mergeAttr foc $ focusAttr ctx+                   } -      img <- render_ impl wRef sz newCtx-      let imgsz =  DisplayRegion (image_width img) (image_height img)-      when (image_width img > region_width sz ||-            image_height img > region_height sz) $ throw $ ImageTooBig (show impl) sz imgsz-      setCurrentSize wRef $ DisplayRegion (image_width img) (image_height img)-      return img+  img <- render_ impl wRef sz newCtx+  let imgsz =  DisplayRegion (image_width img) (image_height img) -renderAndPosition :: (MonadIO m, Show a) => Widget a -> DisplayRegion -> DisplayRegion-                  -> RenderContext -> m Image+  when (image_width img > region_width sz ||+        image_height img > region_height sz) $ throw $ ImageTooBig (show impl) sz imgsz++  setCurrentSize wRef $ DisplayRegion (image_width img) (image_height img)+  return img++renderAndPosition :: (Show a) => Widget a -> DisplayRegion -> DisplayRegion+                  -> RenderContext -> IO Image renderAndPosition wRef pos sz ctx = do   img <- render wRef sz ctx   -- Position post-processing depends on the sizes being correct!   setCurrentPosition wRef pos   return img -setCurrentSize :: (MonadIO m) => Widget a -> DisplayRegion -> m ()+setCurrentSize :: Widget a -> DisplayRegion -> IO () setCurrentSize wRef newSize =-    liftIO $ modifyIORef wRef $ \w -> w { currentSize = newSize }+    modifyIORef wRef $ \w -> w { currentSize = newSize } -getCurrentSize :: (MonadIO m) => Widget a -> m DisplayRegion-getCurrentSize wRef = (return . currentSize) =<< (liftIO $ readIORef wRef)+getCurrentSize :: Widget a -> IO DisplayRegion+getCurrentSize wRef = (return . currentSize) =<< (readIORef wRef) -getCurrentPosition :: (MonadIO m, Functor m) => Widget a -> m DisplayRegion-getCurrentPosition wRef = currentPosition <$> (liftIO $ readIORef wRef)+getCurrentPosition :: Widget a -> IO DisplayRegion+getCurrentPosition wRef = currentPosition <$> (readIORef wRef) -setCurrentPosition :: (MonadIO m) => Widget a -> DisplayRegion -> m ()+setCurrentPosition :: Widget a -> DisplayRegion -> IO () setCurrentPosition wRef pos = do   updateWidget wRef $ \w -> w { currentPosition = pos }-  liftIO $ do-    w <- readIORef wRef-    (setCurrentPosition_ w) wRef pos+  w <- readIORef wRef+  (setCurrentPosition_ w) wRef pos -newWidget :: (MonadIO m) => (WidgetImpl a -> WidgetImpl a) -> m (Widget a)+newWidget :: (WidgetImpl a -> WidgetImpl a) -> IO (Widget a) newWidget f = do   gfhs <- newHandlers   lfhs <- newHandlers -  wRef <- liftIO $ newIORef $+  wRef <- newIORef $           WidgetImpl { state = undefined                      , render_ = undefined                      , growVertical_ = const $ return False@@ -245,20 +244,20 @@   pos <- getCurrentPosition w   return $ Just $ pos `plusWidth` (region_width sz - 1) -handleKeyEvent :: (MonadIO m) => Widget a -> Key -> [Modifier] -> m Bool+handleKeyEvent :: Widget a -> Key -> [Modifier] -> IO Bool handleKeyEvent wRef keyEvent mods = do   act <- keyEventHandler <~ wRef-  liftIO $ act wRef keyEvent mods+  act wRef keyEvent mods -relayKeyEvents :: (MonadIO m) => Widget a -> Widget b -> m ()+relayKeyEvents :: Widget a -> Widget b -> IO () relayKeyEvents a b = a `onKeyPressed` \_ k mods -> handleKeyEvent b k mods -relayFocusEvents :: (MonadIO m) => Widget a -> Widget b -> m ()+relayFocusEvents :: Widget a -> Widget b -> IO () relayFocusEvents a b = do   a `onGainFocus` \_ -> focus b   a `onLoseFocus` \_ -> unfocus b -onKeyPressed :: (MonadIO m) => Widget a -> (Widget a -> Key -> [Modifier] -> IO Bool) -> m ()+onKeyPressed :: Widget a -> (Widget a -> Key -> [Modifier] -> IO Bool) -> IO () onKeyPressed wRef handler = do   -- Create a new handler that calls this one but defers to the old   -- one if the new one doesn't handle the event.@@ -273,39 +272,38 @@    updateWidget wRef $ \w -> w { keyEventHandler = combinedHandler } -focus :: (MonadIO m) => Widget a -> m ()+focus :: Widget a -> IO () focus wRef = do   updateWidget wRef $ \w -> w { focused = True }   fireEvent wRef (gainFocusHandlers <~) wRef -unfocus :: (MonadIO m) => Widget a -> m ()+unfocus :: Widget a -> IO () unfocus wRef = do   updateWidget wRef $ \w -> w { focused = False }   fireEvent wRef (loseFocusHandlers <~) wRef -onGainFocus :: (MonadIO m) => Widget a -> (Widget a -> IO ()) -> m ()+onGainFocus :: Widget a -> (Widget a -> IO ()) -> IO () onGainFocus = addHandler (gainFocusHandlers <~) -onLoseFocus :: (MonadIO m) => Widget a -> (Widget a -> IO ()) -> m ()+onLoseFocus :: Widget a -> (Widget a -> IO ()) -> IO () onLoseFocus = addHandler (loseFocusHandlers <~) -(<~) :: (MonadIO m) => (a -> b) -> IORef a -> m b-(<~) f wRef = (return . f) =<< (liftIO $ readIORef wRef)+(<~) :: (a -> b) -> IORef a -> IO b+(<~) f wRef = (return . f) =<< (readIORef wRef) -(<~~) :: (MonadIO m) => (a -> b) -> Widget a -> m b-(<~~) f wRef = (return . f . state) =<< (liftIO $ readIORef wRef)+(<~~) :: (a -> b) -> Widget a -> IO b+(<~~) f wRef = (return . f . state) =<< (readIORef wRef) -updateWidget :: (MonadIO m) => Widget a -> (WidgetImpl a -> WidgetImpl a) -> m ()-updateWidget wRef f = (liftIO $ modifyIORef wRef f)+updateWidget :: Widget a -> (WidgetImpl a -> WidgetImpl a) -> IO ()+updateWidget wRef f = modifyIORef wRef f -getState :: (MonadIO m) => Widget a -> m a+getState :: Widget a -> IO a getState wRef = state <~ wRef -updateWidgetState :: (MonadIO m) => Widget a -> (a -> a) -> m ()-updateWidgetState wRef f =-    liftIO $ do-      w <- readIORef wRef-      writeIORef wRef $ w { state = f (state w) }+updateWidgetState :: Widget a -> (a -> a) -> IO ()+updateWidgetState wRef f = do+  w <- readIORef wRef+  writeIORef wRef $ w { state = f (state w) }  data FocusGroupError = FocusGroupEmpty                      | FocusGroupBadIndex Int@@ -321,7 +319,7 @@                              , prevKey :: (Key, [Modifier])                              } -newFocusEntry :: (MonadIO m, Show a) => Widget a -> m (Widget FocusEntry)+newFocusEntry :: (Show a) => Widget a -> IO (Widget FocusEntry) newFocusEntry chRef = do   wRef <- newWidget $ \w ->       w { state = FocusEntry chRef@@ -343,7 +341,7 @@    return wRef -newFocusGroup :: (MonadIO m) => m (Widget FocusGroup)+newFocusGroup :: IO (Widget FocusGroup) newFocusGroup = do   wRef <- newWidget $ \w ->       w { state = FocusGroup { entries = []@@ -377,15 +375,15 @@         }   return wRef -setFocusGroupNextKey :: (MonadIO m) => Widget FocusGroup -> Key -> [Modifier] -> m ()+setFocusGroupNextKey :: Widget FocusGroup -> Key -> [Modifier] -> IO () setFocusGroupNextKey fg k mods =     updateWidgetState fg $ \s -> s { nextKey = (k, mods) } -setFocusGroupPrevKey :: (MonadIO m) => Widget FocusGroup -> Key -> [Modifier] -> m ()+setFocusGroupPrevKey :: Widget FocusGroup -> Key -> [Modifier] -> IO () setFocusGroupPrevKey fg k mods =     updateWidgetState fg $ \s -> s { prevKey = (k, mods) } -mergeFocusGroups :: (MonadIO m) => Widget FocusGroup -> Widget FocusGroup -> m (Widget FocusGroup)+mergeFocusGroups :: Widget FocusGroup -> Widget FocusGroup -> IO (Widget FocusGroup) mergeFocusGroups a b = do   c <- newFocusGroup @@ -416,7 +414,7 @@    return c -resetFocusGroup :: (MonadIO m) => Widget FocusGroup -> m ()+resetFocusGroup :: Widget FocusGroup -> IO () resetFocusGroup fg = do   cur <- currentEntryNum <~~ fg   es <- entries <~~ fg@@ -425,19 +423,19 @@   when (cur >= 0) $        focus =<< currentEntry fg -getCursorPosition :: (MonadIO m) => Widget a -> m (Maybe DisplayRegion)+getCursorPosition :: Widget a -> IO (Maybe DisplayRegion) getCursorPosition wRef = do   ci <- getCursorPosition_ <~ wRef-  liftIO (ci wRef)+  ci wRef -currentEntry :: (MonadIO m) => Widget FocusGroup -> m (Widget FocusEntry)+currentEntry :: Widget FocusGroup -> IO (Widget FocusEntry) currentEntry wRef = do   es <- entries <~~ wRef   i <- currentEntryNum <~~ wRef   when (i == -1) $ throw FocusGroupEmpty   return (es !! i) -addToFocusGroup :: (MonadIO m, Show a) => Widget FocusGroup -> Widget a -> m (Widget FocusEntry)+addToFocusGroup :: (Show a) => Widget FocusGroup -> Widget a -> IO (Widget FocusEntry) addToFocusGroup cRef wRef = do   eRef <- newFocusEntry wRef @@ -456,7 +454,7 @@    return eRef -focusNext :: (MonadIO m) => Widget FocusGroup -> m ()+focusNext :: Widget FocusGroup -> IO () focusNext wRef = do   st <- getState wRef   let cur = currentEntryNum st@@ -466,7 +464,7 @@                       (entries st) !! 0   focus nextEntry -focusPrevious :: (MonadIO m) => Widget FocusGroup -> m ()+focusPrevious :: Widget FocusGroup -> IO () focusPrevious wRef = do   st <- getState wRef   let cur = currentEntryNum st@@ -481,7 +479,7 @@ -- focus on the newly-focused widget, because this is intended to be -- callable from a focus event handler for the widget that got -- focused.-setCurrentFocus :: (MonadIO m) => Widget FocusGroup -> Int -> m ()+setCurrentFocus :: Widget FocusGroup -> Int -> IO () setCurrentFocus cRef i = do   st <- state <~ cRef 

@@ -13,7 +13,6 @@     ) where -import Control.Monad.Trans import Graphics.Vty.Widgets.Centering import Graphics.Vty.Widgets.Button import Graphics.Vty.Widgets.Padding@@ -34,7 +33,7 @@ -- |Create a new dialog with the specified embedded interface and -- title.  Returns the dialog itself and the 'FocusGroup' to which its -- buttons were added, for use in your application.-newDialog :: (MonadIO m, Show a) => Widget a -> String -> m (Dialog, Widget FocusGroup)+newDialog :: (Show a) => Widget a -> String -> IO (Dialog, Widget FocusGroup) newDialog body title = do   okB <- newButton "OK"   cancelB <- newButton "Cancel"@@ -67,17 +66,17 @@   return (dlg, fg)  -- |Register an event handler for the dialog's acceptance event.-onDialogAccept :: (MonadIO m) => Dialog -> (Dialog -> IO ()) -> m ()+onDialogAccept :: Dialog -> (Dialog -> IO ()) -> IO () onDialogAccept = addHandler (return . dialogAcceptHandlers)  -- |Register an event handler for the dialog's cancellation event.-onDialogCancel :: (MonadIO m) => Dialog -> (Dialog -> IO ()) -> m ()+onDialogCancel :: Dialog -> (Dialog -> IO ()) -> IO () onDialogCancel = addHandler (return . dialogCancelHandlers)  -- |Programmatically accept the dialog.-acceptDialog :: (MonadIO m) => Dialog -> m ()+acceptDialog :: Dialog -> IO () acceptDialog dlg = fireEvent dlg (return . dialogAcceptHandlers) dlg  -- |Programmatically cancel the dialog.-cancelDialog :: (MonadIO m) => Dialog -> m ()+cancelDialog :: Dialog -> IO () cancelDialog dlg = fireEvent dlg (return . dialogCancelHandlers) dlg

@@ -19,7 +19,6 @@ import Data.IORef import qualified Data.Map as Map import Control.Monad-import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.List@@ -106,9 +105,9 @@  -- |Create a directory browser widget with the specified skin. -- Returns the browser itself along with its focus group.-newDirBrowser :: (MonadIO m) => BrowserSkin -> m (DirBrowser, Widget FocusGroup)+newDirBrowser :: BrowserSkin -> IO (DirBrowser, Widget FocusGroup) newDirBrowser bSkin = do-  path <- liftIO $ getCurrentDirectory+  path <- getCurrentDirectory   pathWidget <- plainText ""   errorText <- plainText "" >>= withNormalAttribute (browserErrorAttr bSkin)   header <- ((plainText " Path: ") <++> (return pathWidget) <++> (hFill ' ' 1))@@ -118,11 +117,11 @@   footer <- ((plainText " ") <++> (return fileInfo) <++> (hFill ' ' 1) <++> (return errorText))             >>= withNormalAttribute (browserHeaderAttr bSkin) -  l <- newList (browserUnfocusedSelAttr bSkin) (\s -> plainText " " <++> plainText s)+  l <- newList (browserUnfocusedSelAttr bSkin)   ui <- vBox header =<< vBox l footer -  r <- liftIO $ newIORef ""-  r2 <- liftIO $ newIORef Map.empty+  r <- newIORef ""+  r2 <- newIORef Map.empty    hs <- newHandlers   chs <- newHandlers@@ -154,28 +153,28 @@ -- |Report an error in the browser's error-reporting area.  Useful for -- reporting application-specific errors with the user's file -- selection.-reportBrowserError :: (MonadIO m) => DirBrowser -> String -> m ()+reportBrowserError :: DirBrowser -> String -> IO () reportBrowserError b msg = setText (dirBrowserErrorWidget b) $ "Error: " ++ msg -clearError :: (MonadIO m) => DirBrowser -> m ()+clearError :: DirBrowser -> IO () clearError b = setText (dirBrowserErrorWidget b) ""  -- |Register handlers to be invoked when the user makes a selection.-onBrowseAccept :: (MonadIO m) => DirBrowser -> (FilePath -> IO ()) -> m ()+onBrowseAccept :: DirBrowser -> (FilePath -> IO ()) -> IO () onBrowseAccept = addHandler (return . dirBrowserChooseHandlers)  -- |Register handlers to be invoked when the user cancels browsing.-onBrowseCancel :: (MonadIO m) => DirBrowser -> (FilePath -> IO ()) -> m ()+onBrowseCancel :: DirBrowser -> (FilePath -> IO ()) -> IO () onBrowseCancel = addHandler (return . dirBrowserCancelHandlers)  -- |Register handlers to be invoked when the browser's path changes.-onBrowserPathChange :: (MonadIO m) => DirBrowser -> (FilePath -> IO ()) -> m ()+onBrowserPathChange :: DirBrowser -> (FilePath -> IO ()) -> IO () onBrowserPathChange = addHandler (return . dirBrowserPathChangeHandlers) -cancelBrowse :: (MonadIO m) => DirBrowser -> m ()+cancelBrowse :: DirBrowser -> IO () cancelBrowse b = fireEvent b (return . dirBrowserCancelHandlers) =<< getDirBrowserPath b -chooseCurrentEntry :: (MonadIO m) => DirBrowser -> m ()+chooseCurrentEntry :: DirBrowser -> IO () chooseCurrentEntry b = do   p <- getDirBrowserPath b   mCur <- getSelected (dirBrowserList b)@@ -189,13 +188,13 @@     SelectionOff -> setText (dirBrowserFileInfo b) "-"     SelectionOn _ path _ -> setText (dirBrowserFileInfo b) =<< getFileInfo b path -getFileInfo :: (MonadIO m) => DirBrowser -> FilePath -> m String+getFileInfo :: DirBrowser -> FilePath -> IO String getFileInfo b path = do   cur <- getDirBrowserPath b   let newPath = cur </> path-  st <- liftIO $ getSymbolicLinkStatus newPath+  st <- getSymbolicLinkStatus newPath   (_, mkAnn) <- fileAnnotation (dirBrowserSkin b) st cur path-  ann <- liftIO mkAnn+  ann <- mkAnn   return $ path ++ ": " ++ ann  builtInAnnotations :: FilePath -> BrowserSkin -> [(FilePath -> FileStatus -> Bool, FilePath -> FileStatus -> IO String, Attr)]@@ -209,8 +208,8 @@           linkDest <- if not $ isSymbolicLink stat                       then return ""                       else do-                        linkPath <- liftIO $ readSymbolicLink p-                        liftIO $ canonicalizePath $ cur </> linkPath+                        linkPath <- readSymbolicLink p+                        canonicalizePath $ cur </> linkPath           return $ "symbolic link to " ++ linkDest)       , browserLinkAttr sk)     , (\_ s -> isDirectory s, \_ _ -> return "directory", browserDirAttr sk)@@ -220,7 +219,7 @@     , (\_ s -> isSocket s, \_ _ -> return "socket", browserSockAttr sk)     ] -fileAnnotation :: (MonadIO m) => BrowserSkin -> FileStatus -> FilePath -> FilePath -> m (Attr, IO String)+fileAnnotation :: BrowserSkin -> FileStatus -> FilePath -> FilePath -> IO (Attr, IO String) fileAnnotation sk st cur shortPath = do   let fullPath = cur </> shortPath @@ -246,21 +245,20 @@  -- |Refresh the browser by reloading and displaying the contents of -- the browser's current path.-refreshBrowser :: (MonadIO m) => DirBrowser -> m ()+refreshBrowser :: DirBrowser -> IO () refreshBrowser b = setDirBrowserPath b =<< getDirBrowserPath b  -- |Set the browser's current path.-setDirBrowserPath :: (MonadIO m) => DirBrowser -> FilePath -> m ()+setDirBrowserPath :: DirBrowser -> FilePath -> IO () setDirBrowserPath b path = do-  cPath <- liftIO $ canonicalizePath path+  cPath <- canonicalizePath path    -- If for some reason we can't load the directory, report an error   -- and don't change the browser state.-  (res, entries) <--      liftIO $ (do-                 entries <- getDirectoryContents cPath-                 return (True, entries))-                `catch` \e -> do+  (res, entries) <- (do+                      entries <- getDirectoryContents cPath+                      return (True, entries))+                     `catch` \e -> do                              reportBrowserError b (ioeGetErrorString e)                              return (False, []) @@ -274,9 +272,9 @@       Just (i, _) -> storeSelection b cur i      clearList (dirBrowserList b)-    liftIO $ modifyIORef (dirBrowserPath b) $ const cPath+    modifyIORef (dirBrowserPath b) $ const cPath -    liftIO $ load b cPath entries+    load b cPath entries      sel <- getSelection b path     case sel of@@ -286,18 +284,17 @@     fireEvent b (return . dirBrowserPathChangeHandlers) cPath  -- |Get the browser's current path.-getDirBrowserPath :: (MonadIO m) => DirBrowser -> m FilePath-getDirBrowserPath = liftIO . readIORef . dirBrowserPath+getDirBrowserPath :: DirBrowser -> IO FilePath+getDirBrowserPath = readIORef . dirBrowserPath -storeSelection :: (MonadIO m) => DirBrowser -> FilePath -> Int -> m ()+storeSelection :: DirBrowser -> FilePath -> Int -> IO () storeSelection b path i =-    liftIO $ modifyIORef (dirBrowserSelectionMap b) $ \m -> Map.insert path i m+    modifyIORef (dirBrowserSelectionMap b) $ \m -> Map.insert path i m -getSelection :: (MonadIO m) => DirBrowser -> FilePath -> m (Maybe Int)-getSelection b path =-    liftIO $ do-      st <- readIORef (dirBrowserSelectionMap b)-      return $ Map.lookup path st+getSelection :: DirBrowser -> FilePath -> IO (Maybe Int)+getSelection b path = do+  st <- readIORef (dirBrowserSelectionMap b)+  return $ Map.lookup path st  load :: DirBrowser -> FilePath -> [FilePath] -> IO () load b cur entries =@@ -305,11 +302,12 @@       let fullPath = cur </> entry       f <- getSymbolicLinkStatus fullPath       (attr, _) <- fileAnnotation (dirBrowserSkin b) f cur entry-      (_, w) <- addToList (dirBrowserList b) entry+      w <- plainText " " <++> plainText entry+      addToList (dirBrowserList b) entry w       ch <- getSecondChild w       setNormalAttribute ch attr -descend :: (MonadIO m) => DirBrowser -> Bool -> m ()+descend :: DirBrowser -> Bool -> IO () descend b shouldSelect = do   base <- getDirBrowserPath b   mCur <- getSelected (dirBrowserList b)@@ -317,10 +315,10 @@     Nothing -> return ()     Just (_, (p, _)) -> do               let newPath = base </> p-              e <- liftIO $ doesDirectoryExist newPath+              e <- doesDirectoryExist newPath               case e of                 True -> do-                       cPath <- liftIO $ canonicalizePath newPath+                       cPath <- canonicalizePath newPath                        cur <- getDirBrowserPath b                        when (cur /= cPath) $ do                           case takeDirectory cur == cPath of@@ -329,9 +327,9 @@                  False -> when shouldSelect $ chooseCurrentEntry b -ascend :: (MonadIO m) => DirBrowser -> m ()+ascend :: DirBrowser -> IO () ascend b = do-  cur <- liftIO $ getDirBrowserPath b+  cur <- getDirBrowserPath b   let newPath = takeDirectory cur   when (newPath /= cur) $        setDirBrowserPath b newPath

@@ -15,7 +15,6 @@ where  import Control.Monad-import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Events@@ -41,7 +40,7 @@                     ]  -- |Create a new editing widget.-editWidget :: (MonadIO m) => m (Widget Edit)+editWidget :: IO (Widget Edit) editWidget = do   ahs <- newHandlers   chs <- newHandlers@@ -95,7 +94,7 @@   return wRef  -- |Set the maximum length of the edit widget's content.-setEditMaxLength :: (MonadIO m) => Widget Edit -> Int -> m ()+setEditMaxLength :: Widget Edit -> Int -> IO () setEditMaxLength wRef v = do   cur <- maxTextLength <~~ wRef   case cur of@@ -110,10 +109,10 @@ -- |Register handlers to be invoked when the edit widget has been -- ''activated'' (when the user presses Enter while the widget is -- focused).-onActivate :: (MonadIO m) => Widget Edit -> (Widget Edit -> IO ()) -> m ()+onActivate :: Widget Edit -> (Widget Edit -> IO ()) -> IO () onActivate = addHandler (activateHandlers <~~) -notifyActivateHandlers :: (MonadIO m) => Widget Edit -> m ()+notifyActivateHandlers :: Widget Edit -> IO () notifyActivateHandlers wRef = fireEvent wRef (activateHandlers <~~) wRef  notifyChangeHandlers :: Widget Edit -> IO ()@@ -121,28 +120,28 @@   s <- getEditText wRef   fireEvent wRef (changeHandlers <~~) s -notifyCursorMoveHandlers :: (MonadIO m) => Widget Edit -> m ()+notifyCursorMoveHandlers :: Widget Edit -> IO () notifyCursorMoveHandlers wRef = do   pos <- getEditCursorPosition wRef   fireEvent wRef (cursorMoveHandlers <~~) pos  -- |Register handlers to be invoked when the edit widget's contents -- change.  Handlers will be passed the new contents.-onChange :: (MonadIO m) => Widget Edit -> (String -> IO ()) -> m ()+onChange :: Widget Edit -> (String -> IO ()) -> IO () onChange = addHandler (changeHandlers <~~)  -- |Register handlers to be invoked when the edit widget's cursor -- position changes.  Handlers will be passed the new cursor position, -- relative to the beginning of the string (position 0).-onCursorMove :: (MonadIO m) => Widget Edit -> (Int -> IO ()) -> m ()+onCursorMove :: Widget Edit -> (Int -> IO ()) -> IO () onCursorMove = addHandler (cursorMoveHandlers <~~)  -- |Get the current contents of the edit widget.-getEditText :: (MonadIO m) => Widget Edit -> m String+getEditText :: Widget Edit -> IO String getEditText = (currentText <~~)  -- |Set the contents of the edit widget.-setEditText :: (MonadIO m) => Widget Edit -> String -> m ()+setEditText :: Widget Edit -> String -> IO () setEditText wRef str = do   oldS <- currentText <~~ wRef   maxLen <- maxTextLength <~~ wRef@@ -150,14 +149,13 @@     Nothing -> return str     Just l -> return $ take l str   updateWidgetState wRef $ \st -> st { currentText = s }-  when (oldS /= s) $-       liftIO $ do-         gotoBeginning wRef-         notifyChangeHandlers wRef+  when (oldS /= s) $ do+    gotoBeginning wRef+    notifyChangeHandlers wRef  -- |Set the current edit widget cursor position.  Invalid cursor -- positions will be ignored.-setEditCursorPosition :: (MonadIO m) => Widget Edit -> Int -> m ()+setEditCursorPosition :: Widget Edit -> Int -> IO () setEditCursorPosition wRef pos = do   oldPos <- getEditCursorPosition wRef   str <- getEditText wRef@@ -173,10 +171,10 @@          updateWidgetState wRef $ \s ->              s { cursorPosition = newPos                }-         liftIO $ notifyCursorMoveHandlers wRef+         notifyCursorMoveHandlers wRef  -- |Get the edit widget's current cursor position.-getEditCursorPosition :: (MonadIO m) => Widget Edit -> m Int+getEditCursorPosition :: Widget Edit -> IO Int getEditCursorPosition = (cursorPosition <~~)  setDisplayWidth :: Widget Edit -> Int -> IO ()@@ -305,10 +303,3 @@          let newContent = remove (cursorPosition st) (currentText st)          updateWidgetState wRef $ \s -> s { currentText = newContent }          notifyChangeHandlers wRef--remove :: Int -> [a] -> [a]-remove pos as = (take pos as) ++ (drop (pos + 1) as)--inject :: Int -> a -> [a] -> [a]-inject pos a as = let (h, t) = splitAt pos as-                  in h ++ (a:t)

@@ -7,6 +7,7 @@     , CollectionError(..)     , runUi     , schedule+    , shutdownUi     , newCollection     , addToCollection     , setCurrentEntry@@ -18,13 +19,13 @@ import Control.Concurrent import Control.Exception import Control.Monad-import Control.Monad.Trans import System.IO.Unsafe ( unsafePerformIO ) import Graphics.Vty import Graphics.Vty.Widgets.Core  data CombinedEvent = VTYEvent Event                    | UserEvent UserEvent+                   | ShutdownUi  data UserEvent = ScheduledAction (IO ()) @@ -37,17 +38,16 @@ -- provides the default attributes and 'Skin' to use for the -- application.  Throws 'BadCollectionIndex' if the specified -- 'Collection' is empty.-runUi :: (MonadIO m) => Collection -> RenderContext -> m ()-runUi collection ctx =-    liftIO $ do-      vty <- mkVty+runUi :: Collection -> RenderContext -> IO ()+runUi collection ctx = do+  vty <- mkVty -      -- Create VTY event listener thread-      _ <- forkIO $ vtyEventListener vty eventChan+  -- Create VTY event listener thread+  _ <- forkIO $ vtyEventListener vty eventChan -      runUi' vty eventChan collection ctx `finally` do-               reserve_display $ terminal vty-               shutdown vty+  runUi' vty eventChan collection ctx `finally` do+                         reserve_display $ terminal vty+                         shutdown vty  vtyEventListener :: Vty -> Chan CombinedEvent -> IO () vtyEventListener vty chan =@@ -58,9 +58,14 @@ -- |Schedule a widget-mutating 'IO' action to be run by the main event -- loop.  Use of this function is required to guarantee consistency -- between interface presentation and internal state.-schedule :: (MonadIO m) => IO () -> m ()-schedule act = liftIO $ writeChan eventChan $ UserEvent $ ScheduledAction act+schedule :: IO () -> IO ()+schedule act = writeChan eventChan $ UserEvent $ ScheduledAction act +-- |Schedule a vty-ui event loop shutdown.  This event will preempt+-- others so that it will be processed next.+shutdownUi :: IO ()+shutdownUi = unGetChan eventChan ShutdownUi+ runUi' :: Vty -> Chan CombinedEvent -> Collection -> RenderContext -> IO () runUi' vty chan collection ctx = do   sz <- display_bounds $ terminal vty@@ -80,12 +85,13 @@    evt <- readChan chan -  case evt of-    VTYEvent (EvKey k mods) -> handleKeyEvent fg k mods >> return ()-    UserEvent (ScheduledAction act) -> liftIO act-    _ -> return ()+  cont <- case evt of+            VTYEvent (EvKey k mods) -> handleKeyEvent fg k mods >> return True+            VTYEvent _ -> return True+            UserEvent (ScheduledAction act) -> act >> return True+            ShutdownUi -> return False -  runUi' vty chan collection ctx+  when cont $ runUi' vty chan collection ctx  data CollectionError = BadCollectionIndex Int                        deriving (Show, Typeable)@@ -109,20 +115,20 @@                                           , " }"                                           ] -entryRenderAndPosition :: (MonadIO m) => Entry -> DisplayRegion -> DisplayRegion -> RenderContext -> m Image+entryRenderAndPosition :: Entry -> DisplayRegion -> DisplayRegion -> RenderContext -> IO Image entryRenderAndPosition (Entry w _) = renderAndPosition w  entryFocusGroup :: Entry -> Widget FocusGroup entryFocusGroup (Entry _ fg) = fg  -- |Create a new collection.-newCollection :: (MonadIO m) => m Collection+newCollection :: IO Collection newCollection =-    liftIO $ newIORef $ CollectionData { entries = []-                                       , currentEntryNum = -1-                                       }+    newIORef $ CollectionData { entries = []+                              , currentEntryNum = -1+                              } -getCurrentEntry :: (MonadIO m) => Collection -> m Entry+getCurrentEntry :: Collection -> IO Entry getCurrentEntry cRef = do   cur <- currentEntryNum <~ cRef   es <- entries <~ cRef@@ -135,10 +141,10 @@ -- |Add a widget and its focus group to a collection.  Returns an -- action which, when invoked, will switch to the interface specified -- in the call.-addToCollection :: (MonadIO m, Show a) => Collection -> Widget a -> Widget FocusGroup -> m (m ())+addToCollection :: (Show a) => Collection -> Widget a -> Widget FocusGroup -> IO (IO ()) addToCollection cRef wRef fg = do   i <- (length . entries) <~ cRef-  liftIO $ modifyIORef cRef $ \st ->+  modifyIORef cRef $ \st ->       st { entries = (entries st) ++ [Entry wRef fg]          , currentEntryNum = if currentEntryNum st == -1                              then 0@@ -147,11 +153,11 @@   resetFocusGroup fg   return $ setCurrentEntry cRef i -setCurrentEntry :: (MonadIO m) => Collection -> Int -> m ()+setCurrentEntry :: Collection -> Int -> IO () setCurrentEntry cRef i = do-  st <- liftIO $ readIORef cRef+  st <- readIORef cRef   if i < length (entries st) && i >= 0 then-      (liftIO $ modifyIORef cRef $ \s -> s { currentEntryNum = i }) else+      (modifyIORef cRef $ \s -> s { currentEntryNum = i }) else       throw $ BadCollectionIndex i    e <- getCurrentEntry cRef

@@ -10,7 +10,6 @@     ) where -import Control.Monad.Trans import Control.Monad import Data.IORef @@ -23,23 +22,23 @@ -- |Given an event handler collection projection combinator, a target, -- and a handler, add the handler to the target's event handler -- collection.-addHandler :: (MonadIO m) => (w -> m (Handlers a)) -> w -> Handler a -> m ()+addHandler :: (w -> IO (Handlers a)) -> w -> Handler a -> IO () addHandler getRef w handler = do   (Handlers r) <- getRef w-  liftIO $ modifyIORef r $ \s -> s ++ [handler]+  modifyIORef r $ \s -> s ++ [handler]  -- |Fire an event by extracting an event handler collection from a -- target and invoking all of its handlers with the specified -- parameter value.-fireEvent :: (MonadIO m) => w -> (w -> m (Handlers a)) -> a -> m ()+fireEvent :: w -> (w -> IO (Handlers a)) -> a -> IO () fireEvent w getRef ev = do   (Handlers r) <- getRef w-  handlers <- liftIO $ readIORef r+  handlers <- readIORef r   forM_ handlers $ \handler ->-      liftIO $ handler ev+      handler ev  -- |Create a new event handler collection.-newHandlers :: (MonadIO m) => m (Handlers a)+newHandlers :: IO (Handlers a) newHandlers = do-  r <- liftIO $ newIORef []+  r <- newIORef []   return $ Handlers r

@@ -9,7 +9,6 @@     ) where -import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Util@@ -19,7 +18,7 @@  -- |A vertical fill widget.  Fills all available space with the -- specified character and attribute.-vFill :: (MonadIO m) => Char -> m (Widget VFill)+vFill :: Char -> IO (Widget VFill) vFill c = do   wRef <- newWidget $ \w ->       w { state = VFill c@@ -39,7 +38,7 @@  -- |A horizontal fill widget.  Fills the available horizontal space, -- one row high, using the specified character and attribute.-hFill :: (MonadIO m) => Char -> Int -> m (Widget HFill)+hFill :: Char -> Int -> IO (Widget HFill) hFill c h = do   wRef <- newWidget $ \w ->       w { state = HFill c h

@@ -19,7 +19,6 @@ where  import Control.Monad-import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Util@@ -30,7 +29,7 @@     show (HFixed i _) = "HFixed { width = " ++ show i ++ ", ... }"  -- |Impose a fixed horizontal size, in columns, on a 'Widget'.-hFixed :: (MonadIO m, Show a) => Int -> Widget a -> m (Widget (HFixed a))+hFixed :: (Show a) => Int -> Widget a -> IO (Widget (HFixed a)) hFixed fixedWidth child = do   wRef <- newWidget $ \w ->       w { state = HFixed fixedWidth child@@ -61,7 +60,7 @@     show (VFixed i _) = "VFixed { height = " ++ show i ++ ", ... }"  -- |Impose a fixed vertical size, in columns, on a 'Widget'.-vFixed :: (MonadIO m, Show a) => Int -> Widget a -> m (Widget (VFixed a))+vFixed :: (Show a) => Int -> Widget a -> IO (Widget (VFixed a)) vFixed maxHeight child = do   wRef <- newWidget $ \w ->       w { state = VFixed maxHeight child@@ -89,47 +88,47 @@   return wRef  -- |Set the vertical fixed size of a child widget.-setVFixed :: (MonadIO m) => Widget (VFixed a) -> Int -> m ()+setVFixed :: Widget (VFixed a) -> Int -> IO () setVFixed wRef lim =     when (lim >= 1) $          updateWidgetState wRef $ \(VFixed _ ch) -> VFixed lim ch  -- |Set the horizontal fixed size of a child widget.-setHFixed :: (MonadIO m) => Widget (HFixed a) -> Int -> m ()+setHFixed :: Widget (HFixed a) -> Int -> IO () setHFixed wRef lim =     when (lim >= 1) $          updateWidgetState wRef $ \(HFixed _  ch) -> HFixed lim ch  -- |Add to the vertical fixed size of a child widget.-addToVFixed :: (MonadIO m) => Widget (VFixed a) -> Int -> m ()+addToVFixed :: Widget (VFixed a) -> Int -> IO () addToVFixed wRef delta = do   lim <- getVFixedSize wRef   setVFixed wRef $ lim + delta  -- |Add to the horizontal fixed size of a child widget.-addToHFixed :: (MonadIO m) => Widget (HFixed a) -> Int -> m ()+addToHFixed :: Widget (HFixed a) -> Int -> IO () addToHFixed wRef delta = do   lim <- getHFixedSize wRef   setHFixed wRef $ lim + delta  -- |Get the vertical fixed size of a child widget.-getVFixedSize :: (MonadIO m) => Widget (VFixed a) -> m Int+getVFixedSize :: Widget (VFixed a) -> IO Int getVFixedSize wRef = do   (VFixed lim _) <- state <~ wRef   return lim  -- |Get the horizontal fixed size of a child widget.-getHFixedSize :: (MonadIO m) => Widget (HFixed a) -> m Int+getHFixedSize :: Widget (HFixed a) -> IO Int getHFixedSize wRef = do   (HFixed lim _) <- state <~ wRef   return lim  -- |Impose a maximum horizontal and vertical size on a widget.-boxFixed :: (MonadIO m, Show a) =>+boxFixed :: (Show a) =>             Int -- ^Maximum width in columns          -> Int -- ^Maximum height in rows          -> Widget a-         -> m (Widget (VFixed (HFixed a)))+         -> IO (Widget (VFixed (HFixed a))) boxFixed maxWidth maxHeight w = do   ch <- hFixed maxWidth w   vFixed maxHeight ch

@@ -21,7 +21,6 @@ where  import Control.Monad-import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Util@@ -32,7 +31,7 @@     show (HLimit i _) = "HLimit { width = " ++ show i ++ ", ... }"  -- |Impose a maximum horizontal size, in columns, on a 'Widget'.-hLimit :: (MonadIO m, Show a) => Int -> Widget a -> m (Widget (HLimit a))+hLimit :: (Show a) => Int -> Widget a -> IO (Widget (HLimit a)) hLimit maxWidth child = do   wRef <- newWidget $ \w ->       w { state = HLimit maxWidth child@@ -58,7 +57,7 @@     show (VLimit i _) = "VLimit { height = " ++ show i ++ ", ... }"  -- |Impose a maximum vertical size, in columns, on a 'Widget'.-vLimit :: (MonadIO m, Show a) => Int -> Widget a -> m (Widget (VLimit a))+vLimit :: (Show a) => Int -> Widget a -> IO (Widget (VLimit a)) vLimit maxHeight child = do   wRef <- newWidget $ \w ->       w { state = VLimit maxHeight child@@ -80,48 +79,48 @@   return wRef  -- |Set the vertical limit of a child widget's size.-setVLimit :: (MonadIO m) => Widget (VLimit a) -> Int -> m ()+setVLimit :: Widget (VLimit a) -> Int -> IO () setVLimit wRef lim =     when (lim >= 1) $          updateWidgetState wRef $ \(VLimit _ ch) -> VLimit lim ch  -- |Set the horizontal limit of a child widget's size.-setHLimit :: (MonadIO m) => Widget (HLimit a) -> Int -> m ()+setHLimit :: Widget (HLimit a) -> Int -> IO () setHLimit wRef lim =     when (lim >= 1) $          updateWidgetState wRef $ \(HLimit _  ch) -> HLimit lim ch  -- |Add to the vertical limit of a child widget's size.-addToVLimit :: (MonadIO m) => Widget (VLimit a) -> Int -> m ()+addToVLimit :: Widget (VLimit a) -> Int -> IO () addToVLimit wRef delta = do   lim <- getVLimit wRef   setVLimit wRef $ lim + delta  -- |Add to the horizontal limit of a child widget's size.-addToHLimit :: (MonadIO m) => Widget (HLimit a) -> Int -> m ()+addToHLimit :: Widget (HLimit a) -> Int -> IO () addToHLimit wRef delta = do   lim <- getHLimit wRef   setHLimit wRef $ lim + delta  -- |Get the vertical limit of a child widget's size.-getVLimit :: (MonadIO m) => Widget (VLimit a) -> m Int+getVLimit :: Widget (VLimit a) -> IO Int getVLimit wRef = do   (VLimit lim _) <- state <~ wRef   return lim  -- |Get the horizontal limit of a child widget's size.-getHLimit :: (MonadIO m) => Widget (HLimit a) -> m Int+getHLimit :: Widget (HLimit a) -> IO Int getHLimit wRef = do   (HLimit lim _) <- state <~ wRef   return lim  -- |Impose a horizontal and vertical upper bound on the size of a -- widget.-boxLimit :: (MonadIO m, Show a) =>+boxLimit :: (Show a) =>             Int -- ^Maximum width in columns          -> Int -- ^Maximum height in rows          -> Widget a-         -> m (Widget (VLimit (HLimit a)))+         -> IO (Widget (VLimit (HLimit a))) boxLimit maxWidth maxHeight w = do   ch <- hLimit maxWidth w   vLimit maxHeight ch

@@ -17,6 +17,7 @@     , newStringList     , newList     , addToList+    , insertIntoList     , removeFromList     -- ** List manipulation     , scrollBy@@ -30,16 +31,17 @@     , onItemActivated     , activateCurrentItem     , clearList+    , setSelected     -- ** List inspection     , getListSize     , getSelected+    , getListItem     ) where  import Data.Typeable import Control.Exception hiding (Handler) import Control.Monad-import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Text@@ -100,7 +102,6 @@                      , itemRemoveHandlers :: Handlers (RemoveItemEvent a b)                      , itemActivateHandlers :: Handlers (ActivateItemEvent a b)                      , itemHeight :: Int-                     , itemConstructor :: a -> IO (Widget b)                      -- ^Function to construct new items                      } @@ -115,11 +116,9 @@                       , " }"                       ] -newListData :: (MonadIO m) =>-               Attr -- ^The attribute of the selected item-            -> (a -> IO (Widget b)) -- ^Constructor for new item widgets-            -> m (List a b)-newListData selAttr f = do+newListData :: Attr -- ^The attribute of the selected item+            -> IO (List a b)+newListData selAttr = do   schs <- newHandlers   iahs <- newHandlers   irhs <- newHandlers@@ -135,18 +134,18 @@                 , itemRemoveHandlers = irhs                 , itemActivateHandlers = iacths                 , itemHeight = 0-                , itemConstructor = f                 }  -- |Get the length of the list in elements.-getListSize :: (MonadIO m) => Widget (List a b) -> m Int+getListSize :: Widget (List a b) -> IO Int getListSize = ((length . listItems) <~~)  -- |Remove an element from the list at the specified position.  May -- throw 'BadItemIndex'.-removeFromList :: (MonadIO m) => Widget (List a b) -> Int -> m (ListItem a b)+removeFromList :: Widget (List a b) -> Int -> IO (ListItem a b) removeFromList list pos = do   st <- getState list+  foc <- focused <~ list    let numItems = length $ listItems st       oldScr = scrollTopIndex st@@ -185,6 +184,17 @@                                    , scrollTopIndex = newScrollTop                                    } +  when foc $ do+    -- Unfocus the item we are about to remove if it's currently+    -- selected+    when (pos == sel) $ do+               unfocus w+               -- Focus the newly-selected item, if any+               cur <- getSelected list+               case cur of+                 Nothing -> return ()+                 Just (_, (_, w')) -> focus w'+   -- Notify the removal handler.   notifyItemRemoveHandler list pos label w @@ -201,12 +211,14 @@ -- |Add an item to the list.  Its widget will be constructed from the -- specified internal value using the widget constructor passed to -- 'newList'.-addToList :: (MonadIO m, Show b) => Widget (List a b) -> a -> m (ListItem a b)-addToList list key = do+addToList :: (Show b) => Widget (List a b) -> a -> Widget b -> IO ()+addToList list key w = do   numItems <- (length . listItems) <~~ list+  insertIntoList list key w numItems -  makeWidget <- itemConstructor <~~ list-  w <- liftIO $ makeWidget key+insertIntoList :: (Show b) => Widget (List a b) -> a -> Widget b -> Int -> IO ()+insertIntoList list key w pos = do+  numItems <- (length . listItems) <~~ list    v <- growVertical w   when (v) $ throw BadListWidgetSizePolicy@@ -221,53 +233,69 @@            -- same size.  If you violate this, you'll have interesting            -- results!            img <- render w (DisplayRegion 100 100) defaultContext-           return $ fromEnum $ image_height img+           return $ max 1 $ fromEnum $ image_height img          _ -> itemHeight <~~ list +  -- Calculate the new selected index.+  oldSel <- selectedIndex <~~ list+  oldScr <- scrollTopIndex <~~ list+  swSize <- scrollWindowSize <~~ list++  let newSelIndex = if numItems == 0+                    then 0+                    else if pos <= oldSel+                         then oldSel + 1+                         else oldSel+      newScrollTop = if pos <= oldSel+                     then if (oldSel - oldScr + 1) == swSize+                          then oldScr + 1+                          else oldScr+                     else oldScr+   updateWidgetState list $ \s -> s { itemHeight = h-                                   , listItems = listItems s ++ [(key, w)]-                                   , selectedIndex = if numItems == 0-                                                     then 0-                                                     else selectedIndex s+                                   , listItems = inject pos (key, w) (listItems s)+                                   , selectedIndex = newSelIndex+                                   , scrollTopIndex = newScrollTop                                    }    notifyItemAddHandler list (numItems + 1) key w    when (numItems == 0) $-       notifySelectionHandler list+       do+         foc <- focused <~ list+         when foc $ focus w -  return (key, w)+  when (oldSel /= newSelIndex) $ notifySelectionHandler list  -- |Register event handlers to be invoked when the list's selected -- item changes.-onSelectionChange :: (MonadIO m) =>-                     Widget (List a b)+onSelectionChange :: Widget (List a b)                   -> (SelectionEvent a b -> IO ())-                  -> m ()+                  -> IO () onSelectionChange = addHandler (selectionChangeHandlers <~~)  -- |Register event handlers to be invoked when a new item is added to -- the list.-onItemAdded :: (MonadIO m) => Widget (List a b)-            -> (NewItemEvent a b -> IO ()) -> m ()+onItemAdded :: Widget (List a b)+            -> (NewItemEvent a b -> IO ()) -> IO () onItemAdded = addHandler (itemAddHandlers <~~)  -- |Register event handlers to be invoked when an item is removed from -- the list.-onItemRemoved :: (MonadIO m) => Widget (List a b)-              -> (RemoveItemEvent a b -> IO ()) -> m ()+onItemRemoved :: Widget (List a b)+              -> (RemoveItemEvent a b -> IO ()) -> IO () onItemRemoved = addHandler (itemRemoveHandlers <~~)  -- |Register event handlers to be invoked when an item is activated, -- which happens when the user presses Enter on a selected element -- while the list has the focus.-onItemActivated :: (MonadIO m) => Widget (List a b)-            -> (ActivateItemEvent a b -> IO ()) -> m ()+onItemActivated :: Widget (List a b)+            -> (ActivateItemEvent a b -> IO ()) -> IO () onItemActivated = addHandler (itemActivateHandlers <~~)  -- |Clear the list, removing all elements.  Does not invoke any -- handlers.-clearList :: (MonadIO m) => Widget (List a b) -> m ()+clearList :: Widget (List a b) -> IO () clearList w = do   updateWidgetState w $ \l ->       l { selectedIndex = (-1)@@ -276,15 +304,12 @@         }  -- |Create a new list using the specified attribute for the--- currently-selected element when the list does NOT have focus.  Use--- the specified constructor function to create widgets for new items--- in the list.-newList :: (MonadIO m, Show b) =>+-- currently-selected element when the list does NOT have focus.+newList :: (Show b) =>            Attr -- ^The attribute of the selected item-        -> (a -> IO (Widget b)) -- ^Constructor for new item widgets-        -> m (Widget (List a b))-newList selAttr f = do-  list <- newListData selAttr f+        -> IO (Widget (List a b))+newList selAttr = do+  list <- newListData selAttr   wRef <- newWidget $ \w ->       w { state = list         , keyEventHandler = listKeyEvent@@ -294,12 +319,10 @@          , getCursorPosition_ =             \this -> do-              st <- getState this-              pos <- getCurrentPosition this-              sz <- getCurrentSize this-              let newCol = max 0 (region_width pos + region_width sz - 1)-                  newRow = region_height pos + toEnum (max 0 $ selectedIndex st - scrollTopIndex st)-              return $ Just (pos `withWidth` newCol `withHeight` newRow)+              sel <- getSelected this+              case sel of+                Nothing -> return Nothing+                Just (_, (_, e)) -> getCursorPosition e          , render_ =             \this sz ctx -> do@@ -324,6 +347,21 @@               forM_ (zip [0..] items) $ \(i, ((_, iw), _)) ->                   setCurrentPosition iw (pos `plusHeight` (toEnum $ i * ih))         }++  wRef `onGainFocus` \_ ->+      do+        val <- getSelected wRef+        case val of+          Nothing -> return ()+          Just (_, (_, w)) -> focus w++  wRef `onLoseFocus` \_ ->+      do+        val <- getSelected wRef+        case val of+          Nothing -> return ()+          Just (_, (_, w)) -> unfocus w+   return wRef  listKeyEvent :: Widget (List a b) -> Key -> [Modifier] -> IO Bool@@ -332,7 +370,11 @@ listKeyEvent w KPageUp _ = pageUp w >> return True listKeyEvent w KPageDown _ = pageDown w >> return True listKeyEvent w KEnter _ = activateCurrentItem w >> return True-listKeyEvent _ _ _ = return False+listKeyEvent w k mods = do+  val <- getSelected w+  case val of+    Nothing -> return False+    Just (_, (_, e)) -> handleKeyEvent e k mods  renderListWidget :: (Show b) => Bool -> List a b -> DisplayRegion -> RenderContext -> IO Image renderListWidget foc list s ctx = do@@ -371,18 +413,18 @@ -- |A convenience function to create a new list using 'String's as the -- internal values and 'FormattedText' widgets to represent those -- strings.-newStringList :: (MonadIO m) =>-                 Attr -- ^The attribute of the selected item+newStringList :: Attr -- ^The attribute of the selected item               -> [String] -- ^The list items-              -> m (Widget (List String FormattedText))+              -> IO (Widget (List String FormattedText)) newStringList selAttr labels = do-  list <- newList selAttr plainText-  mapM_ (addToList list) labels+  list <- newList selAttr+  forM_ labels $ \l ->+      (addToList list l =<< plainText l)   return list  -- |Programmatically activate the currently-selected item in the list, -- if any.-activateCurrentItem :: (MonadIO m) => Widget (List a b) -> m ()+activateCurrentItem :: Widget (List a b) -> IO () activateCurrentItem wRef = do   mSel <- getSelected wRef   case mSel of@@ -393,14 +435,30 @@ -- note that !! here will always succeed because selectedIndex will -- never be out of bounds and the list will always be non-empty. -- |Get the currently-selected list item.-getSelected :: (MonadIO m) => Widget (List a b) -> m (Maybe (Int, ListItem a b))+getSelected :: Widget (List a b) -> IO (Maybe (Int, ListItem a b)) getSelected wRef = do   list <- state <~ wRef   case selectedIndex list of     (-1) -> return Nothing     i -> return $ Just (i, (listItems list) !! i) -resize :: (MonadIO m) => Widget (List a b) -> Int -> m ()+-- |Get the list item at the specified position.+getListItem :: Widget (List a b) -> Int -> IO (Maybe (ListItem a b))+getListItem wRef pos = do+  list <- state <~ wRef+  case pos >= 0 && pos < (length $ listItems list) of+    False ->  return Nothing+    True -> return $ Just ((listItems list) !! pos)++-- |Set the currently-selected list index.+setSelected :: Widget (List a b) -> Int -> IO ()+setSelected wRef newPos = do+  list <- state <~ wRef+  case selectedIndex list of+    (-1) -> return ()+    curPos -> scrollBy wRef (newPos - curPos)++resize :: Widget (List a b) -> Int -> IO () resize wRef newSize = do   when (newSize == 0) $ throw ResizeError @@ -434,9 +492,24 @@ -- Scrolling by a positive amount scrolls downward and scrolling by a -- negative amount scrolls upward.  This automatically takes care of -- managing internal list state and invoking event handlers.-scrollBy :: (MonadIO m) => Widget (List a b) -> Int -> m ()+scrollBy :: Widget (List a b) -> Int -> IO () scrollBy wRef amount = do+  foc <- focused <~ wRef++  -- Unfocus the currently-selected item.+  old <- getSelected wRef+  case old of+    Nothing -> return ()+    Just (_, (_, w)) -> when foc $ unfocus w+   updateWidgetState wRef $ scrollBy' amount++  -- Focus the newly-selected item.+  new <- getSelected wRef+  case new of+    Nothing -> return ()+    Just (_, (_, w)) -> when foc $ focus w+   notifySelectionHandler wRef  scrollBy' :: Int -> List a b -> List a b@@ -468,7 +541,7 @@      else list { scrollTopIndex = adjustedTop                , selectedIndex = newSelected } -notifySelectionHandler :: (MonadIO m) => Widget (List a b) -> m ()+notifySelectionHandler :: Widget (List a b) -> IO () notifySelectionHandler wRef = do   sel <- getSelected wRef   case sel of@@ -477,35 +550,35 @@     Just (pos, (a, b)) ->         fireEvent wRef (selectionChangeHandlers <~~) $ SelectionOn pos a b -notifyItemRemoveHandler :: (MonadIO m) => Widget (List a b) -> Int -> a -> Widget b -> m ()+notifyItemRemoveHandler :: Widget (List a b) -> Int -> a -> Widget b -> IO () notifyItemRemoveHandler wRef pos k w =     fireEvent wRef (itemRemoveHandlers <~~) $ RemoveItemEvent pos k w -notifyItemAddHandler :: (MonadIO m) => Widget (List a b) -> Int -> a -> Widget b -> m ()+notifyItemAddHandler :: Widget (List a b) -> Int -> a -> Widget b -> IO () notifyItemAddHandler wRef pos k w =     fireEvent wRef (itemAddHandlers <~~) $ NewItemEvent pos k w  -- |Scroll a list down by one position.-scrollDown :: (MonadIO m) => Widget (List a b) -> m ()+scrollDown :: Widget (List a b) -> IO () scrollDown wRef = scrollBy wRef 1  -- |Scroll a list up by one position.-scrollUp :: (MonadIO m) => Widget (List a b) -> m ()+scrollUp :: Widget (List a b) -> IO () scrollUp wRef = scrollBy wRef (-1)  -- |Scroll a list down by one page from the current cursor position.-pageDown :: (MonadIO m) => Widget (List a b) -> m ()+pageDown :: Widget (List a b) -> IO () pageDown wRef = do   amt <- scrollWindowSize <~~ wRef   scrollBy wRef amt  -- |Scroll a list up by one page from the current cursor position.-pageUp :: (MonadIO m) => Widget (List a b) -> m ()+pageUp :: Widget (List a b) -> IO () pageUp wRef = do   amt <- scrollWindowSize <~~ wRef   scrollBy wRef (-1 * amt) -getVisibleItems :: (MonadIO m) => Widget (List a b) -> m [(ListItem a b, Bool)]+getVisibleItems :: Widget (List a b) -> IO [(ListItem a b, Bool)] getVisibleItems wRef = do   list <- state <~ wRef   return $ getVisibleItems_ list

@@ -21,7 +21,6 @@  import Data.Word import Data.Monoid-import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Util@@ -100,11 +99,11 @@ padLeftRight v = Padding 0 v 0 v  -- |Monadic combinator to construct a 'Padded' wrapper.-withPadding :: (MonadIO m, Show a) => Padding -> Widget a -> m (Widget Padded)+withPadding :: (Show a) => Padding -> Widget a -> IO (Widget Padded) withPadding = flip padded  -- |Create a 'Padded' wrapper to add padding.-padded :: (MonadIO m, Show a) => Widget a -> Padding -> m (Widget Padded)+padded :: (Show a) => Widget a -> Padding -> IO (Widget Padded) padded ch padding = do   wRef <- newWidget $ \w ->       w { state = Padded ch padding

@@ -30,7 +30,7 @@  -- |Create a new progress bar with the specified completed and -- uncompleted colors, respectively.-newProgressBar :: (MonadIO m) => Color -> Color -> m ProgressBar+newProgressBar :: Color -> Color -> IO ProgressBar newProgressBar completeColor incompleteColor = do   let completeAttr = completeColor `on` completeColor       incompleteAttr = incompleteColor `on` incompleteColor@@ -45,12 +45,12 @@  -- |Register a handler to be invoked when the progress bar's progress -- value changes.  The handler will be passed the new progress value.-onProgressChange :: (MonadIO m) => ProgressBar -> (Int -> IO ()) -> m ()+onProgressChange :: ProgressBar -> (Int -> IO ()) -> IO () onProgressChange = addHandler (return . onChangeHandlers)  -- |Set the progress bar's progress value.  Values outside the allowed -- range will be ignored.-setProgress :: (MonadIO m) => ProgressBar -> Int -> m ()+setProgress :: ProgressBar -> Int -> IO () setProgress p amt =     when (amt >= 0 && amt <= 100) $ do       liftIO $ writeIORef (progressBarAmount p) amt@@ -58,11 +58,11 @@       fireEvent p (return . onChangeHandlers) amt  -- |Get the progress bar's current progress value.-getProgress :: (MonadIO m) => ProgressBar -> m Int+getProgress :: ProgressBar -> IO Int getProgress = liftIO . readIORef . progressBarAmount  -- |Add a delta value to the progress bar's current value.-addProgress :: (MonadIO m) => ProgressBar -> Int -> m ()+addProgress :: ProgressBar -> Int -> IO () addProgress p amt = do   cur <- getProgress p   let newAmt = cur + amt

@@ -33,7 +33,6 @@ import Control.Applicative hiding ((<|>)) import Control.Exception import Control.Monad-import Control.Monad.Trans import Graphics.Vty import Graphics.Vty.Widgets.Core import Graphics.Vty.Widgets.Text@@ -199,11 +198,11 @@ emptyCell = EmptyCell  -- |Set the default table-wide cell alignment.-setDefaultCellAlignment :: (MonadIO m) => Widget Table -> Alignment -> m ()+setDefaultCellAlignment :: Widget Table -> Alignment -> IO () setDefaultCellAlignment t a = updateWidgetState t $ \s -> s { defaultCellAlignment = a }  -- |Set the default table-wide cell padding.-setDefaultCellPadding :: (MonadIO m) => Widget Table -> Padding -> m ()+setDefaultCellPadding :: Widget Table -> Padding -> IO () setDefaultCellPadding t p = updateWidgetState t $ \s -> s { defaultCellPadding = p }  -- |Create a column.@@ -212,10 +211,10 @@  -- |Create a table widget using a list of column specifications and a -- border style.-newTable :: (MonadIO m) =>+newTable ::              [ColumnSpec]          -> BorderStyle-         -> m (Widget Table)+         -> IO (Widget Table) newTable specs borderSty = do   t <- newWidget $ \w ->       w { state = Table { rows = []@@ -298,7 +297,7 @@         }   return t -getCellAlignment :: (MonadIO m) => Widget Table -> Int -> TableCell -> m Alignment+getCellAlignment :: Widget Table -> Int -> TableCell -> IO Alignment getCellAlignment _ _ (TableCell _ (Just p) _) = return p getCellAlignment t columnNumber _ = do   -- If the column for this cell has properties, use those; otherwise@@ -310,7 +309,7 @@     Nothing -> defaultCellAlignment <~~ t     Just p -> return p -getCellPadding :: (MonadIO m) => Widget Table -> Int -> TableCell -> m Padding+getCellPadding :: Widget Table -> Int -> TableCell -> IO Padding getCellPadding _ _ (TableCell _ _ (Just p)) = return p getCellPadding t columnNumber _ = do   -- If the column for this cell has properties, use those; otherwise@@ -439,7 +438,7 @@    doPositioning 0 $ zip szs cells -autoWidth :: (MonadIO m) => Widget Table -> DisplayRegion -> m Word+autoWidth :: Widget Table -> DisplayRegion -> IO Word autoWidth t sz = do   specs <- columnSpecs <~~ t   bs <- borderStyle <~~ t@@ -456,16 +455,16 @@   return $ toEnum ((max 0 ((fromEnum $ region_width sz) - totalFixed - edgeWidth - colWidth))                    `div` numAuto) -addHeadingRow :: (MonadIO m) => Widget Table -> Attr -> [String] -> m [Widget FormattedText]+addHeadingRow :: Widget Table -> Attr -> [String] -> IO [Widget FormattedText] addHeadingRow tbl attr labels = do   ws <- mapM (\s -> plainText s >>= withNormalAttribute attr) labels   addRow tbl ws   return ws -addHeadingRow_ :: (MonadIO m) => Widget Table -> Attr -> [String] -> m ()+addHeadingRow_ :: Widget Table -> Attr -> [String] -> IO () addHeadingRow_ tbl attr labels = addHeadingRow tbl attr labels >> return () -applyCellAlignment :: (MonadIO m) => Alignment -> TableCell -> m TableCell+applyCellAlignment :: Alignment -> TableCell -> IO TableCell applyCellAlignment _ EmptyCell = return EmptyCell applyCellAlignment al (TableCell w a p) = do   case al of@@ -488,7 +487,7 @@                   return $ TableCell w' a p         True -> return $ TableCell w a p -applyCellPadding :: (MonadIO m) => Padding -> TableCell -> m TableCell+applyCellPadding :: Padding -> TableCell -> IO TableCell applyCellPadding _ EmptyCell = return EmptyCell applyCellPadding padding (TableCell w a p) = do   w' <- padded w padding@@ -498,7 +497,7 @@ -- row.  Throws 'BadTableWidgetSizePolicy' if any widgets in the row -- grow vertically; throws 'ColumnCountMismatch' if the row's number -- of columns does not match the table's column count.-addRow :: (MonadIO m, RowLike a) => Widget Table -> a -> m ()+addRow :: (RowLike a) => Widget Table -> a -> IO () addRow t row = do   let (TableRow cells_) = mkRow row 

@@ -21,7 +21,6 @@     ) where -import Control.Monad.Trans import Data.Maybe import Data.Word import Graphics.Vty@@ -70,7 +69,7 @@  -- |Construct a Widget directly from a String.  This is recommended if -- you don't need to use a 'Formatter'.-plainText :: (MonadIO m) => String -> m (Widget FormattedText)+plainText :: String -> IO (Widget FormattedText) plainText s = textWidget nullFormatter s  -- |A formatter for wrapping text into the available space.  This@@ -103,12 +102,13 @@ -- |Construct a text widget formatted with the specified formatters. -- the formatters will be applied in the order given here, so be aware -- of how the formatters will modify the text (and affect each other).-textWidget :: (MonadIO m) => Formatter -> String -> m (Widget FormattedText)+textWidget :: Formatter -> String -> IO (Widget FormattedText) textWidget format s = do   wRef <- newWidget $ \w ->       w { state = FormattedText { text = prepareText s                                 , formatter = format                                 }+        , getCursorPosition_ = const $ return Nothing         , render_ =             \this size ctx -> do               ft <- getState this@@ -118,7 +118,7 @@   return wRef  -- |Set the text value of a 'FormattedText' widget.-setText :: (MonadIO m) => Widget FormattedText -> String -> m ()+setText :: Widget FormattedText -> String -> IO () setText wRef s = do   updateWidgetState wRef $ \st ->       st { text = (prepareText s) }

@@ -9,6 +9,9 @@     , withHeight     , plusWidth     , plusHeight+    , remove+    , inject+    , repl     ) where @@ -37,11 +40,12 @@ -- Left-most attribute's fields take precedence. -- |Merge two attributes.  Leftmost attribute takes precedence where -- it specifies any of the foreground color, background color, or--- style.+-- style.  Note that the style precedence is total: all bits of the+-- style mask will take precedence if any are set. mergeAttr :: Attr -> Attr -> Attr mergeAttr a b =     let b1 = case attr_style a of-               SetTo v -> b `with_style` v+               SetTo v -> b { attr_style = SetTo v }                _ -> b         b2 = case attr_fore_color a of                SetTo v -> b1 `with_fore_color` v@@ -76,3 +80,13 @@     if (fromEnum h' + fromEnum h < 0)     then error $ "plusHeight: would overflow on " ++ (show h') ++ " + " ++ (show h)     else DisplayRegion w (h + h')++remove :: Int -> [a] -> [a]+remove pos as = (take pos as) ++ (drop (pos + 1) as)++inject :: Int -> a -> [a] -> [a]+inject pos a as = let (h, t) = splitAt pos as+                  in h ++ (a:t)++repl :: Int -> a -> [a] -> [a]+repl pos a as = inject pos a (remove pos as)

@@ -106,7 +106,8 @@   -- context.   (theEdit st) `onChange` (updateFooterText st (theEdit st))   (theEdit st) `onActivate` \e -> do-         addToList (theList st) =<< getEditText e+         s <- getEditText e+         addToList (theList st) s =<< plainText s          setEditText e ""    let doBodyUpdate (SelectionOn i _ _) = updateBody st i@@ -152,6 +153,7 @@            _ -> return False    setEditText (theEdit st) "edit me"+  focus (theEdit st)    -- We need to call these handlers manually because while they will   -- be called automatically as items are added to the list in the

@@ -3,7 +3,6 @@ -- This demo is discussed in the vty-ui user's manual.  import Control.Monad-import Control.Monad.Trans  import Graphics.Vty import Graphics.Vty.Widgets.All@@ -26,7 +25,7 @@               , activateHandlers :: Handlers PhoneNumber               } -newPhoneInput :: (MonadIO m) => m (PhoneInput, Widget FocusGroup)+newPhoneInput :: IO (PhoneInput, Widget FocusGroup) newPhoneInput = do    ahs <- newHandlers    e1 <- editWidget@@ -64,8 +63,8 @@    mapM_ (addToFocusGroup fg) [e1, e2, e3]    return (w, fg) -onPhoneInputActivate :: (MonadIO m) => PhoneInput-                     -> (PhoneNumber -> IO ()) -> m ()+onPhoneInputActivate :: PhoneInput+                     -> (PhoneNumber -> IO ()) -> IO () onPhoneInputActivate input handler =     addHandler (return . activateHandlers) input handler 

@@ -1,5 +1,5 @@ Name:                vty-ui-Version:             1.0.1+Version:             1.1 Synopsis:            An interactive terminal user interface library                      for Vty Description:         An extensible library of user interface widgets@@ -75,10 +75,10 @@   Build-Depends:     base >= 4 && < 5,     vty >= 4.6 && < 4.7,-    containers >= 0.2 && < 0.4,+    containers >= 0.2 && < 0.5,     pcre-light >= 0.3 && < 0.4,-    directory >= 1.0 && < 1.1,-    filepath >= 1.1 && < 1.2,+    directory >= 1.0 && < 1.2,+    filepath >= 1.1 && < 1.3,     unix >= 2.4 && < 2.5,     mtl >= 2.0 && < 2.1 @@ -155,7 +155,7 @@     base >= 4 && < 5,     mtl >= 2.0 && < 2.1,     bytestring >= 0.9 && < 1.0,-    time >= 1.1 && < 1.2,+    time >= 1.1 && < 1.3,     old-locale >= 1.0 && < 1.1,     pcre-light >= 0.3 && < 0.4,     vty >= 4.6 && < 4.7