{-|
hledger-ui - a hledger add-on providing an efficient TUI.

SPDX-License-Identifier: GPL-3.0-or-later
Copyright (c) 2007-2025 (each year in this range) Simon Michael <simon@joyful.com> and contributors.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this program.
If not, see <https://www.gnu.org/licenses/>.

-}

{-# LANGUAGE CPP                   #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE MultiWayIf #-}

module Hledger.UI.Main where

import Control.Applicative ((<|>))
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (withAsync)
#if MIN_VERSION_base(4,20,0)
import Control.Exception.Backtrace (setBacktraceMechanismState, BacktraceMechanism(..))
#endif
import Control.Monad (forM_, void, when)
import Data.Bifunctor (first)
import Data.Function ((&))
import Data.List (find)
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Graphics.Vty (Mode (Mouse), Vty (outputIface), Output (setMode))
import Graphics.Vty.CrossPlatform (mkVty)
import Lens.Micro ((^.))
import System.Directory (canonicalizePath)
import System.Environment (withProgName)
import System.FilePath (takeDirectory)
import System.FSNotify (Event(Modified), watchDir, withManager, EventIsDirectory (IsFile))
import Brick hiding (bsDraw)
import qualified Brick.BChan as BC

import Hledger
import Hledger.Cli hiding (progname,prognameandversion)
import Hledger.UI.Theme
import Hledger.UI.UIOptions
import Hledger.UI.UITypes
import Hledger.UI.UIState (uiState, getDepth)
import Hledger.UI.UIUtils (dbguiEv, showScreenStack, showScreenSelection)
import Hledger.UI.MenuScreen
import Hledger.UI.AccountsScreen
import Hledger.UI.CashScreen
import Hledger.UI.BalancesheetScreen
import Hledger.UI.IncomestatementScreen
import Hledger.UI.RegisterScreen
import Hledger.UI.TransactionScreen
import Hledger.UI.ErrorScreen
import Hledger.UI.UIScreens


----------------------------------------------------------------------

newChan :: IO (BC.BChan a)
newChan :: forall a. IO (BChan a)
newChan = Int -> IO (BChan a)
forall a. Int -> IO (BChan a)
BC.newBChan Int
10

writeChan :: BC.BChan a -> a -> IO ()
writeChan :: forall a. BChan a -> a -> IO ()
writeChan = BChan a -> a -> IO ()
forall a. BChan a -> a -> IO ()
BC.writeBChan


hledgerUiMain :: IO ()
hledgerUiMain :: IO ()
hledgerUiMain = IO () -> IO ()
handleExit (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall {a}. a -> a
withGhcDebug' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO () -> IO ()
forall a. [Char] -> IO a -> IO a
withProgName [Char]
"hledger-ui.log" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do  -- force Hledger.Utils.Debug.* to log to hledger-ui.log
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GhcDebugMode
ghcDebugMode GhcDebugMode -> GhcDebugMode -> Bool
forall a. Eq a => a -> a -> Bool
== GhcDebugMode
GDPauseAtStart) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
ghcDebugPause'

#if MIN_VERSION_base(4,20,0)
  -- Control ghc 9.10+'s stack traces.
  -- CostCentreBacktrace   - collect cost-centre stack backtraces (only available when built with profiling)
  -- HasCallStackBacktrace - collect HasCallStack backtraces
  -- ExecutionBacktrace    - collect backtraces from native execution stack unwinding
  -- IPEBacktrace          - collect backtraces from Info Table Provenance Entries
#ifdef DEBUG
  setBacktraceMechanismState HasCallStackBacktrace True
#else
  BacktraceMechanism -> Bool -> IO ()
setBacktraceMechanismState BacktraceMechanism
HasCallStackBacktrace Bool
False
#endif
#endif

  [Char] -> IO ()
forall (m :: * -> *). MonadIO m => [Char] -> m ()
dbg1MsgIO [Char]
"\n\n\n\n==== hledger-ui start"
  [Char] -> [[Char]] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => [Char] -> a -> m ()
dbg1IO [Char]
"args" [[Char]]
progArgs
  [Char] -> Int -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => [Char] -> a -> m ()
dbg1IO [Char]
"debugLevel" Int
debugLevel

  opts1@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=iopts,rawopts_=rawopts}} <- IO UIOpts
