slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ui: UIUtils export list, cleanup

Browse Source
This commit is contained in:
Simon Michael 2018-10-23 04:56:29 -07:00
parent 3f6922b51f
commit cf9eb78ad2
1 changed files with 56 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
hledger-ui/Hledger/UI/UIUtils.hs
View File

@ -1,16 +1,31 @@
{-# LANGUAGE CPP #-}
{- | Rendering & misc. helpers. -} {- | Rendering & misc. helpers. -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Hledger.UI.UIUtils module Hledger.UI.UIUtils (
borderDepthStr
,borderKeysStr
,borderKeysStr'
,borderPeriodStr
,borderQueryStr
,defaultLayout
,helpDialog
,helpHandle
,minibuffer
,moveDownEvents
,moveLeftEvents
,moveRightEvents
,moveUpEvents
,normaliseMovementKeys
,replaceHiddenAccountsNameWith
,scrollSelectionToMiddle
)
where where
import Brick import Brick
import Brick.Widgets.Border import Brick.Widgets.Border
import Brick.Widgets.Border.Style import Brick.Widgets.Border.Style
-- import Brick.Widgets.Center
import Brick.Widgets.Dialog import Brick.Widgets.Dialog
import Brick.Widgets.Edit import Brick.Widgets.Edit
import Brick.Widgets.List import Brick.Widgets.List
@ -178,49 +193,49 @@ hiddenAccountsName = "..." -- for now
-- generic -- generic
topBottomBorderWithLabel :: Widget Name -> Widget Name -> Widget Name --topBottomBorderWithLabel :: Widget Name -> Widget Name -> Widget Name
topBottomBorderWithLabel label = \wrapped -> --topBottomBorderWithLabel label = \wrapped ->
Widget Greedy Greedy $ do -- Widget Greedy Greedy $ do
c <- getContext -- c <- getContext
let (_w,h) = (c^.availWidthL, c^.availHeightL) -- let (_w,h) = (c^.availWidthL, c^.availHeightL)
h' = h - 2 -- h' = h - 2
wrapped' = vLimit (h') wrapped -- wrapped' = vLimit (h') wrapped
debugmsg = -- debugmsg =
"" -- ""
-- " debug: "++show (_w,h') -- -- " debug: "++show (_w,h')
render $ -- render $
hBorderWithLabel (label <+> str debugmsg) -- hBorderWithLabel (label <+> str debugmsg)
<=> -- <=>
wrapped' -- wrapped'
<=> -- <=>
hBorder -- hBorder
topBottomBorderWithLabels :: Widget Name -> Widget Name -> Widget Name -> Widget Name topBottomBorderWithLabels :: Widget Name -> Widget Name -> Widget Name -> Widget Name
topBottomBorderWithLabels toplabel bottomlabel = \wrapped -> topBottomBorderWithLabels toplabel bottomlabel body =
Widget Greedy Greedy $ do Widget Greedy Greedy $ do
c <- getContext c <- getContext
let (_w,h) = (c^.availWidthL, c^.availHeightL) let (_w,h) = (c^.availWidthL, c^.availHeightL)
h' = h - 2 h' = h - 2
wrapped' = vLimit (h') wrapped body' = vLimit (h') body
debugmsg = debugmsg =
"" ""
-- " debug: "++show (_w,h') -- " debug: "++show (_w,h')
render $ render $
hBorderWithLabel (toplabel <+> str debugmsg) hBorderWithLabel (toplabel <+> str debugmsg)
<=> <=>
wrapped' body'
<=> <=>
hBorderWithLabel bottomlabel hBorderWithLabel bottomlabel
-- XXX should be equivalent to the above, but isn't (page down goes offscreen) ---- XXX should be equivalent to the above, but isn't (page down goes offscreen)
_topBottomBorderWithLabel2 :: Widget Name -> Widget Name -> Widget Name --_topBottomBorderWithLabel2 :: Widget Name -> Widget Name -> Widget Name
_topBottomBorderWithLabel2 label = \wrapped -> --_topBottomBorderWithLabel2 label = \wrapped ->
let debugmsg = "" -- let debugmsg = ""
in hBorderWithLabel (label <+> str debugmsg) -- in hBorderWithLabel (label <+> str debugmsg)
<=> -- <=>
wrapped -- wrapped
<=> -- <=>
hBorder -- hBorder
-- XXX superseded by pad, in theory -- XXX superseded by pad, in theory
-- | Wrap a widget in a margin with the given horizontal and vertical -- | Wrap a widget in a margin with the given horizontal and vertical
@ -250,17 +265,17 @@ margin h v mcolour = \w ->
withBorderAttr :: Attr -> Widget Name -> Widget Name withBorderAttr :: Attr -> Widget Name -> Widget Name
withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)]) withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)])
-- | Like brick's continue, but first run some action to modify brick's state. ---- | Like brick's continue, but first run some action to modify brick's state.
-- This action does not affect the app state, but might eg adjust a widget's scroll position. ---- This action does not affect the app state, but might eg adjust a widget's scroll position.
continueWith :: EventM n () -> ui -> EventM n (Next ui) --continueWith :: EventM n () -> ui -> EventM n (Next ui)
continueWith brickaction ui = brickaction >> continue ui --continueWith brickaction ui = brickaction >> continue ui
-- | Scroll a list's viewport so that the selected item is centered in the ---- | Scroll a list's viewport so that the selected item is at the top
-- middle of the display area. ---- of the display area.
scrollToTop :: List Name e -> EventM Name () --scrollToTop :: List Name e -> EventM Name ()
scrollToTop list = do --scrollToTop list = do
let vpname = list^.listNameL -- let vpname = list^.listNameL
setTop (viewportScroll vpname) 0 -- setTop (viewportScroll vpname) 0
-- | Scroll a list's viewport so that the selected item is centered in the -- | Scroll a list's viewport so that the selected item is centered in the
-- middle of the display area. -- middle of the display area.