dev: ui: enable/fix name shadowing warnings

This commit is contained in:
Simon Michael 2022-08-23 02:55:37 +01:00
parent a0e31091fc
commit 96db4fe9cc
9 changed files with 45 additions and 46 deletions

View File

@ -29,7 +29,7 @@ import System.FilePath (takeFileName)
import Text.DocLayout (realLength)
import Hledger
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
@ -259,8 +259,8 @@ asHandle ev = do
where s = chomp $ unlines $ map strip $ getEditContents ed
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
VtyEvent ev -> do
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
VtyEvent e -> do
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent e)
put' ui{aMode=Minibuffer "filter" ed'}
AppEvent _ -> 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
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
list <- nestEventM' _asList $ handleListEvent e
if isBlankElement $ listSelectedElement list
l <- nestEventM' _asList $ handleListEvent e
if isBlankElement $ listSelectedElement l
then do
let list' = listMoveTo lastnonblankidx list
scrollSelectionToMiddle list'
put' ui{aScreen=scr{_asList=list'}}
let l' = listMoveTo lastnonblankidx l
scrollSelectionToMiddle l'
put' ui{aScreen=scr{_asList=l'}}
else
put' ui{aScreen=scr{_asList=list}}
put' ui{aScreen=scr{_asList=l}}
-- fall through to the list's event handler (handles up/down)
VtyEvent ev -> do
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys ev)
VtyEvent e -> do
list' <- nestEventM' _asList $ handleListEvent (normaliseMovementKeys e)
put' ui{aScreen=scr & asList .~ list' & asSelectedAccount .~ selacct }
MouseDown{} -> return ()
@ -384,7 +384,7 @@ asEnterRegister d selacct ui = do
regscr = rsSetAccount selacct isdepthclipped registerScreen
where
isdepthclipped = case getDepth ui of
Just d -> accountNameLevel selacct >= d
Just de -> accountNameLevel selacct >= de
Nothing -> False
rsCenterSelection (screenEnter d regscr ui) >>= put'

View File

@ -24,7 +24,7 @@ import Lens.Micro ((^.))
import Text.Megaparsec
import Text.Megaparsec.Char
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Cli hiding (mode, progname,prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
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)
where
(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)
e | e `elem` [VtyEvent (EvKey (KChar 'g') []), AppEvent FileChange] ->
liftIO (uiReloadJournal copts d (popScreen ui)) >>= put' . uiCheckBalanceAssertions d

View File

@ -166,8 +166,8 @@ runBrickUi uopts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=rs
appStartEvent = return ()
, appAttrMap = const $ fromMaybe defaultTheme $ getTheme =<< uoTheme uopts'
, appChooseCursor = showFirstCursor
, appHandleEvent = \ev -> do ui <- get; sHandle (aScreen ui) ev
, appDraw = \ui -> sDraw (aScreen ui) ui
, appHandleEvent = \ev -> do ui' <- get; sHandle (aScreen ui') ev
, appDraw = \ui' -> sDraw (aScreen ui') ui'
}
-- print (length (show ui)) >> exitSuccess -- show any debug output to this point & quit

View File

@ -31,7 +31,7 @@ import System.Console.ANSI
import Hledger
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Cli hiding (mode, progname,prognameandversion)
import Hledger.UI.UIOptions
-- import Hledger.UI.Theme
import Hledger.UI.UITypes
@ -284,7 +284,7 @@ rsHandle ev = do
dlogUiTraceM "rsHandle 1"
case ui0 of
ui@UIState{
aScreen=s@RegisterScreen{..}
aScreen=scr@RegisterScreen{..}
,aopts=UIOpts{uoCliOpts=copts}
,ajournal=j
,aMode=mode
@ -307,8 +307,8 @@ rsHandle ev = do
-- VtyEvent (EvKey (KChar '/') []) -> put' $ regenerateScreens j d $ showMinibuffer ui
VtyEvent (EvKey (KChar 'l') [MCtrl]) -> redraw
VtyEvent (EvKey (KChar 'z') [MCtrl]) -> suspend ui
VtyEvent ev -> do
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent ev)
VtyEvent e -> do
ed' <- nestEventM' ed $ handleEditorEvent (VtyEvent e)
put' ui{aMode=Minibuffer "filter" ed'}
AppEvent _ -> return ()
MouseDown{} -> return ()
@ -341,7 +341,7 @@ rsHandle ev = do
(pos,f) = case listSelectedElement rsList of
Nothing -> (endPosition, journalFilePath j)
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
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
-- just use it to move the selection
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
-- and on MouseUp, enter the subscreen
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
let scrollamt = if btn==BScrollUp then -1 else 1
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
VtyEvent e@(EvKey k []) | k `elem` [KPageDown, KEnd] -> do
list <- nestEventM' rsList $ handleListEvent e
if isBlankElement $ listSelectedElement list
l <- nestEventM' rsList $ handleListEvent e
if isBlankElement $ listSelectedElement l
then do
let list' = listMoveTo lastnonblankidx list
scrollSelectionToMiddle list'
put' ui{aScreen=s{rsList=list'}}
let l' = listMoveTo lastnonblankidx l
scrollSelectionToMiddle l'
put' ui{aScreen=scr{rsList=l'}}
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)
VtyEvent ev -> do
let ev' = normaliseMovementKeys ev
newitems <- nestEventM' rsList $ handleListEvent ev'
put' ui{aScreen=s{rsList=newitems}}
VtyEvent e -> do
let e' = normaliseMovementKeys e
newitems <- nestEventM' rsList $ handleListEvent e'
put' ui{aScreen=scr{rsList=newitems}}
MouseDown{} -> return ()
MouseUp{} -> return ()

