;web: tests: refactor, add a test for --forecast (#1390)
This commit is contained in:
		
							parent
							
								
									1f94aa1628
								
							
						
					
					
						commit
						3651a5f5f4
					
				| @ -6,6 +6,7 @@ | |||||||
| module Hledger.Web.Application | module Hledger.Web.Application | ||||||
|   ( makeApplication |   ( makeApplication | ||||||
|   , makeFoundation |   , makeFoundation | ||||||
|  |   , makeFoundationWith | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
| import Data.IORef (newIORef, writeIORef) | import Data.IORef (newIORef, writeIORef) | ||||||
| @ -50,3 +51,11 @@ makeFoundation conf opts' = do | |||||||
|     s <- staticSite |     s <- staticSite | ||||||
|     jref <- newIORef nulljournal |     jref <- newIORef nulljournal | ||||||
|     return $ App conf s manager opts' jref |     return $ App conf s manager opts' jref | ||||||
|  | 
 | ||||||
|  | -- Make a Foundation with the given Journal as its state. | ||||||
|  | makeFoundationWith :: Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App | ||||||
|  | makeFoundationWith j' conf opts' = do | ||||||
|  |     manager <- newManager defaultManagerSettings | ||||||
|  |     s <- staticSite | ||||||
|  |     jref <- newIORef j' | ||||||
|  |     return $ App conf s manager opts' jref | ||||||
|  | |||||||
| @ -4,7 +4,7 @@ cabal-version: 1.12 | |||||||
| -- | -- | ||||||
| -- see: https://github.com/sol/hpack | -- see: https://github.com/sol/hpack | ||||||
| -- | -- | ||||||
| -- hash: 80d248f9e183a9f4f099aab192fd5041fe081ed554baa8ba48b8a3fc4ed777c3 | -- hash: 0c023ce93e25342762ee67e15231e3d07bff45c813ae6ad729c8b3823ab45a3e | ||||||
| 
 | 
 | ||||||
| name:           hledger-web | name:           hledger-web | ||||||
| version:        1.19.99 | version:        1.19.99 | ||||||
| @ -236,6 +236,7 @@ test-suite test | |||||||
|     , hledger-lib |     , hledger-lib | ||||||
|     , hledger-web |     , hledger-web | ||||||
|     , hspec |     , hspec | ||||||
|  |     , text | ||||||
|     , yesod |     , yesod | ||||||
|     , yesod-test |     , yesod-test | ||||||
|   if (flag(dev)) || (flag(library-only)) |   if (flag(dev)) || (flag(library-only)) | ||||||
|  | |||||||
| @ -170,5 +170,6 @@ tests: | |||||||
|     - hledger |     - hledger | ||||||
|     - hledger-web |     - hledger-web | ||||||
|     - hspec |     - hspec | ||||||
|  |     - text | ||||||
|     - yesod |     - yesod | ||||||
|     - yesod-test |     - yesod-test | ||||||
|  | |||||||
| @ -1,48 +1,44 @@ | |||||||
| {-# LANGUAGE OverloadedStrings #-} | {-# LANGUAGE OverloadedStrings #-} | ||||||
| {-# LANGUAGE NoMonomorphismRestriction #-} | {-# LANGUAGE NoMonomorphismRestriction #-} | ||||||
| {-# OPTIONS_GHC -fno-warn-orphans #-} | {-# OPTIONS_GHC -fno-warn-orphans #-} | ||||||
| 
 |  | ||||||
| module Main where |  | ||||||
| 
 |  | ||||||
| -- cabal missing-home-modules workaround from hledger-lib needed here ? | -- cabal missing-home-modules workaround from hledger-lib needed here ? | ||||||
| -- {-# LANGUAGE PackageImports #-} | -- {-# LANGUAGE PackageImports #-} | ||||||
| 
 | 
 | ||||||
|  | module Main where | ||||||
|  | 
 | ||||||
|  | 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 (makeFoundation) | import Hledger.Web | ||||||
| import Hledger.Web.Foundation | import Hledger.Web.Application | ||||||
| import Hledger.Web.Settings (parseExtra) | -- import Hledger.Web.Foundation | ||||||
| import Hledger.Web.WebOptions -- (defwebopts, cliopts_) | import Hledger.Web.Import hiding (get, j) | ||||||
| -- import Hledger.Cli.CliOptions -- (defcliopts, reportspec_) | import Hledger.Cli hiding (tests) | ||||||
| -- import Hledger  -- .Reports.ReportOptions (defreportopts, forecast_) | 
 | ||||||
|  | 
 | ||||||
|  | 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 = do | ||||||
|   conf <- Yesod.Default.Config.loadConfig $  |  | ||||||
|             (configSettings Testing){ csParseExtra = parseExtra } |  | ||||||
| 
 | 
 | ||||||
|   foundation <- makeFoundation conf defwebopts |   -- https://hackage.haskell.org/package/yesod-test-1.6.10/docs/Yesod-Test.html | ||||||
|   hspec $ yesodSpec foundation specs |   -- http://hspec.github.io/writing-specs.html | ||||||
| 
 | 
 | ||||||
|   -- run hledger-web with some forecasted transactions |   -- XXX these tests use makeFoundation, bypassing the startup code in Hledger.Web.Main | ||||||
|   -- XXX problem: these tests use makeFoundation, bypassing the journal setup in Hledger.Web.Main |  | ||||||
|   -- 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 |  | ||||||
|   -- foundationForecast <- makeFoundation conf  |  | ||||||
|   --   defwebopts{cliopts_=defcliopts{file_=["hledger-web/tests/forecast.j"], reportspec_=rspec}} |  | ||||||
|   -- hspec $ yesodSpec foundationForecast specsForecast |  | ||||||
|    |    | ||||||
| -- https://hackage.haskell.org/package/yesod-test/docs/Yesod-Test.html |   -- 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. | ||||||
| 
 | 
 | ||||||
| specs :: YesodSpec App |   conf <- Yesod.Default.Config.loadConfig $ (configSettings Testing){ csParseExtra = parseExtra } | ||||||
| specs = do | 
 | ||||||
|   ydescribe "hledger-web basic functionality" $ do |   -- basic tests | ||||||
|  |   runTestsWith 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 | ||||||
| @ -54,22 +50,26 @@ specs = do | |||||||
|         statusIs 200 |         statusIs 200 | ||||||
|         bodyContains "accounts" |         bodyContains "accounts" | ||||||
| 
 | 
 | ||||||
| -- specsForecast :: YesodSpec App |   -- test with forecasted transactions | ||||||
| -- specsForecast = do |   d <- getCurrentDay | ||||||
| --   ydescribe "hledger-web --forecast" $ do |   let | ||||||
| --     yit "serves a reasonable-looking journal page" $ do |     ropts = defreportopts{forecast_=Just nulldatespan} | ||||||
| --       get JournalR |     rspec = case reportOptsToSpec d ropts of | ||||||
| --       statusIs 200 |               Left e   -> error $ "failed to set up report options for tests, shouldn't happen: " ++ show e | ||||||
| --       bodyContains "Add a transaction" |               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. | ||||||
| 
 | 
 | ||||||
| 
 |  | ||||||
| 
 |  | ||||||
| -- post "/" $ do |  | ||||||
| --   addNonce |  | ||||||
| --   fileByLabel "Choose a file" "tests/main.hs" "text/plain" -- talk about self-reference |  | ||||||
| --   byLabel "What's on the file?" "Some Content" |  | ||||||
| -- statusIs 200 |  | ||||||
| -- htmlCount ".message" 1 |  | ||||||
| -- htmlAllContain ".message" "Some Content" |  | ||||||
| -- htmlAllContain ".message" "text/plain" |  | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user