feat: setup command, checks hledger installation (Merge branch 'sm-setup')
Not yet finished, but it's useful and usable so far.
This commit is contained in:
commit
8edef3345e
@ -92,6 +92,9 @@ module Hledger.Read (
|
|||||||
defaultJournalPath,
|
defaultJournalPath,
|
||||||
requireJournalFileExists,
|
requireJournalFileExists,
|
||||||
ensureJournalFileExists,
|
ensureJournalFileExists,
|
||||||
|
journalEnvVar,
|
||||||
|
-- journalEnvVar2,
|
||||||
|
journalDefaultFilename,
|
||||||
|
|
||||||
-- * Journal parsing
|
-- * Journal parsing
|
||||||
runExceptT,
|
runExceptT,
|
||||||
@ -110,6 +113,7 @@ module Hledger.Read (
|
|||||||
-- * Misc
|
-- * Misc
|
||||||
saveLatestDates,
|
saveLatestDates,
|
||||||
saveLatestDatesForFiles,
|
saveLatestDatesForFiles,
|
||||||
|
isWindowsUnsafeDotPath,
|
||||||
|
|
||||||
-- * Re-exported
|
-- * Re-exported
|
||||||
JournalReader.tmpostingrulep,
|
JournalReader.tmpostingrulep,
|
||||||
@ -141,7 +145,7 @@ import qualified Data.Text as T
|
|||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
import Data.Time (Day)
|
import Data.Time (Day)
|
||||||
import Safe (headDef, headMay)
|
import Safe (headDef, headMay)
|
||||||
import System.Directory (doesFileExist, getHomeDirectory)
|
import System.Directory (doesFileExist)
|
||||||
import System.Environment (getEnv)
|
import System.Environment (getEnv)
|
||||||
import System.FilePath ((<.>), (</>), splitDirectories, splitFileName, takeFileName)
|
import System.FilePath ((<.>), (</>), splitDirectories, splitFileName, takeFileName)
|
||||||
import System.Info (os)
|
import System.Info (os)
|
||||||
@ -196,7 +200,7 @@ defaultJournalPath = do
|
|||||||
`C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2
|
`C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2
|
||||||
`C.catch` (\(_::C.IOException) -> return ""))
|
`C.catch` (\(_::C.IOException) -> return ""))
|
||||||
defpath = do
|
defpath = do
|
||||||
home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "")
|
home <- fromMaybe "" <$> getHomeSafe
|
||||||
return $ home </> journalDefaultFilename
|
return $ home </> journalDefaultFilename
|
||||||
|
|
||||||
-- | A file path optionally prefixed by a reader name and colon
|
-- | A file path optionally prefixed by a reader name and colon
|
||||||
|
|||||||
@ -33,6 +33,7 @@ module Hledger.Utils.IO (
|
|||||||
getCurrentZonedTime,
|
getCurrentZonedTime,
|
||||||
|
|
||||||
-- * Files
|
-- * Files
|
||||||
|
getHomeSafe,
|
||||||
embedFileRelative,
|
embedFileRelative,
|
||||||
expandHomePath,
|
expandHomePath,
|
||||||
expandPath,
|
expandPath,
|
||||||
@ -294,6 +295,10 @@ getCurrentZonedTime = do
|
|||||||
|
|
||||||
-- Files
|
-- Files
|
||||||
|
|
||||||
|
-- | Like getHomeDirectory, but in case of IO error (home directory not found, not understood, etc.), returns "".
|
||||||
|
getHomeSafe :: IO (Maybe FilePath)
|
||||||
|
getHomeSafe = fmap Just getHomeDirectory `catch` (\(_ :: IOException) -> return Nothing)
|
||||||
|
|
||||||
-- | Expand a tilde (representing home directory) at the start of a file path.
|
-- | Expand a tilde (representing home directory) at the start of a file path.
|
||||||
-- ~username is not supported. Can raise an error.
|
-- ~username is not supported. Can raise an error.
|
||||||
expandHomePath :: FilePath -> IO FilePath
|
expandHomePath :: FilePath -> IO FilePath
|
||||||
|
|||||||
@ -271,7 +271,9 @@ main = exitOnExceptions $ withGhcDebug' $ do
|
|||||||
-- Read extra general and command-specific args/opts from the config file, if any.
|
-- Read extra general and command-specific args/opts from the config file, if any.
|
||||||
(conf, mconffile) <-
|
(conf, mconffile) <-
|
||||||
seq cliconfrawopts $ -- order debug output
|
seq cliconfrawopts $ -- order debug output
|
||||||
getConf cliconfrawopts
|
if clicmdarg=="setup" -- the setup command checks config files, but never uses one itself
|
||||||
|
then return (nullconf,Nothing)
|
||||||
|
else getConf cliconfrawopts
|
||||||
|
|
||||||
---------------------------------------------------------------
|
---------------------------------------------------------------
|
||||||
dbgIO "\n3. Identify a command name from config file or command line" ()
|
dbgIO "\n3. Identify a command name from config file or command line" ()
|
||||||
@ -421,7 +423,7 @@ main = exitOnExceptions $ withGhcDebug' $ do
|
|||||||
| manFlag -> runManForTopic "hledger" mmodecmdname
|
| manFlag -> runManForTopic "hledger" mmodecmdname
|
||||||
|
|
||||||
-- 6.5.2. builtin command which should not require or read the journal - run it
|
-- 6.5.2. builtin command which should not require or read the journal - run it
|
||||||
| cmdname `elem` ["commands","demo","help","test"] ->
|
| cmdname `elem` ["commands","demo","help","setup","test"] ->
|
||||||
cmdaction opts (ignoredjournal cmdname)
|
cmdaction opts (ignoredjournal cmdname)
|
||||||
|
|
||||||
-- 6.5.3. builtin command which should create the journal if missing - do that and run it
|
-- 6.5.3. builtin command which should create the journal if missing - do that and run it
|
||||||
|
|||||||
@ -49,6 +49,7 @@ module Hledger.Cli.Commands (
|
|||||||
,module Hledger.Cli.Commands.Register
|
,module Hledger.Cli.Commands.Register
|
||||||
,module Hledger.Cli.Commands.Rewrite
|
,module Hledger.Cli.Commands.Rewrite
|
||||||
,module Hledger.Cli.Commands.Run
|
,module Hledger.Cli.Commands.Run
|
||||||
|
,module Hledger.Cli.Commands.Setup
|
||||||
,module Hledger.Cli.Commands.Stats
|
,module Hledger.Cli.Commands.Stats
|
||||||
,module Hledger.Cli.Commands.Tags
|
,module Hledger.Cli.Commands.Tags
|
||||||
)
|
)
|
||||||
@ -99,6 +100,7 @@ import Hledger.Cli.Commands.Register
|
|||||||
import Hledger.Cli.Commands.Rewrite
|
import Hledger.Cli.Commands.Rewrite
|
||||||
import Hledger.Cli.Commands.Roi
|
import Hledger.Cli.Commands.Roi
|
||||||
import Hledger.Cli.Commands.Run
|
import Hledger.Cli.Commands.Run
|
||||||
|
import Hledger.Cli.Commands.Setup
|
||||||
import Hledger.Cli.Commands.Stats
|
import Hledger.Cli.Commands.Stats
|
||||||
import Hledger.Cli.Commands.Tags
|
import Hledger.Cli.Commands.Tags
|
||||||
import Hledger.Cli.Utils (tests_Cli_Utils)
|
import Hledger.Cli.Utils (tests_Cli_Utils)
|
||||||
@ -138,6 +140,7 @@ builtinCommands = [
|
|||||||
,(roimode , roi)
|
,(roimode , roi)
|
||||||
,(runmode , runOrReplStub)
|
,(runmode , runOrReplStub)
|
||||||
,(replmode , runOrReplStub)
|
,(replmode , runOrReplStub)
|
||||||
|
,(setupmode , setup)
|
||||||
,(statsmode , stats)
|
,(statsmode , stats)
|
||||||
,(tagsmode , tags)
|
,(tagsmode , tags)
|
||||||
,(testmode , testcmd)
|
,(testmode , testcmd)
|
||||||
@ -292,6 +295,7 @@ commandsList progversion othercmds =
|
|||||||
," diff compare an account's transactions in two journals"
|
," diff compare an account's transactions in two journals"
|
||||||
,"+git save or view journal file history simply in git" -- hledger-git
|
,"+git save or view journal file history simply in git" -- hledger-git
|
||||||
,"+pijul save or view journal file history simply in pijul" -- hledger-pijul
|
,"+pijul save or view journal file history simply in pijul" -- hledger-pijul
|
||||||
|
," setup check and show the status of the hledger installation"
|
||||||
," test run some self tests"
|
," test run some self tests"
|
||||||
,""
|
,""
|
||||||
-----------------------------------------80-------------------------------------
|
-----------------------------------------80-------------------------------------
|
||||||
|
|||||||
355
hledger/Hledger/Cli/Commands/Setup.hs
Normal file
355
hledger/Hledger/Cli/Commands/Setup.hs
Normal file
@ -0,0 +1,355 @@
|
|||||||
|
{-|
|
||||||
|
|
||||||
|
Check and show the status of the hledger installation.
|
||||||
|
|
||||||
|
-}
|
||||||
|
|
||||||
|
-- {-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
-- {-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
-- {-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
|
{-# OPTIONS_GHC -Wno-name-shadowing #-}
|
||||||
|
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
||||||
|
-- {-# OPTIONS_GHC -Wno-unused-matches #-}
|
||||||
|
|
||||||
|
module Hledger.Cli.Commands.Setup (
|
||||||
|
setupmode
|
||||||
|
,setup
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Applicative ((<|>))
|
||||||
|
import Control.Exception
|
||||||
|
import Control.Monad
|
||||||
|
import Data.Functor ((<&>))
|
||||||
|
import Data.Maybe
|
||||||
|
-- import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
|
-- import qualified Data.Text.IO as T
|
||||||
|
import Network.HTTP.Client
|
||||||
|
import Network.HTTP.Types (statusCode, hLocation)
|
||||||
|
import Network.HTTP.Req as R
|
||||||
|
import Safe
|
||||||
|
import System.Directory
|
||||||
|
import System.Exit
|
||||||
|
import System.FilePath
|
||||||
|
import System.Info
|
||||||
|
-- import System.IO
|
||||||
|
import System.Process
|
||||||
|
import Text.Megaparsec.Error (errorBundlePretty)
|
||||||
|
import Text.Printf (printf)
|
||||||
|
|
||||||
|
import Hledger
|
||||||
|
import Hledger.Cli.CliOptions
|
||||||
|
import Hledger.Cli.Conf
|
||||||
|
import System.Environment (lookupEnv)
|
||||||
|
import Data.Char
|
||||||
|
import Data.List
|
||||||
|
|
||||||
|
setupmode = hledgerCommandMode
|
||||||
|
$(embedFileRelative "Hledger/Cli/Commands/Setup.txt")
|
||||||
|
[]
|
||||||
|
[generalflagsgroup3]
|
||||||
|
[]
|
||||||
|
([], Nothing)
|
||||||
|
|
||||||
|
-- | Test and print the status of various aspects of the hledger installation.
|
||||||
|
-- Also show extra info and hints on how to fix problems.
|
||||||
|
setup :: CliOpts -> Journal -> IO ()
|
||||||
|
setup _opts@CliOpts{rawopts_=_rawopts, reportspec_=_rspec} _ignoredj = do
|
||||||
|
-- This command is not given a journal and should not use _ignoredj;
|
||||||
|
-- instead detect it ourselves when we are ready.
|
||||||
|
putStrLn "Checking your hledger setup.."
|
||||||
|
setupHledger
|
||||||
|
setupConfig
|
||||||
|
setupFiles
|
||||||
|
-- setupAccounts
|
||||||
|
-- setupCommodities
|
||||||
|
-- setupTags
|
||||||
|
putStr "\n"
|
||||||
|
|
||||||
|
-- | Print a setup test groups heading.
|
||||||
|
pgroup :: String -> IO ()
|
||||||
|
pgroup s = putStr $ bold' $ "\n" <> s <> ":\n"
|
||||||
|
|
||||||
|
-- | Print a setup test's description, formatting and padding it to a fixed width.
|
||||||
|
pdesc :: String -> IO ()
|
||||||
|
pdesc s = printf "* %-38s" s
|
||||||
|
|
||||||
|
-- yes, no, unknown
|
||||||
|
data YNU = Y | N | U deriving (Eq)
|
||||||
|
|
||||||
|
-- Show status, in red/green/yellow if supported.
|
||||||
|
instance Show YNU where
|
||||||
|
show Y = bold' (brightGreen' "yes") -- ✅ apple emojis - won't work everywhere
|
||||||
|
show N = bold' (brightRed' "no ") -- ❌
|
||||||
|
show U = bold' (brightYellow' " ? ")
|
||||||
|
|
||||||
|
-- Show status, in blue/yellow if supported.
|
||||||
|
showInfo Y = bold' (brightBlue' "yes") -- ℹ️
|
||||||
|
showInfo N = bold' (brightBlue' "no ") -- ℹ️
|
||||||
|
showInfo U = bold' (brightYellow' " ? ")
|
||||||
|
|
||||||
|
-- | Print a test's pass or fail status, as "yes" or "no" or "",
|
||||||
|
-- in green/red if supported, and the (possibly empty) provided message.
|
||||||
|
p :: YNU -> String -> IO ()
|
||||||
|
p ok msg = putStrLn $ unwords ["", show ok, "", msg]
|
||||||
|
|
||||||
|
-- | Like p, but display the status as info, in neutral blue.
|
||||||
|
i :: YNU -> String -> IO ()
|
||||||
|
i ok msg = putStrLn $ unwords ["", showInfo ok, "", msg]
|
||||||
|
|
||||||
|
|
||||||
|
setupHledger :: IO ()
|
||||||
|
setupHledger = do
|
||||||
|
pgroup "hledger"
|
||||||
|
|
||||||
|
pdesc "is in PATH ?"
|
||||||
|
pathexes <- findExecutables progname
|
||||||
|
home <- getHomeDirectory
|
||||||
|
appdata <- getXdgDirectory XdgData ""
|
||||||
|
otherexes <- flip findExecutablesInDirectories progname $
|
||||||
|
[home </> ".local/bin"
|
||||||
|
,home </> ".cabal/bin"
|
||||||
|
,home </> ".nix-profile/bin"
|
||||||
|
,"/opt/homebrew/bin"
|
||||||
|
,"/usr/local/bin"
|
||||||
|
,"/usr/bin"
|
||||||
|
]
|
||||||
|
++ [appdata </> "local/bin" | os == "mingw32"]
|
||||||
|
++ [appdata </> "cabal/bin" | os == "mingw32"]
|
||||||
|
let
|
||||||
|
ok = if null pathexes then N else Y
|
||||||
|
pathexe = quoteIfNeeded $ headDef (error' "showing nonexistent executable") pathexes
|
||||||
|
otherexe = quoteIfNeeded $ headDef (error' "showing nonexistent executable") otherexes
|
||||||
|
otherdir = takeDirectory otherexe
|
||||||
|
msg
|
||||||
|
| ok == Y = pathexe
|
||||||
|
| null otherexes = "Add " <> progname <> "'s directory to your shell's PATH."
|
||||||
|
| otherwise = unlines
|
||||||
|
["Add " <> otherdir <> " to PATH in your shell config."
|
||||||
|
," Eg on unix: echo 'export PATH=" <> otherdir <> ":$PATH' >> ~/.profile"
|
||||||
|
," and start a new shell session."
|
||||||
|
]
|
||||||
|
p ok msg
|
||||||
|
|
||||||
|
-- If hledger was found in PATH, run more checks
|
||||||
|
when (ok==Y) $ do
|
||||||
|
|
||||||
|
pdesc "runs ?"
|
||||||
|
let arg = "--version"
|
||||||
|
(exit,out,err) <- readProcessWithExitCode progname [arg] ""
|
||||||
|
let
|
||||||
|
ok = if exit == ExitSuccess then Y else N
|
||||||
|
msg = if ok==Y then "" else "'" <> progname <> " " <> arg <> "' failed: \n" <> err
|
||||||
|
p ok msg
|
||||||
|
-- save output, used below
|
||||||
|
let
|
||||||
|
versionstr = rstrip out
|
||||||
|
versionstrparts = words versionstr
|
||||||
|
|
||||||
|
-- If hledger runs, run more checks
|
||||||
|
when (ok==Y) $ do
|
||||||
|
pdesc "is a native binary ?"
|
||||||
|
let
|
||||||
|
exearch = case drop 2 versionstrparts of
|
||||||
|
w:_ -> w
|
||||||
|
_ -> error' "couldn't parse arch from --version output"
|
||||||
|
os' -- keep synced: Version.hs
|
||||||
|
| os == "darwin" = "mac"
|
||||||
|
| os == "mingw32" = "windows"
|
||||||
|
| otherwise = os
|
||||||
|
sysarch = os' <> "-" <> arch
|
||||||
|
(ok, msg)
|
||||||
|
| exearch == sysarch = (Y, versionstr)
|
||||||
|
| otherwise = (N, "installed binary is for " <> exearch <> ", system is " <> sysarch)
|
||||||
|
p ok msg
|
||||||
|
|
||||||
|
pdesc "is up to date ?"
|
||||||
|
elatestver <- getLatestHledgerVersion
|
||||||
|
let
|
||||||
|
(ok, msg) = case elatestver of
|
||||||
|
Left e -> (U, "could not read " <> latestHledgerVersionUrlStr <> " : " <> e)
|
||||||
|
Right latestver ->
|
||||||
|
case drop 1 versionstrparts of
|
||||||
|
[] -> (U, "could not parse --version output")
|
||||||
|
w:_ -> (ok, msg)
|
||||||
|
where
|
||||||
|
exever = takeWhile (`elem` ("0123456789."::String)) w
|
||||||
|
ok = if splitAtElement '.' exever >= splitAtElement '.' latestver then Y else N
|
||||||
|
msg =
|
||||||
|
if exever == latestver
|
||||||
|
then exever
|
||||||
|
else exever <> " installed, latest is " <> latestver
|
||||||
|
p ok msg
|
||||||
|
|
||||||
|
-- pdesc "eget installed ?"
|
||||||
|
|
||||||
|
setupConfig = do
|
||||||
|
pgroup "config"
|
||||||
|
|
||||||
|
pdesc "a user config file exists ? (optional)"
|
||||||
|
muf <- activeUserConfFile
|
||||||
|
let
|
||||||
|
(ok, msg) = case muf of
|
||||||
|
Just f -> (Y, f)
|
||||||
|
Nothing -> (N, "")
|
||||||
|
i ok msg
|
||||||
|
|
||||||
|
pdesc "a local config file exists ?"
|
||||||
|
mlf <- activeLocalConfFile
|
||||||
|
let
|
||||||
|
(ok, msg) = case mlf of
|
||||||
|
Just f -> (Y, f) -- <> if isJust muf then " (masking user config)" else "")
|
||||||
|
Nothing -> (N, "")
|
||||||
|
i ok msg
|
||||||
|
|
||||||
|
when (isJust muf && isJust mlf) $ do
|
||||||
|
pdesc "local config is masking user config ?"
|
||||||
|
i Y ""
|
||||||
|
|
||||||
|
let mf = mlf <|> muf
|
||||||
|
case mf of
|
||||||
|
Nothing -> return ()
|
||||||
|
Just f -> do
|
||||||
|
pdesc "config file is readable ?"
|
||||||
|
ecs <- readFile f <&> parseConf f . T.pack
|
||||||
|
case ecs of
|
||||||
|
Right _ -> p Y ""
|
||||||
|
Left e -> p N (errorBundlePretty e)
|
||||||
|
|
||||||
|
-- pdesc "common general options configured ?"
|
||||||
|
-- --pretty --ignore-assertions --infer-costs"
|
||||||
|
-- print --explicit --show-costs"
|
||||||
|
|
||||||
|
setupFiles = do
|
||||||
|
pgroup "file"
|
||||||
|
|
||||||
|
pdesc "a home directory journal file exists ?"
|
||||||
|
mh <- getHomeSafe
|
||||||
|
(ok,msg) <- case mh of
|
||||||
|
Just h -> do
|
||||||
|
let f = h </> journalDefaultFilename
|
||||||
|
e <- doesFileExist f
|
||||||
|
return (if e then Y else N, if e then f else "")
|
||||||
|
Nothing -> return (N, "")
|
||||||
|
i ok msg
|
||||||
|
|
||||||
|
pdesc "LEDGER_FILE variable is defined ?"
|
||||||
|
mf <- lookupEnv journalEnvVar
|
||||||
|
let
|
||||||
|
(ok, msg) = case mf of
|
||||||
|
Just f -> (Y, f)
|
||||||
|
Nothing -> (N, "")
|
||||||
|
i ok msg
|
||||||
|
|
||||||
|
-- case mf of
|
||||||
|
-- Nothing -> return ()
|
||||||
|
-- Just f -> do
|
||||||
|
-- pdesc "$LEDGER_FILE journal exists ?"
|
||||||
|
-- e <- doesFileExist f
|
||||||
|
-- i e "" ""
|
||||||
|
|
||||||
|
-- when (isJust mh && isJust mf) $ do
|
||||||
|
-- pdesc "$LEDGER_FILE is masking home journal ?"
|
||||||
|
-- i Y ""
|
||||||
|
|
||||||
|
pdesc "default journal file exists ?"
|
||||||
|
jfile <- defaultJournalPath
|
||||||
|
exists <- doesFileExist jfile
|
||||||
|
let (ok, msg) = (if exists then Y else N, if exists then jfile else "")
|
||||||
|
p ok msg
|
||||||
|
|
||||||
|
when exists $ do
|
||||||
|
|
||||||
|
when (os == "mingw32") $ do
|
||||||
|
pdesc "default journal file path is safe for Windows ?"
|
||||||
|
let
|
||||||
|
(ok, msg) =
|
||||||
|
-- like ensureJournalFileExists:
|
||||||
|
if isWindowsUnsafeDotPath jfile
|
||||||
|
then (N, "the file name ends with a dot, this is unsafe on Windows")
|
||||||
|
else (Y, "")
|
||||||
|
p ok msg
|
||||||
|
|
||||||
|
pdesc "default journal file is readable ?"
|
||||||
|
ej <- runExceptT $ readJournalFile definputopts jfile -- like defaultJournal
|
||||||
|
case ej of
|
||||||
|
Right _ -> p Y ""
|
||||||
|
Left e -> p N e
|
||||||
|
|
||||||
|
setupAccounts = do
|
||||||
|
pgroup "accounts"
|
||||||
|
-- pdesc "all account types declared or detected ?"
|
||||||
|
-- pdesc "\n"
|
||||||
|
-- pdesc " asset, liability, equity, revenue, expense, cash, conversion"
|
||||||
|
-- pdesc "\n"
|
||||||
|
-- pdesc "untyped accounts ?"
|
||||||
|
-- pdesc "\n"
|
||||||
|
-- pdesc "all used accounts declared ?"
|
||||||
|
-- pdesc "\n"
|
||||||
|
-- pdesc "\n"
|
||||||
|
|
||||||
|
setupCommodities = do
|
||||||
|
pgroup "commodities"
|
||||||
|
-- pdesc "all used commodities declared ?"
|
||||||
|
-- pdesc "\n"
|
||||||
|
-- pdesc "\n"
|
||||||
|
|
||||||
|
setupTags = do
|
||||||
|
pgroup "tags"
|
||||||
|
-- pdesc "all used tags declared ?"
|
||||||
|
-- pdesc "\n"
|
||||||
|
-- pdesc "\n"
|
||||||
|
|
||||||
|
(getLatestHledgerVersion, latestHledgerVersionUrlStr) =
|
||||||
|
-- (getLatestHledgerVersionFromHackage, "https://hackage.haskell.org/package/hledger/docs")
|
||||||
|
(getLatestHledgerVersionFromHledgerOrg, "https://hledger.org/install.html")
|
||||||
|
|
||||||
|
httptimeout = 10000000 -- 10s
|
||||||
|
|
||||||
|
-- | Get the current hledger release version from the internet.
|
||||||
|
-- Currently requests the latest doc page from Hackage and inspects the redirect path.
|
||||||
|
-- Should catch all normal errors, and time out after 10 seconds.
|
||||||
|
getLatestHledgerVersionFromHackage :: IO (Either String String)
|
||||||
|
getLatestHledgerVersionFromHackage = do
|
||||||
|
let url = https "hackage.haskell.org" /: "package" /: "hledger" /: "docs" /: ""
|
||||||
|
result <- try $ runReq defaultHttpConfig{httpConfigRedirectCount=0} $
|
||||||
|
req HEAD url NoReqBody bsResponse (R.responseTimeout httptimeout)
|
||||||
|
case result of
|
||||||
|
Right _ -> return $ Left "expected a redirect"
|
||||||
|
Left (VanillaHttpException (HttpExceptionRequest _ (StatusCodeException rsp _))) -> do
|
||||||
|
let status = statusCode $ responseStatus rsp
|
||||||
|
if status >= 300 && status < 400
|
||||||
|
then do
|
||||||
|
let locationHeader = lookup hLocation (responseHeaders rsp)
|
||||||
|
case fmap T.decodeUtf8 locationHeader of
|
||||||
|
Nothing -> return $ Left "no Location header"
|
||||||
|
Just location -> do
|
||||||
|
let packagename = take 1 $ drop 1 $ reverse $ T.splitOn "/" location
|
||||||
|
case packagename of
|
||||||
|
[n] -> return $ Right $ dropWhile (`notElem` ['0'..'9']) $ T.unpack n
|
||||||
|
_ -> return $ Left "could not parse Location"
|
||||||
|
else return $ Left $ "HTTP status " ++ show status
|
||||||
|
Left err -> return $ Left $ "other exception: " ++ show err
|
||||||
|
|
||||||
|
-- | Like the above, but get the version from the first number on the hledger.org Install page.
|
||||||
|
getLatestHledgerVersionFromHledgerOrg :: IO (Either String String)
|
||||||
|
getLatestHledgerVersionFromHledgerOrg = do
|
||||||
|
let url = https "hledger.org" /: "install.html"
|
||||||
|
result <- try $ runReq defaultHttpConfig $
|
||||||
|
req GET url NoReqBody bsResponse (R.responseTimeout httptimeout)
|
||||||
|
case result of
|
||||||
|
Left (e :: R.HttpException) -> return $ Left $ show e
|
||||||
|
Right rsp -> case T.decodeUtf8' $ R.responseBody rsp of
|
||||||
|
Left e -> return $ Left $ show e
|
||||||
|
Right t -> return $
|
||||||
|
if null version then Left "could not parse version" else Right version
|
||||||
|
where
|
||||||
|
-- keep synced
|
||||||
|
versionline = take 1 $ dropWhile (not . ("current hledger release" `isInfixOf`)) $ lines $ T.unpack t
|
||||||
|
version = takeWhile (`elem` ("0123456789."::[Char])) $ dropWhile (not . isDigit) $ headDef "" $ versionline
|
||||||
9
hledger/Hledger/Cli/Commands/Setup.md
Normal file
9
hledger/Hledger/Cli/Commands/Setup.md
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
## setup
|
||||||
|
|
||||||
|
Check and show the status of various aspects of the hledger installation.
|
||||||
|
|
||||||
|
```flags
|
||||||
|
Flags:
|
||||||
|
no command-specific flags
|
||||||
|
```
|
||||||
|
|
||||||
6
hledger/Hledger/Cli/Commands/Setup.txt
Normal file
6
hledger/Hledger/Cli/Commands/Setup.txt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
setup
|
||||||
|
|
||||||
|
Check and help set up various installation things.
|
||||||
|
|
||||||
|
Flags:
|
||||||
|
no command-specific flags
|
||||||
@ -70,6 +70,7 @@ _command_({{Rewrite}})
|
|||||||
|
|
||||||
_command_({{Check}})
|
_command_({{Check}})
|
||||||
_command_({{Diff}})
|
_command_({{Diff}})
|
||||||
|
_command_({{Setup}})
|
||||||
_command_({{Test}})
|
_command_({{Test}})
|
||||||
|
|
||||||
}})m4_dnl
|
}})m4_dnl
|
||||||
|
|||||||
@ -8,7 +8,14 @@ Read extra CLI arguments from a hledger config file.
|
|||||||
|
|
||||||
module Hledger.Cli.Conf (
|
module Hledger.Cli.Conf (
|
||||||
getConf
|
getConf
|
||||||
|
,nullconf
|
||||||
,confLookup
|
,confLookup
|
||||||
|
,activeConfFile
|
||||||
|
,activeLocalConfFile
|
||||||
|
,activeUserConfFile
|
||||||
|
,confFiles
|
||||||
|
,userConfFiles
|
||||||
|
,parseConf
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -19,6 +26,7 @@ import qualified Data.Map as M
|
|||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as T (pack)
|
import qualified Data.Text as T (pack)
|
||||||
|
import Safe (headMay)
|
||||||
import System.Directory (getHomeDirectory, getXdgDirectory, XdgDirectory (XdgConfig), doesFileExist, getCurrentDirectory)
|
import System.Directory (getHomeDirectory, getXdgDirectory, XdgDirectory (XdgConfig), doesFileExist, getCurrentDirectory)
|
||||||
import System.FilePath ((</>), takeDirectory)
|
import System.FilePath ((</>), takeDirectory)
|
||||||
import Text.Megaparsec
|
import Text.Megaparsec
|
||||||
@ -99,12 +107,9 @@ getConf rawopts = do
|
|||||||
NoConfFile -> return $ traceAt 1 "ignoring config files" (nullconf, Nothing)
|
NoConfFile -> return $ traceAt 1 "ignoring config files" (nullconf, Nothing)
|
||||||
SomeConfFile f -> getCurrentDirectory >>= flip expandPath f >>= readConfFile . dbg1 "using specified config file"
|
SomeConfFile f -> getCurrentDirectory >>= flip expandPath f >>= readConfFile . dbg1 "using specified config file"
|
||||||
AutoConfFile -> do
|
AutoConfFile -> do
|
||||||
defconfpaths <- defaultConfFilePaths
|
fs <- confFiles
|
||||||
conffiles <- fmap catMaybes $ forM defconfpaths $ \f -> do
|
case fs of
|
||||||
exists <- doesFileExist f
|
f:_ -> dbg8IO "found config files" fs >> dbg1IO "using nearest config file" f >> readConfFile f
|
||||||
return $ if exists then Just f else Nothing
|
|
||||||
case conffiles of
|
|
||||||
f:_ -> dbg8IO "found config files" conffiles >> dbg1IO "using nearest config file" f >> readConfFile f
|
|
||||||
[] -> return $ traceAt 1 "no config file found" (nullconf, Nothing)
|
[] -> return $ traceAt 1 "no config file found" (nullconf, Nothing)
|
||||||
|
|
||||||
-- | Read this config file and parse its contents, or raise an error.
|
-- | Read this config file and parse its contents, or raise an error.
|
||||||
@ -113,7 +118,6 @@ readConfFile f = do
|
|||||||
-- avoid GHC 9.10.1's ugly stack trace when calling readFile on a nonexistent file
|
-- avoid GHC 9.10.1's ugly stack trace when calling readFile on a nonexistent file
|
||||||
exists <- doesFileExist f
|
exists <- doesFileExist f
|
||||||
when (not exists) $ error' $ f <> " does not exist"
|
when (not exists) $ error' $ f <> " does not exist"
|
||||||
|
|
||||||
ecs <- readFile f <&> parseConf f . T.pack
|
ecs <- readFile f <&> parseConf f . T.pack
|
||||||
case ecs of
|
case ecs of
|
||||||
Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err
|
Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err
|
||||||
@ -125,17 +129,67 @@ readConfFile f = do
|
|||||||
Just f
|
Just f
|
||||||
)
|
)
|
||||||
|
|
||||||
-- | Get the possible paths for a hledger config file, depending on the current directory.
|
-- | Get the highest precedence config file, based on the current directory.
|
||||||
defaultConfFilePaths :: IO [FilePath]
|
activeConfFile :: IO (Maybe FilePath)
|
||||||
defaultConfFilePaths = do
|
activeConfFile = headMay <$> confFiles
|
||||||
ds <- confDirs
|
|
||||||
|
-- | Get the highest precedence local config file:
|
||||||
|
-- a config file in the current directory or above, that is not a user-wide config file.
|
||||||
|
activeLocalConfFile :: IO (Maybe FilePath)
|
||||||
|
activeLocalConfFile = do
|
||||||
|
ufs <- userConfFiles
|
||||||
|
mf <- headMay <$> confFiles
|
||||||
|
return $ case mf of
|
||||||
|
Just f | f `notElem` ufs -> Just f
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
-- | Get the highest precedence user-wide config file, based on the current directory.
|
||||||
|
-- (This may not be the active config file.)
|
||||||
|
activeUserConfFile :: IO (Maybe FilePath)
|
||||||
|
activeUserConfFile = headMay <$> userConfFiles
|
||||||
|
|
||||||
|
-- | Get the possibleConfFiles which exist, based on the current directory.
|
||||||
|
confFiles :: IO [FilePath]
|
||||||
|
confFiles = possibleConfFiles >>= existingFiles
|
||||||
|
|
||||||
|
-- | Get the possibleUserConfFiles which exist, based on the current directory.
|
||||||
|
userConfFiles :: IO [FilePath]
|
||||||
|
userConfFiles = possibleUserConfFiles >>= existingFiles
|
||||||
|
|
||||||
|
-- | Filter a list of paths to just the existing files.
|
||||||
|
existingFiles :: [FilePath] -> IO [FilePath]
|
||||||
|
existingFiles fs =
|
||||||
|
fmap catMaybes $ forM fs $ \f -> do
|
||||||
|
exists <- doesFileExist f
|
||||||
|
return $ if exists then Just f else Nothing
|
||||||
|
|
||||||
|
-- | Get the possible paths for a hledger config file, highest precedence first:
|
||||||
|
-- hledger.conf in the current directory,
|
||||||
|
-- hledger.conf in any parent directory,
|
||||||
|
-- .hledger.conf in the home directory,
|
||||||
|
-- or hledger.conf in the XdgConfig directory.
|
||||||
|
possibleConfFiles :: IO [FilePath]
|
||||||
|
possibleConfFiles = do
|
||||||
|
ds <- possibleConfDirs
|
||||||
home <- getHomeDirectory
|
home <- getHomeDirectory
|
||||||
return $ dbg8 "possible config file paths" $
|
return $ dbg8 "possible config file paths" $
|
||||||
flip map ds $ \d -> d </> if d==home then ".hledger.conf" else "hledger.conf"
|
flip map ds $ \d -> d </> if d==home then ".hledger.conf" else "hledger.conf"
|
||||||
|
|
||||||
-- | Get the directories to check for a hledger config file.
|
-- | Like possibleConfFiles, but consider only user-wide hledger config files:
|
||||||
confDirs :: IO [FilePath]
|
-- .hledger.conf in the home directory,
|
||||||
confDirs = do
|
-- or hledger.conf in the XdgConfig directory.
|
||||||
|
possibleUserConfFiles :: IO [FilePath]
|
||||||
|
possibleUserConfFiles = do
|
||||||
|
home <- getHomeDirectory
|
||||||
|
xdgc <- getXdgDirectory XdgConfig "hledger"
|
||||||
|
let ds = [home,xdgc]
|
||||||
|
return $ dbg8 "possible user config file paths" $
|
||||||
|
flip map ds $ \d -> d </> if d==home then ".hledger.conf" else "hledger.conf"
|
||||||
|
|
||||||
|
-- | Get the directories where a hledger config file could be, highest precedence first:
|
||||||
|
-- the current directory, any parent directory, the home directory, or the XdgConfig directory.
|
||||||
|
possibleConfDirs :: IO [FilePath]
|
||||||
|
possibleConfDirs = do
|
||||||
xdgc <- getXdgDirectory XdgConfig "hledger"
|
xdgc <- getXdgDirectory XdgConfig "hledger"
|
||||||
home <- getHomeDirectory
|
home <- getHomeDirectory
|
||||||
here <- getCurrentDirectory
|
here <- getCurrentDirectory
|
||||||
|
|||||||
@ -87,6 +87,7 @@ extra-source-files:
|
|||||||
Hledger/Cli/Commands/Repl.txt
|
Hledger/Cli/Commands/Repl.txt
|
||||||
Hledger/Cli/Commands/Roi.txt
|
Hledger/Cli/Commands/Roi.txt
|
||||||
Hledger/Cli/Commands/Run.txt
|
Hledger/Cli/Commands/Run.txt
|
||||||
|
Hledger/Cli/Commands/Setup.txt
|
||||||
Hledger/Cli/Commands/Stats.txt
|
Hledger/Cli/Commands/Stats.txt
|
||||||
Hledger/Cli/Commands/Tags.txt
|
Hledger/Cli/Commands/Tags.txt
|
||||||
Hledger/Cli/Commands/Test.txt
|
Hledger/Cli/Commands/Test.txt
|
||||||
@ -139,6 +140,7 @@ library
|
|||||||
Hledger.Cli.Commands.Rewrite
|
Hledger.Cli.Commands.Rewrite
|
||||||
Hledger.Cli.Commands.Roi
|
Hledger.Cli.Commands.Roi
|
||||||
Hledger.Cli.Commands.Run
|
Hledger.Cli.Commands.Run
|
||||||
|
Hledger.Cli.Commands.Setup
|
||||||
Hledger.Cli.Commands.Stats
|
Hledger.Cli.Commands.Stats
|
||||||
Hledger.Cli.Commands.Tags
|
Hledger.Cli.Commands.Tags
|
||||||
Hledger.Cli.CompoundBalanceCommand
|
Hledger.Cli.CompoundBalanceCommand
|
||||||
|
|||||||
@ -615,6 +615,8 @@ This is useful when using hledger in scripts, or when troubleshooting.
|
|||||||
When both `--conf` and `--no-conf` options are used, the right-most wins.
|
When both `--conf` and `--no-conf` options are used, the right-most wins.
|
||||||
|
|
||||||
To inspect the processing of config files, use `--debug` or `--debug=8`.
|
To inspect the processing of config files, use `--debug` or `--debug=8`.
|
||||||
|
Or, run the `setup` command, which will display any active config files.
|
||||||
|
(Apart from this, `setup` is not affected by config files, unlike other commands.)
|
||||||
|
|
||||||
**Warning!**
|
**Warning!**
|
||||||
|
|
||||||
@ -702,6 +704,7 @@ Here are those commands and the formats currently supported:
|
|||||||
| prices | | | | | |
|
| prices | | | | | |
|
||||||
| rewrite | | | | | |
|
| rewrite | | | | | |
|
||||||
| roi | | | | | |
|
| roi | | | | | |
|
||||||
|
| setup | | | | | |
|
||||||
| stats | | | | | |
|
| stats | | | | | |
|
||||||
| stockquotes | | | | | |
|
| stockquotes | | | | | |
|
||||||
| tags | | | | | |
|
| tags | | | | | |
|
||||||
@ -6513,6 +6516,7 @@ If you have installed more [add-on commands](../scripts.md), they also will be l
|
|||||||
|
|
||||||
- [check](#check) - check for various kinds of error in the data
|
- [check](#check) - check for various kinds of error in the data
|
||||||
- [diff](#diff) - compare account transactions in two journal files
|
- [diff](#diff) - compare account transactions in two journal files
|
||||||
|
- [setup](#setup) - check and show the status of the hledger installation
|
||||||
- [test](#test) - run self tests
|
- [test](#test) - run self tests
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -85,6 +85,7 @@ extra-source-files:
|
|||||||
- Hledger/Cli/Commands/Repl.txt
|
- Hledger/Cli/Commands/Repl.txt
|
||||||
- Hledger/Cli/Commands/Roi.txt
|
- Hledger/Cli/Commands/Roi.txt
|
||||||
- Hledger/Cli/Commands/Run.txt
|
- Hledger/Cli/Commands/Run.txt
|
||||||
|
- Hledger/Cli/Commands/Setup.txt
|
||||||
- Hledger/Cli/Commands/Stats.txt
|
- Hledger/Cli/Commands/Stats.txt
|
||||||
- Hledger/Cli/Commands/Tags.txt
|
- Hledger/Cli/Commands/Tags.txt
|
||||||
- Hledger/Cli/Commands/Test.txt
|
- Hledger/Cli/Commands/Test.txt
|
||||||
@ -196,6 +197,7 @@ library:
|
|||||||
- Hledger.Cli.Commands.Rewrite
|
- Hledger.Cli.Commands.Rewrite
|
||||||
- Hledger.Cli.Commands.Roi
|
- Hledger.Cli.Commands.Roi
|
||||||
- Hledger.Cli.Commands.Run
|
- Hledger.Cli.Commands.Run
|
||||||
|
- Hledger.Cli.Commands.Setup
|
||||||
- Hledger.Cli.Commands.Stats
|
- Hledger.Cli.Commands.Stats
|
||||||
- Hledger.Cli.Commands.Tags
|
- Hledger.Cli.Commands.Tags
|
||||||
- Hledger.Cli.CompoundBalanceCommand
|
- Hledger.Cli.CompoundBalanceCommand
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user