ui: support/require brick 0.7+ #379
This commit is contained in:
		
							parent
							
								
									326c1f6931
								
							
						
					
					
						commit
						9b0cadc179
					
				| @ -42,7 +42,7 @@ accountsScreen = AccountsScreen{ | ||||
|    sInit   = asInit | ||||
|   ,sDraw   = asDraw | ||||
|   ,sHandle = asHandle | ||||
|   ,_asList            = list "accounts" V.empty 1 | ||||
|   ,_asList            = list AccountsList V.empty 1 | ||||
|   ,_asSelectedAccount = "" | ||||
|   } | ||||
| 
 | ||||
| @ -54,13 +54,13 @@ asInit d reset ui@UIState{ | ||||
|   } = | ||||
|   ui{aopts=uopts', aScreen=s & asList .~ newitems'} | ||||
|    where | ||||
|     newitems = list (Name "accounts") (V.fromList displayitems) 1 | ||||
|     newitems = list AccountsList (V.fromList displayitems) 1 | ||||
| 
 | ||||
|     -- keep the selection near the last selected account | ||||
|     -- (may need to move to the next leaf account when entering flat mode) | ||||
|     newitems' = listMoveTo selidx newitems | ||||
|       where | ||||
|         selidx = case (reset, listSelectedElement $ s ^. asList) of | ||||
|         selidx = case (reset, listSelectedElement $ _asList s) of | ||||
|                    (True, _)               -> 0 | ||||
|                    (_, Nothing)            -> 0 | ||||
|                    (_, 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" | ||||
| 
 | ||||
| asDraw :: UIState -> [Widget] | ||||
| asDraw :: UIState -> [Widget Name] | ||||
| asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} | ||||
|                            ,ajournal=j | ||||
|                            ,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" | ||||
|     nonzero | empty_ ropts = str "" | ||||
|             | 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 -> "-" | ||||
|                 Just i -> show (i + 1)) | ||||
|     total = str $ show $ V.length $ s ^. asList . listElementsL | ||||
| @ -183,7 +183,7 @@ asDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} | ||||
| 
 | ||||
|         colwidths = (acctwidth, balwidth) | ||||
| 
 | ||||
|       render $ defaultLayout toplabel bottomlabel $ renderList (s ^. asList) (asDrawItem colwidths) | ||||
|       render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (_asList s) | ||||
| 
 | ||||
|       where | ||||
|         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" | ||||
| 
 | ||||
| asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget | ||||
| asDrawItem :: (Int,Int) -> Bool -> AccountsScreenItem -> Widget Name | ||||
| asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = | ||||
|   Widget Greedy Fixed $ do | ||||
|     -- c <- getContext | ||||
| @ -217,21 +217,21 @@ asDrawItem (acctwidth, balwidth) selected AccountsScreenItem{..} = | ||||
|       where | ||||
|         balspace as = replicate n ' ' | ||||
|           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 [a] w = (<+> renderamt a) w | ||||
|         -- foldl' :: (b -> a -> b) -> b -> t a -> b | ||||
|         -- foldl' (Widget -> String -> Widget) -> Widget -> [String] -> Widget | ||||
|         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 | ||||
|         renderamt :: String -> Widget | ||||
|         renderamt :: String -> Widget Name | ||||
|         renderamt a | '-' `elem` a = withAttr (sel $ "list" <> "balance" <> "negative") $ str a | ||||
|                     | otherwise    = withAttr (sel $ "list" <> "balance" <> "positive") $ str a | ||||
|         sel | selected  = (<> "selected") | ||||
|             | otherwise = id | ||||
| 
 | ||||
