diff --git a/programs/AttrDemo.hs b/programs/AttrDemo.hs index 0bd37b4..ca0c44c 100644 --- a/programs/AttrDemo.hs +++ b/programs/AttrDemo.hs @@ -23,28 +23,28 @@ import Brick.Widgets.Core , modifyDefAttr ) import Brick.Util (on, fg) -import Brick.AttrMap (attrMap, AttrMap) +import Brick.AttrMap (attrMap, AttrMap, attrName) ui :: Widget n ui = vBox [ str "This text uses the global default attribute." - , withAttr "foundFull" $ + , withAttr (attrName "foundFull") $ str "Specifying an attribute name means we look it up in the attribute tree." - , (withAttr "foundFgOnly" $ + , (withAttr (attrName "foundFgOnly") $ str ("When we find a value, we merge it with its parent in the attribute") <=> str "name tree all the way to the root (the global default).") - , withAttr "missing" $ + , withAttr (attrName "missing") $ str "A missing attribute name just resumes the search at its parent." - , withAttr ("general" <> "specific") $ + , withAttr (attrName "general" <> attrName "specific") $ str "In this way we build complete attribute values by using an inheritance scheme." - , withAttr "foundFull" $ + , withAttr (attrName "foundFull") $ str "You can override everything ..." - , withAttr "foundFgOnly" $ + , withAttr (attrName "foundFgOnly") $ str "... or only what you want to change and inherit the rest." , str "Attribute names are assembled with the Monoid append operation to indicate" , str "hierarchy levels, e.g. \"window\" <> \"title\"." , str " " - , withAttr "linked" $ + , withAttr (attrName "linked") $ str "This text is hyperlinked in terminals that support hyperlinking." , str " " , hyperlink "http://www.google.com/" $ @@ -59,11 +59,12 @@ globalDefault = white `on` blue theMap :: AttrMap theMap = attrMap globalDefault - [ ("foundFull", white `on` green) - , ("foundFgOnly", fg red) - , ("general", yellow `on` black) - , ("general" <> "specific", fg cyan) - , ("linked", fg yellow `withURL` "http://www.google.com/") + [ (attrName "foundFull", white `on` green) + , (attrName "foundFgOnly", fg red) + , (attrName "general", yellow `on` black) + , (attrName "general" <> attrName "specific", + fg cyan) + , (attrName "linked", fg yellow `withURL` "http://www.google.com/") ] app :: App () e () diff --git a/programs/BorderDemo.hs b/programs/BorderDemo.hs index 4248a53..88a22e5 100644 --- a/programs/BorderDemo.hs +++ b/programs/BorderDemo.hs @@ -68,7 +68,7 @@ mkBorderDemo (styleName, sty) = txt $ " " <> styleName <> " style " titleAttr :: A.AttrName -titleAttr = "title" +titleAttr = A.attrName "title" borderMappings :: [(A.AttrName, V.Attr)] borderMappings = diff --git a/programs/CacheDemo.hs b/programs/CacheDemo.hs index d84872d..9840cda 100644 --- a/programs/CacheDemo.hs +++ b/programs/CacheDemo.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad (void) @@ -31,6 +30,7 @@ import Brick.Widgets.Center ) import Brick.AttrMap ( AttrName + , attrName , attrMap ) @@ -66,7 +66,7 @@ appEvent (VtyEvent (V.EvKey V.KEsc [])) = M.halt appEvent _ = return () emphAttr :: AttrName -emphAttr = "emphasis" +emphAttr = attrName "emphasis" app :: M.App Int e Name app = diff --git a/programs/FileBrowserDemo.hs b/programs/FileBrowserDemo.hs index 11a58ec..99b420b 100644 --- a/programs/FileBrowserDemo.hs +++ b/programs/FileBrowserDemo.hs @@ -12,7 +12,7 @@ import Control.Monad.State (get) import qualified Data.Text as Text import qualified Brick.Main as M import qualified Brick.Widgets.List as L -import Brick.AttrMap (AttrName) +import Brick.AttrMap (AttrName, attrName) import Brick.Types ( Widget , BrickEvent(..) @@ -77,7 +77,7 @@ appEvent (VtyEvent ev) = do appEvent _ = return () errorAttr :: AttrName -errorAttr = "error" +errorAttr = attrName "error" theMap :: A.AttrMap theMap = A.attrMap V.defAttr diff --git a/programs/LayerDemo.hs b/programs/LayerDemo.hs index 7c60e34..0a0813c 100644 --- a/programs/LayerDemo.hs +++ b/programs/LayerDemo.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where @@ -31,6 +30,7 @@ import Brick.Util (fg) import Brick.AttrMap ( attrMap , AttrName + , attrName ) data St = @@ -96,7 +96,7 @@ appEvent (T.VtyEvent (V.EvKey V.KEsc [])) = M.halt appEvent _ = return () arrowAttr :: AttrName -arrowAttr = "attr" +arrowAttr = attrName "attr" app :: M.App St e Name app = diff --git a/programs/ListDemo.hs b/programs/ListDemo.hs index 0ff6338..b1b04c4 100644 --- a/programs/ListDemo.hs +++ b/programs/ListDemo.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where @@ -84,7 +83,7 @@ initialState :: L.List () Char initialState = L.list () (Vec.fromList ['a','b','c']) 1 customAttr :: A.AttrName -customAttr = L.listSelectedAttr <> "custom" +customAttr = L.listSelectedAttr <> A.attrName "custom" theMap :: A.AttrMap theMap = A.attrMap V.defAttr diff --git a/programs/ListViDemo.hs b/programs/ListViDemo.hs index 0aaef35..12aaa64 100644 --- a/programs/ListViDemo.hs +++ b/programs/ListViDemo.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main where @@ -75,7 +74,7 @@ initialState :: L.List () Char initialState = L.list () (Vec.fromList ['a','b','c']) 1 customAttr :: A.AttrName -customAttr = L.listSelectedAttr <> "custom" +customAttr = L.listSelectedAttr <> A.attrName "custom" theMap :: A.AttrMap theMap = A.attrMap V.defAttr diff --git a/programs/MouseDemo.hs b/programs/MouseDemo.hs index 11d585a..bf7de5f 100644 --- a/programs/MouseDemo.hs +++ b/programs/MouseDemo.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Main where @@ -51,9 +50,9 @@ buttonLayer st = C.hCenterLayer (vLimit 3 $ hLimit 50 $ E.renderEditor (str . unlines) True (st^.edit)) where buttons = mkButton <$> buttonData - buttonData = [ (Button1, "Button 1", "button1") - , (Button2, "Button 2", "button2") - , (Button3, "Button 3", "button3") + buttonData = [ (Button1, "Button 1", attrName "button1") + , (Button2, "Button 2", attrName "button2") + , (Button3, "Button 3", attrName "button3") ] mkButton (name, label, attr) = let wasClicked = (fst <$> st^.lastReportedClick) == Just name @@ -82,7 +81,7 @@ infoLayer st = T.Widget T.Fixed T.Fixed $ do Just (name, T.Location l) -> "Mouse down at " <> show name <> " @ " <> show l T.render $ translateBy (T.Location (0, h-1)) $ clickable Info $ - withDefAttr "info" $ + withDefAttr (attrName "info") $ C.hCenter $ str msg appEvent :: T.BrickEvent Name e -> T.EventM Name St () @@ -104,10 +103,10 @@ appEvent ev = aMap :: AttrMap aMap = attrMap V.defAttr - [ ("info", V.white `on` V.magenta) - , ("button1", V.white `on` V.cyan) - , ("button2", V.white `on` V.green) - , ("button3", V.white `on` V.blue) + [ (attrName "info", V.white `on` V.magenta) + , (attrName "button1", V.white `on` V.cyan) + , (attrName "button2", V.white `on` V.green) + , (attrName "button3", V.white `on` V.blue) , (E.editFocusedAttr, V.black `on` V.yellow) ] diff --git a/programs/ThemeDemo.hs b/programs/ThemeDemo.hs index 613ff77..5b7c173 100644 --- a/programs/ThemeDemo.hs +++ b/programs/ThemeDemo.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad (void) @@ -32,7 +31,7 @@ import Brick.Widgets.Core , withDefAttr ) import Brick.Util (on, fg) -import Brick.AttrMap (AttrName) +import Brick.AttrMap (AttrName, attrName) ui :: Widget n ui = @@ -44,7 +43,7 @@ ui = ] keybindingAttr :: AttrName -keybindingAttr = "keybinding" +keybindingAttr = attrName "keybinding" theme1 :: Theme theme1 = diff --git a/programs/VisibilityDemo.hs b/programs/VisibilityDemo.hs index 1ebc840..7c15591 100644 --- a/programs/VisibilityDemo.hs +++ b/programs/VisibilityDemo.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} module Main where @@ -16,7 +15,7 @@ import qualified Brick.Types as T import qualified Brick.Main as M import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Border as B -import Brick.AttrMap (AttrMap, AttrName, attrMap) +import Brick.AttrMap (AttrMap, AttrName, attrMap, attrName) import Brick.Util (on) import Brick.Types ( Widget @@ -56,7 +55,7 @@ vp3Size :: (Int, Int) vp3Size = (25, 25) selectedAttr :: AttrName -selectedAttr = "selected" +selectedAttr = attrName "selected" drawUi :: St -> [Widget Name] drawUi st = [ui] diff --git a/src/Brick/AttrMap.hs b/src/Brick/AttrMap.hs index 0563187..398ed83 100644 --- a/src/Brick/AttrMap.hs +++ b/src/Brick/AttrMap.hs @@ -2,9 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} -- | This module provides types and functions for managing an attribute -- map which maps attribute names ('AttrName') to attributes ('Attr'). --- This module is designed to be used with the 'OverloadedStrings' --- language extension to permit easy construction of 'AttrName' values --- and you should also use 'mappend' ('<>') to combine names. -- -- Attribute maps work by mapping hierarchical attribute names to -- attributes and inheriting parent names' attributes when child names @@ -52,7 +49,6 @@ import Data.Bits ((.|.)) import qualified Data.Map as M import Data.Maybe (catMaybes) import Data.List (inits) -import Data.String (IsString(..)) import GHC.Generics (Generic) import Graphics.Vty (Attr(..), MaybeDefault(..), Style) @@ -65,9 +61,9 @@ import Graphics.Vty (Attr(..), MaybeDefault(..), Style) -- example: -- -- @ --- "window" <> "border" --- "window" <> "title" --- "header" <> "clock" <> "seconds" +-- attrName "window" <> attrName "border" +-- attrName "window" <> attrName "title" +-- attrName "header" <> attrName "clock" <> attrName "seconds" -- @ data AttrName = AttrName [String] deriving (Show, Read, Eq, Ord, Generic, NFData) @@ -79,9 +75,6 @@ instance Monoid AttrName where mempty = AttrName [] mappend = (Sem.<>) -instance IsString AttrName where - fromString = AttrName . (:[]) - -- | An attribute map which maps 'AttrName' values to 'Attr' values. data AttrMap = AttrMap Attr (M.Map AttrName Attr) | ForceAttr Attr diff --git a/src/Brick/Forms.hs b/src/Brick/Forms.hs index 313b43d..87a4180 100644 --- a/src/Brick/Forms.hs +++ b/src/Brick/Forms.hs @@ -642,15 +642,15 @@ toPassword s = txt $ T.replicate (T.length $ T.concat s) "*" -- | The namespace for the other form attributes. formAttr :: AttrName -formAttr = "brickForm" +formAttr = attrName "brickForm" -- | The attribute for form input fields with invalid values. invalidFormInputAttr :: AttrName -invalidFormInputAttr = formAttr <> "invalidInput" +invalidFormInputAttr = formAttr <> attrName "invalidInput" -- | The attribute for form input fields that have the focus. focusedFormInputAttr :: AttrName -focusedFormInputAttr = formAttr <> "focusedInput" +focusedFormInputAttr = formAttr <> attrName "focusedInput" -- | Returns whether all form fields in the form currently have valid -- values according to the fields' validation functions. This is useful diff --git a/src/Brick/Widgets/Border.hs b/src/Brick/Widgets/Border.hs index 70f9df9..76d063e 100644 --- a/src/Brick/Widgets/Border.hs +++ b/src/Brick/Widgets/Border.hs @@ -39,7 +39,7 @@ import qualified Brick.BorderMap as BM -- | The top-level border attribute name. borderAttr :: AttrName -borderAttr = "border" +borderAttr = attrName "border" -- | Draw the specified border element using the active border style -- using 'borderAttr'. diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index 6d80dc9..2ddfeb2 100644 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -1544,17 +1544,17 @@ viewport vpname typ p = -- | The base attribute for scroll bars. scrollbarAttr :: AttrName -scrollbarAttr = "scrollbar" +scrollbarAttr = attrName "scrollbar" -- | The attribute for scroll bar troughs. This attribute is a -- specialization of @scrollbarAttr@. scrollbarTroughAttr :: AttrName -scrollbarTroughAttr = scrollbarAttr <> "trough" +scrollbarTroughAttr = scrollbarAttr <> attrName "trough" -- | The attribute for scroll bar handles. This attribute is a -- specialization of @scrollbarAttr@. scrollbarHandleAttr :: AttrName -scrollbarHandleAttr = scrollbarAttr <> "handle" +scrollbarHandleAttr = scrollbarAttr <> attrName "handle" maybeClick :: (Ord n) => n diff --git a/src/Brick/Widgets/Dialog.hs b/src/Brick/Widgets/Dialog.hs index cc3b8d4..2100407 100644 --- a/src/Brick/Widgets/Dialog.hs +++ b/src/Brick/Widgets/Dialog.hs @@ -99,15 +99,15 @@ dialog title buttonData w = -- | The default attribute of the dialog dialogAttr :: AttrName -dialogAttr = "dialog" +dialogAttr = attrName "dialog" -- | The default attribute for all dialog buttons buttonAttr :: AttrName -buttonAttr = "button" +buttonAttr = attrName "button" -- | The attribute for the selected dialog button (extends 'dialogAttr') buttonSelectedAttr :: AttrName -buttonSelectedAttr = buttonAttr <> "selected" +buttonSelectedAttr = buttonAttr <> attrName "selected" -- | Render a dialog with the specified body widget. This renders the -- dialog as a layer, which makes this suitable as a top-level layer in diff --git a/src/Brick/Widgets/Edit.hs b/src/Brick/Widgets/Edit.hs index 41400f2..4692471 100644 --- a/src/Brick/Widgets/Edit.hs +++ b/src/Brick/Widgets/Edit.hs @@ -193,12 +193,12 @@ applyEdit f e = e & editContentsL %~ f -- | The attribute assigned to the editor when it does not have focus. editAttr :: AttrName -editAttr = "edit" +editAttr = attrName "edit" -- | The attribute assigned to the editor when it has focus. Extends -- 'editAttr'. editFocusedAttr :: AttrName -editFocusedAttr = editAttr <> "focused" +editFocusedAttr = editAttr <> attrName "focused" -- | Get the contents of the editor. getEditContents :: Monoid t => Editor t n -> [t] diff --git a/src/Brick/Widgets/FileBrowser.hs b/src/Brick/Widgets/FileBrowser.hs index 499444a..7f50147 100644 --- a/src/Brick/Widgets/FileBrowser.hs +++ b/src/Brick/Widgets/FileBrowser.hs @@ -165,7 +165,7 @@ import qualified System.FilePath as FP import Text.Printf (printf) import Brick.Types -import Brick.AttrMap (AttrName) +import Brick.AttrMap (AttrName, attrName) import Brick.Widgets.Core import Brick.Widgets.List @@ -837,49 +837,49 @@ attrForFileType UnixSocket = fileBrowserUnixSocketAttr -- | The base attribute for all file browser attributes. fileBrowserAttr :: AttrName -fileBrowserAttr = "fileBrowser" +fileBrowserAttr = attrName "fileBrowser" -- | The attribute used for the current directory displayed at the top -- of the browser. fileBrowserCurrentDirectoryAttr :: AttrName -fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> "currentDirectory" +fileBrowserCurrentDirectoryAttr = fileBrowserAttr <> attrName "currentDirectory" -- | The attribute used for the entry information displayed at the -- bottom of the browser. fileBrowserSelectionInfoAttr :: AttrName -fileBrowserSelectionInfoAttr = fileBrowserAttr <> "selectionInfo" +fileBrowserSelectionInfoAttr = fileBrowserAttr <> attrName "selectionInfo" -- | The attribute used to render directory entries. fileBrowserDirectoryAttr :: AttrName -fileBrowserDirectoryAttr = fileBrowserAttr <> "directory" +fileBrowserDirectoryAttr = fileBrowserAttr <> attrName "directory" -- | The attribute used to render block device entries. fileBrowserBlockDeviceAttr :: AttrName -fileBrowserBlockDeviceAttr = fileBrowserAttr <> "block" +fileBrowserBlockDeviceAttr = fileBrowserAttr <> attrName "block" -- | The attribute used to render regular file entries. fileBrowserRegularFileAttr :: AttrName -fileBrowserRegularFileAttr = fileBrowserAttr <> "regular" +fileBrowserRegularFileAttr = fileBrowserAttr <> attrName "regular" -- | The attribute used to render character device entries. fileBrowserCharacterDeviceAttr :: AttrName -fileBrowserCharacterDeviceAttr = fileBrowserAttr <> "char" +fileBrowserCharacterDeviceAttr = fileBrowserAttr <> attrName "char" -- | The attribute used to render named pipe entries. fileBrowserNamedPipeAttr :: AttrName -fileBrowserNamedPipeAttr = fileBrowserAttr <> "pipe" +fileBrowserNamedPipeAttr = fileBrowserAttr <> attrName "pipe" -- | The attribute used to render symbolic link entries. fileBrowserSymbolicLinkAttr :: AttrName -fileBrowserSymbolicLinkAttr = fileBrowserAttr <> "symlink" +fileBrowserSymbolicLinkAttr = fileBrowserAttr <> attrName "symlink" -- | The attribute used to render Unix socket entries. fileBrowserUnixSocketAttr :: AttrName -fileBrowserUnixSocketAttr = fileBrowserAttr <> "unixSocket" +fileBrowserUnixSocketAttr = fileBrowserAttr <> attrName "unixSocket" -- | The attribute used for selected entries in the file browser. fileBrowserSelectedAttr :: AttrName -fileBrowserSelectedAttr = fileBrowserAttr <> "selected" +fileBrowserSelectedAttr = fileBrowserAttr <> attrName "selected" -- | A file type filter for use with 'setFileBrowserEntryFilter'. This -- filter permits entries whose file types are in the specified list. diff --git a/src/Brick/Widgets/List.hs b/src/Brick/Widgets/List.hs index f0ea336..7c83898 100644 --- a/src/Brick/Widgets/List.hs +++ b/src/Brick/Widgets/List.hs @@ -250,17 +250,17 @@ listMoveToEnd l = listMoveTo (max 0 $ length (listElements l) - 1) l -- | The top-level attribute used for the entire list. listAttr :: AttrName -listAttr = "list" +listAttr = attrName "list" -- | The attribute used only for the currently-selected list item when -- the list does not have focus. Extends 'listAttr'. listSelectedAttr :: AttrName -listSelectedAttr = listAttr <> "selected" +listSelectedAttr = listAttr <> attrName "selected" -- | The attribute used only for the currently-selected list item when -- the list has focus. Extends 'listSelectedAttr'. listSelectedFocusedAttr :: AttrName -listSelectedFocusedAttr = listSelectedAttr <> "focused" +listSelectedFocusedAttr = listSelectedAttr <> attrName "focused" -- | Construct a list in terms of container 't' with element type 'e'. list :: (Foldable t) diff --git a/src/Brick/Widgets/ProgressBar.hs b/src/Brick/Widgets/ProgressBar.hs index 1aaaa53..076d104 100644 --- a/src/Brick/Widgets/ProgressBar.hs +++ b/src/Brick/Widgets/ProgressBar.hs @@ -22,11 +22,11 @@ import Brick.Widgets.Core -- | The attribute of the completed portion of the progress bar. progressCompleteAttr :: AttrName -progressCompleteAttr = "progressComplete" +progressCompleteAttr = attrName "progressComplete" -- | The attribute of the incomplete portion of the progress bar. progressIncompleteAttr :: AttrName -progressIncompleteAttr = "progressIncomplete" +progressIncompleteAttr = attrName "progressIncomplete" -- | Draw a progress bar with the specified (optional) label and -- progress value. This fills available horizontal space and is one row