imp!:web:tests: respect options when running tests

The hledger-web tests have been cleaned up and now allow more testing
of command line options like (though still not everything).

Note tests now run the app listening on its default host and port,
127.0.0.1 and 5000, instead of "any IPv4 or IPv6 hostname" and 3000.
This would seem to mean hledger-web tests can conflict more with
things running on port 5000, eg a normal hledger-web instance, but I
haven't been able to reproduce it.
This commit is contained in:
Simon Michael 2023-12-15 09:08:39 -10:00
parent 80ebd18d08
commit 9c56ed1104
3 changed files with 117 additions and 70 deletions

View File

@ -9,6 +9,8 @@ more easily by hledger commands/scripts in this and other packages.
module Hledger.Data.RawOptions ( module Hledger.Data.RawOptions (
RawOpts, RawOpts,
mkRawOpts,
overRawOpts,
setopt, setopt,
setboolopt, setboolopt,
unsetboolopt, unsetboolopt,
@ -24,8 +26,7 @@ module Hledger.Data.RawOptions (
posintopt, posintopt,
maybeintopt, maybeintopt,
maybeposintopt, maybeposintopt,
maybecharopt, maybecharopt
overRawOpts
) )
where where
@ -42,6 +43,10 @@ newtype RawOpts = RawOpts { unRawOpts :: [(String,String)] }
instance Default RawOpts where def = RawOpts [] instance Default RawOpts where def = RawOpts []
mkRawOpts :: [(String,String)] -> RawOpts
mkRawOpts = RawOpts
overRawOpts :: ([(String,String)] -> [(String,String)]) -> RawOpts -> RawOpts
overRawOpts f = RawOpts . f . unRawOpts overRawOpts f = RawOpts . f . unRawOpts
setopt :: String -> String -> RawOpts -> RawOpts setopt :: String -> String -> RawOpts -> RawOpts

View File

@ -49,7 +49,8 @@ defport = 5000
defbaseurl :: String -> Int -> String defbaseurl :: String -> Int -> String
defbaseurl host port = defbaseurl host port =
if ':' `elem` host then if ':' `elem` host
then -- ipv6 address
"http://[" ++ host ++ "]" ++ if port /= 80 then ":" ++ show port else "" "http://[" ++ host ++ "]" ++ if port /= 80 then ":" ++ show port else ""
else else
"http://" ++ host ++ if port /= 80 then ":" ++ show port else "" "http://" ++ host ++ if port /= 80 then ":" ++ show port else ""

View File

@ -1,57 +1,100 @@
{-|
Test suite for hledger-web.
Dev notes:
http://hspec.github.io/writing-specs.html
https://hackage.haskell.org/package/yesod-test-1.6.10/docs/Yesod-Test.html
"The best way to see an example project using yesod-test is to create a scaffolded Yesod project:
stack new projectname yesodweb/sqlite
(See https://github.com/commercialhaskell/stack-templates/wiki#yesod for the full list of Yesod templates)"
These tests don't exactly match the production code path, eg these bits are missing:
withJournalDo copts (web wopts) -- extra withJournalDo logic (journalTransform..)
...
-- query logic, more options logic
let depthlessinitialq = filterQuery (not . queryIsDepth) . _rsQuery . reportspec_ $ cliopts_ wopts
j' = filterJournalTransactions depthlessinitialq j
h = host_ wopts
p = port_ wopts
u = base_url_ wopts
staticRoot = T.pack <$> file_url_ wopts
appconfig = AppConfig{appEnv = Development
,appHost = fromString h
,appPort = p
,appRoot = T.pack u
,appExtra = Extra "" Nothing staticRoot
}
The production code path, when called in this test context, which I guess is using
yesod's dev mode, needs to read ./config/settings.yml and fails without it (loadConfig).
-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Hledger.Web.Test ( module Hledger.Web.Test (
hledgerWebTest hledgerWebTest
) where ) where
import Data.String (fromString)
import Data.Function ((&))
import qualified Data.Text as T import qualified Data.Text as T
import Test.Hspec (hspec) import Test.Hspec (hspec)
import Yesod.Default.Config import Yesod.Default.Config
import Yesod.Test import Yesod.Test
import Hledger.Web.Application ( makeFoundationWith ) import Hledger.Web.Application ( makeFoundationWith )
import Hledger.Web.WebOptions ( WebOpts(cliopts_), defwebopts, prognameandversion ) import Hledger.Web.WebOptions -- ( WebOpts(..), defwebopts, prognameandversion )
import Hledger.Web.Import hiding (get, j) import Hledger.Web.Import hiding (get, j)
import Hledger.Cli hiding (prognameandversion) import Hledger.Cli hiding (prognameandversion)
runHspecTestsWith :: AppConfig DefaultEnv Extra -> WebOpts -> Journal -> YesodSpec App -> IO () -- | Given a tests description, zero or more raw option name/value pairs,
runHspecTestsWith yesodconf hledgerwebopts j specs = do -- a journal and some hspec tests, parse the options and configure the
app <- makeFoundationWith j yesodconf hledgerwebopts -- web app more or less as we normally would (see details above), then run the tests.
hspec $ yesodSpec app specs --
-- Raw option names are like the long flag without the --, eg "file" or "base-url".
-- Run hledger-web's built-in tests using the hspec test runner. --
hledgerWebTest :: IO () -- The journal and raw options should correspond enough to not cause problems.
hledgerWebTest = do -- Be cautious - without a [("file", "somepath")], perhaps journalReload could load
putStrLn $ "Running tests for " ++ prognameandversion -- ++ " (--test --help for options)" -- the user's default journal.
--
-- loadConfig fails without ./config/settings.yml; use a hard-coded one runTests :: String -> [(String,String)] -> Journal -> YesodSpec App -> IO ()
let conf = AppConfig{ runTests testsdesc rawopts j tests = do
wopts <- rawOptsToWebOpts $ mkRawOpts rawopts
-- print $ host_ wopts
-- print $ port_ wopts
-- print $ base_url_ wopts
let yconf = AppConfig{ -- :: AppConfig DefaultEnv Extra
appEnv = Testing appEnv = Testing
,appPort = 3000 -- will it clash with a production instance ? doesn't seem to -- https://hackage.haskell.org/package/conduit-extra/docs/Data-Conduit-Network.html#t:HostPreference
,appRoot = "http://localhost:3000" -- ,appHost = "*4" -- "any IPv4 or IPv6 hostname, IPv4 preferred"
,appHost = "*4" -- ,appPort = 3000 -- force a port for tests ?
-- Test with the host and port from opts. XXX more fragile, can clash with a running instance ?
,appHost = host_ wopts & fromString
,appPort = port_ wopts
,appRoot = base_url_ wopts & T.pack
,appExtra = Extra ,appExtra = Extra
{ extraCopyright = "" { extraCopyright = ""
, extraAnalytics = Nothing , extraAnalytics = Nothing
, extraStaticRoot = Nothing , extraStaticRoot = T.pack <$> file_url_ wopts
} }
} }
app <- makeFoundationWith j yconf wopts
hspec $ yesodSpec app $ ydescribe testsdesc tests -- https://hackage.haskell.org/package/yesod-test/docs/Yesod-Test.html
-- http://hspec.github.io/writing-specs.html -- | Run hledger-web's built-in tests using the hspec test runner.
-- https://hackage.haskell.org/package/yesod-test-1.6.10/docs/Yesod-Test.html hledgerWebTest :: IO ()
-- "The best way to see an example project using yesod-test is to create a scaffolded Yesod project: hledgerWebTest = do
-- stack new projectname yesodweb/sqlite putStrLn $ "Running tests for " ++ prognameandversion -- ++ " (--test --help for options)"
-- (See https://github.com/commercialhaskell/stack-templates/wiki#yesod for the full list of Yesod templates)" let d = fromGregorian 2000 1 1
-- Since these tests use makeFoundation, the startup code in Hledger.Web.Main is not tested. XXX runTests "hledger-web" [] nulljournal $ do
--
-- Be aware that unusual combinations of opts/files here could cause problems,
-- eg if cliopts{file_} is left empty journalReload might reload the user's default journal.
-- basic tests
runHspecTestsWith conf defwebopts nulljournal $ do
ydescribe "hledger-web" $ do
yit "serves a reasonable-looking journal page" $ do yit "serves a reasonable-looking journal page" $ do
get JournalR get JournalR
@ -80,22 +123,20 @@ hledgerWebTest = do
-- yit "can add transactions" $ do -- yit "can add transactions" $ do
let let
-- Have forecasting on for testing rawopts = [("forecast","")]
iopts = definputopts{forecast_=Just nulldatespan} iopts = rawOptsToInputOpts d $ mkRawOpts rawopts
copts = defcliopts{inputopts_=iopts, file_=[""]} -- non-empty, see file_ note above f = "fake" -- need a non-null filename so forecast transactions get index 0
wopts = defwebopts{cliopts_=copts}
pj <- readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail pj <- readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail
["~ monthly" ["~ monthly"
," assets 10" ," assets 10"
," income" ," income"
]) ])
-- Have to give a non-null filename "fake" so forecast transactions get index 0 j <- fmap (either error id) . runExceptT $ journalFinalise iopts f "" pj -- PARTIAL: journalFinalise should not fail
j <- fmap (either error id) . runExceptT $ journalFinalise iopts "fake" "" pj -- PARTIAL: journalFinalise should not fail runTests "hledger-web with --forecast" rawopts j $ do
runHspecTestsWith conf wopts j $ do
ydescribe "hledger-web --forecast" $ do
yit "serves a journal page showing forecasted transactions" $ do yit "shows forecasted transactions" $ do
get JournalR get JournalR
statusIs 200 statusIs 200
bodyContains "id=\"transaction-2-1\"" bodyContains "id=\"transaction-2-1\""
bodyContains "id=\"transaction-2-2\"" bodyContains "id=\"transaction-2-2\""