ui: support/require brick 0.7+ #379

This commit is contained in:
Simon Michael 2016-07-24 18:06:49 -07:00
parent 326c1f6931
commit 9b0cadc179
13 changed files with 82 additions and 74 deletions

View File

@ -42,7 +42,7 @@ accountsScreen = AccountsScreen{
sInit = asInit sInit = asInit
,sDraw = asDraw ,sDraw = asDraw
,sHandle = asHandle ,sHandle = asHandle
,_asList = list "accounts" V.empty 1 ,_asList = list AccountsList V.empty 1
,_asSelectedAccount = "" ,_asSelectedAccount = ""
} }
@ -54,13 +54,13 @@ asInit d reset ui@UIState{
} = } =
ui{aopts=uopts', aScreen=s & asList .~ newitems'} ui{aopts=uopts', aScreen=s & asList .~ newitems'}
where where
newitems = list (Name "accounts") (V.fromList displayitems) 1 newitems = list AccountsList (V.fromList displayitems) 1
-- keep the selection near the last selected account -- keep the selection near the last selected account
-- (may need to move to the next leaf account when entering flat mode) -- (may need to move to the next leaf account when entering flat mode)
newitems' = listMoveTo selidx newitems newitems' = listMoveTo selidx newitems
where where
selidx = case (reset, listSelectedElement $ s ^. asList) of selidx = case (reset, listSelectedElement $ _asList s) of
(True, _) -> 0 (True, _) -> 0
(_, Nothing) -> 0 (_, Nothing) -> 0
(_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch (_, Just (_,AccountsScreenItem{asItemAccountName=a})) -> fromMaybe (fromMaybe 0 mprefixmatch) mexactmatch
@ -99,7 +99,7 @@ asInit d reset ui@UIState{
asInit _ _ _ = error "init function called with wrong screen type, should not happen" asInit _ _ _ = error "init function called with wrong screen type, should not happen"
asDraw :: UIState -> [Widget] asDraw :: UIState -> [Widget Name]
asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
,ajournal=j ,ajournal=j
,aScreen=s@AccountsScreen{} ,aScreen=s@AccountsScreen{}
@ -144,7 +144,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns" fs -> str " with " <+> withAttr (borderAttr <> "query") (str $ intercalate ", " fs) <+> str " txns"
nonzero | empty_ ropts = str "" nonzero | empty_ ropts = str ""
| otherwise = withAttr (borderAttr <> "query") (str " nonzero") | otherwise = withAttr (borderAttr <> "query") (str " nonzero")
cur = str (case s ^. asList ^. listSelectedL of -- XXX second ^. required here but not below.. cur = str (case _asList s ^. listSelectedL of
Nothing -> "-" Nothing -> "-"
Just i -> show (i + 1)) Just i -> show (i + 1))
total = str $ show $ V.length $ s ^. asList . listElementsL total = str $ show $ V.length $ s ^. asList . listElementsL
@ -183,7 +183,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
colwidths = (acctwidth, balwidth) colwidths = (acctwidth, balwidth)
render $ defaultLayout toplabel bottomlabel $ renderList (s ^. asList) (asDrawItem colwidths) render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (_asList s)
where where
bottomlabel = case mode of bottomlabel = case mode of
@ -204,7 +204,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
asDraw _ = error "draw function called with wrong screen type, should not happen" asDraw _ = error "draw function called with wrong screen type, should not happen"
asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name
asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
-- c <- getContext -- c <- getContext
@ -217,21 +217,21 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} =
where where
balspace as = replicate n ' ' balspace as = replicate n ' '
where n = max 0 (balwidth - (sum (map strWidth as) + 2 * (length as - 1))) where n = max 0 (balwidth - (sum (map strWidth as) + 2 * (length as - 1)))
addamts :: [String] -> Widget -> Widget addamts :: [String] -> Widget Name -> Widget Name
addamts [] w = w addamts [] w = w
addamts [a] w = (<+> renderamt a) w addamts [a] w = (<+> renderamt a) w
-- foldl' :: (b -> a -> b) -> b -> t a -> b -- foldl' :: (b -> a -> b) -> b -> t a -> b
-- foldl' (Widget -> String -> Widget) -> Widget -> [String] -> Widget -- foldl' (Widget -> String -> Widget) -> Widget -> [String] -> Widget
addamts (a:as) w = foldl' addamt (addamts [a] w) as addamts (a:as) w = foldl' addamt (addamts [a] w) as
addamt :: Widget -> String -> Widget addamt :: Widget Name -> String -> Widget Name
addamt w a = ((<+> renderamt a) . (<+> str ", ")) w addamt w a = ((<+> renderamt a) . (<+> str ", ")) w
renderamt :: String -> Widget renderamt :: String -> Widget Name
renderamt a | '-' `elem` a = withAttr (sel $ "list" <> "balance" <> "negative") $ str a renderamt a | '-' `elem` a = withAttr (sel $ "list" <> "balance" <> "negative") $ str a
| otherwise = withAttr (sel $ "list" <> "balance" <> "positive") $ str a | otherwise = withAttr (sel $ "list" <> "balance" <> "positive") $ str a
sel | selected = (<> "selected") sel | selected = (<> "selected")
| otherwise = id | otherwise = id
asHandle :: UIState -> Event -> EventM (Next UIState) asHandle :: UIState -> Event -> EventM Name (Next UIState)
asHandle ui0@UIState{ asHandle ui0@UIState{
aScreen=scr@AccountsScreen{..} aScreen=scr@AccountsScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
@ -245,7 +245,7 @@ asHandle ui0@UIState{
-- save the currently selected account, in case we leave this screen and lose the selection -- save the currently selected account, in case we leave this screen and lose the selection
let let
selacct = case listSelectedElement $ scr ^. asList of selacct = case listSelectedElement _asList of
Just (_, AccountsScreenItem{..}) -> asItemAccountName Just (_, AccountsScreenItem{..}) -> asItemAccountName
Nothing -> scr ^. asSelectedAccount Nothing -> scr ^. asSelectedAccount
ui = ui0{aScreen=scr & asSelectedAccount .~ selacct} ui = ui0{aScreen=scr & asSelectedAccount .~ selacct}
@ -256,7 +256,7 @@ asHandle ui0@UIState{
EvKey KEsc [] -> continue $ closeMinibuffer ui EvKey KEsc [] -> continue $ closeMinibuffer ui
EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui
where s = chomp $ unlines $ getEditContents ed where s = chomp $ unlines $ getEditContents ed
ev -> do ed' <- handleEvent ev ed ev -> do ed' <- handleEditorEvent ev ed
continue $ ui{aMode=Minibuffer ed'} continue $ ui{aMode=Minibuffer ed'}
Help -> Help ->
@ -305,7 +305,7 @@ asHandle ui0@UIState{
EvKey (KChar 'k') [] -> EvKey (KUp) [] EvKey (KChar 'k') [] -> EvKey (KUp) []
EvKey (KChar 'j') [] -> EvKey (KDown) [] EvKey (KChar 'j') [] -> EvKey (KDown) []
_ -> ev _ -> ev
newitems <- handleEvent ev' (scr ^. asList) newitems <- handleListEvent ev' _asList
continue $ ui{aScreen=scr & asList .~ newitems continue $ ui{aScreen=scr & asList .~ newitems
& asSelectedAccount .~ selacct & asSelectedAccount .~ selacct
} }
@ -317,8 +317,8 @@ asHandle ui0@UIState{
-- scroll down just far enough to reveal the selection, which -- scroll down just far enough to reveal the selection, which
-- usually leaves it at bottom of screen). -- usually leaves it at bottom of screen).
-- XXX better: scroll so selection is in middle of screen ? -- XXX better: scroll so selection is in middle of screen ?
scrollTop = vScrollToBeginning $ viewportScroll "accounts" scrollTop = vScrollToBeginning $ viewportScroll AccountsViewport
scrollTopRegister = vScrollToBeginning $ viewportScroll "register" scrollTopRegister = vScrollToBeginning $ viewportScroll RegisterViewport
asHandle _ _ = error "event handler called with wrong screen type, should not happen" asHandle _ _ = error "event handler called with wrong screen type, should not happen"

View File

@ -38,7 +38,7 @@ esInit :: Day -> Bool -> UIState -> UIState
esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui
esInit _ _ _ = error "init function called with wrong screen type, should not happen" esInit _ _ _ = error "init function called with wrong screen type, should not happen"
esDraw :: UIState -> [Widget] esDraw :: UIState -> [Widget Name]
esDraw UIState{ --aopts=UIOpts{cliopts_=copts@CliOpts{}} esDraw UIState{ --aopts=UIOpts{cliopts_=copts@CliOpts{}}
aScreen=ErrorScreen{..} aScreen=ErrorScreen{..}
,aMode=mode} = ,aMode=mode} =
@ -67,7 +67,7 @@ esDraw UIState{ --aopts=UIOpts{cliopts_=copts@CliOpts{}}
esDraw _ = error "draw function called with wrong screen type, should not happen" esDraw _ = error "draw function called with wrong screen type, should not happen"
esHandle :: UIState -> Event -> EventM (Next UIState) esHandle :: UIState -> Event -> EventM Name (Next UIState)
esHandle ui@UIState{ esHandle ui@UIState{
aScreen=ErrorScreen{..} aScreen=ErrorScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}

View File

@ -127,7 +127,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do
,aMode=Normal ,aMode=Normal
} }
brickapp :: App (UIState) V.Event brickapp :: App (UIState) V.Event Name
brickapp = App { brickapp = App {
appLiftVtyEvent = id appLiftVtyEvent = id
, appStartEvent = return , appStartEvent = return

View File

@ -42,7 +42,7 @@ registerScreen = RegisterScreen{
sInit = rsInit sInit = rsInit
,sDraw = rsDraw ,sDraw = rsDraw
,sHandle = rsHandle ,sHandle = rsHandle
,rsList = list "register" V.empty 1 ,rsList = list RegisterList V.empty 1
,rsAccount = "" ,rsAccount = ""
} }
@ -83,7 +83,7 @@ rsInit d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajo
} }
-- build the List -- build the List
newitems = list (Name "register") (V.fromList displayitems) 1 newitems = list RegisterList (V.fromList displayitems) 1
-- keep the selection on the previously selected transaction if possible, -- keep the selection on the previously selected transaction if possible,
-- (eg after toggling nonzero mode), otherwise select the last element. -- (eg after toggling nonzero mode), otherwise select the last element.
@ -98,7 +98,7 @@ rsInit d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajo
rsInit _ _ _ = error "init function called with wrong screen type, should not happen" rsInit _ _ _ = error "init function called with wrong screen type, should not happen"
rsDraw :: UIState -> [Widget] rsDraw :: UIState -> [Widget Name]
rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
,aScreen=RegisterScreen{..} ,aScreen=RegisterScreen{..}
,aMode=mode ,aMode=mode
@ -180,7 +180,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
acctswidth = maxdescacctswidth - descwidth acctswidth = maxdescacctswidth - descwidth
colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth) colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth)
render $ defaultLayout toplabel bottomlabel $ renderList rsList (rsDrawItem colwidths) render $ defaultLayout toplabel bottomlabel $ renderList (rsDrawItem colwidths) True rsList
where where
bottomlabel = case mode of bottomlabel = case mode of
@ -200,7 +200,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
rsDraw _ = error "draw function called with wrong screen type, should not happen" rsDraw _ = error "draw function called with wrong screen type, should not happen"
rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget rsDrawItem :: (Int,Int,Int,Int,Int) -> Bool -> RegisterScreenItem -> Widget Name
rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} = rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected RegisterScreenItem{..} =
Widget Greedy Fixed $ do Widget Greedy Fixed $ do
render $ render $
@ -221,7 +221,7 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist
sel | selected = (<> "selected") sel | selected = (<> "selected")
| otherwise = id | otherwise = id
rsHandle :: UIState -> Event -> EventM (Next UIState) rsHandle :: UIState -> Event -> EventM Name (Next UIState)
rsHandle ui@UIState{ rsHandle ui@UIState{
aScreen=s@RegisterScreen{..} aScreen=s@RegisterScreen{..}
,aopts=UIOpts{cliopts_=copts} ,aopts=UIOpts{cliopts_=copts}
@ -236,7 +236,7 @@ rsHandle ui@UIState{
EvKey KEsc [] -> continue $ closeMinibuffer ui EvKey KEsc [] -> continue $ closeMinibuffer ui
EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui
where s = chomp $ unlines $ getEditContents ed where s = chomp $ unlines $ getEditContents ed
ev -> do ed' <- handleEvent ev ed ev -> do ed' <- handleEditorEvent ev ed
continue $ ui{aMode=Minibuffer ed'} continue $ ui{aMode=Minibuffer ed'}
Help -> Help ->
@ -283,11 +283,11 @@ rsHandle ui@UIState{
EvKey (KChar 'k') [] -> EvKey (KUp) [] EvKey (KChar 'k') [] -> EvKey (KUp) []
EvKey (KChar 'j') [] -> EvKey (KDown) [] EvKey (KChar 'j') [] -> EvKey (KDown) []
_ -> ev _ -> ev
newitems <- handleEvent ev' rsList newitems <- handleListEvent ev' rsList
continue ui{aScreen=s{rsList=newitems}} continue ui{aScreen=s{rsList=newitems}}
-- continue =<< handleEventLensed ui someLens ev -- continue =<< handleEventLensed ui someLens ev
where where
-- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs) -- Encourage a more stable scroll position when toggling list items (cf AccountsScreen.hs)
scrollTop = vScrollToBeginning $ viewportScroll "register" scrollTop = vScrollToBeginning $ viewportScroll RegisterViewport
rsHandle _ _ = error "event handler called with wrong screen type, should not happen" rsHandle _ _ = error "event handler called with wrong screen type, should not happen"

View File

@ -45,7 +45,7 @@ tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
,aScreen=TransactionScreen{..}} = ui ,aScreen=TransactionScreen{..}} = ui
tsInit _ _ _ = error "init function called with wrong screen type, should not happen" tsInit _ _ _ = error "init function called with wrong screen type, should not happen"
tsDraw :: UIState -> [Widget] tsDraw :: UIState -> [Widget Name]
tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
,aScreen=TransactionScreen{ ,aScreen=TransactionScreen{
tsTransaction=(i,t) tsTransaction=(i,t)
@ -102,7 +102,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
tsDraw _ = error "draw function called with wrong screen type, should not happen" tsDraw _ = error "draw function called with wrong screen type, should not happen"
tsHandle :: UIState -> Event -> EventM (Next UIState) tsHandle :: UIState -> Event -> EventM Name (Next UIState)
tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t) tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
,tsTransactions=nts ,tsTransactions=nts
,tsAccount=acct} ,tsAccount=acct}

View File

@ -127,7 +127,7 @@ setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_
showMinibuffer :: UIState -> UIState showMinibuffer :: UIState -> UIState
showMinibuffer ui = setMode (Minibuffer e) ui showMinibuffer ui = setMode (Minibuffer e) ui
where where
e = applyEdit gotoEOL $ editor "minibuffer" (str . unlines) (Just 1) oldq e = applyEdit gotoEOL $ editor MinibufferEditor (str . unlines) (Just 1) oldq
oldq = query_ $ reportopts_ $ cliopts_ $ aopts ui oldq = query_ $ reportopts_ $ cliopts_ $ aopts ui
-- | Close the minibuffer, discarding any edit in progress. -- | Close the minibuffer, discarding any edit in progress.

View File

@ -38,13 +38,11 @@ Brick.defaultMain brickapp st
module Hledger.UI.UITypes where module Hledger.UI.UITypes where
import Data.Monoid
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Graphics.Vty (Event) import Graphics.Vty (Event)
import Brick import Brick
import Brick.Widgets.List import Brick.Widgets.List
import Brick.Widgets.Edit (Editor) import Brick.Widgets.Edit (Editor)
import qualified Data.Vector as V
import Lens.Micro.Platform import Lens.Micro.Platform
import Text.Show.Functions () import Text.Show.Functions ()
-- import the Show instance for functions. Warning, this also re-exports it -- import the Show instance for functions. Warning, this also re-exports it
@ -52,8 +50,8 @@ import Text.Show.Functions ()
import Hledger import Hledger
import Hledger.UI.UIOptions import Hledger.UI.UIOptions
instance Show (List a) where show _ = "<List>" instance Show (List n a) where show _ = "<List>"
instance Show Editor where show _ = "<Editor>" instance Show (Editor n) where show _ = "<Editor>"
-- | hledger-ui's application state. This holds one or more stateful screens. -- | hledger-ui's application state. This holds one or more stateful screens.
-- As you navigate through screens, the old ones are saved in a stack. -- As you navigate through screens, the old ones are saved in a stack.
@ -72,12 +70,21 @@ data UIState = UIState {
data Mode = data Mode =
Normal Normal
| Help | Help
| Minibuffer Editor | Minibuffer (Editor Name)
deriving (Show,Eq) deriving (Show,Eq)
-- Ignore the editor when comparing Modes. -- Ignore the editor when comparing Modes.
instance Eq Editor where _ == _ = True instance Eq (Editor n) where _ == _ = True
-- Unique names required for widgets, viewports, cursor locations etc.
data Name =
HelpDialog
| MinibufferEditor
| AccountsViewport
| AccountsList
| RegisterViewport
| RegisterList
deriving (Ord, Show, Eq)
-- | hledger-ui screen types & instances. -- | hledger-ui screen types & instances.
-- Each screen type has generically named initialisation, draw, and event handling functions, -- Each screen type has generically named initialisation, draw, and event handling functions,
@ -87,24 +94,24 @@ instance Eq Editor where _ == _ = True
data Screen = data Screen =
AccountsScreen { AccountsScreen {
sInit :: Day -> Bool -> UIState -> UIState -- ^ function to initialise or update this screen's state sInit :: Day -> Bool -> UIState -> UIState -- ^ function to initialise or update this screen's state
,sDraw :: UIState -> [Widget] -- ^ brick renderer for this screen ,sDraw :: UIState -> [Widget Name] -- ^ brick renderer for this screen
,sHandle :: UIState -> Event -> EventM (Next UIState) -- ^ brick event handler for this screen ,sHandle :: UIState -> Event -> EventM Name (Next UIState) -- ^ brick event handler for this screen
-- state fields.These ones have lenses: -- state fields.These ones have lenses:
,_asList :: List AccountsScreenItem -- ^ list widget showing account names & balances ,_asList :: List Name AccountsScreenItem -- ^ list widget showing account names & balances
,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "") ,_asSelectedAccount :: AccountName -- ^ a backup of the account name from the list widget's selected item (or "")
} }
| RegisterScreen { | RegisterScreen {
sInit :: Day -> Bool -> UIState -> UIState sInit :: Day -> Bool -> UIState -> UIState
,sDraw :: UIState -> [Widget] ,sDraw :: UIState -> [Widget Name]
,sHandle :: UIState -> Event -> EventM (Next UIState) ,sHandle :: UIState -> Event -> EventM Name (Next UIState)
-- --
,rsList :: List RegisterScreenItem -- ^ list widget showing transactions affecting this account ,rsList :: List Name RegisterScreenItem -- ^ list widget showing transactions affecting this account
,rsAccount :: AccountName -- ^ the account this register is for ,rsAccount :: AccountName -- ^ the account this register is for
} }
| TransactionScreen { | TransactionScreen {
sInit :: Day -> Bool -> UIState -> UIState sInit :: Day -> Bool -> UIState -> UIState
,sDraw :: UIState -> [Widget] ,sDraw :: UIState -> [Widget Name]
,sHandle :: UIState -> Event -> EventM (Next UIState) ,sHandle :: UIState -> Event -> EventM Name (Next UIState)
-- --
,tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list ,tsTransaction :: NumberedTransaction -- ^ the transaction we are currently viewing, and its position in the list
,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through ,tsTransactions :: [NumberedTransaction] -- ^ list of transactions we can step through
@ -112,8 +119,8 @@ data Screen =
} }
| ErrorScreen { | ErrorScreen {
sInit :: Day -> Bool -> UIState -> UIState sInit :: Day -> Bool -> UIState -> UIState
,sDraw :: UIState -> [Widget] ,sDraw :: UIState -> [Widget Name]
,sHandle :: UIState -> Event -> EventM (Next UIState) ,sHandle :: UIState -> Event -> EventM Name (Next UIState)
-- --
,esError :: String -- ^ error message to show ,esError :: String -- ^ error message to show
} }
@ -140,10 +147,10 @@ data RegisterScreenItem = RegisterScreenItem {
type NumberedTransaction = (Integer, Transaction) type NumberedTransaction = (Integer, Transaction)
-- dummy monoid instance needed make lenses work with List fields not common across constructors -- dummy monoid instance needed make lenses work with List fields not common across constructors
instance Monoid (List a) --instance Monoid (List n a)
where -- where
mempty = list "" V.empty 1 -- mempty = list "" V.empty 1 -- XXX problem in 0.7, every list requires a unique Name
mappend l1 l2 = l1 & listElementsL .~ (l1^.listElementsL <> l2^.listElementsL) -- mappend l1 l2 = l1 & listElementsL .~ (l1^.listElementsL <> l2^.listElementsL)
concat <$> mapM makeLenses [ concat <$> mapM makeLenses [
''Screen ''Screen

View File

@ -29,12 +29,12 @@ runHelp = runCommand "hledger-ui --help | less" >>= waitForProcess
-- ui -- ui
-- | Draw the help dialog, called when help mode is active. -- | Draw the help dialog, called when help mode is active.
helpDialog :: Widget helpDialog :: Widget Name
helpDialog = helpDialog =
Widget Fixed Fixed $ do Widget Fixed Fixed $ do
c <- getContext c <- getContext
render $ render $
renderDialog (dialog "help" (Just "Help (?/LEFT/ESC to close)") Nothing (c^.availWidthL - 2)) $ -- (Just (0,[("ok",())])) renderDialog (dialog (Just "Help (?/LEFT/ESC to close)") Nothing (c^.availWidthL - 2)) $ -- (Just (0,[("ok",())]))
padTopBottom 1 $ padLeftRight 1 $ padTopBottom 1 $ padLeftRight 1 $
vBox [ vBox [
hBox [ hBox [
@ -87,7 +87,7 @@ helpDialog =
renderKey (key,desc) = withAttr (borderAttr <> "keys") (str key) <+> str " " <+> str desc renderKey (key,desc) = withAttr (borderAttr <> "keys") (str key) <+> str " " <+> str desc
-- | Event handler used when help mode is active. -- | Event handler used when help mode is active.
helpHandle :: UIState -> Event -> EventM (Next UIState) helpHandle :: UIState -> Event -> EventM Name (Next UIState)
helpHandle ui ev = helpHandle ui ev =
case ev of case ev of
EvKey k [] | k `elem` [KEsc, KLeft, KChar 'h', KChar '?'] -> continue $ setMode Normal ui EvKey k [] | k `elem` [KEsc, KLeft, KChar 'h', KChar '?'] -> continue $ setMode Normal ui
@ -97,14 +97,14 @@ helpHandle ui ev =
_ -> continue ui _ -> continue ui
-- | Draw the minibuffer. -- | Draw the minibuffer.
minibuffer :: Editor -> Widget minibuffer :: Editor Name -> Widget Name
minibuffer ed = minibuffer ed =
forceAttr (borderAttr <> "minibuffer") $ forceAttr (borderAttr <> "minibuffer") $
hBox $ hBox $
[txt "filter: ", renderEditor ed] [txt "filter: ", renderEditor True ed]
-- | Wrap a widget in the default hledger-ui screen layout. -- | Wrap a widget in the default hledger-ui screen layout.
defaultLayout :: Widget -> Widget -> Widget -> Widget defaultLayout :: Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout toplabel bottomlabel = defaultLayout toplabel bottomlabel =
topBottomBorderWithLabels (str " "<+>toplabel<+>str " ") (str " "<+>bottomlabel<+>str " ") . topBottomBorderWithLabels (str " "<+>toplabel<+>str " ") (str " "<+>bottomlabel<+>str " ") .
margin 1 0 Nothing margin 1 0 Nothing
@ -112,15 +112,15 @@ defaultLayout toplabel bottomlabel =
-- padLeftRight 1 -- XXX should reduce inner widget's width by 2, but doesn't -- padLeftRight 1 -- XXX should reduce inner widget's width by 2, but doesn't
-- "the layout adjusts... if you use the core combinators" -- "the layout adjusts... if you use the core combinators"
borderQueryStr :: String -> Widget borderQueryStr :: String -> Widget Name
borderQueryStr "" = str "" borderQueryStr "" = str ""
borderQueryStr qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry) borderQueryStr qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry)
borderDepthStr :: Maybe Int -> Widget borderDepthStr :: Maybe Int -> Widget Name
borderDepthStr Nothing = str "" borderDepthStr Nothing = str ""
borderDepthStr (Just d) = str " to " <+> withAttr (borderAttr <> "query") (str $ "depth "++show d) borderDepthStr (Just d) = str " to " <+> withAttr (borderAttr <> "query") (str $ "depth "++show d)
borderKeysStr :: [(String,String)] -> Widget borderKeysStr :: [(String,String)] -> Widget Name
borderKeysStr keydescs = borderKeysStr keydescs =
hBox $ hBox $
intersperse sep $ intersperse sep $
@ -141,7 +141,7 @@ hiddenAccountsName = "..." -- for now
-- generic -- generic
topBottomBorderWithLabel :: Widget -> Widget -> Widget 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
@ -158,7 +158,7 @@ topBottomBorderWithLabel label = \wrapped ->
<=> <=>
hBorder hBorder
topBottomBorderWithLabels :: Widget -> Widget -> Widget -> Widget topBottomBorderWithLabels :: Widget Name -> Widget Name -> Widget Name -> Widget Name
topBottomBorderWithLabels toplabel bottomlabel = \wrapped -> topBottomBorderWithLabels toplabel bottomlabel = \wrapped ->
Widget Greedy Greedy $ do Widget Greedy Greedy $ do
c <- getContext c <- getContext
@ -176,7 +176,7 @@ topBottomBorderWithLabels toplabel bottomlabel = \wrapped ->
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 -> Widget -> Widget _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)
@ -191,7 +191,7 @@ _topBottomBorderWithLabel2 label = \wrapped ->
-- colour. -- colour.
-- XXX May disrupt border style of inner widgets. -- XXX May disrupt border style of inner widgets.
-- XXX Should reduce the available size visible to inner widget, but doesn't seem to (cf rsDraw2). -- XXX Should reduce the available size visible to inner widget, but doesn't seem to (cf rsDraw2).
margin :: Int -> Int -> Maybe Color -> Widget -> Widget margin :: Int -> Int -> Maybe Color -> Widget Name -> Widget Name
margin h v mcolour = \w -> margin h v mcolour = \w ->
Widget Greedy Greedy $ do Widget Greedy Greedy $ do
c <- getContext c <- getContext
@ -210,6 +210,6 @@ margin h v mcolour = \w ->
-- withBorderStyle (borderStyleFromChar ' ') . -- withBorderStyle (borderStyleFromChar ' ') .
-- applyN n border -- applyN n border
withBorderAttr :: Attr -> Widget -> Widget withBorderAttr :: Attr -> Widget Name -> Widget Name
withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)]) withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)])

