{-# LANGUAGE OverloadedStrings #-}

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


runHspecTestsWith :: AppConfig DefaultEnv Extra -> WebOpts -> Journal -> YesodSpec App -> IO ()
runHspecTestsWith :: AppConfig DefaultEnv Extra
-> WebOpts -> Journal -> YesodSpec App -> IO ()
runHspecTestsWith AppConfig DefaultEnv Extra
yesodconf WebOpts
hledgerwebopts Journal
j YesodSpec App
specs = do
  App
app <- Journal -> AppConfig DefaultEnv Extra -> WebOpts -> IO App
makeFoundationWith Journal
j AppConfig DefaultEnv Extra
yesodconf WebOpts
hledgerwebopts
  Spec -> IO ()
hspec forall a b. (a -> b) -> a -> b
$ forall site. YesodDispatch site => site -> YesodSpec site -> Spec
yesodSpec App
app YesodSpec App
specs

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

  -- loadConfig fails without ./config/settings.yml; use a hard-coded one
  let conf :: AppConfig DefaultEnv Extra
conf = AppConfig{
               appEnv :: DefaultEnv
appEnv = DefaultEnv
Testing
              ,appPort :: Int
appPort = Int
3000  -- will it clash with a production instance ? doesn't seem to
              ,appRoot :: Text
appRoot = Text
"http://localhost:3000"
              ,appHost :: HostPreference
appHost = HostPreference
"*4"
              ,appExtra :: Extra
appExtra = Extra
                          { extraCopyright :: Text
extraCopyright  = Text
""
                          , extraAnalytics :: Maybe Text
extraAnalytics  = forall a. Maybe a
Nothing
                          , extraStaticRoot :: Maybe Text
extraStaticRoot = forall a. Maybe a
Nothing
                          }
                  }

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

  -- 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
  AppConfig DefaultEnv Extra
-> WebOpts -> Journal -> YesodSpec App -> IO ()
runHspecTestsWith AppConfig DefaultEnv Extra
conf WebOpts
defwebopts Journal
nulljournal forall a b. (a -> b) -> a -> b
$ do
    forall site. [Char] -> YesodSpec site -> YesodSpec site
ydescribe [Char]
"hledger-web" 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"

      -- 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
    -- Have forecasting on for testing
    iopts :: InputOpts
iopts = InputOpts
definputopts{forecast_ :: Maybe DateSpan
forecast_=forall a. a -> Maybe a
Just DateSpan
nulldatespan}
    copts :: CliOpts
copts = CliOpts
defcliopts{inputopts_ :: InputOpts
inputopts_=InputOpts
iopts, file_ :: [[Char]]
file_=[[Char]
""]}  -- non-empty, see file_ note above
    wopts :: WebOpts
wopts = WebOpts
defwebopts{cliopts_ :: CliOpts
cliopts_=CliOpts
copts}
  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"
    ])
  -- Have to give a non-null filename "fake" so forecast transactions get index 0
  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]
"fake" Text
"" Journal
pj  -- PARTIAL: journalFinalise should not fail
  AppConfig DefaultEnv Extra
-> WebOpts -> Journal -> YesodSpec App -> IO ()
runHspecTestsWith AppConfig DefaultEnv Extra
conf WebOpts
wopts Journal
j forall a b. (a -> b) -> a -> b
$ do
    forall site. [Char] -> YesodSpec site -> YesodSpec site
ydescribe [Char]
"hledger-web --forecast" forall a b. (a -> b) -> a -> b
$ do

      forall site. [Char] -> YesodExample site () -> YesodSpec site
yit [Char]
"serves a journal page showing 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\""