{-|
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 Data.Text qualified 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(Added, Modified), watchDir, withManager, EventIsDirectory (IsFile))
import Brick hiding (bsDraw)
import Brick.BChan qualified 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
$ FilePath -> IO () -> IO ()
forall a. FilePath -> IO a -> IO a
withProgName FilePath
"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

  FilePath -> IO ()
forall (m :: * -> *). MonadIO m => FilePath -> m ()
dbg1MsgIO FilePath
"\n\n\n\n==== hledger-ui start"
  FilePath -> [FilePath] -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
FilePath -> a -> m ()
dbg1IO FilePath
"args" [FilePath]
progArgs
  FilePath -> Int -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
FilePath -> a -> m ()
dbg1IO FilePath
"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
_ | FilePath -> RawOpts -> Bool
boolopt FilePath
"help"    RawOpts
rawopts -> FilePath -> IO ()
runPager (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> FilePath
forall a. Mode a -> FilePath
showModeUsage Mode RawOpts
uimode FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
    Bool
_ | FilePath -> RawOpts -> Bool
boolopt FilePath
"tldr"    RawOpts
rawopts -> FilePath -> IO ()
runTldrForPage FilePath
"hledger-ui"
    Bool
_ | FilePath -> RawOpts -> Bool
boolopt FilePath
"info"    RawOpts
rawopts -> FilePath -> Maybe FilePath -> IO ()
runInfoForTopic FilePath
"hledger-ui" Maybe FilePath
forall a. Maybe a
Nothing
    Bool
_ | FilePath -> RawOpts -> Bool
boolopt FilePath
"man"     RawOpts
rawopts -> FilePath -> Maybe FilePath -> IO ()
runManForTopic  FilePath
"hledger-ui" Maybe FilePath
forall a. Maybe a
Nothing
    Bool
_ | FilePath -> RawOpts -> Bool
boolopt FilePath
"version" RawOpts
rawopts -> FilePath -> IO ()
putStrLn FilePath
prognameandversion
    -- _ | boolopt "binary-filename" rawopts -> putStrLn (binaryfilename progname)
    Bool
_                                         -> CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournal 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) -> FilePath)
-> ([Screen], Screen) -> ([Screen], Screen)
forall a. (a -> FilePath) -> a -> a
dbg1With (FilePath -> (Screen -> FilePath) -> UIState -> FilePath
showScreenStack FilePath
"initial" Screen -> FilePath
showScreenSelection (UIState -> FilePath)
-> (([Screen], Screen) -> UIState)
-> ([Screen], Screen)
-> FilePath
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.
        | FilePath -> RawOpts -> Bool
boolopt FilePath
"cash" RawOpts
rawopts -> ([Int -> Screen -> Screen
msSetSelectedScreen Int
csItemIndex Screen
menuscr], Screen
csacctsscr)
        | FilePath -> RawOpts -> Bool
boolopt FilePath
"bs"   RawOpts
rawopts -> ([Int -> Screen -> Screen
msSetSelectedScreen Int
bsItemIndex Screen
menuscr], Screen
bsacctsscr)
        | FilePath -> RawOpts -> Bool
boolopt FilePath
"is"   RawOpts
rawopts -> ([Int -> Screen -> Screen
msSetSelectedScreen Int
isItemIndex Screen
menuscr], Screen
isacctsscr)
        | FilePath -> RawOpts -> Bool
boolopt FilePath
"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 FilePath
apat <- UIOpts -> Maybe FilePath
uoRegister UIOpts
uopts ->
          let
            -- the account being requested
            acct :: Text
acct = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Text
forall a. FilePath -> a
error' (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
"--register "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
apatFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
" 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 FilePath Regexp
toRegexCI (Text -> Either FilePath Regexp) -> Text -> Either FilePath Regexp
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
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  FilePath
_  -> 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 FilePath -> App UIState AppEvent Name
brickApp (UIOpts -> Maybe FilePath
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 <- ((FilePath, Text) -> IO FilePath)
-> [(FilePath, Text)] -> IO [FilePath]
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 (FilePath -> IO FilePath
canonicalizePath (FilePath -> IO FilePath)
-> ((FilePath, Text) -> FilePath)
-> (FilePath, Text)
-> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Text) -> FilePath
forall a b. (a, b) -> a
fst) ([(FilePath, Text)] -> IO [FilePath])
-> [(FilePath, Text)] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ Journal -> [(FilePath, Text)]
jfiles Journal
j
        let directories = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubSort ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
takeDirectory [FilePath]
files
        dbg1IO "files" files
        dbg1IO "directories to watch" directories

        forM_ directories $ \FilePath
d -> WatchManager -> FilePath -> ActionPredicate -> Action -> IO (IO ())
watchDir
          WatchManager
mgr
          FilePath
d
          -- predicate: ignore changes not involving our files
          (\case
            Added FilePath
f UTCTime
_ EventIsDirectory
IsFile -> FilePath
f FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
files -- for editors which write the whole file from scratch on saves
            Modified FilePath
f UTCTime
_ EventIsDirectory
IsFile -> FilePath
f FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
files -- for editors which modify existing files in place
            -- 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
            FilePath -> FilePath -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
FilePath -> a -> m ()
dbg1IO FilePath
"fsnotify" (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Event -> FilePath
forall a. Show a => a -> FilePath
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 FilePath -> App UIState AppEvent Name
brickApp Maybe FilePath
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
$ FilePath -> Maybe AttrMap
getTheme (FilePath -> Maybe AttrMap) -> Maybe FilePath -> Maybe AttrMap
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe FilePath
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
  FilePath -> EventM Name UIState ()
forall s. FilePath -> EventM Name s ()
dbguiEv (FilePath -> EventM Name UIState ())
-> FilePath -> EventM Name UIState ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\n==== " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ BrickEvent Name AppEvent -> FilePath
forall a. Show a => a -> FilePath
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