From ee73a6aabfbb8ba1e4f902a8acef64f61c457576 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 16 Nov 2020 13:58:48 -0800 Subject: [PATCH] web: --test [-- HSPECARGS] runs the test suite --- .gitignore | 1 - hledger-web/Hledger/Web/Main.hs | 38 ++++++++------ hledger-web/Hledger/Web/Test.hs | 72 ++++++++++++++++++++++++++ hledger-web/Hledger/Web/WebOptions.hs | 5 ++ hledger-web/hledger-web.cabal | 5 +- hledger-web/hledger-web.m4.md | 3 ++ hledger-web/package.yaml | 3 ++ hledger-web/test/test.hs | 73 ++------------------------- 8 files changed, 112 insertions(+), 88 deletions(-) create mode 100644 hledger-web/Hledger/Web/Test.hs diff --git a/.gitignore b/.gitignore index 2ffe01aa5..6df86314c 100644 --- a/.gitignore +++ b/.gitignore @@ -70,7 +70,6 @@ old !/bin/*.sh !/bin/*.md /.latest.* -test.hs hledger/test/addons/hledger-* tools/generatejournal tools/simplebench diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 771ad9a53..c87901900 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -1,12 +1,15 @@ -{-# LANGUAGE OverloadedStrings #-} {-| hledger-web - a hledger add-on providing a web interface. -Copyright (c) 2007-2012 Simon Michael +Copyright (c) 2007-2020 Simon Michael Released under GPL version 3 or later. -} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + module Hledger.Web.Main where import Control.Exception (bracket) @@ -19,6 +22,7 @@ import Network.Wai.Handler.Warp (runSettings, runSettingsSocket, defaultSettings import Network.Wai.Handler.Launch (runHostPortFullUrl) import Prelude hiding (putStrLn) import System.Directory (removeFile) +import System.Environment ( getArgs, withArgs ) import System.Exit (exitSuccess, exitFailure) import System.IO (hFlush, stdout) import System.PosixCompat.Files (getFileStatus, isSocket) @@ -31,15 +35,10 @@ import Hledger.Cli hiding (progname,prognameandversion) import Hledger.Utils.UTF8IOCompat (putStrLn) import Hledger.Web.Application (makeApplication) import Hledger.Web.Settings (Extra(..), parseExtra) +import Hledger.Web.Test (hledgerWebTest) import Hledger.Web.WebOptions - -hledgerWebMain :: IO () -hledgerWebMain = do - opts <- getHledgerWebOpts - when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts) - runWith opts - +-- Run in fast reloading mode for yesod devel. hledgerWebDev :: IO (Int, Application) hledgerWebDev = withJournalDo (cliopts_ defwebopts) (defaultDevelApp loader . makeApplication defwebopts) @@ -48,14 +47,21 @@ hledgerWebDev = Yesod.Default.Config.loadConfig (configSettings Development) {csParseExtra = parseExtra} -runWith :: WebOpts -> IO () -runWith opts - | "help" `inRawOpts` rawopts_ (cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess - | "version" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn prognameandversion >> exitSuccess - | "binary-filename" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn (binaryfilename progname) - | otherwise = withJournalDo (cliopts_ opts) (web opts) +-- Run normally. +hledgerWebMain :: IO () +hledgerWebMain = do + wopts@WebOpts{cliopts_=copts@CliOpts{debug_, rawopts_}} <- getHledgerWebOpts + when (debug_ > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show wopts) + if + | "help" `inRawOpts` rawopts_ -> putStr (showModeUsage webmode) >> exitSuccess + | "version" `inRawOpts` rawopts_ -> putStrLn prognameandversion >> exitSuccess + | "binary-filename" `inRawOpts` rawopts_ -> putStrLn (binaryfilename progname) + | "test" `inRawOpts` rawopts_ -> do + -- remove --test and --, leaving other args for hspec + filter (not . (`elem` ["--test","--"])) <$> getArgs >>= flip withArgs hledgerWebTest + | otherwise -> withJournalDo copts (web wopts) --- | The web command. +-- | The hledger web command. web :: WebOpts -> Journal -> IO () web opts j = do let initq = rsQuery . reportspec_ $ cliopts_ opts diff --git a/hledger-web/Hledger/Web/Test.hs b/hledger-web/Hledger/Web/Test.hs new file mode 100644 index 000000000..efbe87473 --- /dev/null +++ b/hledger-web/Hledger/Web/Test.hs @@ -0,0 +1,72 @@ +module Hledger.Web.Test ( + hledgerWebTest +) where + +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 ) +import Hledger.Web.Import hiding (get, j) +import Hledger.Cli hiding (tests) + + +runHspecTestsWith :: AppConfig DefaultEnv Extra -> WebOpts -> Journal -> YesodSpec App -> IO () +runHspecTestsWith yesodconf hledgerwebopts j specs = do + app <- makeFoundationWith j yesodconf hledgerwebopts + hspec $ yesodSpec app specs + +-- 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)" + + conf <- Yesod.Default.Config.loadConfig $ (configSettings Testing){ csParseExtra = parseExtra } + + -- https://hackage.haskell.org/package/yesod-test-1.6.10/docs/Yesod-Test.html + -- http://hspec.github.io/writing-specs.html + -- + -- 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. + + -- basic tests + runHspecTestsWith conf defwebopts nulljournal $ do + ydescribe "hledger-web" $ do + + yit "serves a reasonable-looking journal page" $ do + get JournalR + statusIs 200 + bodyContains "Add a transaction" + + yit "serves a reasonable-looking register page" $ do + get RegisterR + statusIs 200 + bodyContains "accounts" + + -- test with forecasted transactions + d <- getCurrentDay + let + ropts = defreportopts{forecast_=Just nulldatespan} + rspec = case reportOptsToSpec d ropts of + Left e -> error $ "failed to set up report options for tests, shouldn't happen: " ++ show e + Right rs -> rs + copts = defcliopts{reportspec_=rspec, file_=[""]} -- non-empty, see file_ note above + wopts = defwebopts{cliopts_=copts} + j <- fmap (journalTransform copts) $ readJournal' (T.pack $ unlines -- PARTIAL: readJournal' should not fail + ["~ monthly" + ," assets 10" + ," income" + ]) + runHspecTestsWith conf wopts j $ do + ydescribe "hledger-web --forecast" $ do + + yit "serves a journal page showing forecasted transactions" $ do + get JournalR + statusIs 200 + bodyContains "id=\"transaction-0-1\"" -- 0 indicates a fileless (forecasted) txn + bodyContains "id=\"transaction-0-2\"" -- etc. + diff --git a/hledger-web/Hledger/Web/WebOptions.hs b/hledger-web/Hledger/Web/WebOptions.hs index 2825ded2b..2376668f0 100644 --- a/hledger-web/Hledger/Web/WebOptions.hs +++ b/hledger-web/Hledger/Web/WebOptions.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} + module Hledger.Web.WebOptions where import Data.ByteString (ByteString) @@ -78,6 +79,10 @@ webflags = (\s opts -> Right $ setopt "capabilities-header" s opts) "HTTPHEADER" "read capabilities to enable from a HTTP header, like X-Sandstorm-Permissions (default: disabled)" + , flagNone + ["test"] + (setboolopt "test") + "run hledger-web's tests and exit. hspec test runner args may follow a --, eg: hledger-web --test -- --help" ] webmode :: Mode RawOpts diff --git a/hledger-web/hledger-web.cabal b/hledger-web/hledger-web.cabal index 1581dcd53..6100e0120 100644 --- a/hledger-web/hledger-web.cabal +++ b/hledger-web/hledger-web.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0c023ce93e25342762ee67e15231e3d07bff45c813ae6ad729c8b3823ab45a3e +-- hash: 08ced666fbf9ade30534a40547c91f9787478e157c9aa55c401e83aca852803e name: hledger-web version: 1.19.99 @@ -143,6 +143,7 @@ library Hledger.Web.Main Hledger.Web.Settings Hledger.Web.Settings.StaticFiles + Hledger.Web.Test Hledger.Web.WebOptions Hledger.Web.Widget.AddForm Hledger.Web.Widget.Common @@ -172,6 +173,7 @@ library , hjsmin , hledger >=1.19.99 && <1.20 , hledger-lib >=1.19.99 && <1.20 + , hspec , http-client , http-conduit , http-types @@ -196,6 +198,7 @@ library , yesod-core >=1.4 && <1.7 , yesod-form >=1.4 && <1.7 , yesod-static >=1.4 && <1.7 + , yesod-test if (flag(dev)) || (flag(library-only)) cpp-options: -DDEVELOPMENT if flag(dev) diff --git a/hledger-web/hledger-web.m4.md b/hledger-web/hledger-web.m4.md index f770c645c..8ef6ce739 100644 --- a/hledger-web/hledger-web.m4.md +++ b/hledger-web/hledger-web.m4.md @@ -91,6 +91,9 @@ serve them from another server for efficiency, you would set the url with this. `--capabilities-header=HTTPHEADER` : read capabilities to enable from a HTTP header, like X-Sandstorm-Permissions (default: disabled) +`--test` +: run hledger-web's tests and exit. hspec test runner args may follow a --, eg: hledger-web --test -- --help + hledger input options: _inputoptions_ diff --git a/hledger-web/package.yaml b/hledger-web/package.yaml index 541c96f08..b4b445516 100644 --- a/hledger-web/package.yaml +++ b/hledger-web/package.yaml @@ -96,6 +96,7 @@ library: - Hledger.Web.Main - Hledger.Web.Settings - Hledger.Web.Settings.StaticFiles + - Hledger.Web.Test - Hledger.Web.WebOptions - Hledger.Web.Widget.AddForm - Hledger.Web.Widget.Common @@ -143,6 +144,8 @@ library: - yesod-core >=1.4 && < 1.7 - yesod-form >=1.4 && < 1.7 - yesod-static >=1.4 && < 1.7 + - hspec + - yesod-test executables: hledger-web: diff --git a/hledger-web/test/test.hs b/hledger-web/test/test.hs index 6b5118d37..4c039099b 100644 --- a/hledger-web/test/test.hs +++ b/hledger-web/test/test.hs @@ -1,75 +1,8 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} --- cabal missing-home-modules workaround from hledger-lib needed here ? --- {-# LANGUAGE PackageImports #-} +-- hledger-web package test suite. Also runnable via hledger-web --test. module Main where -import qualified Data.Text as T -import Test.Hspec (hspec) -import Yesod.Default.Config -import Yesod.Test - -import Hledger.Web -import Hledger.Web.Application --- import Hledger.Web.Foundation -import Hledger.Web.Import hiding (get, j) -import Hledger.Cli hiding (tests) - - -runTestsWith :: AppConfig DefaultEnv Extra -> WebOpts -> Journal -> YesodSpec App -> IO () -runTestsWith yesodconf hledgerwebopts j specs = do - app <- makeFoundationWith j yesodconf hledgerwebopts - hspec $ yesodSpec app specs +import Hledger.Web.Test (hledgerWebTest) main :: IO () -main = do - - -- https://hackage.haskell.org/package/yesod-test-1.6.10/docs/Yesod-Test.html - -- http://hspec.github.io/writing-specs.html - - -- XXX these tests use makeFoundation, bypassing the startup code in Hledger.Web.Main - - -- Be careful about the opts/files provided here, unusual combinations might cause problems. - -- Eg journalReload can reload the user's default journal if cliopts{file_} is left empty. - - conf <- Yesod.Default.Config.loadConfig $ (configSettings Testing){ csParseExtra = parseExtra } - - -- basic tests - runTestsWith conf defwebopts nulljournal $ do - ydescribe "hledger-web" $ do - - yit "serves a reasonable-looking journal page" $ do - get JournalR - statusIs 200 - bodyContains "Add a transaction" - - yit "serves a reasonable-looking register page" $ do - get RegisterR - statusIs 200 - bodyContains "accounts" - - -- test with forecasted transactions - d <- getCurrentDay - let - ropts = defreportopts{forecast_=Just nulldatespan} - rspec = case reportOptsToSpec d ropts of - Left e -> error $ "failed to set up report options for tests, shouldn't happen: " ++ show e - Right rs -> rs - copts = defcliopts{reportspec_=rspec, file_=[""]} -- non-empty, see file_ note above - wopts = defwebopts{cliopts_=copts} - j <- fmap (journalTransform copts) $ readJournal' (T.unlines -- PARTIAL: readJournal' should not fail - ["~ monthly" - ," assets 10" - ," income" - ]) - runTestsWith conf wopts j $ do - ydescribe "hledger-web --forecast" $ do - - yit "serves a journal page showing forecasted transactions" $ do - get JournalR - statusIs 200 - bodyContains "id=\"transaction-0-1\"" -- 0 indicates a fileless (forecasted) txn - bodyContains "id=\"transaction-0-2\"" -- etc. - +main = hledgerWebTest