{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.UI.MenuScreen
(msNew
,msUpdate
,msDraw
,msHandle
,msSetSelectedScreen
)
where
import Brick
import Brick.Widgets.List
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Maybe
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import qualified Data.Vector as V
import Data.Vector ((!?))
import Graphics.Vty (Event(..),Key(..),Modifier(..), Button (BLeft, BScrollDown, BScrollUp))
import Lens.Micro.Platform
import System.Console.ANSI
import System.FilePath (takeFileName)
import Hledger
import Hledger.Cli hiding (mode, progname, prognameandversion)
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState
import Hledger.UI.UIUtils
import Hledger.UI.UIScreens
import Hledger.UI.ErrorScreen (uiReloadJournal, uiCheckBalanceAssertions, uiReloadJournalIfChanged)
import Hledger.UI.Editor (runIadd, runEditor, endPosition)
import Brick.Widgets.Edit (getEditContents, handleEditorEvent)
msDraw :: UIState -> [Widget Name]
msDraw :: UIState -> [Widget Name]
msDraw UIState{aopts :: UIState -> UIOpts
aopts=_uopts :: UIOpts
_uopts@UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
_rspec}}
,ajournal :: UIState -> Journal
ajournal=Journal
j
,aScreen :: UIState -> Screen
aScreen=MS MenuScreenState
sst
,aMode :: UIState -> Mode
aMode=Mode
mode
} = String -> [Widget Name] -> [Widget Name]
forall a. String -> a -> a
dbgui String
"msDraw" ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$
case Mode
mode of
Mode
Help -> [Widget Name
helpDialog, Widget Name
maincontent]
Mode
_ -> [Widget Name
maincontent]
where
maincontent :: Widget Name
maincontent = Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout Widget Name
forall {n}. Widget n
toplabel Widget Name
bottomlabel (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Bool -> MenuScreenItem -> Widget Name)
-> Bool -> GenericList Name Vector MenuScreenItem -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> MenuScreenItem -> Widget Name
msDrawItem Bool
True (MenuScreenState
sst MenuScreenState
-> Getting
(GenericList Name Vector MenuScreenItem)
MenuScreenState
(GenericList Name Vector MenuScreenItem)
-> GenericList Name Vector MenuScreenItem
forall s a. s -> Getting a s a -> a
^. Getting
(GenericList Name Vector MenuScreenItem)
MenuScreenState
(GenericList Name Vector MenuScreenItem)
Lens' MenuScreenState (GenericList Name Vector MenuScreenItem)
mssList)
where
toplabel :: Widget n
toplabel =
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"filename") Widget n
forall {n}. Widget n
files
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> (if BalancingOpts -> Bool
ignore_assertions_ (BalancingOpts -> Bool)
-> (InputOpts -> BalancingOpts) -> InputOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> BalancingOpts
balancingopts_ (InputOpts -> Bool) -> InputOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
copts
then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (String -> AttrName
attrName String
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"query") (String -> Widget n
forall n. String -> Widget n
str String
" ignoring balance assertions")
else String -> Widget n
forall n. String -> Widget n
str String
"")
where
files :: Widget n
files = case Journal -> [String]
journalFilePaths Journal
j of
[] -> String -> Widget n
forall n. String -> Widget n
str String
""
String
f:[String]
_ -> String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
f
bottomlabel :: Widget Name
bottomlabel = case Mode
mode of
Minibuffer Text
label Editor String Name
ed -> Text -> Editor String Name -> Widget Name
minibuffer Text
label Editor String Name
ed
Mode
_ -> Widget Name
quickhelp
where
quickhelp :: Widget Name
quickhelp = [(String, Widget Name)] -> Widget Name
borderKeysStr' [
(String
"DOWN/UP", String -> Widget Name
forall n. String -> Widget n
str String
"select")
,(String
"RIGHT", String -> Widget Name
forall n. String -> Widget n
str String
"enter screen")
,(String
"a", String -> Widget Name
forall n. String -> Widget n
str String
"add txn")
,(String
"?", String -> Widget Name
forall n. String -> Widget n
str String
"help")
,(String
"q", String -> Widget Name
forall n. String -> Widget n
str String
"quit")
]
msDraw UIState
_ = String -> [Widget Name] -> [Widget Name]
forall a. String -> a -> a
dbgui String
"msDraw" ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ String -> [Widget Name]
forall a. String -> a
errorWrongScreenType String
"draw function"
msDrawItem :: Bool -> MenuScreenItem -> Widget Name
msDrawItem :: Bool -> MenuScreenItem -> Widget Name
msDrawItem Bool
_selected MenuScreenItem{Text
ScreenName
msItemScreenName :: Text
msItemScreen :: ScreenName
msItemScreenName :: MenuScreenItem -> Text
msItemScreen :: MenuScreenItem -> ScreenName
..} =
Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
msItemScreenName
msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle BrickEvent Name AppEvent
ev = do
UIState
ui0 <- EventM Name UIState UIState
get'
String -> EventM Name UIState ()
forall s. String -> EventM Name s ()
dbguiEv String
"msHandle"
case UIState
ui0 of
ui :: UIState
ui@UIState{
aopts :: UIState -> UIOpts
aopts=UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=CliOpts
copts}
,ajournal :: UIState -> Journal
ajournal=Journal
j
,aMode :: UIState -> Mode
aMode=Mode
mode
,aScreen :: UIState -> Screen
aScreen=MS MenuScreenState
sst
} -> do
let
mselscr :: Maybe ScreenName
mselscr = case GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem))
-> GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst of
Just (Int
_, MenuScreenItem{Text
ScreenName
msItemScreenName :: MenuScreenItem -> Text
msItemScreen :: MenuScreenItem -> ScreenName
msItemScreenName :: Text
msItemScreen :: ScreenName
..}) -> ScreenName -> Maybe ScreenName
forall a. a -> Maybe a
Just ScreenName
msItemScreen
Maybe (Int, MenuScreenItem)
Nothing -> Maybe ScreenName
forall a. Maybe a
Nothing
nonblanks :: Vector MenuScreenItem
nonblanks = (MenuScreenItem -> Bool)
-> Vector MenuScreenItem -> Vector MenuScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile (Bool -> Bool
not (Bool -> Bool)
-> (MenuScreenItem -> Bool) -> MenuScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null (Text -> Bool)
-> (MenuScreenItem -> Text) -> MenuScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MenuScreenItem -> Text
msItemScreenName) (Vector MenuScreenItem -> Vector MenuScreenItem)
-> Vector MenuScreenItem -> Vector MenuScreenItem
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem)
-> GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall a b. (a -> b) -> a -> b
$ MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst
lastnonblankidx :: Int
lastnonblankidx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Vector MenuScreenItem -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector MenuScreenItem
nonblanks Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Day
d <- IO Day -> EventM Name UIState Day
forall a. IO a -> EventM Name UIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Day
getCurrentDay
case Mode
mode of
Minibuffer Text
_ Editor String Name
ed ->
case BrickEvent Name AppEvent
ev of
VtyEvent (EvKey Key
KEsc []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui
VtyEvent (EvKey Key
KEnter []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$
case String -> UIState -> Either String UIState
setFilter String
s (UIState -> Either String UIState)
-> UIState -> Either String UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
closeMinibuffer UIState
ui of
Left String
bad -> Text -> Maybe String -> UIState -> UIState
showMinibuffer Text
"Cannot compile regular expression" (String -> Maybe String
forall a. a -> Maybe a
Just String
bad) UIState
ui
Right UIState
ui' -> UIState
ui'
where s :: String
s = String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strip ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Editor String Name -> [String]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor String Name
ed
VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> EventM Name UIState ()
forall a s. EventM a s ()
redraw
VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> UIState -> EventM Name UIState ()
forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
VtyEvent Event
e -> do
Editor String Name
ed' <- Editor String Name
-> EventM Name (Editor String Name) ()
-> EventM Name UIState (Editor String Name)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' Editor String Name
ed (EventM Name (Editor String Name) ()
-> EventM Name UIState (Editor String Name))
-> EventM Name (Editor String Name) ()
-> EventM Name UIState (Editor String Name)
forall a b. (a -> b) -> a -> b
$ BrickEvent Name Any -> EventM Name (Editor String Name) ()
forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (Event -> BrickEvent Name Any
forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
UIState -> EventM Name UIState ()
put' UIState
ui{aMode=Minibuffer "filter" ed'}
AppEvent AppEvent
_ -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MouseDown{} -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MouseUp{} -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Mode
Help ->
case BrickEvent Name AppEvent
ev of
VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> EventM Name UIState ()
forall a s. EventM a s ()
redraw
VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> UIState -> EventM Name UIState ()
forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
BrickEvent Name AppEvent
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
helpHandle BrickEvent Name AppEvent
ev
Mode
Normal ->
case BrickEvent Name AppEvent
ev of
VtyEvent (EvKey (KChar Char
'q') []) -> EventM Name UIState ()
forall a s. EventM a s ()
halt
VtyEvent (EvKey Key
KEsc []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
resetScreens Day
d UIState
ui
VtyEvent (EvKey (KChar Char
c) []) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Mode -> UIState -> UIState
setMode Mode
Help UIState
ui
AppEvent (DateChange Day
old Day
_) | Period -> Bool
isStandardPeriod Period
p Bool -> Bool -> Bool
&& Period
p Period -> Day -> Bool
`periodContainsDate` Day
old ->
UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ Period -> UIState -> UIState
setReportPeriod (Day -> Period
DayPeriod Day
d) UIState
ui
where
p :: Period
p = UIState -> Period
reportPeriod UIState
ui
BrickEvent Name AppEvent
e | BrickEvent Name AppEvent
e BrickEvent Name AppEvent -> [BrickEvent Name AppEvent] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event -> BrickEvent Name AppEvent
forall n e. Event -> BrickEvent n e
VtyEvent (Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'g') []), AppEvent -> BrickEvent Name AppEvent
forall n e. e -> BrickEvent n e
AppEvent AppEvent
FileChange] ->
IO UIState -> EventM Name UIState UIState
forall a. IO a -> EventM Name UIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CliOpts -> Day -> UIState -> IO UIState
uiReloadJournal CliOpts
copts Day
d UIState
ui) EventM Name UIState UIState
-> (UIState -> EventM Name UIState ()) -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> (a -> EventM Name UIState b) -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UIState -> EventM Name UIState ()
put'
VtyEvent (EvKey (KChar Char
'I') []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Day -> UIState -> UIState
uiCheckBalanceAssertions Day
d (UIState -> UIState
toggleIgnoreBalanceAssertions UIState
ui)
VtyEvent (EvKey (KChar Char
'a') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ()
clearScreen IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO ()
setCursorPosition Int
0 Int
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Journal -> IO ()
add CliOpts
copts Journal
j IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
VtyEvent (EvKey (KChar Char
'A') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> IO ExitCode
runIadd (Journal -> String
journalFilePath Journal
j)) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
VtyEvent (EvKey (KChar Char
'E') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO UIState -> EventM Name UIState ())
-> IO UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe TextPosition -> String -> IO ExitCode
runEditor Maybe TextPosition
endPosition (Journal -> String
journalFilePath Journal
j)) IO () -> IO UIState -> IO UIState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CliOpts -> Day -> Journal -> UIState -> IO UIState
uiReloadJournalIfChanged CliOpts
copts Day
d Journal
j UIState
ui
VtyEvent (EvKey (KChar Char
'/') []) -> UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ Text -> Maybe String -> UIState -> UIState
showMinibuffer Text
"filter" Maybe String
forall a. Maybe a
Nothing UIState
ui
VtyEvent (EvKey Key
k []) | Key
k Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KBS, Key
KDel] -> (UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Journal -> Day -> UIState -> UIState
regenerateScreens Journal
j Day
d (UIState -> UIState) -> UIState -> UIState
forall a b. (a -> b) -> a -> b
$ UIState -> UIState
resetFilter UIState
ui)
VtyEvent (EvKey (KChar Char
'l') [Modifier
MCtrl]) -> GenericList Name Vector MenuScreenItem -> EventM Name UIState ()
forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) EventM Name UIState ()
-> EventM Name UIState () -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> EventM Name UIState b -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventM Name UIState ()
forall a s. EventM a s ()
redraw
VtyEvent (EvKey (KChar Char
'z') [Modifier
MCtrl]) -> UIState -> EventM Name UIState ()
forall a s. Ord a => s -> EventM a s ()
suspend UIState
ui
VtyEvent Event
e | Event
e Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveRightEvents
, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Int, MenuScreenItem) -> Bool
forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement (Maybe (Int, MenuScreenItem) -> Bool)
-> Maybe (Int, MenuScreenItem) -> Bool
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) ->
Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen Day
d (ScreenName -> Maybe ScreenName -> ScreenName
forall a. a -> Maybe a -> a
fromMaybe ScreenName
Accounts Maybe ScreenName
mselscr) UIState
ui
MouseDown Name
_n Button
BLeft [Modifier]
_mods Location{loc :: Location -> (Int, Int)
loc=(Int
_x,Int
y)} | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
"") Text
clickedname -> do
UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS sst}
where
item :: Maybe MenuScreenItem
item = GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) Vector MenuScreenItem -> Int -> Maybe MenuScreenItem
forall a. Vector a -> Int -> Maybe a
!? Int
y
clickedname :: Text
clickedname = Text -> (MenuScreenItem -> Text) -> Maybe MenuScreenItem -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" MenuScreenItem -> Text
msItemScreenName Maybe MenuScreenItem
item
MouseUp Name
_n (Just Button
BLeft) Location{loc :: Location -> (Int, Int)
loc=(Int
_x,Int
y)} ->
case Maybe ScreenName
mclickedscr of
Just ScreenName
scr -> Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen Day
d ScreenName
scr UIState
ui
Maybe ScreenName
Nothing -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
item :: Maybe MenuScreenItem
item = GenericList Name Vector MenuScreenItem -> Vector MenuScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) Vector MenuScreenItem -> Int -> Maybe MenuScreenItem
forall a. Vector a -> Int -> Maybe a
!? Int
y
mclickedscr :: Maybe ScreenName
mclickedscr = MenuScreenItem -> ScreenName
msItemScreen (MenuScreenItem -> ScreenName)
-> Maybe MenuScreenItem -> Maybe ScreenName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe MenuScreenItem
item
VtyEvent Event
e | Event
e Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveDownEvents, Maybe (Int, MenuScreenItem) -> Bool
forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement Maybe (Int, MenuScreenItem)
mnextelement -> do
ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name
forall a b. (a -> b) -> a -> b
$ (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst)GenericList Name Vector MenuScreenItem
-> Getting Name (GenericList Name Vector MenuScreenItem) Name
-> Name
forall s a. s -> Getting a s a -> a
^.Getting Name (GenericList Name Vector MenuScreenItem) Name
forall n1 (t :: * -> *) e n2 (f :: * -> *).
Functor f =>
(n1 -> f n2) -> GenericList n1 t e -> f (GenericList n2 t e)
listNameL) Int
1
where mnextelement :: Maybe (Int, MenuScreenItem)
mnextelement = GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem))
-> GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem
-> GenericList Name Vector MenuScreenItem
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst)
MouseDown Name
name Button
btn [Modifier]
_mods Location
_loc | Button
btn Button -> [Button] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Button
BScrollUp, Button
BScrollDown] -> do
let scrollamt :: Int
scrollamt = if Button
btnButton -> Button -> Bool
forall a. Eq a => a -> a -> Bool
==Button
BScrollUp then -Int
1 else Int
1
GenericList Name Vector MenuScreenItem
list' <- GenericList Name Vector MenuScreenItem
-> EventM
Name
(GenericList Name Vector MenuScreenItem)
(GenericList Name Vector MenuScreenItem)
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) (EventM
Name
(GenericList Name Vector MenuScreenItem)
(GenericList Name Vector MenuScreenItem)
-> EventM Name UIState (GenericList Name Vector MenuScreenItem))
-> EventM
Name
(GenericList Name Vector MenuScreenItem)
(GenericList Name Vector MenuScreenItem)
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ Name
-> Int
-> Int
-> EventM
Name
(GenericList Name Vector MenuScreenItem)
(GenericList Name Vector MenuScreenItem)
forall item.
Name -> Int -> Int -> EventM Name (List Name item) (List Name item)
listScrollPushingSelection Name
name (GenericList Name Vector MenuScreenItem -> Int
forall {n}. GenericList n Vector MenuScreenItem -> Int
msListSize (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst)) Int
scrollamt
UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS sst{_mssList=list'}}
VtyEvent e :: Event
e@(EvKey Key
k []) | Key
k Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KPageDown, Key
KEnd] -> do
GenericList Name Vector MenuScreenItem
l <- GenericList Name Vector MenuScreenItem
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) (EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem))
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ Event -> EventM Name (GenericList Name Vector MenuScreenItem) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e
if Maybe (Int, MenuScreenItem) -> Bool
forall {a}. Maybe (a, MenuScreenItem) -> Bool
isBlankElement (Maybe (Int, MenuScreenItem) -> Bool)
-> Maybe (Int, MenuScreenItem) -> Bool
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector MenuScreenItem
-> Maybe (Int, MenuScreenItem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement GenericList Name Vector MenuScreenItem
l
then do
let l' :: GenericList Name Vector MenuScreenItem
l' = Int
-> GenericList Name Vector MenuScreenItem
-> GenericList Name Vector MenuScreenItem
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
lastnonblankidx GenericList Name Vector MenuScreenItem
l
GenericList Name Vector MenuScreenItem -> EventM Name UIState ()
forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle GenericList Name Vector MenuScreenItem
l'
UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS sst{_mssList=l'}}
else
UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS sst{_mssList=l}}
VtyEvent Event
e -> do
GenericList Name Vector MenuScreenItem
list' <- GenericList Name Vector MenuScreenItem
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' (MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList MenuScreenState
sst) (EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem))
-> EventM Name (GenericList Name Vector MenuScreenItem) ()
-> EventM Name UIState (GenericList Name Vector MenuScreenItem)
forall a b. (a -> b) -> a -> b
$ Event -> EventM Name (GenericList Name Vector MenuScreenItem) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent (Event -> Event
normaliseMovementKeys Event
e)
UIState -> EventM Name UIState ()
put' UIState
ui{aScreen=MS $ sst & mssList .~ list'}
MouseDown{} -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
MouseUp{} -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
AppEvent AppEvent
_ -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
UIState
_ -> String -> EventM Name UIState ()
forall s. String -> EventM Name s ()
dbguiEv String
"msHandle" EventM Name UIState ()
-> EventM Name UIState () -> EventM Name UIState ()
forall a b.
EventM Name UIState a
-> EventM Name UIState b -> EventM Name UIState b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> EventM Name UIState ()
forall a. String -> a
errorWrongScreenType String
"event handler"
msEnterScreen :: Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen :: Day -> ScreenName -> UIState -> EventM Name UIState ()
msEnterScreen Day
d ScreenName
scrname ui :: UIState
ui@UIState{ajournal :: UIState -> Journal
ajournal=Journal
j, aopts :: UIState -> UIOpts
aopts=UIOpts
uopts} = do
String -> EventM Name UIState ()
forall s. String -> EventM Name s ()
dbguiEv String
"msEnterScreen"
let
scr :: Screen
scr = case ScreenName
scrname of
ScreenName
Accounts -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
asNew UIOpts
uopts Day
d Journal
j Maybe Text
forall a. Maybe a
Nothing
ScreenName
CashScreen -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
csNew UIOpts
uopts Day
d Journal
j Maybe Text
forall a. Maybe a
Nothing
ScreenName
Balancesheet -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
bsNew UIOpts
uopts Day
d Journal
j Maybe Text
forall a. Maybe a
Nothing
ScreenName
Incomestatement -> UIOpts -> Day -> Journal -> Maybe Text -> Screen
isNew UIOpts
uopts Day
d Journal
j Maybe Text
forall a. Maybe a
Nothing
UIState -> EventM Name UIState ()
put' (UIState -> EventM Name UIState ())
-> UIState -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ Screen -> UIState -> UIState
pushScreen Screen
scr UIState
ui
msSetSelectedScreen :: Int -> Screen -> Screen
msSetSelectedScreen :: Int -> Screen -> Screen
msSetSelectedScreen Int
selidx (MS mss :: MenuScreenState
mss@MSS{_mssList :: MenuScreenState -> GenericList Name Vector MenuScreenItem
_mssList=GenericList Name Vector MenuScreenItem
l}) = MenuScreenState -> Screen
MS MenuScreenState
mss{_mssList=listMoveTo selidx l}
msSetSelectedScreen Int
_ Screen
s = Screen
s
isBlankElement :: Maybe (a, MenuScreenItem) -> Bool
isBlankElement Maybe (a, MenuScreenItem)
mel = ((MenuScreenItem -> Text
msItemScreenName (MenuScreenItem -> Text)
-> ((a, MenuScreenItem) -> MenuScreenItem)
-> (a, MenuScreenItem)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, MenuScreenItem) -> MenuScreenItem
forall a b. (a, b) -> b
snd) ((a, MenuScreenItem) -> Text)
-> Maybe (a, MenuScreenItem) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, MenuScreenItem)
mel) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
msListSize :: GenericList n Vector MenuScreenItem -> Int
msListSize = Vector MenuScreenItem -> Int
forall a. Vector a -> Int
V.length (Vector MenuScreenItem -> Int)
-> (GenericList n Vector MenuScreenItem -> Vector MenuScreenItem)
-> GenericList n Vector MenuScreenItem
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MenuScreenItem -> Bool)
-> Vector MenuScreenItem -> Vector MenuScreenItem
forall a. (a -> Bool) -> Vector a -> Vector a
V.takeWhile ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
"")(Text -> Bool)
-> (MenuScreenItem -> Text) -> MenuScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MenuScreenItem -> Text
msItemScreenName) (Vector MenuScreenItem -> Vector MenuScreenItem)
-> (GenericList n Vector MenuScreenItem -> Vector MenuScreenItem)
-> GenericList n Vector MenuScreenItem
-> Vector MenuScreenItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericList n Vector MenuScreenItem -> Vector MenuScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements