mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-08 07:09:28 +03:00
dev: ui: enable/fix name shadowing warnings
This commit is contained in:
parent
a0e31091fc
commit
96db4fe9cc
@ -29,7 +29,7 @@ import System.FilePath (takeFileName)
|
|||||||
import Text.DocLayout (realLength)
|
import Text.DocLayout (realLength)
|
||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli hiding (progname,prognameandversion)
|
import Hledger.Cli hiding (mode, progname, prognameandversion)
|
||||||
import Hledger.UI.UIOptions
|
import Hledger.UI.UIOptions
|
||||||
import Hledger.UI.UITypes
|
import Hledger.UI.UITypes
|
||||||
import Hledger.UI.UIState
|
import Hledger.UI.UIState
|
||||||
@ -259,8 +259,8 @@ asHandle ev = do
|
|||||||
where s = chomp $ unlines $ map strip $ getEditContents ed
|
where s = chomp $ unlines $ map strip $ getEditContents ed
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
VtyEvent ev -> do
|
VtyEvent e -> do
|
||||||
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent e)
|
||||||
put' ui{aMode=Minibuffer "filter" ed'}
|
put' ui{aMode=Minibuffer "filter" ed'}
|
||||||
AppEvent _ -> return ()
|
AppEvent _ -> return ()
|
||||||
MouseDown{} -> return ()
|
MouseDown{} -> return ()
|
||||||
@ -357,18 +357,18 @@ asHandle ev = do
|
|||||||
|
|
||||||
-- if page down or end leads to a blank padding item, stop at last non-blank
|
-- if page down or end leads to a blank padding item, stop at last non-blank
|
||||||
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
||||||
list <- nestEventM' _asList $ handleListEvent e
|
l <- nestEventM' _asList $ handleListEvent e
|
||||||
if isBlankElement $ listSelectedElement list
|
if isBlankElement $ listSelectedElement l
|
||||||
then do
|
then do
|
||||||
let list' = listMoveTo lastnonblankidx list
|
let l' = listMoveTo lastnonblankidx l
|
||||||
scrollSelectionToMiddle list'
|
scrollSelectionToMiddle l'
|
||||||
put' ui{aScreen=scr{_asList=list'}}
|
put' ui{aScreen=scr{_asList=l'}}
|
||||||
else
|
else
|
||||||
put' ui{aScreen=scr{_asList=list}}
|
put' ui{aScreen=scr{_asList=l}}
|
||||||
|
|
||||||
-- fall through to the list's event handler (handles up/down)
|
-- fall through to the list's event handler (handles up/down)
|
||||||
VtyEvent ev -> do
|
VtyEvent e -> do
|
||||||
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys ev)
|
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys e)
|
||||||
put' ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct }
|
put' ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct }
|
||||||
|
|
||||||
MouseDown{} -> return ()
|
MouseDown{} -> return ()
|
||||||
@ -384,7 +384,7 @@ asEnterRegister d selacct ui = do
|
|||||||
regscr = rsSetAccount selacct isdepthclipped registerScreen
|
regscr = rsSetAccount selacct isdepthclipped registerScreen
|
||||||
where
|
where
|
||||||
isdepthclipped = case getDepth ui of
|
isdepthclipped = case getDepth ui of
|
||||||
Just d -> accountNameLevel selacct >= d
|
Just de -> accountNameLevel selacct >= de
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
rsCenterSelection (screenEnter d regscr ui) >>= put'
|
rsCenterSelection (screenEnter d regscr ui) >>= put'
|
||||||
|
|
||||||
|
@ -24,7 +24,7 @@ import Lens.Micro ((^.))
|
|||||||
import Text.Megaparsec
|
import Text.Megaparsec
|
||||||
import Text.Megaparsec.Char
|
import Text.Megaparsec.Char
|
||||||
|
|
||||||
import Hledger.Cli hiding (progname,prognameandversion)
|
import Hledger.Cli hiding (mode, progname,prognameandversion)
|
||||||
import Hledger.UI.UIOptions
|
import Hledger.UI.UIOptions
|
||||||
import Hledger.UI.UITypes
|
import Hledger.UI.UITypes
|
||||||
import Hledger.UI.UIState
|
import Hledger.UI.UIState
|
||||||
@ -101,7 +101,7 @@ esHandle ev = do
|
|||||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j (popScreen ui)
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j (popScreen ui)
|
||||||
where
|
where
|
||||||
(pos,f) = case parsewithString hledgerparseerrorpositionp esError of
|
(pos,f) = case parsewithString hledgerparseerrorpositionp esError of
|
||||||
Right (f,l,c) -> (Just (l, Just c),f)
|
Right (f',l,c) -> (Just (l, Just c),f')
|
||||||
Left _ -> (endPosition, journalFilePath j)
|
Left _ -> (endPosition, journalFilePath j)
|
||||||
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
|
||||||
liftIO (uiReloadJournal copts d (popScreen ui)) >>= put' . uiCheckBalanceAssertions d
|
liftIO (uiReloadJournal copts d (popScreen ui)) >>= put' . uiCheckBalanceAssertions d
|
||||||
|
@ -166,8 +166,8 @@ runBrickUi uopts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=rs
|
|||||||
appStartEvent = return ()
|
appStartEvent = return ()
|
||||||
, appAttrMap = const $ fromMaybe defaultTheme $ getTheme =<< uoTheme uopts'
|
, appAttrMap = const $ fromMaybe defaultTheme $ getTheme =<< uoTheme uopts'
|
||||||
, appChooseCursor = showFirstCursor
|
, appChooseCursor = showFirstCursor
|
||||||
, appHandleEvent = \ev -> do ui <- get; sHandle (aScreen ui) ev
|
, appHandleEvent = \ev -> do ui' <- get; sHandle (aScreen ui') ev
|
||||||
, appDraw = \ui -> sDraw (aScreen ui) ui
|
, appDraw = \ui' -> sDraw (aScreen ui') ui'
|
||||||
}
|
}
|
||||||
|
|
||||||
-- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit
|
-- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit
|
||||||
|
@ -31,7 +31,7 @@ import System.Console.ANSI
|
|||||||
|
|
||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli hiding (progname,prognameandversion)
|
import Hledger.Cli hiding (mode, progname,prognameandversion)
|
||||||
import Hledger.UI.UIOptions
|
import Hledger.UI.UIOptions
|
||||||
-- import Hledger.UI.Theme
|
-- import Hledger.UI.Theme
|
||||||
import Hledger.UI.UITypes
|
import Hledger.UI.UITypes
|
||||||
@ -284,7 +284,7 @@ rsHandle ev = do
|
|||||||
dlogUiTraceM "rsHandle 1"
|
dlogUiTraceM "rsHandle 1"
|
||||||
case ui0 of
|
case ui0 of
|
||||||
ui@UIState{
|
ui@UIState{
|
||||||
aScreen=s@RegisterScreen{..}
|
aScreen=scr@RegisterScreen{..}
|
||||||
,aopts=UIOpts{uoCliOpts=copts}
|
,aopts=UIOpts{uoCliOpts=copts}
|
||||||
,ajournal=j
|
,ajournal=j
|
||||||
,aMode=mode
|
,aMode=mode
|
||||||
@ -307,8 +307,8 @@ rsHandle ev = do
|
|||||||
-- VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer ui
|
-- VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer ui
|
||||||
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
|
||||||
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
|
||||||
VtyEvent ev -> do
|
VtyEvent e -> do
|
||||||
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
|
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent e)
|
||||||
put' ui{aMode=Minibuffer "filter" ed'}
|
put' ui{aMode=Minibuffer "filter" ed'}
|
||||||
AppEvent _ -> return ()
|
AppEvent _ -> return ()
|
||||||
MouseDown{} -> return ()
|
MouseDown{} -> return ()
|
||||||
@ -341,7 +341,7 @@ rsHandle ev = do
|
|||||||
(pos,f) = case listSelectedElement rsList of
|
(pos,f) = case listSelectedElement rsList of
|
||||||
Nothing -> (endPosition, journalFilePath j)
|
Nothing -> (endPosition, journalFilePath j)
|
||||||
Just (_, RegisterScreenItem{
|
Just (_, RegisterScreenItem{
|
||||||
rsItemTransaction=Transaction{tsourcepos=(SourcePos f l c,_)}}) -> (Just (unPos l, Just $ unPos c),f)
|
rsItemTransaction=Transaction{tsourcepos=(SourcePos f' l c,_)}}) -> (Just (unPos l, Just $ unPos c),f')
|
||||||
|
|
||||||
-- display mode/query toggles
|
-- display mode/query toggles
|
||||||
VtyEvent (EvKey (KChar 'B') []) -> rsCenterSelection (regenerateScreens j d $ toggleConversionOp ui) >>= put'
|
VtyEvent (EvKey (KChar 'B') []) -> rsCenterSelection (regenerateScreens j d $ toggleConversionOp ui) >>= put'
|
||||||
@ -381,7 +381,7 @@ rsHandle ev = do
|
|||||||
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
-- MouseDown is sometimes duplicated, https://github.com/jtdaugherty/brick/issues/347
|
||||||
-- just use it to move the selection
|
-- just use it to move the selection
|
||||||
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
MouseDown _n BLeft _mods Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
||||||
put' $ ui{aScreen=s{rsList=listMoveTo y rsList}}
|
put' $ ui{aScreen=scr{rsList=listMoveTo y rsList}}
|
||||||
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
where clickeddate = maybe "" rsItemDate $ listElements rsList !? y
|
||||||
-- and on MouseUp, enter the subscreen
|
-- and on MouseUp, enter the subscreen
|
||||||
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
MouseUp _n (Just BLeft) Location{loc=(_x,y)} | not $ (=="") clickeddate -> do
|
||||||
@ -398,24 +398,24 @@ rsHandle ev = do
|
|||||||
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
MouseDown name btn _mods _loc | btn `elem` [BScrollUp, BScrollDown] -> do
|
||||||
let scrollamt = if btn==BScrollUp then -1 else 1
|
let scrollamt = if btn==BScrollUp then -1 else 1
|
||||||
list' <- nestEventM' rsList $ listScrollPushingSelection name (rsListSize rsList) scrollamt
|
list' <- nestEventM' rsList $ listScrollPushingSelection name (rsListSize rsList) scrollamt
|
||||||
put' ui{aScreen=s{rsList=list'}}
|
put' ui{aScreen=scr{rsList=list'}}
|
||||||
|
|
||||||
-- if page down or end leads to a blank padding item, stop at last non-blank
|
-- if page down or end leads to a blank padding item, stop at last non-blank
|
||||||
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
|
||||||
list <- nestEventM' rsList $ handleListEvent e
|
l <- nestEventM' rsList $ handleListEvent e
|
||||||
if isBlankElement $ listSelectedElement list
|
if isBlankElement $ listSelectedElement l
|
||||||
then do
|
then do
|
||||||
let list' = listMoveTo lastnonblankidx list
|
let l' = listMoveTo lastnonblankidx l
|
||||||
scrollSelectionToMiddle list'
|
scrollSelectionToMiddle l'
|
||||||
put' ui{aScreen=s{rsList=list'}}
|
put' ui{aScreen=scr{rsList=l'}}
|
||||||
else
|
else
|
||||||
put' ui{aScreen=s{rsList=list}}
|
put' ui{aScreen=scr{rsList=l}}
|
||||||
|
|
||||||
-- fall through to the list's event handler (handles other [pg]up/down events)
|
-- fall through to the list's event handler (handles other [pg]up/down events)
|
||||||
VtyEvent ev -> do
|
VtyEvent e -> do
|
||||||
let ev' = normaliseMovementKeys ev
|
let e' = normaliseMovementKeys e
|
||||||
newitems <- nestEventM' rsList $ handleListEvent ev'
|
newitems <- nestEventM' rsList $ handleListEvent e'
|
||||||
put' ui{aScreen=s{rsList=newitems}}
|
put' ui{aScreen=scr{rsList=newitems}}
|
||||||
|
|
||||||
MouseDown{} -> return ()
|
MouseDown{} -> return ()
|
||||||
MouseUp{} -> return ()
|
MouseUp{} -> return ()
|
||||||
|
@ -22,7 +22,7 @@ import Brick
|
|||||||
import Brick.Widgets.List (listElementsL, listMoveTo, listSelectedElement)
|
import Brick.Widgets.List (listElementsL, listMoveTo, listSelectedElement)
|
||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli hiding (progname,prognameandversion)
|
import Hledger.Cli hiding (mode, prices, progname,prognameandversion)
|
||||||
import Hledger.UI.UIOptions
|
import Hledger.UI.UIOptions
|
||||||
-- import Hledger.UI.Theme
|
-- import Hledger.UI.Theme
|
||||||
import Hledger.UI.UITypes
|
import Hledger.UI.UITypes
|
||||||
@ -170,7 +170,7 @@ tsHandle ev = do
|
|||||||
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
VtyEvent (EvKey (KChar 'E') []) -> suspendAndResume $ void (runEditor pos f) >> uiReloadJournalIfChanged copts d j ui
|
||||||
where
|
where
|
||||||
(pos,f) = case tsourcepos t of
|
(pos,f) = case tsourcepos t of
|
||||||
(SourcePos f l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f)
|
(SourcePos f' l1 c1,_) -> (Just (unPos l1, Just $ unPos c1),f')
|
||||||
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
AppEvent (DateChange old _) | isStandardPeriod p && p `periodContainsDate` old ->
|
||||||
put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
|
||||||
where
|
where
|
||||||
|
@ -286,11 +286,11 @@ regenerateScreens j d ui@UIState{aScreen=s,aPrevScreens=ss} =
|
|||||||
-- remove all the screens from the appstate and then add them back
|
-- remove all the screens from the appstate and then add them back
|
||||||
-- one at a time, regenerating as we go.
|
-- one at a time, regenerating as we go.
|
||||||
let
|
let
|
||||||
first:rest = reverse $ s:ss :: [Screen]
|
frst:rest = reverse $ s:ss :: [Screen]
|
||||||
ui0 = ui{ajournal=j, aScreen=first, aPrevScreens=[]} :: UIState
|
ui0 = ui{ajournal=j, aScreen=frst, aPrevScreens=[]} :: UIState
|
||||||
|
|
||||||
ui1 = (sInit first) d False ui0 :: UIState
|
ui1 = (sInit frst) d False ui0 :: UIState
|
||||||
ui2 = foldl' (\ui s -> (sInit s) d False $ pushScreen s ui) ui1 rest :: UIState
|
ui2 = foldl' (\ui' s' -> (sInit s') d False $ pushScreen s' ui') ui1 rest :: UIState
|
||||||
in
|
in
|
||||||
ui2
|
ui2
|
||||||
|
|
||||||
|
@ -312,8 +312,8 @@ topBottomBorderWithLabels toplabel bottomlabel body =
|
|||||||
-- 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 Name -> Widget Name
|
margin :: Int -> Int -> Maybe Color -> Widget Name -> Widget Name
|
||||||
margin h v mcolour w = Widget Greedy Greedy $ do
|
margin h v mcolour w = Widget Greedy Greedy $ do
|
||||||
c <- getContext
|
ctx <- getContext
|
||||||
let w' = vLimit (c^.availHeightL - v*2) $ hLimit (c^.availWidthL - h*2) w
|
let w' = vLimit (ctx^.availHeightL - v*2) $ hLimit (ctx^.availWidthL - h*2) w
|
||||||
attr = maybe currentAttr (\c -> c `on` c) mcolour
|
attr = maybe currentAttr (\c -> c `on` c) mcolour
|
||||||
render $
|
render $
|
||||||
withBorderAttr attr $
|
withBorderAttr attr $
|
||||||
@ -375,8 +375,8 @@ normaliseMovementKeys ev
|
|||||||
-- and forecast transactions (generated by --forecast), if the given forecast DateSpan is Nothing,
|
-- and forecast transactions (generated by --forecast), if the given forecast DateSpan is Nothing,
|
||||||
-- and include them otherwise.
|
-- and include them otherwise.
|
||||||
reportSpecSetFutureAndForecast :: Day -> Maybe DateSpan -> ReportSpec -> ReportSpec
|
reportSpecSetFutureAndForecast :: Day -> Maybe DateSpan -> ReportSpec -> ReportSpec
|
||||||
reportSpecSetFutureAndForecast d forecast rspec =
|
reportSpecSetFutureAndForecast d fcast rspec =
|
||||||
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq forecast]}
|
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq fcast]}
|
||||||
where
|
where
|
||||||
periodq = Date . periodAsDateSpan . period_ $ _rsReportOpts rspec
|
periodq = Date . periodAsDateSpan . period_ $ _rsReportOpts rspec
|
||||||
-- Except in forecast mode, exclude future/forecast transactions.
|
-- Except in forecast mode, exclude future/forecast transactions.
|
||||||
|
@ -44,7 +44,6 @@ ghc-options:
|
|||||||
- -Wall
|
- -Wall
|
||||||
- -Wno-incomplete-uni-patterns
|
- -Wno-incomplete-uni-patterns
|
||||||
- -Wno-missing-signatures
|
- -Wno-missing-signatures
|
||||||
- -Wno-name-shadowing
|
|
||||||
- -Wno-orphans
|
- -Wno-orphans
|
||||||
- -Wno-type-defaults
|
- -Wno-type-defaults
|
||||||
- -Wno-unused-do-bind
|
- -Wno-unused-do-bind
|
||||||
|
@ -144,8 +144,8 @@ main = do
|
|||||||
printUsage = putStr $ showModeUsage $ mainmode addons
|
printUsage = putStr $ showModeUsage $ mainmode addons
|
||||||
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL:
|
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL:
|
||||||
hasHelpFlag args = any (`elem` args) ["-h","--help"]
|
hasHelpFlag args = any (`elem` args) ["-h","--help"]
|
||||||
hasManFlag args = any (`elem` args) ["--man"]
|
hasManFlag args = (`elem` args) "--man"
|
||||||
hasInfoFlag args = any (`elem` args) ["--info"]
|
hasInfoFlag args = (`elem` args) "--info"
|
||||||
f `orShowHelp` mode
|
f `orShowHelp` mode
|
||||||
| hasHelpFlag args = putStr $ showModeUsage mode
|
| hasHelpFlag args = putStr $ showModeUsage mode
|
||||||
| hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode)
|
| hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode)
|
||||||
|
Loading…
Reference in New Issue
Block a user