{-|
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 ( makeAppWith )
import Hledger.Web.WebOptions  -- ( WebOpts(..), defwebopts, prognameandversion )
import Hledger.Web.Import hiding (get, j)
import Hledger.Cli hiding (prognameandversion)


-- | 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 :: [Char] -> [([Char], [Char])] -> Journal -> YesodSpec App -> IO ()
runTests [Char]
testsdesc [([Char], [Char])]
rawopts Journal
j YesodSpec App
tests = do
  WebOpts
wopts <- RawOpts -> IO WebOpts
rawOptsToWebOpts forall a b. (a -> b) -> a -> b
$ [([Char], [Char])] -> RawOpts
mkRawOpts [([Char], [Char])]
rawopts
  let yconf :: AppConfig DefaultEnv Extra
yconf = AppConfig{  -- :: AppConfig DefaultEnv Extra
          appEnv :: DefaultEnv
appEnv = DefaultEnv
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 :: HostPreference
appHost = WebOpts -> [Char]
host_ WebOpts
wopts forall a b. a -> (a -> b) -> b
& forall a. IsString a => [Char] -> a
fromString
        ,appPort :: Int
appPort = WebOpts -> Int
port_ WebOpts
wopts
        ,appRoot :: Text
appRoot = WebOpts -> [Char]
base_url_ WebOpts
wopts forall a b. a -> (a -> b) -> b
& [Char] -> Text
T.pack  -- XXX not sure this or extraStaticRoot get used
        ,appExtra :: Extra
appExtra = Extra
                    { extraCopyright :: Text
extraCopyright  = Text
""
                    , extraAnalytics :: Maybe Text
extraAnalytics  = forall a. Maybe a
Nothing
                    , extraStaticRoot :: Maybe Text
extraStaticRoot = [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebOpts -> Maybe [Char]
file_url_ WebOpts
wopts
                    }
        }
  App
app <- Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeAppWith Journal
j AppConfig DefaultEnv Extra
yconf WebOpts
wopts
  Spec -> IO ()
hspec forall a b. (a -> b) -> a -> b
$ forall site. YesodDispatch site => site -> YesodSpec site -> Spec
yesodSpec App
app forall a b. (a -> b) -> a -> b
$ forall site. [Char] -> YesodSpec site -> YesodSpec site
ydescribe [Char]
testsdesc YesodSpec App
tests    -- https://hackage.haskell.org/package/yesod-test/docs/Yesod-Test.html

-- | Run hledger-web's built-in tests using the hspec test runner.
hledgerWebTest :: IO ()
hledgerWebTest :: IO ()
hledgerWebTest = do
  [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Running tests for " forall a. [a] -> [a] -> [a]
++ [Char]
prognameandversion -- ++ " (--test --help for options)"
  let d :: Day
d = Year -> Int -> Int -> Day
fromGregorian Year
2000 Int
1 Int
1

  [Char] -> [([Char], [Char])] -> Journal -> YesodSpec App -> IO ()
runTests [Char]
"hledger-web" [] Journal
nulljournal forall a b. (a -> b) -> a -> b
$ do

    forall site. [Char] -> YesodExample site () -> YesodSpec site
yit [Char]
"serves a reasonable-looking journal page" forall a b. (a -> b) -> a -> b
$ do
      forall site url.
(Yesod site, RedirectUrl site url) =>
url -> YesodExample site ()
get Route App
JournalR
      forall site. HasCallStack => Int -> YesodExample site ()
statusIs Int
200
      forall site. HasCallStack => [Char] -> YesodExample site ()
bodyContains [Char]
"Add a transaction"

    forall site. [Char] -> YesodExample site () -> YesodSpec site
yit [Char]
"serves a reasonable-looking register page" forall a b. (a -> b) -> a -> b
$ do
      forall site url.
(Yesod site, RedirectUrl site url) =>
url -> YesodExample site ()
get Route App
RegisterR
      forall site. HasCallStack => Int -> YesodExample site ()
statusIs Int
200
      forall site. HasCallStack => [Char] -> YesodExample site ()
bodyContains [Char]
"accounts"

    forall site. [Char] -> YesodExample site () -> YesodSpec site
yit [Char]
"hyperlinks use a base url made from the default host and port" forall a b. (a -> b) -> a -> b
$ do
      forall site url.
(Yesod site, RedirectUrl site url) =>
url -> YesodExample site ()
get Route App
JournalR
      forall site. HasCallStack => Int -> YesodExample site ()
statusIs Int
200
      let defaultbaseurl :: [Char]
defaultbaseurl = [Char] -> Int -> [Char]
defbaseurl [Char]
defhost Int
defport
      forall site. HasCallStack => [Char] -> YesodExample site ()
bodyContains ([Char]
"href=\"" forall a. [a] -> [a] -> [a]
++ [Char]
defaultbaseurl)
      forall site. HasCallStack => [Char] -> YesodExample site ()
bodyContains ([Char]
"src=\"" forall a. [a] -> [a] -> [a]
++ [Char]
defaultbaseurl)

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

  let
    rawopts :: [([Char], [Char])]
rawopts = [([Char]
"forecast",[Char]
"")]
    iopts :: InputOpts
iopts = Day -> RawOpts -> InputOpts
rawOptsToInputOpts Day
d forall a b. (a -> b) -> a -> b
$ [([Char], [Char])] -> RawOpts
mkRawOpts [([Char], [Char])]
rawopts
    f :: [Char]
f = [Char]
"fake"  -- need a non-null filename so forecast transactions get index 0
  Journal
pj <- Text -> IO Journal
readJournal' ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines  -- PARTIAL: readJournal' should not fail
    [[Char]
"~ monthly"
    ,[Char]
"    assets    10"
    ,[Char]
"    income"
    ])
  Journal
j <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ InputOpts -> [Char] -> Text -> Journal -> ExceptT [Char] IO Journal
journalFinalise InputOpts
iopts [Char]
f Text
"" Journal
pj  -- PARTIAL: journalFinalise should not fail
  [Char] -> [([Char], [Char])] -> Journal -> YesodSpec App -> IO ()
runTests [Char]
"hledger-web with --forecast" [([Char], [Char])]
rawopts Journal
j forall a b. (a -> b) -> a -> b
$ do

    forall site. [Char] -> YesodExample site () -> YesodSpec site
yit [Char]
"shows forecasted transactions" forall a b. (a -> b) -> a -> b
$ do
      forall site url.
(Yesod site, RedirectUrl site url) =>
url -> YesodExample site ()
get Route App
JournalR
      forall site. HasCallStack => Int -> YesodExample site ()
statusIs Int
200
      forall site. HasCallStack => [Char] -> YesodExample site ()
bodyContains [Char]
"id=\"transaction-2-1\""
      forall site. HasCallStack => [Char] -> YesodExample site ()
bodyContains [Char]
"id=\"transaction-2-2\""

  -- #2127
  -- XXX I'm pretty sure this test lies, ie does not match production behaviour.
  -- (test with curl -s http://localhost:5000/journal | rg '(href)="[\w/].*?"' -o )
  -- App root setup is a maze of twisty passages, all alike.
  -- runTests "hledger-web with --base-url"
  --   [("base-url","https://base")] nulljournal $ do
  --   yit "hyperlinks respect --base-url" $ do
  --     get JournalR
  --     statusIs 200
  --     bodyContains "href=\"https://base"
  --     bodyContains "src=\"https://base"

  -- #2139
  -- XXX Not passing.
  -- Static root setup is a maze of twisty passages, all different.
  -- runTests "hledger-web with --base-url, --file-url"
  --   [("base-url","https://base"), ("file-url","https://files")] nulljournal $ do
  --   yit "static file hyperlinks respect --file-url, others respect --base-url" $ do
  --     get JournalR
  --     statusIs 200
  --     bodyContains "href=\"https://base"
  --     bodyContains "src=\"https://files"