ui: support/require brick 0.7+ #379
This commit is contained in:
		
							parent
							
								
									326c1f6931
								
							
						
					
					
						commit
						9b0cadc179
					
				| @ -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" | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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} | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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" | ||||||
|  | |||||||
| @ -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} | ||||||
|  | |||||||
| @ -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. | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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)]) | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -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) | ||||||
|  | |||||||
| @ -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) | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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/ | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user