diff --git a/Application/Helper/Controller.hs b/Application/Helper/Controller.hs index 15c8399..12162bf 100644 --- a/Application/Helper/Controller.hs +++ b/Application/Helper/Controller.hs @@ -41,4 +41,16 @@ rsaPrivateKey = (getAppConfig @Config.RsaKeys).privateKey rsaSignatureMatches :: (?context :: ControllerContext) => Text -> Text -> Bool rsaSignatureMatches original signature = case Base64.decode $ cs signature of Left msg -> False - Right decodedSignature -> RSA.PKCS15.verify (Just Hash.Algorithms.SHA256) rsaPublicKey (cs original) decodedSignature \ No newline at end of file + Right decodedSignature -> RSA.PKCS15.verify (Just Hash.Algorithms.SHA256) rsaPublicKey (cs original) decodedSignature + +setFormStatus :: (?context :: ControllerContext) => FormStatus -> IO () +setFormStatus formStatus = setSession "formStatus" (show formStatus) + +-- | Get the form status from the session and clear it. +getAndClearFormStatus :: (?context :: ControllerContext) => IO FormStatus +getAndClearFormStatus = do + maybeFormStatus <- getSessionAndClear @Text "formStatus" + pure $ case maybeFormStatus of + Just "FormStatusSuccess" -> FormStatusSuccess + Just "FormStatusError" -> FormStatusError + _ -> FormStatusNotSubmitted \ No newline at end of file diff --git a/Application/Helper/View.hs b/Application/Helper/View.hs index 7bb88f9..da521c6 100644 --- a/Application/Helper/View.hs +++ b/Application/Helper/View.hs @@ -6,6 +6,7 @@ import "cryptonite" Crypto.Hash.Algorithms as Hash.Algorithms import Data.ByteString.Base64 as Base64 import Application.Helper.Controller import qualified Text.MMark as MMark +import Web.Types -- Here you can add functions which are available in all your views @@ -22,4 +23,5 @@ renderMarkdown text = case text |> MMark.parse "" of -- On error, render the text as is. Left error -> cs text - Right markdown -> MMark.render markdown |> tshow |> preEscapedToHtml \ No newline at end of file + Right markdown -> MMark.render markdown |> tshow |> preEscapedToHtml + diff --git a/Web/Controller/ImageStyle.hs b/Web/Controller/ImageStyle.hs index 72d4f7b..b5fe4a6 100644 --- a/Web/Controller/ImageStyle.hs +++ b/Web/Controller/ImageStyle.hs @@ -10,7 +10,7 @@ import "cryptonite" Crypto.PubKey.RSA.PKCS15 as RSA import "cryptonite" Crypto.Hash.Algorithms as Hash.Algorithms import Config import Data.ByteString.Base64 as Base64 -import qualified Data.UUID as UUID (fromString) +import qualified Data.UUID as UUID (fromText) instance Controller ImageStyleController where action RenderImageStyleAction { width, height, originalImagePath, signed } = do @@ -38,7 +38,7 @@ instance Controller ImageStyleController where let options :: StoreFileOptions = def { directory = imageStylePathDirectory , preprocess = applyImageMagick "jpg" ["-resize", cs size <> "^", "-gravity", "center", "-extent", cs size, "-quality", "85%", "-strip"] - , fileName = UUID.fromString (cs uuid) + , fileName = UUID.fromText uuid } storedFile <- storeFileFromPath (cs $ storagePrefix <> originalImageDirectory <> "/" <> uuid) options diff --git a/Web/Controller/LandingPages.hs b/Web/Controller/LandingPages.hs index e912a5c..5ae740f 100644 --- a/Web/Controller/LandingPages.hs +++ b/Web/Controller/LandingPages.hs @@ -13,6 +13,7 @@ instance Controller LandingPagesController where action NewLandingPageAction = do let landingPage = newRecord + setFormStatus FormStatusNotSubmitted render NewView { .. } action ShowLandingPageAction { landingPageId } = do @@ -23,6 +24,8 @@ instance Controller LandingPagesController where action EditLandingPageAction { landingPageId } = do landingPageWithRecords <- fetchLandingPageWithRecords landingPageId + formStatus <- getAndClearFormStatus + render EditView { .. } action UpdateLandingPageAction { landingPageId } = do @@ -41,7 +44,9 @@ instance Controller LandingPagesController where |> set #meta landingPage'.meta |> set #title landingPage'.title - render EditView { landingPageWithRecords = landingPageWithRecords {landingPage = landingPageWithMeta}} + let formStatus = FormStatusError + + render EditView { landingPageWithRecords = landingPageWithRecords {landingPage = landingPageWithMeta}, formStatus = formStatus } Right landingPage -> do landingPage <- landingPage |> updateRecord @@ -83,6 +88,7 @@ instance Controller LandingPagesController where pure () setSuccessMessage "LandingPage updated" + setFormStatus FormStatusSuccess redirectTo EditLandingPageAction { .. } action CreateLandingPageAction = do @@ -90,10 +96,13 @@ instance Controller LandingPagesController where landingPage |> buildLandingPage |> ifValid \case - Left landingPage -> render NewView { .. } + Left landingPage -> do + setFormStatus FormStatusError + render NewView { .. } Right landingPage -> do landingPage <- landingPage |> createRecord setSuccessMessage "LandingPage created" + setFormStatus FormStatusSuccess -- After we create the Landing page, we can start adding Paragraphs to it. redirectTo EditLandingPageAction { landingPageId = landingPage.id } diff --git a/Web/Controller/ParagraphQuotes.hs b/Web/Controller/ParagraphQuotes.hs index 793beac..0728df5 100644 --- a/Web/Controller/ParagraphQuotes.hs +++ b/Web/Controller/ParagraphQuotes.hs @@ -11,26 +11,34 @@ instance Controller ParagraphQuotesController where |> set #landingPageId landingPageId |> set #weight weight + let formStatus = FormStatusNotSubmitted + render NewView { .. } action EditParagraphQuoteAction { paragraphQuoteId } = do paragraphQuote <- fetch paragraphQuoteId + -- Get from the session, if the form was submitted successfully. + formStatus <- getAndClearFormStatus render EditView { .. } action UpdateParagraphQuoteAction { paragraphQuoteId } = do let uploadImage = uploadToStorageWithOptions $ def { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } + formStatus <- getAndClearFormStatus paragraphQuote <- fetch paragraphQuoteId paragraphQuote |> uploadImage #imageUrl >>= buildParagraphQuote >>= ifValid \case - Left paragraphQuote -> render EditView { .. } + Left paragraphQuote -> do + setFormStatus FormStatusError + render EditView { .. } Right paragraphQuote -> do paragraphQuote <- paragraphQuote |> updateRecord setSuccessMessage "Quote updated" + -- We don't setFormStatus, since we redirect to a new page. redirectTo EditLandingPageAction { landingPageId = paragraphQuote.landingPageId } action CreateParagraphQuoteAction = do @@ -38,15 +46,19 @@ instance Controller ParagraphQuotesController where { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } let paragraphQuote = newRecord @ParagraphQuote + let formStatus = FormStatusNotSubmitted paragraphQuote |> uploadImage #imageUrl >>= buildParagraphQuote >>= ifValid \case - Left paragraphQuote -> render NewView { .. } + Left paragraphQuote -> do + setFormStatus FormStatusError + render NewView { .. } Right paragraphQuote -> do paragraphQuote <- paragraphQuote |> createRecord setSuccessMessage "Quote created" + -- We don't setFormStatus, since we redirect to a new page. redirectTo EditLandingPageAction { landingPageId = paragraphQuote.landingPageId } action DeleteParagraphQuoteAction { paragraphQuoteId } = do diff --git a/Web/Element/InnerElementLayout.hs b/Web/Element/InnerElementLayout.hs deleted file mode 100644 index f226d2d..0000000 --- a/Web/Element/InnerElementLayout.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Web.Element.InnerElementLayout where - -import Web.View.Prelude - -import Web.Element.Types - - -getInnerElementBaseClasses :: Text -getInnerElementBaseClasses = "relative rounded-lg border border-gray-300 w-full h-full overflow-hidden" - -buildInnerElementLayout :: Color -> Html -> Html -buildInnerElementLayout color element = - [hsx| -
- {element} -
- |] - where - classes' = classes - [ (getInnerElementBaseClasses, True) - , (getBackgroundColor color, True) - , "p-6 md:px-8" - ] - - --- @todo: Remove -buildElementLayoutSplitImageAndContent :: Text -> Html -> Html -buildElementLayoutSplitImageAndContent imageUrl items = - -- We use grid and row/col start to position both the image and the text on the same cell. - [hsx| -
- -
-
- {image} -
-
-
- {items} -
-
- |] - where - image = [hsx||] diff --git a/Web/Element/SubmitButton.hs b/Web/Element/SubmitButton.hs new file mode 100644 index 0000000..584fd9e --- /dev/null +++ b/Web/Element/SubmitButton.hs @@ -0,0 +1,39 @@ +module Web.Element.SubmitButton where + +import Web.View.Prelude + +import Application.Helper.Icons +import Web.Element.ElementWrap +import Web.Element.Types + +renderSubmitButtonwithFormStatus :: SubmitButton -> FormStatus -> Html +renderSubmitButtonwithFormStatus submitButton formStatus = [hsx| + {submitButton} + + {- We show only one of these messages -} +
+ {formStatusMessage} +
+|] + |> wrapHorizontalSpacing AlignEnd + where + formStatusWrapper element = [hsx|
{element}
|] + maybeFormStatusMessage = + case formStatus of + FormStatusNotSubmitted -> Nothing + + FormStatusSuccess -> + "Changes saved" + |> wrapTextColor Green600 + |> Just + + FormStatusError -> + "Errors in the form" + |> wrapTextColor Red600 + |> Just + + formStatusMessage = maybeFormStatusMessage + |> fromMaybe "" + |> wrapTextItalic + |> \e -> [hsx|
{e}
|] + diff --git a/Web/Types.hs b/Web/Types.hs index 29fc2bc..5878b64 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -19,6 +19,16 @@ data LandingPageWithRecords = LandingPageWithRecords , paragraphQuotes :: ![ParagraphQuote] } deriving (Show) +{-| With the `FormStatus` we can show a message to the user after submitting a form, +indicating if the form was successful or not. +-} +data FormStatus + = FormStatusNotSubmitted + | FormStatusSuccess + | FormStatusError deriving (Eq, Show) + +-- Instances + instance CanSelect LandingPage where type SelectValue LandingPage = Id LandingPage selectValue landingPage = landingPage.id diff --git a/Web/View/CustomCSSFramework.hs b/Web/View/CustomCSSFramework.hs index 3f284de..594df65 100644 --- a/Web/View/CustomCSSFramework.hs +++ b/Web/View/CustomCSSFramework.hs @@ -203,7 +203,8 @@ customTailwind = def |] - styledSubmitButtonClass = "bg-blue-500 hover:bg-blue-700 text-white font-bold py-2 px-4 rounded" + -- We set the style of the submit button on app.css. + styledSubmitButtonClass = "btn" styledFormFieldHelp _ FormField { helpText = "" } = mempty styledFormFieldHelp _ FormField { helpText } = [hsx|

{helpText}

|] diff --git a/Web/View/LandingPages/Edit.hs b/Web/View/LandingPages/Edit.hs index 7912980..45d1e4f 100644 --- a/Web/View/LandingPages/Edit.hs +++ b/Web/View/LandingPages/Edit.hs @@ -3,31 +3,32 @@ import Web.Controller.Prelude import Web.Element.Button import Web.Element.ElementWrap import Web.Element.Link +import Web.Element.SubmitButton import Web.Element.Types import Web.View.Prelude -data EditView = EditView { landingPageWithRecords :: LandingPageWithRecords } +data EditView = EditView + { landingPageWithRecords :: LandingPageWithRecords + , formStatus :: FormStatus + } + instance View EditView where - html EditView { .. } = [hsx| - {body} - |] + html EditView { .. } = + [ header + , renderForm landingPage paragraphCtas paragraphQuotes formStatus + ] + |> mconcat + |> wrapVerticalSpacing AlignNone + |> wrapContainerWide where - body = - [ header - , renderForm landingPage paragraphCtas paragraphQuotes - ] - |> mconcat - |> wrapVerticalSpacing AlignNone - |> wrapContainerWide - landingPage = landingPageWithRecords.landingPage paragraphCtas = landingPageWithRecords.paragraphCtas paragraphQuotes = landingPageWithRecords.paragraphQuotes breadcrumb = renderBreadcrumb - [ breadcrumbLink "LandingPages" LandingPagesAction - , breadcrumbText "Edit LandingPage" + [ breadcrumbLink "Landing Pages" LandingPagesAction + , breadcrumbText "Edit Landing Page" ] header = @@ -45,11 +46,8 @@ instance View EditView where |> mconcat |> wrapHorizontalSpacingTiny AlignBaseline -renderForm :: LandingPage -> [ParagraphCta] -> [ParagraphQuote] -> Html -renderForm landingPage paragraphCtas paragraphQuotes = formFor landingPage [hsx| - {body} -|] - +renderForm :: LandingPage -> [ParagraphCta] -> [ParagraphQuote] -> FormStatus -> Html +renderForm landingPage paragraphCtas paragraphQuotes formStatus = formFor landingPage body where body :: (?formContext :: FormContext LandingPage) => Html body = [hsx| @@ -59,13 +57,16 @@ renderForm landingPage paragraphCtas paragraphQuotes = formFor landingPage [hsx| {paragraphs} - {submitButton {label = "Save Landing page"}} + { renderSubmitButtonwithFormStatus + (submitButton {label = "Save Landing page"}) + formStatus + } |] |> wrapVerticalSpacing AlignNone paragraphs = - [ addParagraphs - , [hsx| + [ addParagraphs + , [hsx| diff --git a/Web/View/Layout.hs b/Web/View/Layout.hs index d460e89..cf2e442 100644 --- a/Web/View/Layout.hs +++ b/Web/View/Layout.hs @@ -28,7 +28,7 @@ defaultLayout currentTime inner = [hsx|
- {renderFlashMessages} + {renderFlashMessages |> wrapContainerWide} {inner}
diff --git a/Web/View/ParagraphQuotes/Edit.hs b/Web/View/ParagraphQuotes/Edit.hs index 0e79457..690d85b 100644 --- a/Web/View/ParagraphQuotes/Edit.hs +++ b/Web/View/ParagraphQuotes/Edit.hs @@ -2,13 +2,16 @@ module Web.View.ParagraphQuotes.Edit where import Web.View.Prelude import Web.View.ParagraphQuotes.Form -data EditView = EditView { paragraphQuote :: ParagraphQuote } +data EditView = EditView + { paragraphQuote :: ParagraphQuote + , formStatus :: FormStatus + } instance View EditView where html EditView { .. } = [hsx| {breadcrumb}

Edit ParagraphQuote

- {renderForm paragraphQuote False} + {renderForm paragraphQuote False formStatus} |] where breadcrumb = renderBreadcrumb diff --git a/Web/View/ParagraphQuotes/Form.hs b/Web/View/ParagraphQuotes/Form.hs index 635aeea..2d3bc15 100644 --- a/Web/View/ParagraphQuotes/Form.hs +++ b/Web/View/ParagraphQuotes/Form.hs @@ -3,30 +3,35 @@ module Web.View.ParagraphQuotes.Form where import Web.View.Prelude import Web.Element.Types import Web.Element.ElementWrap - -renderForm :: ParagraphQuote -> Bool -> Html -renderForm paragraphQuote isImageRequired = formFor paragraphQuote [hsx| +import Web.Element.SubmitButton + +{-| When editing the form, the image input field isn't required. +That is, the image itself is required, but since we've already uploaded one, +when editing, we don't require re-uploading the same image. +-} +renderForm :: ParagraphQuote -> Bool -> FormStatus -> Html +renderForm paragraphQuote isImageRequired formStatus = formFor paragraphQuote [hsx| {(hiddenField #landingPageId)} {(hiddenField #weight)} {visibleForm paragraphQuote} |] where - visibleForm :: (?formContext :: FormContext ParagraphQuote) => ParagraphQuote -> Html - visibleForm paragraphQuote = - [hsx| - {(textareaField #body) {required = True}} - {(textField #subtitle) {required = True}} - -
- {(fileField #imageUrl) {required = isImageRequired, additionalAttributes = [("accept", "image/*"), ("data-preview", "#imageUrlPreview")]}} - - -
- - {submitButton} - |] - |> wrapVerticalSpacing AlignNone - |> wrapContainerWide + visibleForm :: (?formContext :: FormContext ParagraphQuote) => ParagraphQuote -> Html + visibleForm paragraphQuote = + [hsx| + {(textareaField #body) {required = True}} + {(textField #subtitle) {required = True}} + +
+ {(fileField #imageUrl) {required = isImageRequired, additionalAttributes = [("accept", "image/*"), ("data-preview", "#imageUrlPreview")]}} + + +
+ + {renderSubmitButtonwithFormStatus submitButton formStatus} + |] + |> wrapVerticalSpacing AlignNone + |> wrapContainerWide diff --git a/Web/View/ParagraphQuotes/New.hs b/Web/View/ParagraphQuotes/New.hs index aa10b02..a88907b 100644 --- a/Web/View/ParagraphQuotes/New.hs +++ b/Web/View/ParagraphQuotes/New.hs @@ -3,13 +3,16 @@ import Web.View.Prelude import Web.View.ParagraphQuotes.Form -data NewView = NewView { paragraphQuote :: ParagraphQuote } +data NewView = NewView + { paragraphQuote :: ParagraphQuote + , formStatus :: FormStatus + } instance View NewView where html NewView { .. } = [hsx| {breadcrumb}

New ParagraphQuote

- {renderForm paragraphQuote False} + {renderForm paragraphQuote True formStatus} |] where breadcrumb = renderBreadcrumb diff --git a/static/app.js b/static/app.js index dd365d5..8c6681c 100644 --- a/static/app.js +++ b/static/app.js @@ -1,13 +1,133 @@ -$(document).on('ready turbolinks:load', () => { +$(document).on('ihp:unload', () => { + // Unload bindings. + $('form:not([data-disable-form-submit-observe-change])').each(function () { + this.initDisableSubmitButtonIfFormNotChanged = false; + }); + + $('.js-sortable').each(function () { + this.initSortable = false; + }); +}); + + +$(document).on('ihp:load', () => { + initDisableSubmitButtonIfFormNotChanged(); + initSortable(); +}); + +const initDisableSubmitButtonIfFormNotChanged = function () { + // Disable submit button if form has not changed. + $('form[data-disable-form-submit-observe-change]').each(function () { + // Mark submit button as enabled. + $(this).find('button[type=submit]') + .toggleClass('disabled', false) + .toggleClass('enabled', true); + }); + + $('form:not([data-disable-form-submit-observe-change])').each(function () { + if (Boolean(this.initDisableSubmitButtonIfFormNotChanged) === true) { + // Already binded. + return; + } + this.initDisableSubmitButtonIfFormNotChanged = true; + const $this = $(this); + + const formData = new FormData(this); + + // Helper function to convert a value to a string representation. + // File objects are converted to a string like "FILE:filename-size-type". + function serializeValue(value) { + if (value instanceof File && value.name) { + return `FILE:${value.name}-${value.size}-${value.type}`; + } + return value; + } + + // Helper function to convert form data to an array of key-value pairs + function formDataToArray(formData) { + const formDataEntries = []; + for (let pair of formData.entries()) { + const key = pair[0]; + const value = pair[1]; + formDataEntries.push({ [key]: serializeValue(value) }); + } + return formDataEntries; + } + + const formDataEntries = formDataToArray(formData); + $this.data('formDataSerialized', JSON.stringify(formDataEntries)); + $this.find('button[type=submit]').prop('disabled', true); + + $this.on('change input', function () { + const $this = $(this); + const formData = new FormData(this); + const formDataEntries = formDataToArray(formData); + const changed = $this.data('formDataSerialized') !== JSON.stringify(formDataEntries); + $this.find('button[type=submit]') + .prop('disabled', !changed) + .toggleClass('disabled', !changed) + .toggleClass('enabled', changed); + + $this.find('.form-status-wrapper').remove(); + }); + }); + + // Show the remove file checkbox if a file is uploaded. + $('form .file-upload-wrapper :file').on('change', function () { + const $this = $(this); + + const $wrapper = $this.closest('.file-upload-wrapper'); + $wrapper + .find('.remove-file-wrapper') + .toggleClass('hidden', !$this.val()); + + if (!!$this.val()) { + // A file is uploaded, uncheck the "Remove file" checkbox, + // in case it was previously checked. + $wrapper + .find(':checkbox') + .prop('checked', false); + } + }); + + // Hide the file upload wrapper if the remove file checkbox is checked. + $('form .remove-file-checkbox:checkbox').on('change', function () { + const $wrapper = $(this).closest('.file-upload-wrapper'); + $wrapper + .find(':file') + .val(null); + + $wrapper + .find('img') + // We don't null the src, so we we don't get a broken image icon. + // from https://stackoverflow.com/a/9967193/750039 + .attr('src', 'data:image/gif;base64,R0lGODlhAQABAAAAACH5BAEKAAEALAAAAAABAAEAAAICTAEAOw=='); + + $wrapper + .find('a.download-link') + .hide(); + + // Hide the remove file checkbox. + $wrapper.find('.remove-file-wrapper') + .addClass('hidden'); + + }); +} + + +const initSortable = function () { // Init sortable. - document.querySelectorAll('.js-sortable').forEach(function (elem) { - if (Boolean(elem.jsSortableInitialized) === false) { - Sortable.create(elem, { - handle: '.sortable-handle', - animation: 150, - }); - elem.jsSortableInitialized = true; + $('.js-sortable').each(function () { + if (Boolean(this.initSortable) === true) { + // Already binded. + return; } + + this.initSortable = true; + Sortable.create(this, { + handle: '.sortable-handle', + animation: 150, + }); }); -}); \ No newline at end of file +} \ No newline at end of file diff --git a/tailwind/app.css b/tailwind/app.css index 1917a9a..1e2caca 100644 --- a/tailwind/app.css +++ b/tailwind/app.css @@ -6,9 +6,13 @@ .container-wide { @apply max-w-7xl mx-auto px-4 sm:px-6 lg:px-8 xl:px-20; - } + } - .container-narrow { + .container-narrow { @apply max-w-3xl mx-auto px-4 md:px-10 lg:px-8 xl:px-20; - } + } + + .btn { + @apply flex flex-row gap-x-2 enabled:bg-blue-500 enabled:text-white disabled:bg-gray-100 disabled:text-gray-500 enabled:hover:text-gray-200 enabled:hover:bg-blue-500 py-2 px-4 rounded; + } } \ No newline at end of file