getHledgerUIOpts
  -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)

  usecolor <- useColorOnStdout
  -- When ANSI colour/styling is available and enabled, encourage user's $PAGER to use it (for command line help).
  when usecolor setupPager
  -- And when it's not, disable colour in the TUI ?
  -- Theme.hs's themes currently hard code various colours and styles provided by vty,
  -- which probably are disabled automatically when terminal doesn't support them.
  -- But we'll at least force hledger-ui's theme to a monochrome one.
  let opts = if Bool
usecolor then UIOpts
opts1 else UIOpts
opts1{uoTheme=Just "terminal"}

  -- always generate forecasted periodic transactions; their visibility will be toggled by the UI.
  let copts' = CliOpts
copts{inputopts_=iopts{forecast_=forecast_ iopts <|> Just nulldatespan}}

  case True of
    Bool
_ | [Char] -> RawOpts -> Bool
boolopt [Char]
"help"    RawOpts
rawopts -> [Char] -> IO ()
runPager ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [Char]
forall a. Mode a -> [Char]
showModeUsage Mode RawOpts
uimode [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
    Bool
_ | [Char] -> RawOpts -> Bool
boolopt [Char]
"tldr"    RawOpts
rawopts -> [Char] -> IO ()
runTldrForPage [Char]
"hledger-ui"
    Bool
_ | [Char] -> RawOpts -> Bool
boolopt [Char]
"info"    RawOpts
rawopts -> [Char] -> Maybe [Char] -> IO ()
runInfoForTopic [Char]
"hledger-ui" Maybe [Char]
forall a. Maybe a
Nothing
    Bool
_ | [Char] -> RawOpts -> Bool
boolopt [Char]
"man"     RawOpts
rawopts -> [Char] -> Maybe [Char] -> IO ()
runManForTopic  [Char]
"hledger-ui" Maybe [Char]
forall a. Maybe a
Nothing
    Bool
_ | [Char] -> RawOpts -> Bool
boolopt [Char]
"version" RawOpts
rawopts -> [Char] -> IO ()
putStrLn [Char]
prognameandversion
    -- _ | boolopt "binary-filename" rawopts -> putStrLn (binaryfilename progname)
    Bool
_                                         -> CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
copts' (UIOpts -> Journal -> IO ()
runBrickUi UIOpts
opts)

  when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'

runBrickUi :: UIOpts -> Journal -> IO ()
runBrickUi :: UIOpts -> Journal -> IO ()
runBrickUi uopts0 :: UIOpts
uopts0@UIOpts{uoCliOpts :: UIOpts -> CliOpts
uoCliOpts=copts :: CliOpts
copts@CliOpts{inputopts_ :: CliOpts -> InputOpts
inputopts_=InputOpts
_iopts,reportspec_ :: CliOpts -> ReportSpec
reportspec_=rspec :: ReportSpec
rspec@ReportSpec{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts}}} Journal
j =
  do
  let
    today :: Day
today = CliOpts
coptsCliOpts -> Getting Day CliOpts Day -> Day
forall s a. s -> Getting a s a -> a
^.Getting Day CliOpts Day
forall c. HasReportSpec c => Lens' c Day
Lens' CliOpts Day
rsDay

    -- hledger-ui's query handling is currently in flux, mixing old and new approaches.
    -- Related: #1340, #1383, #1387. Some notes and terminology:

    -- The *startup query* is the Query generated at program startup, from
    -- command line options, arguments, and the current date. hledger CLI
    -- uses this.

    -- hledger-ui/hledger-web allow the query to be changed at will, creating
    -- a new *runtime query* each time.

    -- The startup query or part of it can be used as a *constraint query*,
    -- limiting all runtime queries. hledger-web does this with the startup
    -- report period, never showing transactions outside those dates.
    -- hledger-ui does not do this.

    -- A query is a combination of multiple subqueries/terms, which are
    -- generated from command line options and arguments, ui/web app runtime
    -- state, and/or the current date.

    -- Some subqueries are generated by parsing freeform user input, which
    -- can fail. We don't want hledger users to see such failures except:

    -- 1. at program startup, in which case the program exits
    -- 2. after entering a new freeform query in hledger-ui/web, in which case
    --    the change is rejected and the program keeps running

    -- So we should parse those kinds of subquery only at those times. Any
    -- subqueries which do not require parsing can be kept separate. And
    -- these can be combined to make the full query when needed, eg when
    -- hledger-ui screens are generating their data. (TODO)

    -- Some parts of the query are also kept separate for UI reasons.
    -- hledger-ui provides special UI for controlling depth (number keys), 
    -- the report period (shift arrow keys), realness/status filters (RUPC keys) etc.
    -- There is also a freeform text area for extra query terms (/ key).
    -- It's cleaner and less conflicting to keep the former out of the latter.

    uopts :: UIOpts
