{- | Rendering & misc. helpers. -}

{-# 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
  -- ,Output(displayBounds,mkDisplayContext),DisplayContext(..)
  )
import Lens.Micro.Platform

import Hledger
-- import Hledger.Cli.CliOptions (CliOpts(reportspec_))
import Hledger.Cli.DocFiles
-- import Hledger.UI.UIOptions (UIOpts(uoCliOpts))
import Hledger.UI.UITypes

import Data.Vector (Vector)
import qualified Data.Vector as V

-- | On posix platforms, send the system STOP signal to suspend the
-- current program. On windows, does nothing.
-- (Though, currently hledger-ui is not built on windows.)
#ifdef mingw32_HOST_OS
suspendSignal :: IO ()
suspendSignal = return ()
#else
import System.Posix.Signals
suspendSignal :: IO ()
suspendSignal :: IO ()
suspendSignal = Signal -> IO ()
raiseSignal Signal
sigSTOP
#endif

-- Debug logging for UI state changes.
-- A good place to log things of interest while debugging, see commented examples below.

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
    -- (head $ lines $ pshow $ aScreen x)
    -- ++ " " ++ (show $ map tdescription $ jtxns $ ajournal x)
  -- dbguiEv $ ("query: "++) $ pshow' $ x  & aopts & uoCliOpts & reportspec_ & _rsQuery
  -- dbguiScreensEv "getting" showScreenId x
  -- dbguiScreensEv "getting, with register descriptions" showScreenRegisterDescriptions x
  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
    -- (head $ lines $ pshow $ aScreen x)
    -- ++ " " ++ (show $ map tdescription $ jtxns $ ajournal x)
  -- dbguiEv $ ("query: "++) $ pshow' $ x  & aopts & uoCliOpts & reportspec_ & _rsQuery
  -- dbguiScreensEv "putting" showScreenId x
  -- dbguiScreensEv "putting, with register descriptions" showScreenRegisterDescriptions x
  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')
    -- (head $ lines $ pshow $ aScreen x')
    -- ++ " " ++ (show $ map tdescription $ jtxns $ ajournal x')
  -- dbguiEv $ ("from: "++) $ pshow' $ x  & aopts & uoCliOpts & reportspec_ & _rsQuery
  -- dbguiEv $ ("to:   "++) $ pshow' $ x' & aopts & uoCliOpts & reportspec_ & _rsQuery
  -- dbguiScreensEv "getting" showScreenId x
  -- dbguiScreensEv "putting" showScreenId x'
  -- dbguiScreensEv "getting, with register descriptions" showScreenRegisterDescriptions x
  -- dbguiScreensEv "putting, with register descriptions" showScreenRegisterDescriptions x'
  (UIState -> UIState) -> EventM Name UIState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify UIState -> UIState
f

-- | On posix platforms, suspend the program using the STOP signal,
-- like control-z in bash, returning to the original shell prompt,
-- and when resumed, continue where we left off.
-- On windows, does nothing.
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

-- | Tell vty to redraw the whole screen.
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

-- | Wrap a widget in the default hledger-ui screen layout.
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
  -- topBottomBorderWithLabel label .
  -- padLeftRight 1 -- XXX should reduce inner widget's width by 2, but doesn't
                    -- "the layout adjusts... if you use the core combinators"

-- | Draw the help dialog, called when help mode is active.
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
$ -- (Just (0,[("ok",())]))
      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")
                ]
             ]
--           ,vBox [
--              str " "
--             ,hCenter $ padLeftRight 1 $
--               hCenter (str "MANUAL")
--               <=>
--               hCenter (hBox [
--                  renderKey ("t", "text")
--                 ,str " "
--                 ,renderKey ("m", "man page")
--                 ,str " "
--                 ,renderKey ("i", "info")
--                 ])
--             ]
          ]
  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

-- | Event handler used when help mode is active.
-- May invoke $PAGER, less, man or info, which is likely to fail on MS Windows, TODO.
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') []]

-- | Draw the minibuffer with the given label.
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 = str " | "
    sep :: Widget n
sep = [Char] -> Widget n
forall n. [Char] -> Widget n
str [Char]
" "

-- | Show both states of a toggle ("aaa/bbb"), highlighting the active one.
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)

-- | Show a toggle's label, highlighted (bold) when the toggle is active.
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

-- temporary shenanigans:

-- | Replace the special account names "*" and "..." (from balance reports with depth limit 0)
-- to something clearer.
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
"..." -- for now

-- generic

--topBottomBorderWithLabel :: Widget Name -> Widget Name -> Widget Name
--topBottomBorderWithLabel label = \wrapped ->
--  Widget Greedy Greedy $ do
--    c <- getContext
--    let (_w,h) = (c^.availWidthL, c^.availHeightL)
--        h' = h - 2
--        wrapped' = vLimit (h') wrapped
--        debugmsg =
--          ""
--          -- "  debug: "++show (_w,h')
--    render $
--      hBorderWithLabel (label <+> str debugmsg)
--      <=>
--      wrapped'
--      <=>
--      hBorder

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]
""
          -- "  debug: "++show (_w,h')
    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)

---- XXX should be equivalent to the above, but isn't (page down goes offscreen)
--_topBottomBorderWithLabel :: Widget Name -> Widget Name -> Widget Name
--_topBottomBorderWithLabel label = \wrapped ->
-- let debugmsg = ""
-- in hBorderWithLabel (label <+> str debugmsg)
--    <=>
--    wrapped
--    <=>
--    hBorder

