slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

imp: setup: get version from hledger.org, hackage is down

Browse Source
This commit is contained in:
Simon Michael 2025-04-19 16:54:45 -10:00
parent 580bc0a8f8
commit a18a4c612d
1 changed files with 29 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
hledger/Hledger/Cli/Commands/Setup.hs
View File

@ -47,6 +47,8 @@ import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Cli.Conf import Hledger.Cli.Conf
import System.Environment (lookupEnv) import System.Environment (lookupEnv)
import Data.Char
import Data.List
setupmode = hledgerCommandMode setupmode = hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Setup.txt") $(embedFileRelative "Hledger/Cli/Commands/Setup.txt")
@ -168,7 +170,7 @@ setupHledger = do
elatestver <- getLatestHledgerVersion elatestver <- getLatestHledgerVersion
let let
(ok, msg) = case elatestver of (ok, msg) = case elatestver of
Left e -> (U, "could not get " <> latestHledgerVersionUrlStr <> " : " <> e) Left e -> (U, "could not read " <> latestHledgerVersionUrlStr <> " : " <> e)
Right latestver -> Right latestver ->
case drop 1 verparts of case drop 1 verparts of
[] -> (U, "could not parse --version output") [] -> (U, "could not parse --version output")
@ -301,16 +303,20 @@ setupTags = do
-- pdesc "\n" -- pdesc "\n"
-- pdesc "\n" -- pdesc "\n"
latestHledgerVersionUrl = https "hackage.haskell.org" /: "package" /: "hledger" /: "docs" /: "" (getLatestHledgerVersion, latestHledgerVersionUrlStr) =
latestHledgerVersionUrlStr = "https://hackage.haskell.org/package/hledger/docs" -- (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. -- | Get the current hledger release version from the internet.
-- Currently requests the latest doc page from Hackage and inspects the redirect path. -- Currently requests the latest doc page from Hackage and inspects the redirect path.
-- Should catch all normal errors, and times out after 10 seconds. -- Should catch all normal errors, and time out after 10 seconds.
getLatestHledgerVersion :: IO (Either String String) getLatestHledgerVersionFromHackage :: IO (Either String String)
getLatestHledgerVersion = do getLatestHledgerVersionFromHackage = do
let url = https "hackage.haskell.org" /: "package" /: "hledger" /: "docs" /: ""
result <- try $ runReq defaultHttpConfig{httpConfigRedirectCount=0} $ result <- try $ runReq defaultHttpConfig{httpConfigRedirectCount=0} $
req HEAD latestHledgerVersionUrl NoReqBody bsResponse (R.responseTimeout 10000000) -- 10s req HEAD url NoReqBody bsResponse (R.responseTimeout httptimeout)
case result of case result of
Right _ -> return $ Left "expected a redirect" Right _ -> return $ Left "expected a redirect"
Left (VanillaHttpException (HttpExceptionRequest _ (StatusCodeException rsp _))) -> do Left (VanillaHttpException (HttpExceptionRequest _ (StatusCodeException rsp _))) -> do
@ -328,3 +334,19 @@ getLatestHledgerVersion = do
else return $ Left $ "HTTP status " ++ show status else return $ Left $ "HTTP status " ++ show status
Left err -> return $ Left $ "other exception: " ++ show err 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