uopts = UIOpts
uopts0{
      uoCliOpts=copts{
         reportspec_=rspec{
            _rsQuery=filteredQuery $ _rsQuery rspec,  -- query with depth/date parts removed
            _rsReportOpts=ropts{
               depth_    = queryDepth $ _rsQuery rspec,  -- query's depth part
               period_   = periodfromoptsandargs,       -- query's date part
               no_elide_ = True,  -- avoid squashing boring account names, for a more regular tree (unlike hledger)
               empty_    = not $ empty_ ropts,  -- show zero items by default, hide them with -E (unlike hledger)
               declared_ = True  -- always show declared accounts even if unused
               }
            }
         }
      }
      where
        datespanfromargs :: DateSpan
datespanfromargs = Bool -> Query -> DateSpan
queryDateSpan (ReportOpts -> Bool
date2_ ReportOpts
ropts) (Query -> DateSpan) -> Query -> DateSpan
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Query
_rsQuery ReportSpec
rspec
        periodfromoptsandargs :: Period
periodfromoptsandargs =
          DateSpan -> Period
dateSpanAsPeriod (DateSpan -> Period) -> DateSpan -> Period
forall a b. (a -> b) -> a -> b
$ [DateSpan] -> DateSpan
spansIntersect [Period -> DateSpan
periodAsDateSpan (Period -> DateSpan) -> Period -> DateSpan
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Period
period_ ReportOpts
ropts, DateSpan
datespanfromargs]
        filteredQuery :: Query -> Query
filteredQuery Query
q = Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportOpts -> Query
queryFromFlags ReportOpts
ropts, Query -> Query
filtered Query
q]
          where filtered :: Query -> Query
filtered = (Query -> Bool) -> Query -> Query
filterQuery (\Query
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Query -> Bool
queryIsDepth Query
x Bool -> Bool -> Bool
|| Query -> Bool
queryIsDate Query
x)

    -- Choose the initial screen to display.
    -- We also set up a stack of previous screens, as if you had navigated down to it from the top.
    -- Note the previous screens list is ordered nearest-first, with the top-most (menu) screen last.
    -- Keep all of this synced with msNew.
    rawopts :: RawOpts
rawopts = CliOpts -> RawOpts
rawopts_ (CliOpts -> RawOpts) -> CliOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ UIOpts -> CliOpts
uoCliOpts (UIOpts -> CliOpts) -> UIOpts -> CliOpts
forall a b. (a -> b) -> a -> b
$ UIOpts
uopts
    ([Screen]
prevscrs, Screen
currscr) =
      (([Screen], Screen) -> [Char])
-> ([Screen], Screen) -> ([Screen], Screen)
forall a. (a -> [Char]) -> a -> a
dbg1With ([Char] -> (Screen -> [Char]) -> UIState -> [Char]
showScreenStack [Char]
"initial" Screen -> [Char]
showScreenSelection (UIState -> [Char])
-> (([Screen], Screen) -> UIState) -> ([Screen], Screen) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Screen] -> Screen -> UIState) -> ([Screen], Screen) -> UIState
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry2 (UIOpts -> Journal -> [Screen] -> Screen -> UIState
uiState UIOpts
defuiopts Journal
nulljournal)) (([Screen], Screen) -> ([Screen], Screen))
-> ([Screen], Screen) -> ([Screen], Screen)
forall a b. (a -> b) -> a -> b
$
      if
        -- An accounts screen is specified. Its previous screen will be the menu screen with it selected.
        | [Char] -> RawOpts -> Bool
boolopt [Char]
"cash" RawOpts
rawopts -> ([Int -> Screen -> Screen
msSetSelectedScreen Int
csItemIndex Screen
menuscr], Screen
csacctsscr)
        | [Char] -> RawOpts -> Bool