View File

@ -77,12 +77,12 @@ executable hledger-ui
, text-zipper >= 0.4 && < 0.5 , text-zipper >= 0.4 && < 0.5
, transformers , transformers
, vector , vector
if !os(windows) if os(windows)
build-depends:
brick >= 0.2 && < 0.7
,vty >= 5.2 && < 5.8
else
buildable: False buildable: False
else
build-depends:
brick >= 0.7 && < 0.9
, vty >= 5.5 && < 5.8
if flag(threaded) if flag(threaded)
ghc-options: -threaded ghc-options: -threaded
if flag(old-locale) if flag(old-locale)

View File

@ -99,8 +99,8 @@ executables:
buildable: false buildable: false
else: else:
dependencies: dependencies:
- brick >= 0.2 && < 0.7 - brick >= 0.7 && < 0.9
- vty >= 5.2 && < 5.8 - vty >= 5.5 && < 5.8
- condition: flag(threaded) - condition: flag(threaded)
ghc-options: -threaded ghc-options: -threaded
- condition: flag(old-locale) - condition: flag(old-locale)

View File

@ -36,7 +36,7 @@ import Data.Monoid ((<>))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Explicit hiding (Name) -- don't clash with hledger-ui
import Test.HUnit import Test.HUnit
import Hledger import Hledger

View File

@ -14,7 +14,7 @@ flags:
extra-deps: extra-deps:
# hledger-ui # hledger-ui
- brick-0.6.4 - brick-0.8
- text-zipper-0.4 - text-zipper-0.4
# hledger-web # hledger-web
- json-0.9.1 - json-0.9.1

View File

@ -11,5 +11,6 @@ packages:
#flags: #flags:
extra-deps: extra-deps:
- brick-0.8
# https://docs.haskellstack.org/en/stable/yaml_configuration/ # https://docs.haskellstack.org/en/stable/yaml_configuration/