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