boolopt [Char]
"bs"   RawOpts
rawopts -> ([Int -> Screen -> Screen
msSetSelectedScreen Int
bsItemIndex Screen
menuscr], Screen
bsacctsscr)
        | [Char] -> RawOpts -> Bool
boolopt [Char]
"is"   RawOpts
rawopts -> ([Int -> Screen -> Screen
msSetSelectedScreen Int
isItemIndex Screen
menuscr], Screen
isacctsscr)
        | [Char] -> RawOpts -> Bool
boolopt [Char]
"all"  RawOpts
rawopts -> ([Int -> Screen -> Screen
msSetSelectedScreen Int
asItemIndex Screen
menuscr], Screen
allacctsscr)

        -- A register screen is specified with --register=ACCT. The initial screen stack will be:
        --
        --   menu screen, with ACCTSSCR selected
        --    ACCTSSCR (the accounts screen containing ACCT), with ACCT selected
        --     register screen for ACCT
        --
        | Just [Char]
apat <- UIOpts -> Maybe [Char]
uoRegister UIOpts
uopts ->
          let
            -- the account being requested
            acct :: Text
acct = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Text
forall a. [Char] -> a
error' ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"--register "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
apat[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" did not match any account")  -- PARTIAL:
              (Maybe Text -> Text) -> ([Text] -> Maybe Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
firstMatch ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalAccountNamesDeclaredOrImplied Journal
j
              where
                firstMatch :: [Text] -> Maybe Text
firstMatch = case Text -> Either [Char] Regexp
toRegexCI (Text -> Either [Char] Regexp) -> Text -> Either [Char] Regexp
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
apat of
                    Right Regexp
re -> (Text -> Bool) -> [Text] -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Regexp -> Text -> Bool
regexMatchText Regexp
re)
                    Left  [Char]
_  -> Maybe Text -> [Text] -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing

            -- the register screen for acct
            regscr :: Screen
regscr = 
              Text -> Bool -> Screen -> Screen
rsSetAccount Text
acct Bool
False (Screen -> Screen) -> Screen -> Screen
forall a b. (a -> b) -> a -> b
$
              UIOpts -> Day -> Journal -> Text -> Bool -> Screen
rsNew UIOpts
uopts Day
today Journal
j Text
acct Bool
forceinclusive
                where
                  forceinclusive :: Bool
forceinclusive = case UIState -> Maybe Int
getDepth UIState
ui of
                                    Just Int
de -> Text -> Int
accountNameLevel Text
acct Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
de
                                    Maybe Int
Nothing -> Bool
False

            -- The accounts screen containing acct.
            -- Keep these selidx values synced with the menu items in msNew.
            (Screen
acctsscr, Int
selidx) =
              case Journal -> Text -> Maybe AccountType
journalAccountType Journal
j Text
acct of
                Just AccountType
t | AccountType -> Bool
isBalanceSheetAccountType AccountType
t    -> (Screen
bsacctsscr, Int
1)
                Just AccountType
t | AccountType -> Bool
isIncomeStatementAccountType AccountType
t -> (Screen
isacctsscr, Int
2)
                Maybe AccountType
_                                       -> (Screen
allacctsscr,Int
0)
              (Screen, Int) -> ((Screen, Int) -> (Screen, Int)) -> (Screen, Int)
forall a b. a -> (a -> b) -> b
& (Screen -> Screen) -> (Screen, Int) -> (Screen, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Screen -> Screen
asSetSelectedAccount Text
acct)

            -- the menu screen
            menuscr' :: Screen
