{-# LANGUAGE CPP #-}
module Hledger.UI.UIOptions
where
import Data.Default (def)
import Data.List (intercalate)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Lens.Micro (set)
import System.Environment (getArgs)
import Hledger.Cli hiding (packageversion, progname, prognameandversion)
import Hledger.UI.Theme (themes, themeNames)
packageversion :: PackageVersion
packageversion :: PackageVersion
packageversion =
#ifdef VERSION
VERSION
#else
""
#endif
progname :: ProgramName
progname :: PackageVersion
progname = PackageVersion
"hledger-ui"
prognameandversion :: VersionString
prognameandversion :: PackageVersion
prognameandversion = PackageVersion -> PackageVersion -> PackageVersion
versionString PackageVersion
progname PackageVersion
packageversion
uiflags :: [Flag RawOpts]
uiflags = [
[PackageVersion]
-> (RawOpts -> RawOpts) -> PackageVersion -> Flag RawOpts
forall a. [PackageVersion] -> (a -> a) -> PackageVersion -> Flag a
flagNone [PackageVersion
"watch",PackageVersion
"w"] (PackageVersion -> RawOpts -> RawOpts
setboolopt PackageVersion
"watch") PackageVersion
"watch for data and date changes and reload automatically"
,[PackageVersion]
-> Update RawOpts
-> PackageVersion
-> PackageVersion
-> Flag RawOpts
forall a.
[PackageVersion]
-> Update a -> PackageVersion -> PackageVersion -> Flag a
flagReq [PackageVersion
"theme"] (\PackageVersion
s RawOpts
opts -> RawOpts -> Either PackageVersion RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either PackageVersion RawOpts)
-> RawOpts -> Either PackageVersion RawOpts
forall a b. (a -> b) -> a -> b
$ PackageVersion -> PackageVersion -> RawOpts -> RawOpts
setopt PackageVersion
"theme" PackageVersion
s RawOpts
opts) PackageVersion
"THEME" (PackageVersion
"use this custom display theme ("PackageVersion -> PackageVersion -> PackageVersion
forall a. [a] -> [a] -> [a]
++PackageVersion -> [PackageVersion] -> PackageVersion
forall a. [a] -> [[a]] -> [a]
intercalate PackageVersion
", " [PackageVersion]
themeNamesPackageVersion -> PackageVersion -> PackageVersion
forall a. [a] -> [a] -> [a]
++PackageVersion
")")
,[PackageVersion]
-> (RawOpts -> RawOpts) -> PackageVersion -> Flag RawOpts
forall a. [PackageVersion] -> (a -> a) -> PackageVersion -> Flag a
flagNone [PackageVersion
"cash"] (PackageVersion -> RawOpts -> RawOpts
setboolopt PackageVersion
"cash") PackageVersion
"start in the cash accounts screen"
,[PackageVersion]
-> (RawOpts -> RawOpts) -> PackageVersion -> Flag RawOpts
forall a. [PackageVersion] -> (a -> a) -> PackageVersion -> Flag a
flagNone [PackageVersion
"bs"] (PackageVersion -> RawOpts -> RawOpts
setboolopt PackageVersion
"bs") PackageVersion
"start in the balance sheet accounts screen"
,[PackageVersion]
-> (RawOpts -> RawOpts) -> PackageVersion -> Flag RawOpts
forall a. [PackageVersion] -> (a -> a) -> PackageVersion -> Flag a
flagNone [PackageVersion
"is"] (PackageVersion -> RawOpts -> RawOpts
setboolopt PackageVersion
"is") PackageVersion
"start in the income statement accounts screen"
,[PackageVersion]
-> (RawOpts -> RawOpts) -> PackageVersion -> Flag RawOpts
forall a. [PackageVersion] -> (a -> a) -> PackageVersion -> Flag a
flagNone [PackageVersion
"all"] (PackageVersion -> RawOpts -> RawOpts
setboolopt PackageVersion
"all") PackageVersion
"start in the all accounts screen"
,[PackageVersion]
-> Update RawOpts
-> PackageVersion
-> PackageVersion
-> Flag RawOpts
forall a.
[PackageVersion]
-> Update a -> PackageVersion -> PackageVersion -> Flag a
flagReq [PackageVersion
"register"] (\PackageVersion
s RawOpts
opts -> RawOpts -> Either PackageVersion RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either PackageVersion RawOpts)
-> RawOpts -> Either PackageVersion RawOpts
forall a b. (a -> b) -> a -> b
$ PackageVersion -> PackageVersion -> RawOpts -> RawOpts
setopt PackageVersion
"register" PackageVersion
s RawOpts
opts) PackageVersion
"ACCTREGEX" PackageVersion
"start in the (first matched) account's register"
,[PackageVersion]
-> (RawOpts -> RawOpts) -> PackageVersion -> Flag RawOpts
forall a. [PackageVersion] -> (a -> a) -> PackageVersion -> Flag a
flagNone [PackageVersion
"change"] (PackageVersion -> RawOpts -> RawOpts
setboolopt PackageVersion
"change")
PackageVersion
"show period balances (changes) at startup instead of historical balances"
]
[Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ Bool -> [Flag RawOpts]
flattreeflags Bool
False
uimode :: Mode RawOpts
uimode = (PackageVersion
-> RawOpts
-> PackageVersion
-> Arg RawOpts
-> [Flag RawOpts]
-> Mode RawOpts
forall a.
PackageVersion
-> a -> PackageVersion -> Arg a -> [Flag a] -> Mode a
mode PackageVersion
"hledger-ui" (PackageVersion -> PackageVersion -> RawOpts -> RawOpts
setopt PackageVersion
"command" PackageVersion
"ui" RawOpts
forall a. Default a => a
def)
PackageVersion
"browse accounts, postings and entries in a full-window TUI"
(PackageVersion -> Arg RawOpts
argsFlag PackageVersion
"[--cash|--bs|--is|--all|--register=ACCT] [QUERY]") []){
modeGroupFlags = Group {
groupUnnamed = uiflags
,groupHidden = hiddenflags
++
[flagNone ["future"] (setboolopt "forecast") "old flag, use --forecast instead"
,flagNone ["menu"] (setboolopt "menu") "old flag, menu screen is now the default"
]
,groupNamed = [(generalflagsgroup1)]
}
,modeHelpSuffix=[
]
}
data UIOpts = UIOpts
{ UIOpts -> Bool
uoWatch :: Bool
, UIOpts -> Maybe PackageVersion
uoTheme :: Maybe String
, UIOpts -> Maybe PackageVersion
uoRegister :: Maybe String
, UIOpts -> CliOpts
uoCliOpts :: CliOpts
} deriving (Int -> UIOpts -> PackageVersion -> PackageVersion
[UIOpts] -> PackageVersion -> PackageVersion
UIOpts -> PackageVersion
(Int -> UIOpts -> PackageVersion -> PackageVersion)
-> (UIOpts -> PackageVersion)
-> ([UIOpts] -> PackageVersion -> PackageVersion)
-> Show UIOpts
forall a.
(Int -> a -> PackageVersion -> PackageVersion)
-> (a -> PackageVersion)
-> ([a] -> PackageVersion -> PackageVersion)
-> Show a
$cshowsPrec :: Int -> UIOpts -> PackageVersion -> PackageVersion
showsPrec :: Int -> UIOpts -> PackageVersion -> PackageVersion
$cshow :: UIOpts -> PackageVersion
show :: UIOpts -> PackageVersion
$cshowList :: [UIOpts] -> PackageVersion -> PackageVersion
showList :: [UIOpts] -> PackageVersion -> PackageVersion
Show)
defuiopts :: UIOpts
defuiopts = UIOpts
{ uoWatch :: Bool
uoWatch = Bool
False
, uoTheme :: Maybe PackageVersion
uoTheme = Maybe PackageVersion
forall a. Maybe a
Nothing
, uoRegister :: Maybe PackageVersion
uoRegister = Maybe PackageVersion
forall a. Maybe a
Nothing
, uoCliOpts :: CliOpts
uoCliOpts = CliOpts
defcliopts
}
rawOptsToUIOpts :: RawOpts -> IO UIOpts
rawOptsToUIOpts :: RawOpts -> IO UIOpts
rawOptsToUIOpts RawOpts
rawopts = do
CliOpts
cliopts <- ASetter CliOpts CliOpts BalanceAccumulation BalanceAccumulation
-> BalanceAccumulation -> CliOpts -> CliOpts
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter CliOpts CliOpts BalanceAccumulation BalanceAccumulation
forall c. HasReportOptsNoUpdate c => Lens' c BalanceAccumulation
Lens' CliOpts BalanceAccumulation
balanceaccum BalanceAccumulation
accum (CliOpts -> CliOpts) -> IO CliOpts -> IO CliOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts
UIOpts -> IO UIOpts
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UIOpts
defuiopts {
uoWatch = boolopt "watch" rawopts
,uoTheme = checkTheme <$> maybestringopt "theme" rawopts
,uoRegister = maybestringopt "register" rawopts
,uoCliOpts = cliopts
}
where
accum :: BalanceAccumulation
accum = BalanceAccumulation
-> Maybe BalanceAccumulation -> BalanceAccumulation
forall a. a -> Maybe a -> a
fromMaybe BalanceAccumulation
Historical (Maybe BalanceAccumulation -> BalanceAccumulation)
-> Maybe BalanceAccumulation -> BalanceAccumulation
forall a b. (a -> b) -> a -> b
$ RawOpts -> Maybe BalanceAccumulation
balanceAccumulationOverride RawOpts
rawopts
checkTheme :: PackageVersion -> PackageVersion
checkTheme PackageVersion
t = if PackageVersion
t PackageVersion -> Map PackageVersion AttrMap -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map PackageVersion AttrMap
themes then PackageVersion
t else PackageVersion -> PackageVersion
forall a. PackageVersion -> a
usageError (PackageVersion -> PackageVersion)
-> PackageVersion -> PackageVersion
forall a b. (a -> b) -> a -> b
$ PackageVersion
"invalid theme name: " PackageVersion -> PackageVersion -> PackageVersion
forall a. [a] -> [a] -> [a]
++ PackageVersion
t
getHledgerUIOpts :: IO UIOpts
getHledgerUIOpts :: IO UIOpts
getHledgerUIOpts = do
[PackageVersion]
args <- IO [PackageVersion]
getArgs IO [PackageVersion]
-> ([PackageVersion] -> IO [PackageVersion]) -> IO [PackageVersion]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [PackageVersion] -> IO [PackageVersion]
expandArgsAt
let args' :: [PackageVersion]
args' = [PackageVersion] -> [PackageVersion]
replaceNumericFlags ([PackageVersion] -> [PackageVersion])
-> [PackageVersion] -> [PackageVersion]
forall a b. (a -> b) -> a -> b
$ [PackageVersion] -> [PackageVersion]
forall {t :: * -> *}.
(Eq (t Char), IsString (t Char), Foldable t) =>
[t Char] -> [t Char]
ensureDebugHasArg [PackageVersion]
args
let cmdargopts :: RawOpts
cmdargopts = (PackageVersion -> RawOpts)
-> (RawOpts -> RawOpts) -> Either PackageVersion RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PackageVersion -> RawOpts
forall a. PackageVersion -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either PackageVersion RawOpts -> RawOpts)
-> Either PackageVersion RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [PackageVersion] -> Either PackageVersion RawOpts
forall a. Mode a -> [PackageVersion] -> Either PackageVersion a
process Mode RawOpts
uimode [PackageVersion]
args'
RawOpts -> IO UIOpts
rawOptsToUIOpts RawOpts
cmdargopts
instance HasCliOpts UIOpts where
cliOpts :: Lens' UIOpts CliOpts
cliOpts CliOpts -> f CliOpts
f UIOpts
uiopts = (\CliOpts
x -> UIOpts
uiopts{uoCliOpts=x}) (CliOpts -> UIOpts) -> f CliOpts -> f UIOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> f CliOpts
f (UIOpts -> CliOpts
uoCliOpts UIOpts
uiopts)
instance HasInputOpts UIOpts where
inputOpts :: Lens' UIOpts InputOpts
inputOpts = (CliOpts -> f CliOpts) -> UIOpts -> f UIOpts
forall c. HasCliOpts c => Lens' c CliOpts
Lens' UIOpts CliOpts
cliOpts((CliOpts -> f CliOpts) -> UIOpts -> f UIOpts)
-> ((InputOpts -> f InputOpts) -> CliOpts -> f CliOpts)
-> (InputOpts -> f InputOpts)
-> UIOpts
-> f UIOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(InputOpts -> f InputOpts) -> CliOpts -> f CliOpts
forall c. HasInputOpts c => Lens' c InputOpts
Lens' CliOpts InputOpts
inputOpts
instance HasBalancingOpts UIOpts where
balancingOpts :: Lens' UIOpts BalancingOpts
balancingOpts = (CliOpts -> f CliOpts) -> UIOpts -> f UIOpts
forall c. HasCliOpts c => Lens' c CliOpts
Lens' UIOpts CliOpts
cliOpts((CliOpts -> f CliOpts) -> UIOpts -> f UIOpts)
-> ((BalancingOpts -> f BalancingOpts) -> CliOpts -> f CliOpts)
-> (BalancingOpts -> f BalancingOpts)
-> UIOpts
-> f UIOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BalancingOpts -> f BalancingOpts) -> CliOpts -> f CliOpts
forall c. HasBalancingOpts c => Lens' c BalancingOpts
Lens' CliOpts BalancingOpts
balancingOpts
instance HasReportSpec UIOpts where
reportSpec :: Lens' UIOpts ReportSpec
reportSpec = (CliOpts -> f CliOpts) -> UIOpts -> f UIOpts
forall c. HasCliOpts c => Lens' c CliOpts
Lens' UIOpts CliOpts
cliOpts((CliOpts -> f CliOpts) -> UIOpts -> f UIOpts)
-> ((ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts)
-> (ReportSpec -> f ReportSpec)
-> UIOpts
-> f UIOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
forall c. HasReportSpec c => Lens' c ReportSpec
Lens' CliOpts ReportSpec
reportSpec
instance HasReportOptsNoUpdate UIOpts where
reportOptsNoUpdate :: Lens' UIOpts ReportOpts
reportOptsNoUpdate = (CliOpts -> f CliOpts) -> UIOpts -> f UIOpts
forall c. HasCliOpts c => Lens' c CliOpts
Lens' UIOpts CliOpts
cliOpts((CliOpts -> f CliOpts) -> UIOpts -> f UIOpts)
-> ((ReportOpts -> f ReportOpts) -> CliOpts -> f CliOpts)
-> (ReportOpts -> f ReportOpts)
-> UIOpts
-> f UIOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ReportOpts -> f ReportOpts) -> CliOpts -> f CliOpts
forall c. HasReportOptsNoUpdate c => Lens' c ReportOpts
Lens' CliOpts ReportOpts
reportOptsNoUpdate
instance HasReportOpts UIOpts where
reportOpts :: ReportableLens' UIOpts ReportOpts
reportOpts = (CliOpts -> f CliOpts) -> UIOpts -> f UIOpts
forall c. HasCliOpts c => Lens' c CliOpts
Lens' UIOpts CliOpts
cliOpts((CliOpts -> f CliOpts) -> UIOpts -> f UIOpts)
-> ((ReportOpts -> f ReportOpts) -> CliOpts -> f CliOpts)
-> (ReportOpts -> f ReportOpts)
-> UIOpts
-> f UIOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ReportOpts -> f ReportOpts) -> CliOpts -> f CliOpts
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' CliOpts ReportOpts
reportOpts