{-# 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, tests)


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 (Spec -> IO ()) -> Spec -> IO ()
forall a b. (a -> b) -> a -> b
$ App -> YesodSpec App -> Spec
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
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Running tests for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prognameandversion -- ++ " (--test --help for options)"

  -- loadConfig fails without ./config/settings.yml; use a hard-coded one
  let conf :: AppConfig DefaultEnv Extra
conf = AppConfig :: forall environment extra.
environment
-> Int
-> Text
-> HostPreference
-> extra
-> AppConfig environment extra
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 :: Text -> Maybe Text -> Maybe Text -> Extra
Extra
                          { extraCopyright :: Text
extraCopyright  = Text
""
                          , extraAnalytics :: Maybe Text
extraAnalytics  = Maybe Text
forall a. Maybe a
Nothing
                          , extraStaticRoot :: Maybe Text
extraStaticRoot = Maybe Text
forall a. Maybe a
Nothing
                          }
                  }

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

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

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

  -- test with forecasted transactions
  Day
d <- IO Day
getCurrentDay
  let
    ropts :: ReportOpts
ropts = ReportOpts
defreportopts{forecast_ :: Maybe DateSpan
forecast_=DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
Just DateSpan
nulldatespan}
    rspec :: ReportSpec
rspec = case Day -> ReportOpts -> Either String ReportSpec
reportOptsToSpec Day
d ReportOpts
ropts of
            Left String
e   -> String -> ReportSpec
forall a. HasCallStack => String -> a
error (String -> ReportSpec) -> String -> ReportSpec
forall a b. (a -> b) -> a -> b
$ String
"failed to set up report options for tests, shouldn't happen: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
e
            Right ReportSpec
rs -> ReportSpec
rs
    copts :: CliOpts
copts = CliOpts
defcliopts{reportspec_ :: ReportSpec
reportspec_=ReportSpec
rspec, file_ :: [String]
file_=[String
""]}  -- non-empty, see file_ note above
    wopts :: WebOpts
wopts = WebOpts
defwebopts{cliopts_ :: CliOpts
cliopts_=CliOpts
copts}
  Journal
j <- (Journal -> Journal) -> IO Journal -> IO Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CliOpts -> Journal -> Journal
journalTransform CliOpts
copts) (IO Journal -> IO Journal) -> IO Journal -> IO Journal
forall a b. (a -> b) -> a -> b
$ Text -> IO Journal
readJournal' (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines  -- PARTIAL: readJournal' should not fail
    [String
"~ monthly"
    ,String
"    assets    10"
    ,String
"    income"
    ])
  AppConfig DefaultEnv Extra
-> WebOpts -> Journal -> YesodSpec App -> IO ()
runHspecTestsWith AppConfig DefaultEnv Extra
conf WebOpts
wopts Journal
j (YesodSpec App -> IO ()) -> YesodSpec App -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> YesodSpec App -> YesodSpec App
forall site. String -> YesodSpec site -> YesodSpec site
ydescribe String
"hledger-web --forecast" (YesodSpec App -> YesodSpec App) -> YesodSpec App -> YesodSpec App
forall a b. (a -> b) -> a -> b
$ do

      String -> YesodExample App () -> YesodSpec App
forall site. String -> YesodExample site () -> YesodSpec site
yit String
"serves a journal page showing forecasted transactions" (YesodExample App () -> YesodSpec App)
-> YesodExample App () -> YesodSpec App
forall a b. (a -> b) -> a -> b
$ do
        Route App -> YesodExample App ()
forall site url.
(Yesod site, RedirectUrl site url) =>
url -> YesodExample site ()
get Route App
JournalR
        Int -> YesodExample App ()
forall site. HasCallStack => Int -> YesodExample site ()
statusIs Int
200
        String -> YesodExample App ()
forall site. HasCallStack => String -> YesodExample site ()
bodyContains String
"id=\"transaction-0-1\""  -- 0 indicates a fileless (forecasted) txn
        String -> YesodExample App ()
forall site. HasCallStack => String -> YesodExample site ()
bodyContains String
"id=\"transaction-0-2\""  -- etc.