| asHandle :: UIState -> Event -> EventM (Next UIState) | ||||
| asHandle :: UIState -> Event -> EventM Name (Next UIState) | ||||
| asHandle ui0@UIState{ | ||||
|    aScreen=scr@AccountsScreen{..} | ||||
|   ,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 | ||||
|   let | ||||
|     selacct = case listSelectedElement $ scr ^. asList of | ||||
|     selacct = case listSelectedElement _asList of | ||||
|                 Just (_, AccountsScreenItem{..}) -> asItemAccountName | ||||
|                 Nothing -> scr ^. asSelectedAccount | ||||
|     ui = ui0{aScreen=scr & asSelectedAccount .~ selacct} | ||||
| @ -256,7 +256,7 @@ asHandle ui0@UIState{ | ||||
|         EvKey KEsc   [] -> continue $ closeMinibuffer ui | ||||
|         EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui | ||||
|                             where s = chomp $ unlines $ getEditContents ed | ||||
|         ev              -> do ed' <- handleEvent ev ed | ||||
|         ev              -> do ed' <- handleEditorEvent ev ed | ||||
|                               continue $ ui{aMode=Minibuffer ed'} | ||||
| 
 | ||||
|     Help -> | ||||
| @ -305,7 +305,7 @@ asHandle ui0@UIState{ | ||||
|                             EvKey (KChar 'k') [] -> EvKey (KUp) [] | ||||
|                             EvKey (KChar 'j') [] -> EvKey (KDown) [] | ||||
|                             _                    -> ev | ||||
|                 newitems <- handleEvent ev' (scr ^. asList) | ||||
|                 newitems <- handleListEvent ev' _asList | ||||
|                 continue $ ui{aScreen=scr & asList .~ newitems | ||||
|                                           & asSelectedAccount .~ selacct | ||||
|                                           } | ||||
| @ -317,8 +317,8 @@ asHandle ui0@UIState{ | ||||
|     -- scroll down just far enough to reveal the selection, which | ||||
|     -- usually leaves it at bottom of screen). | ||||
|     -- XXX better: scroll so selection is in middle of screen ? | ||||
|     scrollTop         = vScrollToBeginning $ viewportScroll "accounts" | ||||
|     scrollTopRegister = vScrollToBeginning $ viewportScroll "register" | ||||
|     scrollTop         = vScrollToBeginning $ viewportScroll AccountsViewport | ||||
|     scrollTopRegister = vScrollToBeginning $ viewportScroll RegisterViewport | ||||
| 
 | ||||
| asHandle _ _ = error "event handler called with wrong screen type, should not happen" | ||||
| 
 | ||||
|  | ||||
| @ -38,7 +38,7 @@ esInit :: Day -> Bool -> UIState -> UIState | ||||
| esInit _ _ ui@UIState{aScreen=ErrorScreen{}} = ui | ||||
| 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{}} | ||||
|                aScreen=ErrorScreen{..} | ||||
|               ,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" | ||||
| 
 | ||||
| esHandle :: UIState -> Event -> EventM (Next UIState) | ||||
| esHandle :: UIState -> Event -> EventM Name (Next UIState) | ||||
| esHandle ui@UIState{ | ||||
|    aScreen=ErrorScreen{..} | ||||
|   ,aopts=UIOpts{cliopts_=copts} | ||||
|  | ||||
| @ -127,7 +127,7 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} j = do | ||||
|            ,aMode=Normal | ||||
|            } | ||||
| 
 | ||||
|     brickapp :: App (UIState) V.Event | ||||
|     brickapp :: App (UIState) V.Event Name | ||||
|     brickapp = App { | ||||
|         appLiftVtyEvent = id | ||||
|       , appStartEvent   = return | ||||
|  | ||||
| @ -42,7 +42,7 @@ registerScreen = RegisterScreen{ | ||||
|    sInit   = rsInit | ||||
|   ,sDraw   = rsDraw | ||||
|   ,sHandle = rsHandle | ||||
|   ,rsList    = list "register" V.empty 1 | ||||
|   ,rsList    = list RegisterList V.empty 1 | ||||
|   ,rsAccount = "" | ||||
|   } | ||||
| 
 | ||||
| @ -83,7 +83,7 @@ rsInit d reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajo | ||||
|                             } | ||||
| 
 | ||||
|     -- 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, | ||||
|     -- (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" | ||||
| 
 | ||||
| rsDraw :: UIState -> [Widget] | ||||
| rsDraw :: UIState -> [Widget Name] | ||||
| rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} | ||||
|                             ,aScreen=RegisterScreen{..} | ||||
|                             ,aMode=mode | ||||
| @ -180,7 +180,7 @@ rsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} | ||||
|         acctswidth = maxdescacctswidth - descwidth | ||||
|         colwidths = (datewidth,descwidth,acctswidth,changewidth,balwidth) | ||||
| 
 | ||||
|       render $ defaultLayout toplabel bottomlabel $ renderList rsList (rsDrawItem colwidths) | ||||
|       render $ defaultLayout toplabel bottomlabel $ renderList (rsDrawItem colwidths) True rsList | ||||
| 
 | ||||
|       where | ||||
|         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" | ||||
| 
 | ||||
| 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{..} = | ||||
|   Widget Greedy Fixed $ do | ||||
|     render $ | ||||
| @ -221,7 +221,7 @@ rsDrawItem (datewidth,descwidth,acctswidth,changewidth,balwidth) selected Regist | ||||
|     sel | selected  = (<> "selected") | ||||
|         | otherwise = id | ||||
| 
 | ||||
| rsHandle :: UIState -> Event -> EventM (Next UIState) | ||||
| rsHandle :: UIState -> Event -> EventM Name (Next UIState) | ||||
| rsHandle ui@UIState{ | ||||
|    aScreen=s@RegisterScreen{..} | ||||
|   ,aopts=UIOpts{cliopts_=copts} | ||||
| @ -236,7 +236,7 @@ rsHandle ui@UIState{ | ||||
|         EvKey KEsc   [] -> continue $ closeMinibuffer ui | ||||
|         EvKey KEnter [] -> continue $ regenerateScreens j d $ setFilter s $ closeMinibuffer ui | ||||
|                             where s = chomp $ unlines $ getEditContents ed | ||||
|         ev              -> do ed' <- handleEvent ev ed | ||||
|         ev              -> do ed' <- handleEditorEvent ev ed | ||||
|                               continue $ ui{aMode=Minibuffer ed'} | ||||
| 
 | ||||
|     Help -> | ||||
| @ -283,11 +283,11 @@ rsHandle ui@UIState{ | ||||
|                             EvKey (KChar 'k') [] -> EvKey (KUp) [] | ||||
|                             EvKey (KChar 'j') [] -> EvKey (KDown) [] | ||||
|                             _                    -> ev | ||||
|                 newitems <- handleEvent ev' rsList | ||||
|                 newitems <- handleListEvent ev' rsList | ||||
|                 continue ui{aScreen=s{rsList=newitems}} | ||||
|                 -- continue =<< handleEventLensed ui someLens ev | ||||
|       where | ||||
|         -- 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" | ||||
|  | ||||
| @ -45,7 +45,7 @@ tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}} | ||||
|                                            ,aScreen=TransactionScreen{..}} = ui | ||||
| 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}} | ||||
|                               ,aScreen=TransactionScreen{ | ||||
|                                    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" | ||||
| 
 | ||||
| tsHandle :: UIState -> Event -> EventM (Next UIState) | ||||
| tsHandle :: UIState -> Event -> EventM Name (Next UIState) | ||||
| tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t) | ||||
|                                                 ,tsTransactions=nts | ||||
|                                                 ,tsAccount=acct} | ||||
|  | ||||
| @ -127,7 +127,7 @@ setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_ | ||||
| showMinibuffer :: UIState -> UIState | ||||
| showMinibuffer ui = setMode (Minibuffer e) ui | ||||
|   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 | ||||
| 
 | ||||