menuscr' = Int -> Screen -> Screen
msSetSelectedScreen Int
selidx Screen
menuscr
          in ([Screen
acctsscr, Screen
menuscr'], Screen
regscr)

        -- Otherwise, start on the menu screen.
        | Bool
otherwise -> ([], Screen
menuscr)

        where
          menuscr :: Screen
menuscr     = Screen
msNew
          allacctsscr :: Screen
allacctsscr = UIOpts -> Day -> Journal -> Maybe Text -> Screen
asNew UIOpts
uopts Day
today Journal
j Maybe Text
forall a. Maybe a
Nothing
          csacctsscr :: Screen
csacctsscr  = UIOpts -> Day -> Journal -> Maybe Text -> Screen
csNew UIOpts
uopts Day
today Journal
j Maybe Text
forall a. Maybe a
Nothing
          bsacctsscr :: Screen
bsacctsscr  = UIOpts -> Day -> Journal -> Maybe Text -> Screen
bsNew UIOpts
uopts Day
today Journal
j Maybe Text
forall a. Maybe a
Nothing
          isacctsscr :: Screen
isacctsscr  = UIOpts -> Day -> Journal -> Maybe Text -> Screen
isNew UIOpts
uopts Day
today Journal
j Maybe Text
forall a. Maybe a
Nothing

    ui :: UIState
ui = UIOpts -> Journal -> [Screen] -> Screen -> UIState
uiState UIOpts
uopts Journal
j [Screen]
prevscrs Screen
currscr
    app :: App UIState AppEvent Name
app = Maybe [Char] -> App UIState AppEvent Name
brickApp (UIOpts -> Maybe [Char]
uoTheme UIOpts
uopts)

  -- print (length (show ui)) >> exitSuccess  -- show any debug output to this point & quit

  let 
    -- helper: make a Vty terminal controller with mouse support enabled
    makevty :: IO Vty
makevty = do
      v <- VtyUserConfig -> IO Vty
mkVty VtyUserConfig
forall a. Monoid a => a
mempty
      setMode (outputIface v) Mouse True
      return v

  if Bool -> Bool
not (UIOpts -> Bool
uoWatch UIOpts
uopts)
  then do
    vty <- IO Vty
makevty
    void $ customMain vty makevty Nothing app ui

  else do
    -- a channel for sending misc. events to the app
    eventChan <- IO (BChan AppEvent)
forall a. IO (BChan a)
newChan

    -- start a background thread reporting changes in the current date
    -- use async for proper child termination in GHCI
    let
      watchDate Day
old = do
        Int -> IO ()
threadDelay Int
1000000 -- 1 s
        new <- IO Day
getCurrentDay
        when (new /= old) $ do
          let dc = Day -> Day -> AppEvent
DateChange Day
old Day
new
          -- dbg1IO "datechange" dc -- XXX don't uncomment until dbg*IO fixed to use traceIO, GHC may block/end thread
          -- traceIO $ show dc
          writeChan eventChan dc
        watchDate new

    withAsync
      -- run this small task asynchronously:
      (getCurrentDay >>= watchDate)
      -- until this main task terminates:
      $ \Async (ZonkAny 0)
_async ->
      -- start one or more background threads reporting changes in the directories of our files
      -- XXX many quick successive saves causes the problems listed in BUGS
      -- with Debounce increased to 1s it easily gets stuck on an error or blank screen
      -- until you press g, but it becomes responsive again quickly.
      -- withManagerConf defaultConfig{confDebounce=Debounce 1} $ \mgr -> do
      -- with Debounce at the default 1ms it clears transient errors itself
      -- but gets tied up for ages
      (WatchManager -> IO ()) -> IO ()
forall a. (WatchManager -> IO a) -> IO a
withManager ((WatchManager -> IO ()) -> IO ())
-> (WatchManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WatchManager
mgr -> do
        files <- (([Char], Text) -> IO [Char]) -> [([Char], Text)] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> IO [Char]
canonicalizePath ([Char] -> IO [Char])
-> (([Char], Text) -> [Char]) -> ([Char], Text) -> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Text) -> [Char]
forall a b. (a, b) -> a
fst) ([([Char], Text)] -> IO [[Char]])
-> [([Char], Text)] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ Journal -> [([Char], Text)]
jfiles Journal
j
        let directories = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
nubSort ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
takeDirectory [[Char]]
files
        dbg1IO "files" files
        dbg1IO "directories to watch" directories

        forM_ directories $ \[Char]
d -> WatchManager -> [Char] -> ActionPredicate -> Action -> IO (IO ())
watchDir
          WatchManager
mgr
          [Char]
