hledger/hledger-ui/Hledger/UI/Main.hs
Simon Michael e7aa150e52 ui: solidified register screen, added themes
- register screen:
  - smarter width-sensitive layout, with multi-commodity amounts on one line
  - items are sorted in date order
  - jumps to the latest item by default, with consistent scroll position
  - more prerendering, might speed up movement/paging slightly

- themes! --theme to select, --help to list (current themes: default, terminal, greenterm)

- border tweaks - dropped side borders, added side padding
2015-08-24 16:24:11 -07:00

89 lines
2.9 KiB
Haskell

{-|
hledger-ui - a hledger add-on providing a curses-style interface.
Copyright (c) 2007-2015 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Hledger.UI.Main where
-- import Control.Applicative
-- import Control.Lens ((^.))
import Control.Monad
-- import Control.Monad.IO.Class (liftIO)
-- import Data.Default
-- import Data.Monoid --
-- import Data.List
import Data.Maybe
-- import Data.Time.Calendar
-- import Safe
import System.Exit
import qualified Graphics.Vty as V
import Brick
import Hledger
import Hledger.Cli hiding (progname,prognameandversion,green)
import Hledger.UI.Options
import Hledger.UI.UITypes
-- import Hledger.UI.UIUtils
import Hledger.UI.Theme
import Hledger.UI.AccountsScreen as AS
-- import Hledger.UI.RegisterScreen as RS
-- import Hledger.UI.RegisterScreen2 as RS2
----------------------------------------------------------------------
main :: IO ()
main = do
opts <- getHledgerUIOpts
-- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
run opts
where
run opts
| "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp uimode) >> exitSuccess
| "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess
| "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname)
| otherwise = withJournalDo' opts runBrickUi
withJournalDo' :: UIOpts -> (UIOpts -> Journal -> IO ()) -> IO ()
withJournalDo' opts cmd = do
-- journalFilePathFromOpts (cliopts_ opts) >>= readJournalFile Nothing >>=
-- either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
-- XXX head should be safe for now
(head `fmap` journalFilePathFromOpts (cliopts_ opts)) >>= readJournalFile Nothing Nothing True >>=
either error' (cmd opts . journalApplyAliases (aliasesFromOpts $ cliopts_ opts))
runBrickUi :: UIOpts -> Journal -> IO ()
runBrickUi opts j = do
d <- getCurrentDay
let
theme = maybe defaultTheme (fromMaybe defaultTheme . getTheme) $
maybestringopt "theme" $ rawopts_ $ cliopts_ opts
args = words' $ query_ $ reportopts_ $ cliopts_ opts
scr = AS.screen
st = (sInitFn scr) d args
AppState{
aopts=opts
,aargs=args
,ajournal=j
,aScreen=scr
,aPrevScreens=[]
}
app :: App (AppState) V.Event
app = App {
appLiftVtyEvent = id
, appStartEvent = return
, appAttrMap = const theme
, appChooseCursor = showFirstCursor
, appHandleEvent = \st ev -> (sHandleFn $ aScreen st) st ev
, appDraw = \st -> (sDrawFn $ aScreen st) st
}
void $ defaultMain app st