diff --git a/hledger-lib/Hledger/Data/RawOptions.hs b/hledger-lib/Hledger/Data/RawOptions.hs index c2ad93c28..c375006bd 100644 --- a/hledger-lib/Hledger/Data/RawOptions.hs +++ b/hledger-lib/Hledger/Data/RawOptions.hs @@ -9,6 +9,8 @@ more easily by hledger commands/scripts in this and other packages. module Hledger.Data.RawOptions ( RawOpts, + mkRawOpts, + overRawOpts, setopt, setboolopt, unsetboolopt, @@ -24,8 +26,7 @@ module Hledger.Data.RawOptions ( posintopt, maybeintopt, maybeposintopt, - maybecharopt, - overRawOpts + maybecharopt ) where @@ -42,6 +43,10 @@ newtype RawOpts = RawOpts { unRawOpts :: [(String,String)] } instance Default RawOpts where def = RawOpts [] +mkRawOpts :: [(String,String)] -> RawOpts +mkRawOpts = RawOpts + +overRawOpts :: ([(String,String)] -> [(String,String)]) -> RawOpts -> RawOpts overRawOpts f = RawOpts . f . unRawOpts setopt :: String -> String -> RawOpts -> RawOpts diff --git a/hledger-web/Hledger/Web/Settings.hs b/hledger-web/Hledger/Web/Settings.hs index 2964862c4..a3d0a7bd4 100644 --- a/hledger-web/Hledger/Web/Settings.hs +++ b/hledger-web/Hledger/Web/Settings.hs @@ -49,7 +49,8 @@ defport = 5000 defbaseurl :: String -> Int -> String defbaseurl host port = - if ':' `elem` host then + if ':' `elem` host + then -- ipv6 address "http://[" ++ host ++ "]" ++ if port /= 80 then ":" ++ show port else "" else "http://" ++ host ++ if port /= 80 then ":" ++ show port else "" diff --git a/hledger-web/Hledger/Web/Test.hs b/hledger-web/Hledger/Web/Test.hs index f99718d3f..861390aa6 100644 --- a/hledger-web/Hledger/Web/Test.hs +++ b/hledger-web/Hledger/Web/Test.hs @@ -1,101 +1,142 @@ +{-| +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 #-} module Hledger.Web.Test ( hledgerWebTest ) where +import Data.String (fromString) +import Data.Function ((&)) import qualified Data.Text as T import Test.Hspec (hspec) import Yesod.Default.Config import Yesod.Test 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.Cli hiding (prognameandversion) -runHspecTestsWith :: AppConfig DefaultEnv Extra -> WebOpts -> Journal -> YesodSpec App -> IO () -runHspecTestsWith yesodconf hledgerwebopts j specs = do - app <- makeFoundationWith j yesodconf hledgerwebopts - hspec $ yesodSpec app specs +-- | Given a tests description, zero or more raw option name/value pairs, +-- a journal and some hspec tests, parse the options and configure the +-- web app more or less as we normally would (see details above), then run the tests. +-- +-- Raw option names are like the long flag without the --, eg "file" or "base-url". +-- +-- The journal and raw options should correspond enough to not cause problems. +-- Be cautious - without a [("file", "somepath")], perhaps journalReload could load +-- the user's default journal. +-- +runTests :: String -> [(String,String)] -> Journal -> YesodSpec App -> IO () +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 + -- https://hackage.haskell.org/package/conduit-extra/docs/Data-Conduit-Network.html#t:HostPreference + -- ,appHost = "*4" -- "any IPv4 or IPv6 hostname, IPv4 preferred" + -- ,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 + { extraCopyright = "" + , extraAnalytics = 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 --- Run hledger-web's built-in tests using the hspec test runner. +-- | Run hledger-web's built-in tests using the hspec test runner. hledgerWebTest :: IO () hledgerWebTest = do putStrLn $ "Running tests for " ++ prognameandversion -- ++ " (--test --help for options)" + let d = fromGregorian 2000 1 1 - -- loadConfig fails without ./config/settings.yml; use a hard-coded one - let conf = AppConfig{ - appEnv = Testing - ,appPort = 3000 -- will it clash with a production instance ? doesn't seem to - ,appRoot = "http://localhost:3000" - ,appHost = "*4" - ,appExtra = Extra - { extraCopyright = "" - , extraAnalytics = Nothing - , extraStaticRoot = Nothing - } - } + runTests "hledger-web" [] nulljournal $ do - -- 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)" + yit "serves a reasonable-looking journal page" $ do + get JournalR + statusIs 200 + bodyContains "Add a transaction" - -- Since these tests use makeFoundation, the startup code in Hledger.Web.Main is not tested. XXX - -- - -- 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. + yit "serves a reasonable-looking register page" $ do + get RegisterR + statusIs 200 + bodyContains "accounts" - -- basic tests - runHspecTestsWith conf defwebopts nulljournal $ do - ydescribe "hledger-web" $ do + -- WIP + -- yit "shows the add form" $ do + -- get JournalR + -- -- printBody + -- -- let addbutton = "button:contains('add')" + -- -- bodyContains addbutton + -- -- htmlAnyContain "button:visible" "add" + -- printMatches "div#addmodal:visible" + -- htmlCount "div#addmodal:visible" 0 - yit "serves a reasonable-looking journal page" $ do - get JournalR - statusIs 200 - bodyContains "Add a transaction" + -- -- clickOn "a#addformlink" + -- -- printBody + -- -- bodyContains addbutton - yit "serves a reasonable-looking register page" $ do - get RegisterR - statusIs 200 - bodyContains "accounts" - - -- WIP - -- yit "shows the add form" $ do - -- get JournalR - -- -- printBody - -- -- let addbutton = "button:contains('add')" - -- -- bodyContains addbutton - -- -- htmlAnyContain "button:visible" "add" - -- printMatches "div#addmodal:visible" - -- htmlCount "div#addmodal:visible" 0 - - -- -- clickOn "a#addformlink" - -- -- printBody - -- -- bodyContains addbutton - - -- yit "can add transactions" $ do + -- yit "can add transactions" $ do let - -- Have forecasting on for testing - iopts = definputopts{forecast_=Just nulldatespan} - copts = defcliopts{inputopts_=iopts, file_=[""]} -- non-empty, see file_ note above - wopts = defwebopts{cliopts_=copts} + rawopts = [("forecast","")] + iopts = rawOptsToInputOpts d $ mkRawOpts rawopts + f = "fake" -- need a non-null filename so forecast transactions get index 0 pj <- readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail ["~ monthly" ," assets 10" ," income" ]) - -- Have to give a non-null filename "fake" so forecast transactions get index 0 - j <- fmap (either error id) . runExceptT $ journalFinalise iopts "fake" "" pj -- PARTIAL: journalFinalise should not fail - runHspecTestsWith conf wopts j $ do - ydescribe "hledger-web --forecast" $ do + j <- fmap (either error id) . runExceptT $ journalFinalise iopts f "" pj -- PARTIAL: journalFinalise should not fail + runTests "hledger-web with --forecast" rawopts j $ do + + yit "shows forecasted transactions" $ do + get JournalR + statusIs 200 + bodyContains "id=\"transaction-2-1\"" + bodyContains "id=\"transaction-2-2\"" - yit "serves a journal page showing forecasted transactions" $ do - get JournalR - statusIs 200 - bodyContains "id=\"transaction-2-1\"" - bodyContains "id=\"transaction-2-2\""