d
          -- predicate: ignore changes not involving our files
          (\case
            Modified [Char]
f UTCTime
_ EventIsDirectory
IsFile -> [Char]
f [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
files
            -- Added    f _ -> f `elem` files
            -- Removed  f _ -> f `elem` files
            -- we don't handle adding/removing journal files right now
            -- and there might be some of those events from tmp files
            -- clogging things up so let's ignore them
            Event
_ -> Bool
False
            )
          -- action: send event to app
          (\Event
fev -> do
            -- return $ dbglog "fsnotify" $ showFSNEvent fev -- not working
            [Char] -> [Char] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => [Char] -> a -> m ()
dbg1IO [Char]
"fsnotify" ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Event -> [Char]
forall a. Show a => a -> [Char]
show Event
fev
            BChan AppEvent -> AppEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeChan BChan AppEvent
eventChan AppEvent
FileChange
            )

        -- and start the app. Must be inside the withManager block. (XXX makevty too ?)
        vty <- makevty
        void $ customMain vty makevty (Just eventChan) app ui

brickApp :: Maybe String -> App UIState AppEvent Name
brickApp :: Maybe [Char] -> App UIState AppEvent Name
brickApp Maybe [Char]
mtheme = App {
    appStartEvent :: EventM Name UIState ()
appStartEvent   = () -> EventM Name UIState ()
forall a. a -> EventM Name UIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , appAttrMap :: UIState -> AttrMap
appAttrMap      = AttrMap -> UIState -> AttrMap
forall a b. a -> b -> a
const (AttrMap -> UIState -> AttrMap) -> AttrMap -> UIState -> AttrMap
forall a b. (a -> b) -> a -> b
$ AttrMap -> Maybe AttrMap -> AttrMap
forall a. a -> Maybe a -> a
fromMaybe AttrMap
defaultTheme (Maybe AttrMap -> AttrMap) -> Maybe AttrMap -> AttrMap
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe AttrMap
getTheme ([Char] -> Maybe AttrMap) -> Maybe [Char] -> Maybe AttrMap
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [Char]
mtheme
  , appChooseCursor :: UIState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = UIState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor
  , appHandleEvent :: BrickEvent Name AppEvent -> EventM Name UIState ()
appHandleEvent  = BrickEvent Name AppEvent -> EventM Name UIState ()
uiHandle
  , appDraw :: UIState -> [Widget Name]
appDraw         = UIState -> [Widget Name]
uiDraw
  }

uiHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
uiHandle :: BrickEvent Name AppEvent -> EventM Name UIState ()
uiHandle BrickEvent Name AppEvent
ev = 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]
"\n==== " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ BrickEvent Name AppEvent -> [Char]
forall a. Show a => a -> [Char]
show BrickEvent Name AppEvent
ev
  ui <- EventM Name UIState UIState
forall s (m :: * -> *). MonadState s m => m s
get
  case aScreen ui of
    MS MenuScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
msHandle BrickEvent Name AppEvent
ev
    AS AccountsScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
asHandle BrickEvent Name AppEvent
ev
    CS AccountsScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
csHandle BrickEvent Name AppEvent
ev
    BS AccountsScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
bsHandle BrickEvent Name AppEvent
ev
    IS AccountsScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
isHandle BrickEvent Name AppEvent
ev
    RS RegisterScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
rsHandle BrickEvent Name AppEvent
ev
    TS TransactionScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
tsHandle BrickEvent Name AppEvent
ev
    ES ErrorScreenState
_ -> BrickEvent Name AppEvent -> EventM Name UIState ()
esHandle BrickEvent Name AppEvent
ev

uiDraw :: UIState -> [Widget Name]
uiDraw :: UIState -> [Widget Name]
uiDraw UIState
ui =
  case UIState -> Screen
aScreen UIState
ui of
    MS MenuScreenState
_ -> UIState -> [Widget Name]
msDraw UIState
ui
    AS AccountsScreenState
_ -> UIState -> [Widget Name]
asDraw UIState
ui
    CS AccountsScreenState
_ -> UIState -> [Widget Name]
csDraw UIState
ui
    BS AccountsScreenState
_ -> UIState -> [Widget Name]
bsDraw UIState
ui
    IS AccountsScreenState
_ -> UIState -> [Widget Name]
isDraw UIState
ui
    RS RegisterScreenState
_ -> UIState -> [Widget Name]
rsDraw UIState
ui
    TS TransactionScreenState
_ -> UIState -> [Widget Name]
tsDraw UIState
ui
    ES ErrorScreenState
_ -> UIState -> [Widget Name]
esDraw UIState
ui