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.

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

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 ""

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\""