ui: acc: show a better title with filename & query

This commit is contained in:
Simon Michael 2015-08-25 06:56:04 -07:00
parent d32a028a19
commit f496ec9809
3 changed files with 26 additions and 5 deletions

View File

@ -11,8 +11,9 @@ import Control.Lens ((^.))
import Control.Monad.IO.Class
-- import Data.Default
import Data.List
-- import Data.Monoid --
import Data.Monoid
import Data.Time.Calendar (Day)
import System.FilePath (takeFileName)
import qualified Data.Vector as V
import Graphics.Vty as Vty
import Brick
@ -56,9 +57,22 @@ initAccountsScreen d args st@AppState{aopts=opts, ajournal=j, aScreen=s@Accounts
initAccountsScreen _ _ _ = error "init function called with wrong screen type, should not happen"
drawAccountsScreen :: AppState -> [Widget]
drawAccountsScreen st@AppState{aScreen=AccountsScreen{asState=is}} = [ui]
drawAccountsScreen st@AppState{aopts=uopts, ajournal=j, aScreen=AccountsScreen{asState=is}} = [ui]
where
label = str "Account " <+> cur <+> str " of " <+> total
label = str "Accounts in "
<+> withAttr ("border" <> "bold") files
<+> borderQuery querystr
<+> str " ("
<+> cur
<+> str " of "
<+> total
<+> str ")"
files = str $ case journalFilePaths j of
[] -> ""
[f] -> takeFileName f
[f,_] -> takeFileName f ++ " (& 1 included file)"
f:fs -> takeFileName f ++ " (& " ++ show (length fs) ++ " included files)"
querystr = query_ $ reportopts_ $ cliopts_ uopts
cur = str (case is^.listSelectedL of
Nothing -> "-"
Just i -> show (i + 1))

View File

@ -66,7 +66,9 @@ themesList :: [(String, AttrMap)]
themesList = [
("default", attrMap
(black `on` white & bold) [ -- default style for this theme
(borderAttr , white `on` black),
(borderAttr , white `on` black & dim),
(borderAttr <> "bold", white `on` black & bold),
(borderAttr <> "query", yellow `on` black & bold),
-- ("normal" , black `on` white),
("list" , black `on` white), -- regular list items
("list" <> "selected" , white `on` blue & bold) -- selected list items

View File

@ -9,13 +9,14 @@ module Hledger.UI.UIUtils (
,withBorderAttr
,topBottomBorderWithLabel
,defaultLayout
,borderQuery
) where
import Control.Lens ((^.))
-- import Control.Monad
-- import Control.Monad.IO.Class
-- import Data.Default
-- import Data.Monoid --
import Data.Monoid
import Data.Time.Calendar (Day)
import Brick
-- import Brick.Widgets.List
@ -121,3 +122,7 @@ withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)])
-- , str " "
-- , hCenter $ str "Press Esc to exit."
-- ]
borderQuery :: String -> Widget
borderQuery "" = str ""
borderQuery qry = str " filtered by: " <+> withAttr (borderAttr <> "query") (str qry)