{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Web.Handler.EditR
  ( getEditR
  , postEditR
  ) where

import Control.Monad.Except (runExceptT)
import Hledger.Web.Import
import Hledger.Web.Widget.Common
       (fromFormSuccess, helplink, journalFile404, writeJournalTextIfValidAndChanged)

editForm :: FilePath -> Text -> Form Text
editForm :: String -> Text -> Form Text
editForm String
f Text
txt =
  forall (m :: * -> *) a.
Monad m =>
Text
-> (Html -> MForm m (FormResult a, WidgetFor (HandlerSite m) ()))
-> Html
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
identifyForm Text
"edit" forall a b. (a -> b) -> a -> b
$ \Html
extra -> do
    (FormResult Textarea
tRes, FieldView (HandlerSite Handler)
tView) <- forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreq forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Textarea
textareaField forall {master}. FieldSettings master
fs (forall a. a -> Maybe a
Just (Text -> Textarea
Textarea Text
txt))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Textarea -> Text
unTextarea forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormResult Textarea
tRes, $(widgetFile "edit-form"))
  where
    fs :: FieldSettings master
fs = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings SomeMessage master
"text" forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. MonadPlus m => m a
mzero [(Text
"class", Text
"form-control"), (Text
"rows", Text
"25")]

getEditR :: FilePath -> Handler ()
getEditR :: String -> Handler ()
getEditR String
f = do
  Handler ()
checkServerSideUiEnabled
  String -> Handler ()
postEditR String
f

postEditR :: FilePath -> Handler ()
postEditR :: String -> Handler ()
postEditR String
f = do
  Handler ()
checkServerSideUiEnabled
  VD {[Capability]
caps :: ViewData -> [Capability]
caps :: [Capability]
caps, Journal
j :: ViewData -> Journal
j :: Journal
j} <- Handler ViewData
getViewData
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapManage forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'manage' capability")

  (String
f', Text
txt) <- forall m. String -> Journal -> HandlerFor m (String, Text)
journalFile404 String
f Journal
j
  ((FormResult Text
res, Widget
view), Enctype
enctype) <- forall (m :: * -> *) a xml.
(RenderMessage (HandlerSite m) FormMessage, MonadResource m,
 MonadHandler m) =>
(Html -> MForm m (FormResult a, xml))
-> m ((FormResult a, xml), Enctype)
runFormPost (String -> Text -> Form Text
editForm String
f' Text
txt)
  Text
newtxt <- forall (m :: * -> *) a. Applicative m => m a -> FormResult a -> m a
fromFormSuccess (forall {site} {a} {a} {c}.
(Yesod site, ToMarkup a, ToWidget site a) =>
a -> a -> HandlerFor site c
showForm Widget
view Enctype
enctype) FormResult Text
res
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (forall (m :: * -> *).
MonadHandler m =>
String -> Text -> ExceptT String m ()
writeJournalTextIfValidAndChanged String
f Text
newtxt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
e -> do
      forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage forall a b. (a -> b) -> a -> b
$ Html
"Failed to load journal: " forall a. Semigroup a => a -> a -> a
<> forall a. ToMarkup a => a -> Html
toHtml String
e
      forall {site} {a} {a} {c}.
(Yesod site, ToMarkup a, ToWidget site a) =>
a -> a -> HandlerFor site c
showForm Widget
view Enctype
enctype
    Right () -> do
      forall (m :: * -> *). MonadHandler m => Html -> m ()
setMessage forall a b. (a -> b) -> a -> b
$ Html
"Saved journal " forall a. Semigroup a => a -> a -> a
<> forall a. ToMarkup a => a -> Html
toHtml String
f forall a. Semigroup a => a -> a -> a
<> Html
"\n"
      forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect Route App
JournalR
  where
    showForm :: a -> a -> HandlerFor site c
showForm a
view a
enctype =
      forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
c -> m a
sendResponse forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). MonadWidget m => Html -> m ()
setTitle Html
"Edit journal"
        [whamlet|<form method=post enctype=#{enctype}>^{view}|]