View File

@ -22,7 +22,7 @@ import Brick
import Brick.Widgets.List (listElementsL, listMoveTo, listSelectedElement)
import Hledger
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.Cli hiding (mode, prices, progname,prognameandversion)
import Hledger.UI.UIOptions
-- import Hledger.UI.Theme
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
where
(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 ->
put' $ regenerateScreens j d $ setReportPeriod (DayPeriod d) ui
where

View File

@ -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
-- one at a time, regenerating as we go.
let
first:rest = reverse $ s:ss :: [Screen]
ui0 = ui{ajournal=j, aScreen=first, aPrevScreens=[]} :: UIState
frst:rest = reverse $ s:ss :: [Screen]
ui0 = ui{ajournal=j, aScreen=frst, aPrevScreens=[]} :: UIState
ui1 = (sInit first) d False ui0 :: UIState
ui2 = foldl' (\ui s -> (sInit s) d False $ pushScreen s ui) ui1 rest :: UIState
ui1 = (sInit frst) d False ui0 :: UIState
ui2 = foldl' (\ui' s' -> (sInit s') d False $ pushScreen s' ui') ui1 rest :: UIState
in
ui2

View File

@ -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).
margin :: Int -> Int -> Maybe Color -> Widget Name -> Widget Name
margin h v mcolour w = Widget Greedy Greedy $ do
c <- getContext
let w' = vLimit (c^.availHeightL - v*2) $ hLimit (c^.availWidthL - h*2) w
ctx <- getContext
let w' = vLimit (ctx^.availHeightL - v*2) $ hLimit (ctx^.availWidthL - h*2) w
attr = maybe currentAttr (\c -> c `on` c) mcolour
render $
withBorderAttr attr $
@ -375,8 +375,8 @@ normaliseMovementKeys ev
-- and forecast transactions (generated by --forecast), if the given forecast DateSpan is Nothing,
-- and include them otherwise.
reportSpecSetFutureAndForecast :: Day -> Maybe DateSpan -> ReportSpec -> ReportSpec
reportSpecSetFutureAndForecast d forecast rspec =
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq forecast]}
reportSpecSetFutureAndForecast d fcast rspec =
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq fcast]}
where
periodq = Date . periodAsDateSpan . period_ $ _rsReportOpts rspec
-- Except in forecast mode, exclude future/forecast transactions.

View File

@ -44,7 +44,6 @@ ghc-options:
- -Wall
- -Wno-incomplete-uni-patterns
- -Wno-missing-signatures
- -Wno-name-shadowing
- -Wno-orphans
- -Wno-type-defaults
- -Wno-unused-do-bind

View File

@ -144,8 +144,8 @@ main = do
printUsage = putStr $ showModeUsage $ mainmode addons
badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL:
hasHelpFlag args = any (`elem` args) ["-h","--help"]
hasManFlag args = any (`elem` args) ["--man"]
hasInfoFlag args = any (`elem` args) ["--info"]
hasManFlag args = (`elem` args) "--man"
hasInfoFlag args = (`elem` args) "--info"
f `orShowHelp` mode
| hasHelpFlag args = putStr $ showModeUsage mode
| hasInfoFlag args = runInfoForTopic "hledger" (headMay $ modeNames mode)