diff --git a/demos/ComplexDemo.hs b/demos/ComplexDemo.hs --- a/demos/ComplexDemo.hs +++ b/demos/ComplexDemo.hs @@ -3,7 +3,11 @@ module Main where import System.Exit ( exitSuccess ) -import System.Locale +{- + - As of time-1.5, Data.Time.Format re-exports the names we use from + - System.Locale; to be compatible with both time-1.4 and time-1.5, we refer to + - them by a qualified reference to System.Locale. + -} import qualified Data.Text as T import Control.Monad import Control.Concurrent diff --git a/doc/ch1/getting_started.tex b/doc/ch1/getting_started.tex --- a/doc/ch1/getting_started.tex +++ b/doc/ch1/getting_started.tex @@ -97,7 +97,7 @@ Every \vtyui\ program requires a \fw{Collection}. \begin{haskellcode} - addToCollection ui fg + addToCollection c ui fg \end{haskellcode} This adds the top-level user interface widget, \fw{ui}, to the diff --git a/doc/macros.tex b/doc/macros.tex --- a/doc/macros.tex +++ b/doc/macros.tex @@ -1,6 +1,6 @@ % Custom macros. -\newcommand{\vtyuiversion}{1.8} +\newcommand{\vtyuiversion}{1.9} \newcommand{\fw}[1]{\texttt{#1}} \newcommand{\vtyui}{\fw{vty-ui}} diff --git a/src/Graphics/Vty/Widgets/Core.hs b/src/Graphics/Vty/Widgets/Core.hs --- a/src/Graphics/Vty/Widgets/Core.hs +++ b/src/Graphics/Vty/Widgets/Core.hs @@ -161,47 +161,51 @@ -- ^The state of the widget. , visible :: !Bool -- ^Whether the widget is visible. - , render_ :: Widget a -> DisplayRegion -> RenderContext -> IO Image + , render_ :: !(Widget a -> DisplayRegion -> RenderContext -> IO Image) -- ^The rendering routine of the widget. Takes the widget itself, -- a region indicating how much space the rendering process has to -- work with, and a rendering context to be used to determine -- attribute and skin settings. This MUST return an image which -- is no larger than the specified rendering region. - , growHorizontal_ :: a -> IO Bool + , growHorizontal_ :: !(a -> IO Bool) -- ^Returns whether the widget will automatically grow to fill -- available horizontal space. - , growVertical_ :: a -> IO Bool + , growVertical_ :: !(a -> IO Bool) -- ^Returns whether the widget will automatically grow to fill -- available vertical space. - , currentSize :: DisplayRegion + , currentSize :: !DisplayRegion -- ^The size of the widget after its most recent rendering pass. - , currentPosition :: DisplayRegion + + -- NOTE: DisplayRegion is a lazy tuple. + , currentPosition :: !DisplayRegion -- ^The position of the widget after its most recent rendering -- pass. - , normalAttribute :: Attr + + -- NOTE: DisplayRegion is a lazy tuple. + , normalAttribute :: !Attr -- ^The normal (unfocused) attribute of the wiget. - , focusAttribute :: Attr + , focusAttribute :: !Attr -- ^The focused attribute of the widget. - , setCurrentPosition_ :: Widget a -> DisplayRegion -> IO () + , setCurrentPosition_ :: !(Widget a -> DisplayRegion -> IO ()) -- ^Sets the current position of the widget. Takes a widget -- reference and a display region indicating the coordinates of -- the widget's upper left corner. - , keyEventHandler :: Widget a -> Key -> [Modifier] -> IO Bool + , keyEventHandler :: !(Widget a -> Key -> [Modifier] -> IO Bool) -- ^The widget's key event handler. Takes a widget reference, a -- key event, and a list of keyboard modifiers. Returns whether -- the keyboard event was handled. True indicates that the event -- was handled and that event processing should halt; False -- indicates that other event handlers, if present, may handle the -- event. - , gainFocusHandlers :: Handlers (Widget a) + , gainFocusHandlers :: !(Handlers (Widget a)) -- ^List of handlers to be invoked when the widget gains focus. - , resizeHandlers :: Handlers (DisplayRegion, DisplayRegion) + , resizeHandlers :: !(Handlers (DisplayRegion, DisplayRegion)) -- ^List of handlers to be invoked when the widget's size changes. - , loseFocusHandlers :: Handlers (Widget a) + , loseFocusHandlers :: !(Handlers (Widget a)) -- ^List of handlers to be invoked when the widget loses focus. - , focused :: Bool + , focused :: !Bool -- ^Whether the widget is focused. - , getCursorPosition_ :: Widget a -> IO (Maybe DisplayRegion) + , getCursorPosition_ :: !(Widget a -> IO (Maybe DisplayRegion)) -- ^Returns the current terminal cursor position. Should return -- Nothing if the widget does not need to show a cursor, or Just -- if it does. (For example, widgets receiving keyboard input for @@ -319,10 +323,9 @@ setCurrentSize :: Widget a -> DisplayRegion -> IO () setCurrentSize wRef newSize = do oldSize <- getCurrentSize wRef - modifyIORef wRef $ \w -> - let new = w { currentSize = newSize } - in seq new new - when (oldSize /= newSize) $ handleResizeEvent wRef (oldSize, newSize) + when (oldSize /= newSize) $ do + atomicModifyIORef' wRef $ \w -> (w { currentSize = newSize }, ()) + handleResizeEvent wRef (oldSize, newSize) -- |Get the current size of the widget (its size after its most recent -- rendering). @@ -480,8 +483,7 @@ -- |Given a widget and an implementation transformer, apply the -- transformer to the widget's implementation. updateWidget :: Widget a -> (WidgetImpl a -> WidgetImpl a) -> IO () -updateWidget wRef f = modifyIORef wRef $ \val -> let new = f val - in seq new new +updateWidget wRef f = atomicModifyIORef' wRef (\w -> (f w, ())) -- |Get the state value of a widget. getState :: Widget a -> IO a @@ -489,10 +491,8 @@ -- |Apply a state transformation function to a widget's state. updateWidgetState :: Widget a -> (a -> a) -> IO () -updateWidgetState wRef f = do - w <- readIORef wRef - writeIORef wRef $ let new = w { state = f (state w) } - in seq new new +updateWidgetState wRef f = + updateWidget wRef (\w -> w { state = f (state w) }) -- |Focus group handling errors. data FocusGroupError = FocusGroupEmpty diff --git a/src/Graphics/Vty/Widgets/List.hs b/src/Graphics/Vty/Widgets/List.hs --- a/src/Graphics/Vty/Widgets/List.hs +++ b/src/Graphics/Vty/Widgets/List.hs @@ -38,7 +38,9 @@ , setSelected -- ** List inspection , listFindFirst + , listFindFirstBy , listFindAll + , listFindAllBy , getListSize , getSelected , getListItem @@ -478,19 +480,28 @@ -- |Find the first index of the specified key in the list. If the key does not -- exist, return Nothing. listFindFirst :: (Eq a) => Widget (List a b) -> a -> IO (Maybe Int) -listFindFirst wRef item = do +listFindFirst wRef item = listFindFirstBy (== item) wRef + +-- |Find the first index in the list for which the predicate is true. +-- If no item in the list matches the given predicate, return Nothing. +listFindFirstBy :: (a -> Bool) -> Widget (List a b) -> IO (Maybe Int) +listFindFirstBy p wRef = do list <- state <~ wRef return $ V.findIndex matcher (listItems list) where - matcher = \(match, _) -> item == match + matcher = \(match, _) -> p match -- |Find all indicies of the specified key in the list. listFindAll :: (Eq a) => Widget (List a b) -> a -> IO [Int] -listFindAll wRef item = do +listFindAll wRef item = listFindAllBy (== item) wRef + +-- |Find all indices in the list matching the given predicate. +listFindAllBy :: (a -> Bool) -> Widget (List a b) -> IO [Int] +listFindAllBy p wRef = do list <- state <~ wRef return $ V.toList $ V.findIndices matcher (listItems list) where - matcher = \(match, _) -> item == match + matcher = \(match, _) -> p match resizeList :: Widget (List a b) -> Int -> IO () resizeList wRef newSize = do diff --git a/vty-ui.cabal b/vty-ui.cabal --- a/vty-ui.cabal +++ b/vty-ui.cabal @@ -1,5 +1,5 @@ Name: vty-ui -Version: 1.8 +Version: 1.9 Synopsis: An interactive terminal user interface library for Vty @@ -93,7 +93,7 @@ containers >= 0.2 && < 0.6, regex-base >= 0.93 && < 0.94, directory >= 1.0 && < 1.3, - filepath >= 1.1 && < 1.4, + filepath >= 1.1 && < 1.5, unix >= 2.4 && < 2.8, mtl >= 2.0 && < 2.3, stm >= 2.1 && < 2.5, @@ -208,8 +208,7 @@ base >= 4 && < 5, mtl >= 2.0 && < 2.3, bytestring >= 0.9 && < 1.0, - time >= 1.1 && < 1.5, - old-locale >= 1.0 && < 1.1, + time >= 1.5, vty >= 5.1.0, text, vty-ui