-- XXX superseded by pad, in theory
-- | Wrap a widget in a margin with the given horizontal and vertical
-- thickness, using the current background colour or the specified
-- colour.
-- XXX May disrupt border style of inner widgets.
-- XXX Should reduce the available size visible to inner widget, but doesn't seem to (cf rsDraw).
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 .
   -- withBorderStyle (borderStyleFromChar ' ') .
   -- applyN n border

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)])

---- | Like brick's continue, but first run some action to modify brick's state.
---- This action does not affect the app state, but might eg adjust a widget's scroll position.
--continueWith :: EventM n () -> ui -> EventM n (Next ui)
--continueWith brickaction ui = brickaction >> continue ui

---- | Scroll a list's viewport so that the selected item is at the top
---- of the display area.
--scrollToTop :: List Name e -> EventM Name ()
--scrollToTop list = do
--  let vpname = list^.listNameL
--  setTop (viewportScroll vpname) 0

-- | Scroll a list's viewport so that the selected item is centered in the
-- middle of the display area.
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)) -- assuming ViewportScroll's row offset is measured in list items not screen rows
      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

--                 arrow keys       vi keys               emacs keys                 enter key
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

-- | Restrict the ReportSpec's query by adding the given additional query.
reportSpecAddQuery :: Query -> ReportSpec -> ReportSpec
reportSpecAddQuery :: Query -> ReportSpec -> ReportSpec
reportSpecAddQuery Query
q ReportSpec
rspec =
    ReportSpec
rspec{_rsQuery=simplifyQuery $ And [_rsQuery rspec, q]}

-- | Update the ReportSpec's query to exclude future transactions (later than its "today" date)
-- and forecast transactions (generated by --forecast), if the given forecast DateSpan is Nothing,
-- and include them otherwise.
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
    -- Except in forecast mode, exclude future/forecast transactions.
    excludeforecastq :: Maybe a -> Query
excludeforecastq (Just a
_) = Query
Any
    excludeforecastq Maybe a
Nothing  =  -- not:date:tomorrow- not:tag:generated-transaction
      [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
      ]

-- Vertically scroll the named list's viewport with the given number of non-empty items
-- by the given positive or negative number of items (usually 1 or -1).
-- The selection will be moved when necessary to keep it visible and allow the scroll.
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

-- | A debug logging helper for hledger-ui code: at any debug level >= 1,
-- logs the string to hledger-ui.log before returning the second argument.
-- Uses unsafePerformIO.
dbgui :: String -> a -> a
dbgui :: forall a. [Char] -> a -> a
dbgui = Int -> [Char] -> a -> a
forall a. Int -> [Char] -> a -> a
traceLogAt Int
1

-- | Like dbgui, but convenient to use in IO.
dbguiIO :: String -> IO ()
dbguiIO :: [Char] -> IO ()
dbguiIO = Int -> [Char] -> IO ()
forall (m :: * -> *). MonadIO m => Int -> [Char] -> m ()
traceLogAtIO Int
1

-- | Like dbgui, but convenient to use in EventM handlers.
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 ()

-- | Like dbguiEv, but log a compact view of the current screen stack.
-- See showScreenStack.
-- To just log the stack: @dbguiScreensEv "" showScreenId ui@
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

-- Render a compact labelled view of the current screen stack,
-- adding the given postfix to the label (can be empty),
-- from the topmost screen to the currently-viewed screen,
-- with each screen rendered by the given rendering function.
-- Useful for inspecting states across the whole screen stack.
-- Some screen rendering functions are 
-- @showScreenId@, @showScreenSelection@, @showScreenRegisterDescriptions@.
--
-- Eg to just show the stack: @showScreenStack "" showScreenId ui@
--
-- To to show the stack plus selected item indexes: @showScreenStack "" showScreenSelection 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
  ]

-- | Run a function on each screen in a UIState's screen "stack",
-- from topmost screen down to currently-viewed screen.
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

-- Show a screen's compact id (first letter of its constructor).
showScreenId :: Screen -> String
showScreenId :: Screen -> [Char]
showScreenId = \case
  MS MenuScreenState
_ -> [Char]
"M"  -- menu
  AS AccountsScreenState
_ -> [Char]
"A"  -- all accounts
  CS AccountsScreenState
_ -> [Char]
"C"  -- cash accounts
  BS AccountsScreenState
_ -> [Char]
"B"  -- bs accounts
  IS AccountsScreenState
_ -> [Char]
"I"  -- is accounts
  RS RegisterScreenState
_ -> [Char]
"R"  -- menu
  TS TransactionScreenState
_ -> [Char]
"T"  -- transaction
  ES ErrorScreenState
_ -> [Char]
"E"  -- error

-- Show a screen's compact id, plus for register screens, the transaction descriptions.
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
$ -- menu
    [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

-- Show a screen's compact id, plus index of its selected list item if any.
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)  -- menu
  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)  -- all accounts
  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)  -- cash accounts
  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)  -- bs accounts
  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)  -- is accounts
  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)  -- menu
  TS TransactionScreenState
_ -> [Char]
"T"  -- transaction
  ES ErrorScreenState
_ -> [Char]
"E"  -- error

-- | How many blank items to add to lists to fill the full window height.
uiNumBlankItems :: Int
uiNumBlankItems :: Int
uiNumBlankItems
  -- | debugLevel >= uiDebugLevel = 0    -- suppress to improve debug output.
  -- | otherwise 
  = Int
100  -- 100 ought to be enough for anyone