| -- | Close the minibuffer, discarding any edit in progress. | ||||
|  | ||||
| @ -38,13 +38,11 @@ Brick.defaultMain brickapp st | ||||
| 
 | ||||
| module Hledger.UI.UITypes where | ||||
| 
 | ||||
| import Data.Monoid | ||||
| import Data.Time.Calendar (Day) | ||||
| import Graphics.Vty (Event) | ||||
| import Brick | ||||
| import Brick.Widgets.List | ||||
| import Brick.Widgets.Edit (Editor) | ||||
| import qualified Data.Vector as V | ||||
| import Lens.Micro.Platform | ||||
| import Text.Show.Functions () | ||||
|   -- import the Show instance for functions. Warning, this also re-exports it | ||||
| @ -52,8 +50,8 @@ import Text.Show.Functions () | ||||
| import Hledger | ||||
| import Hledger.UI.UIOptions | ||||
| 
 | ||||
| instance Show (List a) where show _ = "<List>" | ||||
| instance Show Editor   where show _ = "<Editor>" | ||||
| instance Show (List n a) where show _ = "<List>" | ||||
| instance Show (Editor n) where show _ = "<Editor>" | ||||
| 
 | ||||
| -- | 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. | ||||
| @ -72,12 +70,21 @@ data UIState = UIState { | ||||
| data Mode = | ||||
|     Normal | ||||
|   | Help | ||||
|   | Minibuffer Editor | ||||
|   | Minibuffer (Editor Name) | ||||
|   deriving (Show,Eq) | ||||
| 
 | ||||
| -- 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. | ||||
| -- Each screen type has generically named initialisation, draw, and event handling functions, | ||||
| @ -87,24 +94,24 @@ instance Eq Editor where _ == _ = True | ||||
| data Screen = | ||||
|     AccountsScreen { | ||||
|        sInit   :: Day -> Bool -> UIState -> UIState              -- ^ function to initialise or update this screen's state | ||||
|       ,sDraw   :: UIState -> [Widget]                             -- ^ brick renderer for this screen | ||||
|       ,sHandle :: UIState -> Event -> EventM (Next UIState)  -- ^ brick event handler for this screen | ||||
|       ,sDraw   :: UIState -> [Widget Name]                             -- ^ brick renderer for this screen | ||||
|       ,sHandle :: UIState -> Event -> EventM Name (Next UIState)  -- ^ brick event handler for this screen | ||||
|       -- 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 "") | ||||
|     } | ||||
|   | RegisterScreen { | ||||
|        sInit   :: Day -> Bool -> UIState -> UIState | ||||
|       ,sDraw   :: UIState -> [Widget] | ||||
|       ,sHandle :: UIState -> Event -> EventM (Next UIState) | ||||
|       ,sDraw   :: UIState -> [Widget Name] | ||||
|       ,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 | ||||
|     } | ||||
|   | TransactionScreen { | ||||
|        sInit   :: Day -> Bool -> UIState -> UIState | ||||
|       ,sDraw   :: UIState -> [Widget] | ||||
|       ,sHandle :: UIState -> Event -> EventM (Next UIState) | ||||
|       ,sDraw   :: UIState -> [Widget Name] | ||||
|       ,sHandle :: UIState -> Event -> EventM Name (Next UIState) | ||||
|       -- | ||||
|       ,tsTransaction  :: NumberedTransaction          -- ^ the transaction we are currently viewing, and its position in the list | ||||
|       ,tsTransactions :: [NumberedTransaction]        -- ^ list of transactions we can step through | ||||
| @ -112,8 +119,8 @@ data Screen = | ||||
|     } | ||||
|   | ErrorScreen { | ||||
|        sInit   :: Day -> Bool -> UIState -> UIState | ||||
|       ,sDraw   :: UIState -> [Widget] | ||||
|       ,sHandle :: UIState -> Event -> EventM (Next UIState) | ||||
|       ,sDraw   :: UIState -> [Widget Name] | ||||
|       ,sHandle :: UIState -> Event -> EventM Name (Next UIState) | ||||
|       -- | ||||
|       ,esError :: String                              -- ^ error message to show | ||||
|     } | ||||
| @ -140,10 +147,10 @@ data RegisterScreenItem = RegisterScreenItem { | ||||
| type NumberedTransaction = (Integer, Transaction) | ||||
| 
 | ||||
| -- dummy monoid instance needed make lenses work with List fields not common across constructors | ||||
| instance Monoid (List a) | ||||
|   where | ||||
|     mempty        = list "" V.empty 1 | ||||
|     mappend l1 l2 = l1 & listElementsL .~ (l1^.listElementsL <> l2^.listElementsL) | ||||
| --instance Monoid (List n a) | ||||
| --  where | ||||
| --    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) | ||||
| 
 | ||||
