{-# 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 = Text -> (Html -> RWST (Maybe (Env, FileEnv), HandlerSite Handler, [Text]) Enctype Ints Handler (FormResult Text, WidgetFor (HandlerSite Handler) ())) -> Html -> RWST (Maybe (Env, FileEnv), HandlerSite Handler, [Text]) Enctype Ints Handler (FormResult Text, WidgetFor (HandlerSite Handler) ()) 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" ((Html -> RWST (Maybe (Env, FileEnv), HandlerSite Handler, [Text]) Enctype Ints Handler (FormResult Text, WidgetFor (HandlerSite Handler) ())) -> Html -> RWST (Maybe (Env, FileEnv), HandlerSite Handler, [Text]) Enctype Ints Handler (FormResult Text, WidgetFor (HandlerSite Handler) ())) -> (Html -> RWST (Maybe (Env, FileEnv), HandlerSite Handler, [Text]) Enctype Ints Handler (FormResult Text, WidgetFor (HandlerSite Handler) ())) -> Html -> RWST (Maybe (Env, FileEnv), HandlerSite Handler, [Text]) Enctype Ints Handler (FormResult Text, WidgetFor (HandlerSite Handler) ()) forall a b. (a -> b) -> a -> b $ \Html extra -> do (FormResult Textarea tRes, FieldView (HandlerSite Handler) tView) <- Field Handler Textarea -> FieldSettings (HandlerSite Handler) -> Maybe Textarea -> MForm Handler (FormResult Textarea, FieldView (HandlerSite Handler)) 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 Field Handler Textarea forall (m :: * -> *). (Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m Textarea textareaField FieldSettings (HandlerSite Handler) forall {master}. FieldSettings master fs (Textarea -> Maybe Textarea forall a. a -> Maybe a Just (Text -> Textarea Textarea Text txt)) (FormResult Text, Widget) -> RWST (Maybe (Env, FileEnv), App, [Text]) Enctype Ints Handler (FormResult Text, Widget) forall a. a -> RWST (Maybe (Env, FileEnv), App, [Text]) Enctype Ints Handler a forall (f :: * -> *) a. Applicative f => a -> f a pure (Textarea -> Text unTextarea (Textarea -> Text) -> FormResult Textarea -> FormResult Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FormResult Textarea tRes, $(widgetFile "edit-form")) where fs :: FieldSettings master fs = SomeMessage master -> Maybe (SomeMessage master) -> Maybe Text -> Maybe Text -> [(Text, Text)] -> FieldSettings master forall master. SomeMessage master -> Maybe (SomeMessage master) -> Maybe Text -> Maybe Text -> [(Text, Text)] -> FieldSettings master FieldSettings SomeMessage master "text" Maybe (SomeMessage master) forall a. Maybe a forall (m :: * -> *) a. MonadPlus m => m a mzero Maybe Text forall a. Maybe a forall (m :: * -> *) a. MonadPlus m => m a mzero Maybe Text forall a. Maybe a 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 {Journal j :: Journal j :: ViewData -> Journal j} <- Handler ViewData getViewData Permission -> Handler () require Permission EditPermission (String f', Text txt) <- String -> Journal -> HandlerFor App (String, Text) forall m. String -> Journal -> HandlerFor m (String, Text) journalFile404 String f Journal j ((FormResult Text res, Widget view), Enctype enctype) <- Form Text -> HandlerFor App ((FormResult Text, Widget), 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 <- HandlerFor App Text -> FormResult Text -> HandlerFor App Text forall (m :: * -> *) a. Applicative m => m a -> FormResult a -> m a fromFormSuccess (Widget -> Enctype -> HandlerFor App Text 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 ExceptT String Handler () -> HandlerFor App (Either String ()) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (String -> Text -> ExceptT String Handler () forall (m :: * -> *). MonadHandler m => String -> Text -> ExceptT String m () writeJournalTextIfValidAndChanged String f Text newtxt) HandlerFor App (Either String ()) -> (Either String () -> Handler ()) -> Handler () forall a b. HandlerFor App a -> (a -> HandlerFor App b) -> HandlerFor App b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Left String e -> do Html -> Handler () forall (m :: * -> *). MonadHandler m => Html -> m () setMessage (Html -> Handler ()) -> Html -> Handler () forall a b. (a -> b) -> a -> b $ Html "Failed to load journal: " Html -> Html -> Html forall a. Semigroup a => a -> a -> a <> String -> Html forall a. ToMarkup a => a -> Html toHtml String e Widget -> Enctype -> Handler () forall {site} {a} {a} {c}. (Yesod site, ToMarkup a, ToWidget site a) => a -> a -> HandlerFor site c showForm Widget view Enctype enctype Right () -> do Html -> Handler () forall (m :: * -> *). MonadHandler m => Html -> m () setMessage (Html -> Handler ()) -> Html -> Handler () forall a b. (a -> b) -> a -> b $ Html "Saved journal " Html -> Html -> Html forall a. Semigroup a => a -> a -> a <> String -> Html forall a. ToMarkup a => a -> Html toHtml String f Html -> Html -> Html forall a. Semigroup a => a -> a -> a <> Html "\n" Route App -> Handler () 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 = Html -> HandlerFor site c forall (m :: * -> *) c a. (MonadHandler m, ToTypedContent c) => c -> m a sendResponse (Html -> HandlerFor site c) -> (WidgetFor site () -> HandlerFor site Html) -> WidgetFor site () -> HandlerFor site c forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< WidgetFor site () -> HandlerFor site Html forall site. Yesod site => WidgetFor site () -> HandlerFor site Html defaultLayout (WidgetFor site () -> HandlerFor site c) -> WidgetFor site () -> HandlerFor site c forall a b. (a -> b) -> a -> b $ do Html -> WidgetFor site () forall (m :: * -> *). MonadWidget m => Html -> m () setTitle Html "Edit journal" WidgetFor site () [whamlet|<form method=post enctype=#{enctype}>^{view}|]