{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
module Hledger.UI.UIUtils (
borderDepthStr
,borderKeysStr
,borderKeysStr'
,borderPeriodStr
,borderQueryStr
,defaultLayout
,helpDialog
,helpHandle
,minibuffer
,moveDownEvents
,moveLeftEvents
,moveRightEvents
,moveUpEvents
,normaliseMovementKeys
,renderToggle
,renderToggle1
,replaceHiddenAccountsNameWith
,scrollSelectionToMiddle
,get'
,put'
,modify'
,suspend
,redraw
,reportSpecAddQuery
,reportSpecSetFutureAndForecast
,listScrollPushingSelection
,dbgui
,dbguiIO
,dbguiEv
,dbguiScreensEv
,showScreenId
,showScreenRegisterDescriptions
,showScreenSelection
,mapScreens
,uiNumBlankItems
,showScreenStack
)
where
import Brick
import Brick.Widgets.Border
import Brick.Widgets.Border.Style
import Brick.Widgets.Dialog
import Brick.Widgets.Edit
import Brick.Widgets.List (List, listSelectedL, listNameL, listItemHeightL, listSelected, listMoveDown, listMoveUp, GenericList, listElements)
import Control.Monad.IO.Class
import Data.Bifunctor (second)
import Data.List
import qualified Data.Text as T
import Data.Time (addDays)
import Graphics.Vty
(Event(..),Key(..),Modifier(..),Vty(..),Color,Attr,currentAttr,refresh, displayBounds
)
import Lens.Micro.Platform
import Hledger
import Hledger.Cli.DocFiles
import Hledger.UI.UITypes
import Data.Vector (Vector)
import qualified Data.Vector as V
#ifdef mingw32_HOST_OS
suspendSignal :: IO ()
suspendSignal = return ()
#else
import System.Posix.Signals
suspendSignal :: IO ()
suspendSignal :: IO ()
suspendSignal = Signal -> IO ()
raiseSignal Signal
sigSTOP
#endif
get' :: EventM Name UIState UIState
get' = do
UIState
ui <- EventM Name UIState UIState
forall s (m :: * -> *). MonadState s m => m s
get
[Char] -> EventM Name UIState ()
forall s. [Char] -> EventM Name s ()
dbguiEv ([Char] -> EventM Name UIState ())
-> [Char] -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ [Char]
"getting state: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char] -> (Screen -> [Char]) -> UIState -> [Char]
showScreenStack [Char]
"" Screen -> [Char]
showScreenSelection UIState
ui
UIState -> EventM Name UIState UIState
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return UIState
ui
put' :: UIState -> EventM Name UIState ()
put' UIState
ui = do
[Char] -> EventM Name UIState ()
forall s. [Char] -> EventM Name s ()
dbguiEv ([Char] -> EventM Name UIState ())
-> [Char] -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ [Char]
"putting state: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char] -> (Screen -> [Char]) -> UIState -> [Char]
showScreenStack [Char]
"" Screen -> [Char]
showScreenSelection UIState
ui
UIState -> EventM Name UIState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put UIState
ui
modify' :: (UIState -> UIState) -> EventM Name UIState ()
modify' UIState -> UIState
f = do
UIState
ui <- EventM Name UIState UIState
forall s (m :: * -> *). MonadState s m => m s
get
let ui' :: UIState
ui' = UIState -> UIState
f UIState
ui
[Char] -> EventM Name UIState ()
forall s. [Char] -> EventM Name s ()
dbguiEv ([Char] -> EventM Name UIState ())
-> [Char] -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ [Char]
"getting state: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Screen -> [Char]) -> UIState -> [Char]
showScreenStack [Char]
"" Screen -> [Char]
showScreenSelection UIState
ui)
[Char] -> EventM Name UIState ()
forall s. [Char] -> EventM Name s ()
dbguiEv ([Char] -> EventM Name UIState ())
-> [Char] -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ [Char]
"putting state: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Screen -> [Char]) -> UIState -> [Char]
showScreenStack [Char]
"" Screen -> [Char]
showScreenSelection UIState
ui')
(UIState -> UIState) -> EventM Name UIState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify UIState -> UIState
f
suspend :: Ord a => s -> EventM a s ()
suspend :: forall a s. Ord a => s -> EventM a s ()
suspend s
st = IO s -> EventM a s ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (IO s -> EventM a s ()) -> IO s -> EventM a s ()
forall a b. (a -> b) -> a -> b
$ IO ()
suspendSignal IO () -> IO s -> IO s
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> s -> IO s
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return s
st
redraw :: EventM a s ()
redraw :: forall a s. EventM a s ()
redraw = EventM a s Vty
forall n s. EventM n s Vty
getVtyHandle EventM a s Vty -> (Vty -> EventM a s ()) -> EventM a s ()
forall a b. EventM a s a -> (a -> EventM a s b) -> EventM a s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> EventM a s ()
forall a. IO a -> EventM a s a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM a s ()) -> (Vty -> IO ()) -> Vty -> EventM a s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vty -> IO ()
refresh
defaultLayout :: Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout :: Widget Name -> Widget Name -> Widget Name -> Widget Name
defaultLayout Widget Name
toplabel Widget Name
bottomlabel =
Widget Name -> Widget Name -> Widget Name -> Widget Name
topBottomBorderWithLabels ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" "Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>Widget Name
toplabelWidget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" ") ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" "Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>Widget Name
bottomlabelWidget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" ") (Widget Name -> Widget Name)
-> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Int -> Maybe Color -> Widget Name -> Widget Name
margin Int
1 Int
0 Maybe Color
forall a. Maybe a
Nothing
helpDialog :: Widget Name
helpDialog :: Widget Name
helpDialog =
Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
Context Name
c <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
getContext
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
$
AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr ([Char] -> AttrName
attrName [Char]
"help") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Dialog Any Name -> Widget Name -> Widget Name
forall n a. Ord n => Dialog a n -> Widget n -> Widget n
renderDialog (Maybe (Widget Name)
-> Maybe (Name, [([Char], Name, Any)]) -> Int -> Dialog Any Name
forall n a.
Eq n =>
Maybe (Widget n)
-> Maybe (n, [([Char], n, a)]) -> Int -> Dialog a n
dialog (Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
Just (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Help (LEFT/ESC/?/q to close help)") Maybe (Name, [([Char], Name, Any)])
forall a. Maybe a
Nothing (Context Name
cContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL)) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
0) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [
Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [
AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"heading") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Navigation"
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"UP/DOWN/PUP/PDN/HOME/END/k/j/C-p/C-n", [Char]
"")
,[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" move selection up/down"
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"RIGHT/l/C-f", [Char]
"show txns, or txn detail")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"LEFT/h/C-b ", [Char]
"go back/see other screens")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"ESC ", [Char]
"cancel, or reset app state")
,[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" "
,AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"heading") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Accounts screens"
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"1234567890-+ ", [Char]
"set/adjust depth limit")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"t ", [Char]
"toggle accounts tree/list mode")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"H ", [Char]
"toggle historical balance/change")
,[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" "
,AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"heading") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Register screens"
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"t ", [Char]
"toggle subaccount txns\n(and accounts tree/list mode)")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"H ", [Char]
"toggle historical/period total")
,[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" "
,AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"heading") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Help"
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"? ", [Char]
"toggle this help")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"p/m/i", [Char]
"while help is open:\nshow manual in pager/man/info")
,[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" "
]
,Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
0) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox [
AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"heading") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Filtering"
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"/ ", [Char]
"set a filter query")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"F ", [Char]
"show future & forecast txns")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"R ", [Char]
"show real/all postings")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"z ", [Char]
"show nonzero/all amounts")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"U/P/C ", [Char]
"show unmarked/pending/cleared")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"S-DOWN /S-UP ", [Char]
"shrink/grow period")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"S-RIGHT/S-LEFT", [Char]
"next/previous period")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"T ", [Char]
"set period to today")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"DEL ", [Char]
"reset filters")
,[Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" "
,AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"heading") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
"Other"
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"a ", [Char]
"add transaction (hledger add)")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"A ", [Char]
"add transaction (hledger-iadd)")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"B ", [Char]
"show amounts/costs")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"E ", [Char]
"open editor")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"I ", [Char]
"toggle balance assertions")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"V ", [Char]
"show amounts/market values")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"g ", [Char]
"reload data")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"C-l ", [Char]
"redraw & recenter")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"C-z ", [Char]
"suspend")
,([Char], [Char]) -> Widget Name
forall {n}. ([Char], [Char]) -> Widget n
renderKey ([Char]
"q ", [Char]
"quit")
]
]
]
where
renderKey :: ([Char], [Char]) -> Widget n
renderKey ([Char]
key,[Char]
desc) = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"help" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"key") ([Char] -> Widget n
forall n. [Char] -> Widget n
str [Char]
key) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget n
forall n. [Char] -> Widget n
str [Char]
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget n
forall n. [Char] -> Widget n
str [Char]
desc
helpHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
helpHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
helpHandle BrickEvent Name AppEvent
ev = do
UIState
ui <- EventM Name UIState UIState
forall s (m :: * -> *). MonadState s m => m s
get
let ui' :: UIState
ui' = UIState
ui{aMode=Normal}
case BrickEvent Name AppEvent
ev of
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]
closeHelpEvents -> UIState -> EventM Name UIState ()
put' UIState
ui'
VtyEvent (EvKey (KChar Char
'p') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume ([Char] -> Maybe [Char] -> IO ()
runPagerForTopic [Char]
"hledger-ui" Maybe [Char]
forall a. Maybe a
Nothing 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
>> UIState -> IO UIState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UIState
ui')
VtyEvent (EvKey (KChar Char
'm') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume ([Char] -> Maybe [Char] -> IO ()
runManForTopic [Char]
"hledger-ui" Maybe [Char]
forall a. Maybe a
Nothing 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
>> UIState -> IO UIState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UIState
ui')
VtyEvent (EvKey (KChar Char
'i') []) -> IO UIState -> EventM Name UIState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume ([Char] -> Maybe [Char] -> IO ()
runInfoForTopic [Char]
"hledger-ui" Maybe [Char]
forall a. Maybe a
Nothing 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
>> UIState -> IO UIState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UIState
ui')
BrickEvent Name AppEvent
_ -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
closeHelpEvents :: [Event]
closeHelpEvents = [Event]
moveLeftEvents [Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++ [Key -> [Modifier] -> Event
EvKey Key
KEsc [], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'?') [], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'q') []]
minibuffer :: T.Text -> Editor String Name -> Widget Name
minibuffer :: AccountName -> Editor [Char] Name -> Widget Name
minibuffer AccountName
string Editor [Char] Name
ed =
AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
forceAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"minibuffer") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [AccountName -> Widget Name
forall n. AccountName -> Widget n
txt (AccountName -> Widget Name) -> AccountName -> Widget Name
forall a b. (a -> b) -> a -> b
$ AccountName
string AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
": ", ([[Char]] -> Widget Name)
-> Bool -> Editor [Char] Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor ([Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char] -> Widget Name)
-> ([[Char]] -> [Char]) -> [[Char]] -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unlines) Bool
True Editor [Char] Name
ed]
borderQueryStr :: String -> Widget Name
borderQueryStr :: [Char] -> Widget Name
borderQueryStr [Char]
"" = [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
""
borderQueryStr [Char]
qry = [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" matching " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"query") ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
qry)
borderDepthStr :: Maybe Int -> Widget Name
borderDepthStr :: Maybe Int -> Widget Name
borderDepthStr Maybe Int
Nothing = [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
""
borderDepthStr (Just Int
d) = [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
" to depth " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"query") ([Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char] -> Widget Name) -> [Char] -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
d)
borderPeriodStr :: String -> Period -> Widget Name
borderPeriodStr :: [Char] -> Period -> Widget Name
borderPeriodStr [Char]
_ Period
PeriodAll = [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
""
borderPeriodStr [Char]
preposition Period
p = [Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char]
" "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
preposition[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" ") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"query") ([Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char] -> Widget Name)
-> (AccountName -> [Char]) -> AccountName -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> [Char]
T.unpack (AccountName -> Widget Name) -> AccountName -> Widget Name
forall a b. (a -> b) -> a -> b
$ Period -> AccountName
showPeriod Period
p)
borderKeysStr :: [(String,String)] -> Widget Name
borderKeysStr :: [([Char], [Char])] -> Widget Name
borderKeysStr = [([Char], Widget Name)] -> Widget Name
borderKeysStr' ([([Char], Widget Name)] -> Widget Name)
-> ([([Char], [Char])] -> [([Char], Widget Name)])
-> [([Char], [Char])]
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [Char]) -> ([Char], Widget Name))
-> [([Char], [Char])] -> [([Char], Widget Name)]
forall a b. (a -> b) -> [a] -> [b]
map (([Char] -> Widget Name)
-> ([Char], [Char]) -> ([Char], Widget Name)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [Char] -> Widget Name
forall n. [Char] -> Widget n
str)
borderKeysStr' :: [(String,Widget Name)] -> Widget Name
borderKeysStr' :: [([Char], Widget Name)] -> Widget Name
borderKeysStr' [([Char], Widget Name)]
keydescs =
[Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$
Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
intersperse Widget Name
forall {n}. Widget n
sep ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$
[AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"key") ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
keys) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
":" Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
desc | ([Char]
keys, Widget Name
desc) <- [([Char], Widget Name)]
keydescs]
where
sep :: Widget n
sep = [Char] -> Widget n
forall n. [Char] -> Widget n
str [Char]
" "
renderToggle :: Bool -> String -> String -> Widget Name
renderToggle :: Bool -> [Char] -> [Char] -> Widget Name
renderToggle Bool
isright [Char]
l [Char]
r =
let bold :: Widget n -> Widget n
bold = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"selected") in
if Bool
isright
then [Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char]
l[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"/") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
bold ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
r)
else Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
bold ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
l) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget Name
forall n. [Char] -> Widget n
str ([Char]
"/"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
r)
renderToggle1 :: Bool -> String -> Widget Name
renderToggle1 :: Bool -> [Char] -> Widget Name
renderToggle1 Bool
isactive [Char]
l =
let bold :: Widget n -> Widget n
bold = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border" AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> [Char] -> AttrName
attrName [Char]
"selected") in
if Bool
isactive
then Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
bold ([Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
l)
else [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
l
replaceHiddenAccountsNameWith :: AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith :: AccountName -> AccountName -> AccountName
replaceHiddenAccountsNameWith AccountName
anew AccountName
a | AccountName
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
hiddenAccountsName = AccountName
anew
| AccountName
a AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
== AccountName
"*" = AccountName
anew
| Bool
otherwise = AccountName
a
hiddenAccountsName :: AccountName
hiddenAccountsName = AccountName
"..."
topBottomBorderWithLabels :: Widget Name -> Widget Name -> Widget Name -> Widget Name
topBottomBorderWithLabels :: Widget Name -> Widget Name -> Widget Name -> Widget Name
topBottomBorderWithLabels Widget Name
toplabel Widget Name
bottomlabel Widget Name
body =
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
Context Name
c <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
getContext
let (Int
_w,Int
h) = (Context Name
cContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL, Context Name
cContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL)
h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
body' :: Widget Name
body' = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit (Int
h') Widget Name
body
debugmsg :: [Char]
debugmsg =
[Char]
""
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
forall {n}. Widget n -> Widget n
hBorderWithLabel (AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border") (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name
toplabel Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> [Char] -> Widget Name
forall n. [Char] -> Widget n
str [Char]
debugmsg)
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
Widget Name
body'
Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
Widget Name -> Widget Name
forall {n}. Widget n -> Widget n
hBorderWithLabel (AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr ([Char] -> AttrName
attrName [Char]
"border") Widget Name
bottomlabel)
margin :: Int -> Int -> Maybe Color -> Widget Name -> Widget Name
margin :: Int -> Int -> Maybe Color -> Widget Name -> Widget Name
margin Int
h Int
v Maybe Color
mcolour Widget Name
w = 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
Context Name
ctx <- RenderM Name (Context Name)
forall n. RenderM n (Context n)
getContext
let w' :: Widget Name
w' = Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit (Context Name
ctxContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit (Context Name
ctxContext Name -> Getting Int (Context Name) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context Name) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) Widget Name
w
attr :: Attr
attr = Attr -> (Color -> Attr) -> Maybe Color -> Attr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Attr
currentAttr (\Color
c -> Color
c Color -> Color -> Attr
`on` Color
c) Maybe Color
mcolour
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
$
Attr -> Widget Name -> Widget Name
withBorderAttr Attr
attr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
BorderStyle -> Widget Name -> Widget Name
forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle (Char -> BorderStyle
borderStyleFromChar Char
' ') (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a. Int -> (a -> a) -> a -> a
applyN Int
v (Widget Name
forall {n}. Widget n
hBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a. Int -> (a -> a) -> a -> a
applyN Int
h (Widget Name
forall {n}. Widget n
vBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a. Int -> (a -> a) -> a -> a
applyN Int
v (Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall {n}. Widget n
hBorder) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Int -> (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a. Int -> (a -> a) -> a -> a
applyN Int
h (Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
forall {n}. Widget n
vBorder) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
Widget Name
w'
withBorderAttr :: Attr -> Widget Name -> Widget Name
withBorderAttr :: Attr -> Widget Name -> Widget Name
withBorderAttr Attr
attr = (AttrMap -> AttrMap) -> Widget Name -> Widget Name
forall n. (AttrMap -> AttrMap) -> Widget n -> Widget n
updateAttrMap ([(AttrName, Attr)] -> AttrMap -> AttrMap
applyAttrMappings [([Char] -> AttrName
attrName [Char]
"border", Attr
attr)])
scrollSelectionToMiddle :: List Name item -> EventM Name UIState ()
scrollSelectionToMiddle :: forall item. List Name item -> EventM Name UIState ()
scrollSelectionToMiddle List Name item
list = do
case List Name item
listList Name item
-> Getting (Maybe Int) (List Name item) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (List Name item) (Maybe Int)
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> GenericList n t e -> f (GenericList n t e)
listSelectedL of
Maybe Int
Nothing -> () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Int
selectedrow -> do
Vty{Output
outputIface :: Output
outputIface :: Vty -> Output
outputIface} <- EventM Name UIState Vty
forall n s. EventM n s Vty
getVtyHandle
Int
pageheight <- [Char] -> Int -> Int
forall a. Show a => [Char] -> a -> a
dbg4 [Char]
"pageheight" (Int -> Int) -> ((Int, Int) -> Int) -> (Int, Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int)
-> EventM Name UIState (Int, Int) -> EventM Name UIState Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Int, Int) -> EventM Name UIState (Int, Int)
forall a. IO a -> EventM Name UIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Output -> IO (Int, Int)
displayBounds Output
outputIface)
let
itemheight :: Int
itemheight = [Char] -> Int -> Int
forall a. Show a => [Char] -> a -> a
dbg4 [Char]
"itemheight" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ List Name item
listList Name item -> Getting Int (List Name item) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (List Name item) Int
forall n (t :: * -> *) e (f :: * -> *).
Functor f =>
(Int -> f Int) -> GenericList n t e -> f (GenericList n t e)
listItemHeightL
itemsperpage :: Int
itemsperpage = [Char] -> Int -> Int
forall a. Show a => [Char] -> a -> a
dbg4 [Char]
"itemsperpage" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
pageheight Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
itemheight
toprow :: Int
toprow = [Char] -> Int -> Int
forall a. Show a => [Char] -> a -> a
dbg4 [Char]
"toprow" (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
selectedrow Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
itemsperpage Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))
ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
setTop (Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll (Name -> ViewportScroll Name) -> Name -> ViewportScroll Name
forall a b. (a -> b) -> a -> b
$ List Name item
listList Name item -> Getting Name (List Name item) Name -> Name
forall s a. s -> Getting a s a -> a
^.Getting Name (List Name item) Name
forall n1 (t :: * -> *) e n2 (f :: * -> *).
Functor f =>
(n1 -> f n2) -> GenericList n1 t e -> f (GenericList n2 t e)
listNameL) Int
toprow
moveUpEvents :: [Event]
moveUpEvents = [Key -> [Modifier] -> Event
EvKey Key
KUp [] , Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'k') [], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'p') [Modifier
MCtrl]]
moveDownEvents :: [Event]
moveDownEvents = [Key -> [Modifier] -> Event
EvKey Key
KDown [] , Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'j') [], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'n') [Modifier
MCtrl]]
moveLeftEvents :: [Event]
moveLeftEvents = [Key -> [Modifier] -> Event
EvKey Key
KLeft [] , Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'h') [], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'b') [Modifier
MCtrl]]
moveRightEvents :: [Event]
moveRightEvents = [Key -> [Modifier] -> Event
EvKey Key
KRight [], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'l') [], Key -> [Modifier] -> Event
EvKey (Char -> Key
KChar Char
'f') [Modifier
MCtrl], Key -> [Modifier] -> Event
EvKey Key
KEnter []]
normaliseMovementKeys :: Event -> Event
normaliseMovementKeys Event
ev
| Event
ev Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveUpEvents = Key -> [Modifier] -> Event
EvKey Key
KUp []
| Event
ev Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveDownEvents = Key -> [Modifier] -> Event
EvKey Key
KDown []
| Event
ev Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveLeftEvents = Key -> [Modifier] -> Event
EvKey Key
KLeft []
| Event
ev Event -> [Event] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Event]
moveRightEvents = Key -> [Modifier] -> Event
EvKey Key
KRight []
| Bool
otherwise = Event
ev
reportSpecAddQuery :: Query -> ReportSpec -> ReportSpec
reportSpecAddQuery :: Query -> ReportSpec -> ReportSpec
reportSpecAddQuery Query
q ReportSpec
rspec =
ReportSpec
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, q]}
reportSpecSetFutureAndForecast :: Maybe DateSpan -> ReportSpec -> ReportSpec
reportSpecSetFutureAndForecast :: Maybe DateSpan -> ReportSpec -> ReportSpec
reportSpecSetFutureAndForecast Maybe DateSpan
fcast ReportSpec
rspec =
ReportSpec
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, periodq, excludeforecastq fcast]}
where
periodq :: Query
periodq = DateSpan -> Query
Date (DateSpan -> Query)
-> (ReportOpts -> DateSpan) -> ReportOpts -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Period -> DateSpan
periodAsDateSpan (Period -> DateSpan)
-> (ReportOpts -> Period) -> ReportOpts -> DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> Period
period_ (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
excludeforecastq :: Maybe a -> Query
excludeforecastq (Just a
_) = Query
Any
excludeforecastq Maybe a
Nothing =
[Query] -> Query
And [
Query -> Query
Not (DateSpan -> Query
Date (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan (EFDay -> Maybe EFDay
forall a. a -> Maybe a
Just (EFDay -> Maybe EFDay) -> EFDay -> Maybe EFDay
forall a b. (a -> b) -> a -> b
$ Day -> EFDay
Exact (Day -> EFDay) -> Day -> EFDay
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
1 (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Day
_rsDay ReportSpec
rspec) Maybe EFDay
forall a. Maybe a
Nothing)
,Query -> Query
Not Query
generatedTransactionTag
]
listScrollPushingSelection :: Name -> Int -> Int -> EventM Name (List Name item) (GenericList Name Vector item)
listScrollPushingSelection :: forall item.
Name -> Int -> Int -> EventM Name (List Name item) (List Name item)
listScrollPushingSelection Name
name Int
listheight Int
scrollamt = do
List Name item
list <- EventM Name (List Name item) (List Name item)
forall s (m :: * -> *). MonadState s m => m s
get
Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
name ViewportScroll Name -> forall s. Int -> EventM Name s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
`vScrollBy` Int
scrollamt
Maybe Viewport
mvp <- Name -> EventM Name (List Name item) (Maybe Viewport)
forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport Name
name
case Maybe Viewport
mvp of
Just VP{Int
_vpTop :: Int
_vpTop :: Viewport -> Int
_vpTop, _vpSize :: Viewport -> (Int, Int)
_vpSize=(Int
_,Int
vpheight)} -> do
let mselidx :: Maybe Int
mselidx = List Name item -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name item
list
case Maybe Int
mselidx of
Just Int
selidx -> List Name item -> EventM Name (List Name item) (List Name item)
forall a. a -> EventM Name (List Name item) a
forall (m :: * -> *) a. Monad m => a -> m a
return (List Name item -> EventM Name (List Name item) (List Name item))
-> List Name item -> EventM Name (List Name item) (List Name item)
forall a b. (a -> b) -> a -> b
$ List Name item -> List Name item
forall {n} {e}. GenericList n Vector e -> GenericList n Vector e
pushsel List Name item
list
where
pushsel :: GenericList n Vector e -> GenericList n Vector e
pushsel
| Int
scrollamt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0, Int
selidx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
_vpTop Bool -> Bool -> Bool
&& Int
selidx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Int
listheightInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) = GenericList n Vector e -> GenericList n Vector e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown
| Int
scrollamt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0, Int
selidx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
_vpTop Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vpheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Bool -> Bool -> Bool
&& Int
selidx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = GenericList n Vector e -> GenericList n Vector e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveUp
| Bool
otherwise = GenericList n Vector e -> GenericList n Vector e
forall a. a -> a
id
Maybe Int
_ -> List Name item -> EventM Name (List Name item) (List Name item)
forall a. a -> EventM Name (List Name item) a
forall (m :: * -> *) a. Monad m => a -> m a
return List Name item
list
Maybe Viewport
_ -> List Name item -> EventM Name (List Name item) (List Name item)
forall a. a -> EventM Name (List Name item) a
forall (m :: * -> *) a. Monad m => a -> m a
return List Name item
list
dbgui :: String -> a -> a
dbgui :: forall a. [Char] -> a -> a
dbgui = Int -> [Char] -> a -> a
forall a. Int -> [Char] -> a -> a
traceLogAt Int
1
dbguiIO :: String -> IO ()
dbguiIO :: [Char] -> IO ()
dbguiIO = Int -> [Char] -> IO ()
forall (m :: * -> *). MonadIO m => Int -> [Char] -> m ()
traceLogAtIO Int
1
dbguiEv :: String -> EventM Name s ()
dbguiEv :: forall s. [Char] -> EventM Name s ()
dbguiEv [Char]
s = [Char] -> EventM Name s () -> EventM Name s ()
forall a. [Char] -> a -> a
dbgui [Char]
s (EventM Name s () -> EventM Name s ())
-> EventM Name s () -> EventM Name s ()
forall a b. (a -> b) -> a -> b
$ () -> EventM Name s ()
forall a. a -> EventM Name s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
dbguiScreensEv :: String -> (Screen -> String) -> UIState -> EventM Name UIState ()
dbguiScreensEv :: [Char] -> (Screen -> [Char]) -> UIState -> EventM Name UIState ()
dbguiScreensEv [Char]
postfix Screen -> [Char]
showscr UIState
ui = [Char] -> EventM Name UIState ()
forall s. [Char] -> EventM Name s ()
dbguiEv ([Char] -> EventM Name UIState ())
-> [Char] -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ [Char] -> (Screen -> [Char]) -> UIState -> [Char]
showScreenStack [Char]
postfix Screen -> [Char]
showscr UIState
ui
showScreenStack :: String -> (Screen -> String) -> UIState -> String
showScreenStack :: [Char] -> (Screen -> [Char]) -> UIState -> [Char]
showScreenStack [Char]
postfix Screen -> [Char]
showscr UIState
ui = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
[Char]
"screen stack"
,if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
postfix then [Char]
"" else [Char]
", " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
postfix
,[Char]
": "
,[[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Screen -> [Char]) -> UIState -> [[Char]]
forall a. (Screen -> a) -> UIState -> [a]
mapScreens Screen -> [Char]
showscr UIState
ui
]
mapScreens :: (Screen -> a) -> UIState -> [a]
mapScreens :: forall a. (Screen -> a) -> UIState -> [a]
mapScreens Screen -> a
f UIState{[Screen]
aPrevScreens :: [Screen]
aPrevScreens :: UIState -> [Screen]
aPrevScreens, Screen
aScreen :: Screen
aScreen :: UIState -> Screen
aScreen} = (Screen -> a) -> [Screen] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Screen -> a
f ([Screen] -> [a]) -> [Screen] -> [a]
forall a b. (a -> b) -> a -> b
$ [Screen] -> [Screen]
forall a. [a] -> [a]
reverse ([Screen] -> [Screen]) -> [Screen] -> [Screen]
forall a b. (a -> b) -> a -> b
$ Screen
aScreen Screen -> [Screen] -> [Screen]
forall a. a -> [a] -> [a]
: [Screen]
aPrevScreens
showScreenId :: Screen -> String
showScreenId :: Screen -> [Char]
showScreenId = \case
MS MenuScreenState
_ -> [Char]
"M"
AS AccountsScreenState
_ -> [Char]
"A"
CS AccountsScreenState
_ -> [Char]
"C"
BS AccountsScreenState
_ -> [Char]
"B"
IS AccountsScreenState
_ -> [Char]
"I"
RS RegisterScreenState
_ -> [Char]
"R"
TS TransactionScreenState
_ -> [Char]
"T"
ES ErrorScreenState
_ -> [Char]
"E"
showScreenRegisterDescriptions :: Screen -> String
showScreenRegisterDescriptions :: Screen -> [Char]
showScreenRegisterDescriptions Screen
scr = case Screen
scr of
RS RegisterScreenState
sst -> ((Screen -> [Char]
showScreenId Screen
scr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (RegisterScreenItem -> [Char]) -> [RegisterScreenItem] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> [Char]
T.unpack (AccountName -> [Char])
-> (RegisterScreenItem -> AccountName)
-> RegisterScreenItem
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> AccountName
rsItemDescription) ([RegisterScreenItem] -> [[Char]])
-> [RegisterScreenItem] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
(RegisterScreenItem -> Bool)
-> [RegisterScreenItem] -> [RegisterScreenItem]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool)
-> (RegisterScreenItem -> Bool) -> RegisterScreenItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null (AccountName -> Bool)
-> (RegisterScreenItem -> AccountName)
-> RegisterScreenItem
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RegisterScreenItem -> AccountName
rsItemDate) ([RegisterScreenItem] -> [RegisterScreenItem])
-> [RegisterScreenItem] -> [RegisterScreenItem]
forall a b. (a -> b) -> a -> b
$ Vector RegisterScreenItem -> [RegisterScreenItem]
forall a. Vector a -> [a]
V.toList (Vector RegisterScreenItem -> [RegisterScreenItem])
-> Vector RegisterScreenItem -> [RegisterScreenItem]
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector RegisterScreenItem
-> Vector RegisterScreenItem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (GenericList Name Vector RegisterScreenItem
-> Vector RegisterScreenItem)
-> GenericList Name Vector RegisterScreenItem
-> Vector RegisterScreenItem
forall a b. (a -> b) -> a -> b
$ RegisterScreenState -> GenericList Name Vector RegisterScreenItem
_rssList RegisterScreenState
sst
Screen
_ -> Screen -> [Char]
showScreenId Screen
scr
showScreenSelection :: Screen -> String
showScreenSelection :: Screen -> [Char]
showScreenSelection = \case
MS MSS{List Name MenuScreenItem
_mssList :: List Name MenuScreenItem
_mssList :: MenuScreenState -> List Name MenuScreenItem
_mssList} -> [Char]
"M" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Int -> [Char]) -> Maybe Int -> [Char]
forall a b. (a -> b) -> a -> b
$ List Name MenuScreenItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name MenuScreenItem
_mssList)
AS ASS{List Name AccountsScreenItem
_assList :: List Name AccountsScreenItem
_assList :: AccountsScreenState -> List Name AccountsScreenItem
_assList} -> [Char]
"A" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Int -> [Char]) -> Maybe Int -> [Char]
forall a b. (a -> b) -> a -> b
$ List Name AccountsScreenItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name AccountsScreenItem
_assList)
CS ASS{List Name AccountsScreenItem
_assList :: AccountsScreenState -> List Name AccountsScreenItem
_assList :: List Name AccountsScreenItem
_assList} -> [Char]
"C" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Int -> [Char]) -> Maybe Int -> [Char]
forall a b. (a -> b) -> a -> b
$ List Name AccountsScreenItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name AccountsScreenItem
_assList)
BS ASS{List Name AccountsScreenItem
_assList :: AccountsScreenState -> List Name AccountsScreenItem
_assList :: List Name AccountsScreenItem
_assList} -> [Char]
"B" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Int -> [Char]) -> Maybe Int -> [Char]
forall a b. (a -> b) -> a -> b
$ List Name AccountsScreenItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name AccountsScreenItem
_assList)
IS ASS{List Name AccountsScreenItem
_assList :: AccountsScreenState -> List Name AccountsScreenItem
_assList :: List Name AccountsScreenItem
_assList} -> [Char]
"I" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Int -> [Char]) -> Maybe Int -> [Char]
forall a b. (a -> b) -> a -> b
$ List Name AccountsScreenItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected List Name AccountsScreenItem
_assList)
RS RSS{GenericList Name Vector RegisterScreenItem
_rssList :: RegisterScreenState -> GenericList Name Vector RegisterScreenItem
_rssList :: GenericList Name Vector RegisterScreenItem
_rssList} -> [Char]
"R" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (Int -> [Char]) -> Maybe Int -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" Int -> [Char]
forall a. Show a => a -> [Char]
show (Maybe Int -> [Char]) -> Maybe Int -> [Char]
forall a b. (a -> b) -> a -> b
$ GenericList Name Vector RegisterScreenItem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected GenericList Name Vector RegisterScreenItem
_rssList)
TS TransactionScreenState
_ -> [Char]
"T"
ES ErrorScreenState
_ -> [Char]
"E"
uiNumBlankItems :: Int
uiNumBlankItems :: Int
uiNumBlankItems
= Int
100