| concat <$> mapM makeLenses [ | ||||
|    ''Screen | ||||
|  | ||||
| @ -29,12 +29,12 @@ runHelp = runCommand "hledger-ui --help | less" >>= waitForProcess | ||||
| -- ui | ||||
| 
 | ||||
| -- | Draw the help dialog, called when help mode is active. | ||||
| helpDialog :: Widget | ||||
| helpDialog :: Widget Name | ||||
| helpDialog = | ||||
|   Widget Fixed Fixed $ do | ||||
|     c <- getContext | ||||
|     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 $ | ||||
|         vBox [ | ||||
|            hBox [ | ||||
| @ -87,7 +87,7 @@ helpDialog = | ||||
|     renderKey (key,desc) = withAttr (borderAttr <> "keys") (str key) <+> str " " <+> str desc | ||||
| 
 | ||||
| -- | Event handler used when help mode is active. | ||||
| helpHandle :: UIState -> Event -> EventM (Next UIState) | ||||
| helpHandle :: UIState -> Event -> EventM Name (Next UIState) | ||||
| helpHandle ui ev = | ||||
|   case ev of | ||||
|     EvKey k [] | k `elem` [KEsc, KLeft, KChar 'h', KChar '?'] -> continue $ setMode Normal ui | ||||
| @ -97,14 +97,14 @@ helpHandle ui ev = | ||||
|     _ -> continue ui | ||||
| 
 | ||||
| -- | Draw the minibuffer. | ||||
| minibuffer :: Editor -> Widget | ||||
| minibuffer :: Editor Name -> Widget Name | ||||
| minibuffer ed = | ||||
|   forceAttr (borderAttr <> "minibuffer") $ | ||||
|   hBox $ | ||||
|   [txt "filter: ", renderEditor ed] | ||||
|   [txt "filter: ", renderEditor True ed] | ||||
| 
 | ||||
| -- | 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 = | ||||
|   topBottomBorderWithLabels (str " "<+>toplabel<+>str " ") (str " "<+>bottomlabel<+>str " ") . | ||||
|   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 | ||||
|                     -- "the layout adjusts... if you use the core combinators" | ||||
| 
 | ||||
| borderQueryStr :: String -> Widget | ||||
| borderQueryStr :: String -> Widget Name | ||||
| borderQueryStr ""  = str "" | ||||
| borderQueryStr qry = str " matching " <+> withAttr (borderAttr <> "query") (str qry) | ||||
| 
 | ||||
| borderDepthStr :: Maybe Int -> Widget | ||||
| borderDepthStr :: Maybe Int -> Widget Name | ||||
| borderDepthStr Nothing  = str "" | ||||
| borderDepthStr (Just d) = str " to " <+> withAttr (borderAttr <> "query") (str $ "depth "++show d) | ||||
| 
 | ||||
| borderKeysStr :: [(String,String)] -> Widget | ||||
| borderKeysStr :: [(String,String)] -> Widget Name | ||||
| borderKeysStr keydescs = | ||||
|   hBox $ | ||||
|   intersperse sep $ | ||||
| @ -141,7 +141,7 @@ hiddenAccountsName = "..." -- for now | ||||
| 
 | ||||
| -- generic | ||||
| 
 | ||||
| topBottomBorderWithLabel :: Widget -> Widget -> Widget | ||||
| topBottomBorderWithLabel :: Widget Name -> Widget Name -> Widget Name | ||||
| topBottomBorderWithLabel label = \wrapped -> | ||||
|   Widget Greedy Greedy $ do | ||||
|     c <- getContext | ||||
| @ -158,7 +158,7 @@ topBottomBorderWithLabel label = \wrapped -> | ||||
|       <=> | ||||
|       hBorder | ||||
| 
 | ||||
| topBottomBorderWithLabels :: Widget -> Widget -> Widget -> Widget | ||||
| topBottomBorderWithLabels :: Widget Name -> Widget Name -> Widget Name -> Widget Name | ||||
| topBottomBorderWithLabels toplabel bottomlabel = \wrapped -> | ||||
|   Widget Greedy Greedy $ do | ||||
|     c <- getContext | ||||
| @ -176,7 +176,7 @@ topBottomBorderWithLabels toplabel bottomlabel = \wrapped -> | ||||
|       hBorderWithLabel bottomlabel | ||||
| 
 | ||||
| -- 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 -> | ||||
|  let debugmsg = "" | ||||
|  in hBorderWithLabel (label <+> str debugmsg) | ||||
| @ -191,7 +191,7 @@ _topBottomBorderWithLabel2 label = \wrapped -> | ||||
| -- colour. | ||||
| -- 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). | ||||
| margin :: Int -> Int -> Maybe Color -> Widget -> Widget | ||||
| margin :: Int -> Int -> Maybe Color -> Widget Name -> Widget Name | ||||
| margin h v mcolour = \w -> | ||||
|   Widget Greedy Greedy $ do | ||||
|     c <- getContext | ||||
| @ -210,6 +210,6 @@ margin h v mcolour = \w -> | ||||
|    -- withBorderStyle (borderStyleFromChar ' ') . | ||||
|    -- applyN n border | ||||
| 
 | ||||
| withBorderAttr :: Attr -> Widget -> Widget | ||||
| withBorderAttr :: Attr -> Widget Name -> Widget Name | ||||
| withBorderAttr attr = updateAttrMap (applyAttrMappings [(borderAttr, attr)]) | ||||
| 
 | ||||
|  | ||||
| @ -77,12 +77,12 @@ executable hledger-ui | ||||
|     , text-zipper >= 0.4 && < 0.5 | ||||
|     , transformers | ||||
|     , vector | ||||
|   if !os(windows) | ||||
|     build-depends: | ||||
|       brick >= 0.2 && < 0.7 | ||||
|      ,vty >= 5.2 && < 5.8 | ||||
|   else | ||||
|   if os(windows) | ||||
|     buildable: False | ||||
|   else | ||||
|     build-depends: | ||||
|         brick >= 0.7 && < 0.9 | ||||
|       , vty >= 5.5 && < 5.8 | ||||
|   if flag(threaded) | ||||
|     ghc-options: -threaded | ||||
|   if flag(old-locale) | ||||
|  | ||||
| @ -99,8 +99,8 @@ executables: | ||||
|           buildable: false | ||||
|         else: | ||||
|           dependencies: | ||||
|             - brick >= 0.2 && < 0.7 | ||||
|             - vty >= 5.2 && < 5.8 | ||||
|             - brick >= 0.7 && < 0.9 | ||||
|             - vty >= 5.5 && < 5.8 | ||||
|       - condition: flag(threaded) | ||||
|         ghc-options: -threaded | ||||
|       - condition: flag(old-locale) | ||||
|  | ||||
| @ -36,7 +36,7 @@ import Data.Monoid ((<>)) | ||||
| import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| 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 Hledger | ||||
|  | ||||
| @ -14,7 +14,7 @@ flags: | ||||
| 
 | ||||
| extra-deps: | ||||
| # hledger-ui | ||||
| - brick-0.6.4 | ||||
| - brick-0.8 | ||||
| - text-zipper-0.4 | ||||
| # hledger-web | ||||
| - json-0.9.1 | ||||
|  | ||||
| @ -11,5 +11,6 @@ packages: | ||||
| #flags: | ||||
| 
 | ||||
| extra-deps: | ||||
| - brick-0.8 | ||||
| 
 | ||||
| # https://docs.haskellstack.org/en/stable/yaml_configuration/ | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user