{- | 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 <- 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
    -- (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
  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
    -- (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
  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')
    -- (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'
  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 = 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

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

-- | 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 (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
  -- 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 =
  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
$ -- (Just (0,[("ok",())]))
      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")
                ]
             ]
--           ,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) = 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

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

-- | 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 =
  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 = str " | "
    sep :: Widget n
sep = 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 = 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)

-- | 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 = 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

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

---- 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 = 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 .
   -- withBorderStyle (borderStyleFromChar ' ') .
   -- applyN n border

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

---- | 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
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)) -- assuming ViewportScroll's row offset is measured in list items not screen rows
      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

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

-- | 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 :: Query
_rsQuery=Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportSpec -> Query
_rsQuery ReportSpec
rspec, Query
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 :: 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
    -- 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 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
      ]

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

-- | 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 = forall a. Int -> [Char] -> a -> a
traceLogAt Int
1

-- | Like dbgui, but convenient to use in IO.
dbguiIO :: String -> IO ()
dbguiIO :: [Char] -> IO ()
dbguiIO = 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 = forall a. [Char] -> a -> a
dbgui [Char]
s forall a b. (a -> b) -> a -> b
$ 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 = 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

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

-- | 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 :: 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

-- 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 forall a. [a] -> [a] -> [a]
++ [Char]
":") forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ -- menu
    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

-- 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 :: 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)  -- menu
  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)  -- all accounts
  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)  -- cash accounts
  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)  -- bs accounts
  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)  -- is accounts
  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)  -- 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