web: --test [-- HSPECARGS] runs the test suite
This commit is contained in:
		
							parent
							
								
									9428df4526
								
							
						
					
					
						commit
						ee73a6aabf
					
				
							
								
								
									
										1
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitignore
									
									
									
									
										vendored
									
									
								
							| @ -70,7 +70,6 @@ old | |||||||
| !/bin/*.sh | !/bin/*.sh | ||||||
| !/bin/*.md | !/bin/*.md | ||||||
| /.latest.* | /.latest.* | ||||||
| test.hs |  | ||||||
| hledger/test/addons/hledger-* | hledger/test/addons/hledger-* | ||||||
| tools/generatejournal | tools/generatejournal | ||||||
| tools/simplebench | tools/simplebench | ||||||
|  | |||||||
| @ -1,12 +1,15 @@ | |||||||
| {-# LANGUAGE OverloadedStrings #-} |  | ||||||
| {-| | {-| | ||||||
| 
 | 
 | ||||||
| hledger-web - a hledger add-on providing a web interface. | hledger-web - a hledger add-on providing a web interface. | ||||||
| Copyright (c) 2007-2012 Simon Michael <simon@joyful.com> | Copyright (c) 2007-2020 Simon Michael <simon@joyful.com> | ||||||
| Released under GPL version 3 or later. | Released under GPL version 3 or later. | ||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
|  | {-# LANGUAGE MultiWayIf #-} | ||||||
|  | {-# LANGUAGE NamedFieldPuns #-} | ||||||
|  | {-# LANGUAGE OverloadedStrings #-} | ||||||
|  | 
 | ||||||
| module Hledger.Web.Main where | module Hledger.Web.Main where | ||||||
| 
 | 
 | ||||||
| import Control.Exception (bracket) | import Control.Exception (bracket) | ||||||
| @ -19,6 +22,7 @@ import Network.Wai.Handler.Warp (runSettings, runSettingsSocket, defaultSettings | |||||||
| import Network.Wai.Handler.Launch (runHostPortFullUrl) | import Network.Wai.Handler.Launch (runHostPortFullUrl) | ||||||
| import Prelude hiding (putStrLn) | import Prelude hiding (putStrLn) | ||||||
| import System.Directory (removeFile) | import System.Directory (removeFile) | ||||||
|  | import System.Environment ( getArgs, withArgs ) | ||||||
| import System.Exit (exitSuccess, exitFailure) | import System.Exit (exitSuccess, exitFailure) | ||||||
| import System.IO (hFlush, stdout) | import System.IO (hFlush, stdout) | ||||||
| import System.PosixCompat.Files (getFileStatus, isSocket) | import System.PosixCompat.Files (getFileStatus, isSocket) | ||||||
| @ -31,15 +35,10 @@ import Hledger.Cli hiding (progname,prognameandversion) | |||||||
| import Hledger.Utils.UTF8IOCompat (putStrLn) | import Hledger.Utils.UTF8IOCompat (putStrLn) | ||||||
| import Hledger.Web.Application (makeApplication) | import Hledger.Web.Application (makeApplication) | ||||||
| import Hledger.Web.Settings (Extra(..), parseExtra) | import Hledger.Web.Settings (Extra(..), parseExtra) | ||||||
|  | import Hledger.Web.Test (hledgerWebTest) | ||||||
| import Hledger.Web.WebOptions | import Hledger.Web.WebOptions | ||||||
| 
 | 
 | ||||||
| 
 | -- Run in fast reloading mode for yesod devel. | ||||||
| hledgerWebMain :: IO () |  | ||||||
| hledgerWebMain = do |  | ||||||
|   opts <- getHledgerWebOpts |  | ||||||
|   when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts) |  | ||||||
|   runWith opts |  | ||||||
| 
 |  | ||||||
| hledgerWebDev :: IO (Int, Application) | hledgerWebDev :: IO (Int, Application) | ||||||
| hledgerWebDev = | hledgerWebDev = | ||||||
|   withJournalDo (cliopts_ defwebopts) (defaultDevelApp loader . makeApplication defwebopts) |   withJournalDo (cliopts_ defwebopts) (defaultDevelApp loader . makeApplication defwebopts) | ||||||
| @ -48,14 +47,21 @@ hledgerWebDev = | |||||||
|       Yesod.Default.Config.loadConfig |       Yesod.Default.Config.loadConfig | ||||||
|         (configSettings Development) {csParseExtra = parseExtra} |         (configSettings Development) {csParseExtra = parseExtra} | ||||||
| 
 | 
 | ||||||
| runWith :: WebOpts -> IO () | -- Run normally. | ||||||
| runWith opts | hledgerWebMain :: IO () | ||||||
|   | "help"            `inRawOpts` rawopts_ (cliopts_ opts) = putStr (showModeUsage webmode) >> exitSuccess | hledgerWebMain = do | ||||||
|   | "version"         `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn prognameandversion >> exitSuccess |   wopts@WebOpts{cliopts_=copts@CliOpts{debug_, rawopts_}} <- getHledgerWebOpts | ||||||
|   | "binary-filename" `inRawOpts` rawopts_ (cliopts_ opts) = putStrLn (binaryfilename progname) |   when (debug_ > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show wopts) | ||||||
|   | otherwise = withJournalDo (cliopts_ opts) (web opts) |   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 :: WebOpts -> Journal -> IO () | ||||||
| web opts j = do | web opts j = do | ||||||
|   let initq = rsQuery . reportspec_ $ cliopts_ opts |   let initq = rsQuery . reportspec_ $ cliopts_ opts | ||||||
|  | |||||||
							
								
								
									
										72
									
								
								hledger-web/Hledger/Web/Test.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										72
									
								
								hledger-web/Hledger/Web/Test.hs
									
									
									
									
									
										Normal file
									
								
							| @ -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. | ||||||
|  | 
 | ||||||
| @ -1,5 +1,6 @@ | |||||||
| {-# LANGUAGE CPP #-} | {-# LANGUAGE CPP #-} | ||||||
| {-# LANGUAGE OverloadedStrings #-} | {-# LANGUAGE OverloadedStrings #-} | ||||||
|  | 
 | ||||||
| module Hledger.Web.WebOptions where | module Hledger.Web.WebOptions where | ||||||
| 
 | 
 | ||||||
| import Data.ByteString (ByteString) | import Data.ByteString (ByteString) | ||||||
| @ -78,6 +79,10 @@ webflags = | |||||||
|       (\s opts -> Right $ setopt "capabilities-header" s opts) |       (\s opts -> Right $ setopt "capabilities-header" s opts) | ||||||
|       "HTTPHEADER" |       "HTTPHEADER" | ||||||
|       "read capabilities to enable from a HTTP header, like X-Sandstorm-Permissions (default: disabled)" |       "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 | webmode :: Mode RawOpts | ||||||
|  | |||||||
| @ -4,7 +4,7 @@ cabal-version: 1.12 | |||||||
| -- | -- | ||||||
| -- see: https://github.com/sol/hpack | -- see: https://github.com/sol/hpack | ||||||
| -- | -- | ||||||
| -- hash: 0c023ce93e25342762ee67e15231e3d07bff45c813ae6ad729c8b3823ab45a3e | -- hash: 08ced666fbf9ade30534a40547c91f9787478e157c9aa55c401e83aca852803e | ||||||
| 
 | 
 | ||||||
| name:           hledger-web | name:           hledger-web | ||||||
| version:        1.19.99 | version:        1.19.99 | ||||||
| @ -143,6 +143,7 @@ library | |||||||
|       Hledger.Web.Main |       Hledger.Web.Main | ||||||
|       Hledger.Web.Settings |       Hledger.Web.Settings | ||||||
|       Hledger.Web.Settings.StaticFiles |       Hledger.Web.Settings.StaticFiles | ||||||
|  |       Hledger.Web.Test | ||||||
|       Hledger.Web.WebOptions |       Hledger.Web.WebOptions | ||||||
|       Hledger.Web.Widget.AddForm |       Hledger.Web.Widget.AddForm | ||||||
|       Hledger.Web.Widget.Common |       Hledger.Web.Widget.Common | ||||||
| @ -172,6 +173,7 @@ library | |||||||
|     , hjsmin |     , hjsmin | ||||||
|     , hledger >=1.19.99 && <1.20 |     , hledger >=1.19.99 && <1.20 | ||||||
|     , hledger-lib >=1.19.99 && <1.20 |     , hledger-lib >=1.19.99 && <1.20 | ||||||
|  |     , hspec | ||||||
|     , http-client |     , http-client | ||||||
|     , http-conduit |     , http-conduit | ||||||
|     , http-types |     , http-types | ||||||
| @ -196,6 +198,7 @@ library | |||||||
|     , yesod-core >=1.4 && <1.7 |     , yesod-core >=1.4 && <1.7 | ||||||
|     , yesod-form >=1.4 && <1.7 |     , yesod-form >=1.4 && <1.7 | ||||||
|     , yesod-static >=1.4 && <1.7 |     , yesod-static >=1.4 && <1.7 | ||||||
|  |     , yesod-test | ||||||
|   if (flag(dev)) || (flag(library-only)) |   if (flag(dev)) || (flag(library-only)) | ||||||
|     cpp-options: -DDEVELOPMENT |     cpp-options: -DDEVELOPMENT | ||||||
|   if flag(dev) |   if flag(dev) | ||||||
|  | |||||||
| @ -91,6 +91,9 @@ serve them from another server for efficiency, you would set the url with this. | |||||||
| `--capabilities-header=HTTPHEADER` | `--capabilities-header=HTTPHEADER` | ||||||
| : read capabilities to enable from a HTTP header, like X-Sandstorm-Permissions (default: disabled) | : 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: | hledger input options: | ||||||
| 
 | 
 | ||||||
| _inputoptions_ | _inputoptions_ | ||||||
|  | |||||||
| @ -96,6 +96,7 @@ library: | |||||||
|   - Hledger.Web.Main |   - Hledger.Web.Main | ||||||
|   - Hledger.Web.Settings |   - Hledger.Web.Settings | ||||||
|   - Hledger.Web.Settings.StaticFiles |   - Hledger.Web.Settings.StaticFiles | ||||||
|  |   - Hledger.Web.Test | ||||||
|   - Hledger.Web.WebOptions |   - Hledger.Web.WebOptions | ||||||
|   - Hledger.Web.Widget.AddForm |   - Hledger.Web.Widget.AddForm | ||||||
|   - Hledger.Web.Widget.Common |   - Hledger.Web.Widget.Common | ||||||
| @ -143,6 +144,8 @@ library: | |||||||
|   - yesod-core   >=1.4 && < 1.7 |   - yesod-core   >=1.4 && < 1.7 | ||||||
|   - yesod-form   >=1.4 && < 1.7 |   - yesod-form   >=1.4 && < 1.7 | ||||||
|   - yesod-static >=1.4 && < 1.7 |   - yesod-static >=1.4 && < 1.7 | ||||||
|  |   - hspec | ||||||
|  |   - yesod-test | ||||||
| 
 | 
 | ||||||
| executables: | executables: | ||||||
|   hledger-web: |   hledger-web: | ||||||
|  | |||||||
| @ -1,75 +1,8 @@ | |||||||
| {-# LANGUAGE OverloadedStrings #-} | -- hledger-web package test suite. Also runnable via hledger-web --test. | ||||||
| {-# LANGUAGE NoMonomorphismRestriction #-} |  | ||||||
| {-# OPTIONS_GHC -fno-warn-orphans #-} |  | ||||||
| -- cabal missing-home-modules workaround from hledger-lib needed here ? |  | ||||||
| -- {-# LANGUAGE PackageImports #-} |  | ||||||
| 
 | 
 | ||||||
| module Main where | module Main where | ||||||
| 
 | 
 | ||||||
| import qualified Data.Text as T | import Hledger.Web.Test (hledgerWebTest) | ||||||
| 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 |  | ||||||
| 
 | 
 | ||||||
| main :: IO () | main :: IO () | ||||||
| main = do | main = hledgerWebTest | ||||||
| 
 |  | ||||||
|   -- 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. |  | ||||||
| 
 |  | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user