{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Hledger.Web.Handler.AddR
  ( getAddR
  , postAddR
  , putAddR
  ) where

import Data.Aeson.Types (Result(..))
import qualified Data.Text as T
import Network.HTTP.Types.Status (status400)
import Text.Blaze.Html (preEscapedToHtml)
import Yesod

import Hledger
import Hledger.Cli.Commands.Add (appendToJournalFileOrStdout, journalAddTransaction)
import Hledger.Web.Import
import Hledger.Web.WebOptions (WebOpts(..))
import Hledger.Web.Widget.AddForm (addForm)

getAddR :: Handler ()
getAddR = do
  checkServerSideUiEnabled
  postAddR

postAddR :: Handler ()
postAddR = do
  checkServerSideUiEnabled
  VD{caps, j, today} <- getViewData
  when (CapAdd `notElem` caps) (permissionDenied "Ei oikeutta lisätä kirjauksia ('add')")

  ((res, view), enctype) <- runFormPost $ addForm j today
  case res of
    FormSuccess (t,f) -> do
      let t' = txnTieKnot t
      liftIO $ do
        ensureJournalFileExists f
        appendToJournalFileOrStdout f (showTransaction t')
      setMessage "Kirjaus lisätty."
      redirect JournalR
    FormMissing -> showForm view enctype
    FormFailure errs -> do
      mapM_ (setMessage . preEscapedToHtml . T.replace "\n" "<br>") errs
      showForm view enctype
  where
    showForm view enctype =
      sendResponse =<< defaultLayout [whamlet|
        <h2>Uusi kirjaus
        <div .row style="margin-top:1em">
          <form#addform.form.col-xs-12.col-sm-11 method=post enctype=#{enctype}>
            ^{view}
      |]

-- Add a single new transaction, send as JSON via PUT, to the journal.
-- The web form handler above should probably use PUT as well.
putAddR :: Handler RepJson
putAddR = do
  VD{caps, j, opts} <- getViewData
  when (CapAdd `notElem` caps) (permissionDenied "Ei oikeutta lisätä kirjauksia ('add')")

  (r :: Result Transaction) <- parseCheckJsonBody
  case r of
    Error err -> sendStatusJSON status400 ("could not parse json: " ++ err ::String)
    Success t -> do
      void $ liftIO $ journalAddTransaction j (cliopts_ opts) t
      sendResponseCreated TransactionsR