From 3e3be799c20f78a385c31bd0b0d73b1908f019cc Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Wed, 17 Jul 2024 18:51:11 +0700 Subject: [PATCH 01/12] Hero Image --- Application/Helper/Controller.hs | 4 ++ Application/Schema.sql | 12 ++++- Web/Controller/LandingPages.hs | 1 + Web/Controller/ParagraphHeroImages.hs | 75 +++++++++++++++++++++++++++ Web/Element/HeroImage.hs | 46 ++++++++++++++++ Web/Element/Types.hs | 6 +++ Web/FrontController.hs | 2 + Web/Routes.hs | 3 +- Web/Types.hs | 9 ++++ Web/View/LandingPages/Edit.hs | 20 ++++--- Web/View/LandingPages/Show.hs | 21 +++++++- Web/View/ParagraphCtas/Edit.hs | 2 +- Web/View/ParagraphCtas/New.hs | 2 +- Web/View/ParagraphHeroImages/Edit.hs | 19 +++++++ Web/View/ParagraphHeroImages/Form.hs | 37 +++++++++++++ Web/View/ParagraphHeroImages/New.hs | 21 ++++++++ 16 files changed, 265 insertions(+), 15 deletions(-) create mode 100644 Web/Controller/ParagraphHeroImages.hs create mode 100644 Web/Element/HeroImage.hs create mode 100644 Web/View/ParagraphHeroImages/Edit.hs create mode 100644 Web/View/ParagraphHeroImages/Form.hs create mode 100644 Web/View/ParagraphHeroImages/New.hs diff --git a/Application/Helper/Controller.hs b/Application/Helper/Controller.hs index 12162bf..c8670c2 100644 --- a/Application/Helper/Controller.hs +++ b/Application/Helper/Controller.hs @@ -16,10 +16,13 @@ fetchLandingPageWithRecords :: (?modelContext :: ModelContext) => Id LandingPage fetchLandingPageWithRecords landingPageId = do landingPage <- fetch landingPageId + paragraphCtas <- fetch landingPage.paragraphCtasRefLandingPages paragraphQuotes <- fetch landingPage.paragraphQuotes + paragraphHeroImages <- fetch landingPage.paragraphHeroImages + return $ LandingPageWithRecords { .. } getParagraphsCount :: (?modelContext::ModelContext) => Id LandingPage -> IO Int @@ -28,6 +31,7 @@ getParagraphsCount landingPageId = do pure $ length landingPageWithRecords.paragraphCtas + length landingPageWithRecords.paragraphQuotes + + length landingPageWithRecords.paragraphHeroImages + 1 -- | The RSA public key, can be used to verify image style URLs that were signed. diff --git a/Application/Schema.sql b/Application/Schema.sql index fa96c87..85f693f 100644 --- a/Application/Schema.sql +++ b/Application/Schema.sql @@ -5,7 +5,6 @@ BEGIN END; $$ language plpgsql; -- Your database schema. Use the Schema Designer at http://localhost:8001/ to add some tables. - CREATE TABLE users ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, email TEXT NOT NULL, @@ -13,7 +12,6 @@ CREATE TABLE users ( locked_at TIMESTAMP WITH TIME ZONE DEFAULT NULL, failed_login_attempts INT DEFAULT 0 NOT NULL ); - CREATE TABLE landing_pages ( id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL, @@ -40,6 +38,16 @@ CREATE TABLE paragraph_ctas ( ); CREATE INDEX paragraph_quotes_landing_page_id_index ON paragraph_quotes (landing_page_id); CREATE INDEX paragraph_ctas_landing_page_id_index ON paragraph_ctas (landing_page_id); +CREATE TABLE paragraph_hero_images ( + id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL, + title TEXT NOT NULL, + subtitle TEXT, + landing_page_id UUID DEFAULT uuid_generate_v4() NOT NULL, + link TEXT DEFAULT NULL, + image_url TEXT, + weight INT NOT NULL +); ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; ALTER TABLE paragraph_ctas ADD CONSTRAINT paragraph_ctas_ref_ref_landing_page_id FOREIGN KEY (ref_landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; +ALTER TABLE paragraph_hero_images ADD CONSTRAINT paragraph_hero_images_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; ALTER TABLE paragraph_quotes ADD CONSTRAINT paragraph_quotes_ref_landing_page_id FOREIGN KEY (landing_page_id) REFERENCES landing_pages (id) ON DELETE NO ACTION; diff --git a/Web/Controller/LandingPages.hs b/Web/Controller/LandingPages.hs index 5ae740f..6fccafe 100644 --- a/Web/Controller/LandingPages.hs +++ b/Web/Controller/LandingPages.hs @@ -67,6 +67,7 @@ instance Controller LandingPagesController where -- Iterate over all paragraphs, and update the weight. forEach landingPageWithRecords.paragraphCtas updateParagraph forEach landingPageWithRecords.paragraphQuotes updateParagraph + forEach landingPageWithRecords.paragraphHeroImages updateParagraph where updateParagraph :: forall record. diff --git a/Web/Controller/ParagraphHeroImages.hs b/Web/Controller/ParagraphHeroImages.hs new file mode 100644 index 0000000..a500038 --- /dev/null +++ b/Web/Controller/ParagraphHeroImages.hs @@ -0,0 +1,75 @@ +module Web.Controller.ParagraphHeroImages where + +import Web.Controller.Prelude +import Web.View.ParagraphHeroImages.New +import Web.View.ParagraphHeroImages.Edit + +instance Controller ParagraphHeroImagesController where + action NewParagraphHeroImageAction { .. } = do + weight <- getParagraphsCount landingPageId + let paragraphHeroImage = newRecord + |> set #landingPageId landingPageId + |> set #weight weight + + let formStatus = FormStatusNotSubmitted + + render NewView { .. } + + action EditParagraphHeroImageAction { paragraphHeroImageId } = do + paragraphHeroImage <- fetch paragraphHeroImageId + -- Get from the session, if the form was submitted successfully. + formStatus <- getAndClearFormStatus + render EditView { .. } + + action UpdateParagraphHeroImageAction { paragraphHeroImageId } = do + let uploadImage = uploadToStorageWithOptions $ def + { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } + + formStatus <- getAndClearFormStatus + + paragraphHeroImage <- fetch paragraphHeroImageId + paragraphHeroImage + |> uploadImage #imageUrl + >>= buildParagraphHeroImage + >>= ifValid \case + Left paragraphHeroImage -> do + setFormStatus FormStatusError + render EditView { .. } + Right paragraphHeroImage -> do + paragraphHeroImage <- paragraphHeroImage |> updateRecord + setSuccessMessage "Hero Image updated" + -- We don't setFormStatus, since we redirect to a new page. + redirectTo EditLandingPageAction { landingPageId = paragraphHeroImage.landingPageId } + + action CreateParagraphHeroImageAction = do + let uploadImage = uploadToStorageWithOptions $ def + { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } + + let paragraphHeroImage = newRecord @ParagraphHeroImage + let formStatus = FormStatusNotSubmitted + + paragraphHeroImage + |> uploadImage #imageUrl + >>= buildParagraphHeroImage + >>= ifValid \case + Left paragraphHeroImage -> do + setFormStatus FormStatusError + render NewView { .. } + Right paragraphHeroImage -> do + paragraphHeroImage <- paragraphHeroImage |> createRecord + setSuccessMessage "Hero Image created" + -- We don't setFormStatus, since we redirect to a new page. + redirectTo EditLandingPageAction { landingPageId = paragraphHeroImage.landingPageId } + + action DeleteParagraphHeroImageAction { paragraphHeroImageId } = do + paragraphHeroImage <- fetch paragraphHeroImageId + deleteRecord paragraphHeroImage + setSuccessMessage "Hero Image deleted" + redirectTo EditLandingPageAction { landingPageId = paragraphHeroImage.landingPageId } + +buildParagraphHeroImage paragraphHeroImage = paragraphHeroImage + |> fill @["landingPageId", "weight", "title", "subtitle"] + |> validateField #title nonEmpty + |> validateField #imageUrl nonEmpty + |> return + diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs new file mode 100644 index 0000000..967db78 --- /dev/null +++ b/Web/Element/HeroImage.hs @@ -0,0 +1,46 @@ +module Web.Element.HeroImage where + +import Web.View.Prelude + +import Application.Helper.Icons +import Web.Element.ElementWrap +import Web.Element.Types + + +render :: RenderHeroImage -> Html +render record@RenderHeroImage {title, subtitle, imageUrl} = + titleWrapped + ++ subTitleWrapped + |> wrapVerticalSpacing AlignNone + |> renderImageAndContent (pathTo $ RenderImageStyleAction 400 200 imageUrl signed) + where + -- Sign the image URL to prevent tampering. + signed = signImageUrl imageUrl 400 200 + + titleWrapped = cs subtitle + |> wrapTextResponsiveFontSize TextSizeSm + + subTitleWrapped = cs subtitle + |> wrapTextResponsiveFontSize TextSizeSm + + +renderImageAndContent :: Text -> Html -> Html +renderImageAndContent 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/Types.hs b/Web/Element/Types.hs index 77eb9e0..6ebe10e 100644 --- a/Web/Element/Types.hs +++ b/Web/Element/Types.hs @@ -60,6 +60,12 @@ data RenderQuote = RenderQuote , imageUrl :: Text } +data RenderHeroImage = RenderHeroImage + { title :: Text + , subtitle :: Text + , imageUrl :: Text + } + -- @todo: Move to Utility.hs? getBackgroundColor :: Color -> Text diff --git a/Web/FrontController.hs b/Web/FrontController.hs index 41ec05f..360efe7 100644 --- a/Web/FrontController.hs +++ b/Web/FrontController.hs @@ -12,6 +12,7 @@ import Web.Controller.ImageStyle import Web.Controller.LandingPages import Web.Controller.ParagraphCtas import Web.Controller.ParagraphQuotes +import Web.Controller.ParagraphHeroImages import IHP.LoginSupport.Middleware import Web.Controller.Sessions @@ -26,6 +27,7 @@ instance FrontController WebApplication where , parseRoute @LandingPagesController , parseRoute @ParagraphCtasController , parseRoute @ParagraphQuotesController + , parseRoute @ParagraphHeroImagesController , parseRoute @SessionsController ] diff --git a/Web/Routes.hs b/Web/Routes.hs index 0bd133d..3b4fa13 100644 --- a/Web/Routes.hs +++ b/Web/Routes.hs @@ -7,13 +7,12 @@ import Web.Types instance AutoRoute ParagraphQuotesController - instance AutoRoute ParagraphCtasController +instance AutoRoute ParagraphHeroImagesController instance AutoRoute LandingPagesController - instance AutoRoute ImageStyleController instance AutoRoute SessionsController diff --git a/Web/Types.hs b/Web/Types.hs index 5878b64..3f55584 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -17,6 +17,7 @@ data LandingPageWithRecords = LandingPageWithRecords { landingPage :: !LandingPage , paragraphCtas :: ![ParagraphCta] , paragraphQuotes :: ![ParagraphQuote] + , paragraphHeroImages :: ![ParagraphHeroImage] } deriving (Show) {-| With the `FormStatus` we can show a message to the user after submitting a form, @@ -64,6 +65,14 @@ data ParagraphQuotesController | DeleteParagraphQuoteAction { paragraphQuoteId :: !(Id ParagraphQuote) } deriving (Eq, Show, Data) +data ParagraphHeroImagesController + = NewParagraphHeroImageAction { landingPageId :: !(Id LandingPage) } + | CreateParagraphHeroImageAction + | EditParagraphHeroImageAction { paragraphHeroImageId :: !(Id ParagraphHeroImage) } + | UpdateParagraphHeroImageAction { paragraphHeroImageId :: !(Id ParagraphHeroImage) } + | DeleteParagraphHeroImageAction { paragraphHeroImageId :: !(Id ParagraphHeroImage) } + deriving (Eq, Show, Data) + data ImageStyleController diff --git a/Web/View/LandingPages/Edit.hs b/Web/View/LandingPages/Edit.hs index 45d1e4f..c58bd48 100644 --- a/Web/View/LandingPages/Edit.hs +++ b/Web/View/LandingPages/Edit.hs @@ -16,7 +16,7 @@ data EditView = EditView instance View EditView where html EditView { .. } = [ header - , renderForm landingPage paragraphCtas paragraphQuotes formStatus + , renderForm landingPage paragraphCtas paragraphQuotes paragraphHeroImages formStatus ] |> mconcat |> wrapVerticalSpacing AlignNone @@ -25,6 +25,7 @@ instance View EditView where landingPage = landingPageWithRecords.landingPage paragraphCtas = landingPageWithRecords.paragraphCtas paragraphQuotes = landingPageWithRecords.paragraphQuotes + paragraphHeroImages = landingPageWithRecords.paragraphHeroImages breadcrumb = renderBreadcrumb [ breadcrumbLink "Landing Pages" LandingPagesAction @@ -46,8 +47,8 @@ instance View EditView where |> mconcat |> wrapHorizontalSpacingTiny AlignBaseline -renderForm :: LandingPage -> [ParagraphCta] -> [ParagraphQuote] -> FormStatus -> Html -renderForm landingPage paragraphCtas paragraphQuotes formStatus = formFor landingPage body +renderForm :: LandingPage -> [ParagraphCta] -> [ParagraphQuote] -> [ParagraphHeroImage] -> FormStatus -> Html +renderForm landingPage paragraphCtas paragraphQuotes paragraphHeroImages formStatus = formFor landingPage body where body :: (?formContext :: FormContext LandingPage) => Html body = [hsx| @@ -68,7 +69,7 @@ renderForm landingPage paragraphCtas paragraphQuotes formStatus = formFor landin [ addParagraphs , [hsx| |] ] @@ -86,14 +87,16 @@ renderForm landingPage paragraphCtas paragraphQuotes formStatus = formFor landin paragraphButtons = [ renderButtonAction (NewParagraphCtaAction landingPage.id) "New CTA" , renderButtonAction (NewParagraphQuoteAction landingPage.id) "New Quote" + , renderButtonAction (NewParagraphHeroImageAction landingPage.id) "New Hero Image" ] |> mconcat |> wrapHorizontalSpacing AlignCenter -orderAndRenderParagraphs :: [ParagraphCta] -> [ParagraphQuote] -> Html -orderAndRenderParagraphs paragraphCtas paragraphQuotes = +orderAndRenderParagraphs :: [ParagraphCta] -> [ParagraphQuote] -> [ParagraphHeroImage] -> Html +orderAndRenderParagraphs paragraphCtas paragraphQuotes paragraphHeroImages = ctas ++ quotes + ++ heroImages |> sortOn fst |> fmap snd |> mconcat @@ -104,6 +107,9 @@ orderAndRenderParagraphs paragraphCtas paragraphQuotes = quotes = paragraphQuotes |> fmap (\paragraph -> (paragraph.weight, paragraphTitleAndOps EditParagraphQuoteAction DeleteParagraphQuoteAction paragraph.id paragraph.subtitle ("Quote" :: Text))) + + heroImages = paragraphHeroImages + |> fmap (\paragraph -> (paragraph.weight, paragraphTitleAndOps EditParagraphHeroImageAction DeleteParagraphHeroImageAction paragraph.id paragraph.title ("Hero Image" :: Text))) @@ -136,7 +142,7 @@ orderAndRenderParagraphs paragraphCtas paragraphQuotes = sortableHandle = if - length ctas + length quotes > 1 + length ctas + length quotes + length heroImages > 1 then [hsx|
diff --git a/Web/View/LandingPages/Show.hs b/Web/View/LandingPages/Show.hs index 249688b..e5d726e 100644 --- a/Web/View/LandingPages/Show.hs +++ b/Web/View/LandingPages/Show.hs @@ -5,6 +5,7 @@ import Web.Element.ElementWrap import Web.Element.Link import Web.Element.Types import Web.Element.Quote +import Web.Element.HeroImage import Web.Types import Web.View.Prelude @@ -43,7 +44,7 @@ instance View ShowView where orderAndRenderParagraphs :: (?context::ControllerContext) => LandingPageWithRecords -> Html orderAndRenderParagraphs landingPageWithRecords = - ctas ++ quotes + ctas ++ quotes ++ heroImages -- Order by weight. |> sortOn fst |> fmap snd @@ -64,6 +65,13 @@ orderAndRenderParagraphs landingPageWithRecords = ) ) + heroImages = landingPageWithRecords.paragraphHeroImages + |> fmap (\paragraph -> + ( paragraph.weight + , renderParagraphHeroImage paragraph + ) + ) + renderParagraphCta :: ParagraphCta -> Html renderParagraphCta paragraphCta = RenderCta @@ -84,4 +92,13 @@ renderParagraphQuote paragraphQuote = , subtitle = paragraphQuote.subtitle , imageUrl = paragraphQuote.imageUrl |> fromMaybe "" } - |> Web.Element.Quote.render \ No newline at end of file + |> Web.Element.Quote.render + +renderParagraphHeroImage :: ParagraphHeroImage -> Html +renderParagraphHeroImage paragraphHeroImage = + RenderHeroImage + { title = paragraphHeroImage.title + , subtitle = paragraphHeroImage.subtitle |> fromMaybe "" + , imageUrl = paragraphHeroImage.imageUrl |> fromMaybe "" + } + |> Web.Element.HeroImage.render \ No newline at end of file diff --git a/Web/View/ParagraphCtas/Edit.hs b/Web/View/ParagraphCtas/Edit.hs index 89b65f2..eaac7ab 100644 --- a/Web/View/ParagraphCtas/Edit.hs +++ b/Web/View/ParagraphCtas/Edit.hs @@ -32,7 +32,7 @@ renderForm paragraphCta landingPages = formFor paragraphCta [hsx| [hsx| {(textField #title) {required = True}} {(textareaField #body) {required = True}} - {(selectField #refLandingPageId landingPages) {required = True, fieldLabel = "Landing page", helpText = "Select the landing page you want to link to."}} + {(selectField #refLandingPageId landingPages) {required = True, fieldLabel = "Landing page", helpText = "Select the landing page you want to link to."}} {submitButton} |] |> wrapVerticalSpacing AlignNone diff --git a/Web/View/ParagraphCtas/New.hs b/Web/View/ParagraphCtas/New.hs index af7059b..28432f6 100644 --- a/Web/View/ParagraphCtas/New.hs +++ b/Web/View/ParagraphCtas/New.hs @@ -31,7 +31,7 @@ renderForm paragraphCta landingPages = formFor paragraphCta [hsx| [hsx| {(textField #title) {required = True}} {(textareaField #body) {required = True}} - {(selectField #refLandingPageId landingPages) {required = True, fieldLabel = "Landing page", helpText = "Select the landing page you want to link to."}} + {(selectField #refLandingPageId landingPages) {required = True, fieldLabel = "Landing page", helpText = "Select the landing page you want to link to."}} {submitButton} |] |> wrapVerticalSpacing AlignNone diff --git a/Web/View/ParagraphHeroImages/Edit.hs b/Web/View/ParagraphHeroImages/Edit.hs new file mode 100644 index 0000000..e8f740c --- /dev/null +++ b/Web/View/ParagraphHeroImages/Edit.hs @@ -0,0 +1,19 @@ +module Web.View.ParagraphHeroImages.Edit where +import Web.View.Prelude +import Web.View.ParagraphHeroImages.Form + +data EditView = EditView + { paragraphHeroImage :: ParagraphHeroImage + , formStatus :: FormStatus + } + +instance View EditView where + html EditView { .. } = [hsx| + {breadcrumb} +

Edit Paragraph Hero Image

+ {renderForm paragraphHeroImage False formStatus} + |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbText "Edit Hero Image" + ] diff --git a/Web/View/ParagraphHeroImages/Form.hs b/Web/View/ParagraphHeroImages/Form.hs new file mode 100644 index 0000000..8ac2308 --- /dev/null +++ b/Web/View/ParagraphHeroImages/Form.hs @@ -0,0 +1,37 @@ +module Web.View.ParagraphHeroImages.Form where + +import Web.View.Prelude +import Web.Element.Types +import Web.Element.ElementWrap +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 :: ParagraphHeroImage -> Bool -> FormStatus -> Html +renderForm paragraphHeroImage isImageRequired formStatus = formFor paragraphHeroImage [hsx| + {(hiddenField #landingPageId)} + {(hiddenField #weight)} + {visibleForm paragraphHeroImage} + |] + where + visibleForm :: (?formContext :: FormContext ParagraphHeroImage) => ParagraphHeroImage -> Html + visibleForm paragraphHeroImage = + [hsx| + {(textField #title) {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/ParagraphHeroImages/New.hs b/Web/View/ParagraphHeroImages/New.hs new file mode 100644 index 0000000..95341af --- /dev/null +++ b/Web/View/ParagraphHeroImages/New.hs @@ -0,0 +1,21 @@ +module Web.View.ParagraphHeroImages.New where +import Web.View.Prelude +import Web.View.ParagraphHeroImages.Form + + +data NewView = NewView + { paragraphHeroImage :: ParagraphHeroImage + , formStatus :: FormStatus + } + +instance View NewView where + html NewView { .. } = [hsx| + {breadcrumb} +

New Paragraph Hero Image

+ {renderForm paragraphHeroImage True formStatus} + |] + where + breadcrumb = renderBreadcrumb + [ breadcrumbText "New Hero Image" + ] + From dd1e8eb19cfe9f45cf29eb2005a3ae3188f690eb Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Thu, 18 Jul 2024 13:07:59 +0700 Subject: [PATCH 02/12] Theming --- Web/Controller/ParagraphHeroImages.hs | 2 +- Web/Element/ElementWrap.hs | 1 + Web/Element/HeroImage.hs | 43 ++++++++++++++++----------- Web/Element/Types.hs | 3 +- Web/View/LandingPages/Show.hs | 11 +++++++ Web/View/ParagraphHeroImages/Edit.hs | 2 +- Web/View/ParagraphHeroImages/Form.hs | 5 ++-- 7 files changed, 45 insertions(+), 22 deletions(-) diff --git a/Web/Controller/ParagraphHeroImages.hs b/Web/Controller/ParagraphHeroImages.hs index a500038..519b54e 100644 --- a/Web/Controller/ParagraphHeroImages.hs +++ b/Web/Controller/ParagraphHeroImages.hs @@ -68,7 +68,7 @@ instance Controller ParagraphHeroImagesController where redirectTo EditLandingPageAction { landingPageId = paragraphHeroImage.landingPageId } buildParagraphHeroImage paragraphHeroImage = paragraphHeroImage - |> fill @["landingPageId", "weight", "title", "subtitle"] + |> fill @["landingPageId", "weight", "title", "subtitle", "link"] |> validateField #title nonEmpty |> validateField #imageUrl nonEmpty |> return diff --git a/Web/Element/ElementWrap.hs b/Web/Element/ElementWrap.hs index 5d5a37f..0ff6e9a 100644 --- a/Web/Element/ElementWrap.hs +++ b/Web/Element/ElementWrap.hs @@ -332,6 +332,7 @@ wrapTextFontWeight fontweight element = case fontweight of FontWeightLight -> "font-light" FontWeightNormal -> "font-normal" + FontWeightMedium -> "font-medium" FontWeightBold -> "font-bold" wrapHeaderTag :: Int -> Html -> Html diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs index 967db78..cde328d 100644 --- a/Web/Element/HeroImage.hs +++ b/Web/Element/HeroImage.hs @@ -5,38 +5,47 @@ import Web.View.Prelude import Application.Helper.Icons import Web.Element.ElementWrap import Web.Element.Types - +import Web.Element.Button render :: RenderHeroImage -> Html -render record@RenderHeroImage {title, subtitle, imageUrl} = +render record@RenderHeroImage {title, subtitle, button, imageUrl} = titleWrapped ++ subTitleWrapped - |> wrapVerticalSpacing AlignNone - |> renderImageAndContent (pathTo $ RenderImageStyleAction 400 200 imageUrl signed) + ++ buttonHtml + |> wrapVerticalSpacingBig AlignNone + |> renderImageAndContent (pathTo $ RenderImageStyleAction 1536 466 imageUrl signed) where -- Sign the image URL to prevent tampering. - signed = signImageUrl imageUrl 400 200 + signed = signImageUrl imageUrl 1536 466 - titleWrapped = cs subtitle + titleWrapped = cs title + |> wrapHeaderTag 1 + |> wrapTextFontWeight FontWeightBold |> wrapTextResponsiveFontSize TextSizeSm subTitleWrapped = cs subtitle - |> wrapTextResponsiveFontSize TextSizeSm + |> wrapTextFontWeight FontWeightMedium + |> wrapTextResponsiveFontSize TextSizeXl + + buttonHtml = case button of + Just btn -> Web.Element.Button.render btn + Nothing -> mempty renderImageAndContent :: Text -> Html -> Html renderImageAndContent imageUrl items = - -- We use grid and row/col start to position both the image and the text on the same cell. [hsx| -
- -
-
- {image} -
-
-
- {items} +
+
+ {image} +
+ +
+
+
+ {items} +
+
|] diff --git a/Web/Element/Types.hs b/Web/Element/Types.hs index 6ebe10e..6b297f9 100644 --- a/Web/Element/Types.hs +++ b/Web/Element/Types.hs @@ -5,7 +5,7 @@ data Align = AlignNone | AlignStart | AlignCenter | AlignEnd | AlignBaseline der data Justify = JustifyStart | JustifyCenter | JustifyEnd | JustifyBetween deriving (Eq, Show) -data FontWeight = FontWeightLight | FontWeightNormal | FontWeightBold deriving (Eq, Show) +data FontWeight = FontWeightLight | FontWeightNormal | FontWeightMedium | FontWeightBold deriving (Eq, Show) data Color = ColorTransparent @@ -64,6 +64,7 @@ data RenderHeroImage = RenderHeroImage { title :: Text , subtitle :: Text , imageUrl :: Text + , button :: Maybe RenderButton } diff --git a/Web/View/LandingPages/Show.hs b/Web/View/LandingPages/Show.hs index e5d726e..7cd678a 100644 --- a/Web/View/LandingPages/Show.hs +++ b/Web/View/LandingPages/Show.hs @@ -96,9 +96,20 @@ renderParagraphQuote paragraphQuote = renderParagraphHeroImage :: ParagraphHeroImage -> Html renderParagraphHeroImage paragraphHeroImage = + let + button = case paragraphHeroImage.link of + Just linkText -> + Just RenderButton + { text = "Read More" + , url = linkText + , isPrimary = True + } + _ -> Nothing + in RenderHeroImage { title = paragraphHeroImage.title , subtitle = paragraphHeroImage.subtitle |> fromMaybe "" , imageUrl = paragraphHeroImage.imageUrl |> fromMaybe "" + , button = button } |> Web.Element.HeroImage.render \ No newline at end of file diff --git a/Web/View/ParagraphHeroImages/Edit.hs b/Web/View/ParagraphHeroImages/Edit.hs index e8f740c..07973dd 100644 --- a/Web/View/ParagraphHeroImages/Edit.hs +++ b/Web/View/ParagraphHeroImages/Edit.hs @@ -11,7 +11,7 @@ instance View EditView where html EditView { .. } = [hsx| {breadcrumb}

Edit Paragraph Hero Image

- {renderForm paragraphHeroImage False formStatus} + {renderForm paragraphHeroImage True formStatus} |] where breadcrumb = renderBreadcrumb diff --git a/Web/View/ParagraphHeroImages/Form.hs b/Web/View/ParagraphHeroImages/Form.hs index 8ac2308..f6b470a 100644 --- a/Web/View/ParagraphHeroImages/Form.hs +++ b/Web/View/ParagraphHeroImages/Form.hs @@ -20,7 +20,8 @@ renderForm paragraphHeroImage isImageRequired formStatus = formFor paragraphHero visibleForm paragraphHeroImage = [hsx| {(textField #title) {required = True}} - {(textField #subtitle) {required = True}} + {(textField #subtitle)} + {(textField #link)}
{(fileField #imageUrl) {required = isImageRequired, additionalAttributes = [("accept", "image/*"), ("data-preview", "#imageUrlPreview")]}} @@ -28,7 +29,7 @@ renderForm paragraphHeroImage isImageRequired formStatus = formFor paragraphHero
- {renderSubmitButtonwithFormStatus submitButton formStatus} + {renderSubmitButtonwithFormStatus (submitButton {label = "Save Hero Image"}) formStatus} |] |> wrapVerticalSpacing AlignNone |> wrapContainerWide From b9cc3bbd74bcda35c61e24c005a852da917490c5 Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Thu, 18 Jul 2024 13:14:37 +0700 Subject: [PATCH 03/12] Add to style guide --- Web/View/StyleGuide/Index.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/Web/View/StyleGuide/Index.hs b/Web/View/StyleGuide/Index.hs index 51576c7..3f766cc 100644 --- a/Web/View/StyleGuide/Index.hs +++ b/Web/View/StyleGuide/Index.hs @@ -6,6 +6,7 @@ import Web.View.Prelude import Web.Element.Cta import Web.Element.PageTitle import Web.Element.Quote +import Web.Element.HeroImage data IndexView = IndexView { } @@ -38,6 +39,7 @@ instance View IndexView where [ renderTitleAndElementWideContainer "Page Title" pageTitle , renderTitleAndElementNoContainer "CTA" cta , renderTitleAndElementNoContainer "Quote" quote + , renderTitleAndElementNoContainer "Hero Image" heroImage ] |> mconcat @@ -62,6 +64,18 @@ instance View IndexView where } |> Web.Element.Quote.render + heroImage = RenderHeroImage + { title = "This is title" + , subtitle = "This is subtitle" + , imageUrl = "/styleGuideImages/8f8827de-e5d4-4ee7-b0a3-abae36274338" + , button = Just RenderButton + { text = "Read more" + , url = "/" + , isPrimary = True + } + } + |> Web.Element.HeroImage.render + renderTitleAndElementNoContainer :: Text -> Html -> Html renderTitleAndElementNoContainer title element = renderTitleAndElementHelper title Nothing element Nothing From 97e93a00acd0dd71c0545394e5a85ef38acf91b7 Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Thu, 18 Jul 2024 13:19:37 +0700 Subject: [PATCH 04/12] Empty lines --- Web/View/LandingPages/Show.hs | 2 +- Web/View/ParagraphHeroImages/Form.hs | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/Web/View/LandingPages/Show.hs b/Web/View/LandingPages/Show.hs index 7cd678a..1fd51ca 100644 --- a/Web/View/LandingPages/Show.hs +++ b/Web/View/LandingPages/Show.hs @@ -112,4 +112,4 @@ renderParagraphHeroImage paragraphHeroImage = , imageUrl = paragraphHeroImage.imageUrl |> fromMaybe "" , button = button } - |> Web.Element.HeroImage.render \ No newline at end of file + |> Web.Element.HeroImage.render diff --git a/Web/View/ParagraphHeroImages/Form.hs b/Web/View/ParagraphHeroImages/Form.hs index f6b470a..17e1f76 100644 --- a/Web/View/ParagraphHeroImages/Form.hs +++ b/Web/View/ParagraphHeroImages/Form.hs @@ -33,6 +33,3 @@ renderForm paragraphHeroImage isImageRequired formStatus = formFor paragraphHero |] |> wrapVerticalSpacing AlignNone |> wrapContainerWide - - - From 62abfb10464a318da3c80df8e9b0d13b9174806a Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Thu, 18 Jul 2024 18:36:46 +0700 Subject: [PATCH 05/12] PR fixes --- Application/Helper/Controller.hs | 6 +-- Web/Controller/ParagraphHeroImages.hs | 67 ++++++++++++--------------- Web/Element/HeroImage.hs | 3 +- Web/View/ParagraphHeroImages/Edit.hs | 2 +- 4 files changed, 36 insertions(+), 42 deletions(-) diff --git a/Application/Helper/Controller.hs b/Application/Helper/Controller.hs index c8670c2..0aad0a6 100644 --- a/Application/Helper/Controller.hs +++ b/Application/Helper/Controller.hs @@ -19,10 +19,10 @@ fetchLandingPageWithRecords landingPageId = do paragraphCtas <- fetch landingPage.paragraphCtasRefLandingPages - paragraphQuotes <- fetch landingPage.paragraphQuotes - paragraphHeroImages <- fetch landingPage.paragraphHeroImages + paragraphQuotes <- fetch landingPage.paragraphQuotes + return $ LandingPageWithRecords { .. } getParagraphsCount :: (?modelContext::ModelContext) => Id LandingPage -> IO Int @@ -30,8 +30,8 @@ getParagraphsCount landingPageId = do landingPageWithRecords <- fetchLandingPageWithRecords landingPageId pure $ length landingPageWithRecords.paragraphCtas - + length landingPageWithRecords.paragraphQuotes + length landingPageWithRecords.paragraphHeroImages + + length landingPageWithRecords.paragraphQuotes + 1 -- | The RSA public key, can be used to verify image style URLs that were signed. diff --git a/Web/Controller/ParagraphHeroImages.hs b/Web/Controller/ParagraphHeroImages.hs index 519b54e..891b9d4 100644 --- a/Web/Controller/ParagraphHeroImages.hs +++ b/Web/Controller/ParagraphHeroImages.hs @@ -22,44 +22,10 @@ instance Controller ParagraphHeroImagesController where render EditView { .. } action UpdateParagraphHeroImageAction { paragraphHeroImageId } = do - let uploadImage = uploadToStorageWithOptions $ def - { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } - - formStatus <- getAndClearFormStatus - - paragraphHeroImage <- fetch paragraphHeroImageId - paragraphHeroImage - |> uploadImage #imageUrl - >>= buildParagraphHeroImage - >>= ifValid \case - Left paragraphHeroImage -> do - setFormStatus FormStatusError - render EditView { .. } - Right paragraphHeroImage -> do - paragraphHeroImage <- paragraphHeroImage |> updateRecord - setSuccessMessage "Hero Image updated" - -- We don't setFormStatus, since we redirect to a new page. - redirectTo EditLandingPageAction { landingPageId = paragraphHeroImage.landingPageId } + createOrUpdateParagraphHeroImageAction (Just paragraphHeroImageId) action CreateParagraphHeroImageAction = do - let uploadImage = uploadToStorageWithOptions $ def - { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } - - let paragraphHeroImage = newRecord @ParagraphHeroImage - let formStatus = FormStatusNotSubmitted - - paragraphHeroImage - |> uploadImage #imageUrl - >>= buildParagraphHeroImage - >>= ifValid \case - Left paragraphHeroImage -> do - setFormStatus FormStatusError - render NewView { .. } - Right paragraphHeroImage -> do - paragraphHeroImage <- paragraphHeroImage |> createRecord - setSuccessMessage "Hero Image created" - -- We don't setFormStatus, since we redirect to a new page. - redirectTo EditLandingPageAction { landingPageId = paragraphHeroImage.landingPageId } + createOrUpdateParagraphHeroImageAction Nothing action DeleteParagraphHeroImageAction { paragraphHeroImageId } = do paragraphHeroImage <- fetch paragraphHeroImageId @@ -71,5 +37,32 @@ buildParagraphHeroImage paragraphHeroImage = paragraphHeroImage |> fill @["landingPageId", "weight", "title", "subtitle", "link"] |> validateField #title nonEmpty |> validateField #imageUrl nonEmpty - |> return + |> pure + +createOrUpdateParagraphHeroImageAction :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Maybe (Id ParagraphHeroImage) -> IO () +createOrUpdateParagraphHeroImageAction maybeParagraphHeroImageId = do + let uploadImage = uploadToStorageWithOptions $ def + { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } + + formStatus <- getAndClearFormStatus + + paragraphHeroImage <- case maybeParagraphHeroImageId of + Just id -> fetch id + Nothing -> pure $ newRecord @ParagraphHeroImage + paragraphHeroImage + |> uploadImage #imageUrl + >>= buildParagraphHeroImage + >>= ifValid \case + Left paragraphHeroImage -> do + setFormStatus FormStatusError + if isJust maybeParagraphHeroImageId + then render EditView { .. } + else render NewView { .. } + Right paragraphHeroImage -> do + paragraphHeroImage <- case maybeParagraphHeroImageId of + Just _ -> paragraphHeroImage |> updateRecord + Nothing -> paragraphHeroImage |> createRecord + setSuccessMessage "Hero Image saved" + -- We don't setFormStatus, since we redirect to a new page. + redirectTo EditLandingPageAction { landingPageId = paragraphHeroImage.landingPageId } diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs index cde328d..b80bc66 100644 --- a/Web/Element/HeroImage.hs +++ b/Web/Element/HeroImage.hs @@ -13,6 +13,7 @@ render record@RenderHeroImage {title, subtitle, button, imageUrl} = ++ subTitleWrapped ++ buttonHtml |> wrapVerticalSpacingBig AlignNone + -- 1536x466 - size of the image. |> renderImageAndContent (pathTo $ RenderImageStyleAction 1536 466 imageUrl signed) where -- Sign the image URL to prevent tampering. @@ -29,7 +30,7 @@ render record@RenderHeroImage {title, subtitle, button, imageUrl} = buttonHtml = case button of Just btn -> Web.Element.Button.render btn - Nothing -> mempty + Nothing -> "" renderImageAndContent :: Text -> Html -> Html diff --git a/Web/View/ParagraphHeroImages/Edit.hs b/Web/View/ParagraphHeroImages/Edit.hs index 07973dd..e8f740c 100644 --- a/Web/View/ParagraphHeroImages/Edit.hs +++ b/Web/View/ParagraphHeroImages/Edit.hs @@ -11,7 +11,7 @@ instance View EditView where html EditView { .. } = [hsx| {breadcrumb}

Edit Paragraph Hero Image

- {renderForm paragraphHeroImage True formStatus} + {renderForm paragraphHeroImage False formStatus} |] where breadcrumb = renderBreadcrumb From 3097f18a6e1ea5d8f39ddff04d605014570ded8c Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Fri, 19 Jul 2024 14:04:35 +0700 Subject: [PATCH 06/12] PR fixes --- Web/Controller/LandingPages.hs | 2 +- Web/Element/HeroImage.hs | 6 ++---- Web/Element/Types.hs | 2 +- Web/View/LandingPages/Edit.hs | 14 ++++++-------- Web/View/LandingPages/Show.hs | 33 ++++++++++++++++----------------- Web/View/StyleGuide/Index.hs | 4 ++-- 6 files changed, 28 insertions(+), 33 deletions(-) diff --git a/Web/Controller/LandingPages.hs b/Web/Controller/LandingPages.hs index 6fccafe..59813c8 100644 --- a/Web/Controller/LandingPages.hs +++ b/Web/Controller/LandingPages.hs @@ -66,8 +66,8 @@ instance Controller LandingPagesController where -- Iterate over all paragraphs, and update the weight. forEach landingPageWithRecords.paragraphCtas updateParagraph - forEach landingPageWithRecords.paragraphQuotes updateParagraph forEach landingPageWithRecords.paragraphHeroImages updateParagraph + forEach landingPageWithRecords.paragraphQuotes updateParagraph where updateParagraph :: forall record. diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs index b80bc66..9ab6373 100644 --- a/Web/Element/HeroImage.hs +++ b/Web/Element/HeroImage.hs @@ -2,18 +2,16 @@ module Web.Element.HeroImage where import Web.View.Prelude -import Application.Helper.Icons import Web.Element.ElementWrap import Web.Element.Types import Web.Element.Button render :: RenderHeroImage -> Html -render record@RenderHeroImage {title, subtitle, button, imageUrl} = +render record@RenderHeroImage {title, subtitle, maybeButton, imageUrl} = titleWrapped ++ subTitleWrapped ++ buttonHtml |> wrapVerticalSpacingBig AlignNone - -- 1536x466 - size of the image. |> renderImageAndContent (pathTo $ RenderImageStyleAction 1536 466 imageUrl signed) where -- Sign the image URL to prevent tampering. @@ -28,7 +26,7 @@ render record@RenderHeroImage {title, subtitle, button, imageUrl} = |> wrapTextFontWeight FontWeightMedium |> wrapTextResponsiveFontSize TextSizeXl - buttonHtml = case button of + buttonHtml = case maybeButton of Just btn -> Web.Element.Button.render btn Nothing -> "" diff --git a/Web/Element/Types.hs b/Web/Element/Types.hs index 6b297f9..68ee504 100644 --- a/Web/Element/Types.hs +++ b/Web/Element/Types.hs @@ -64,7 +64,7 @@ data RenderHeroImage = RenderHeroImage { title :: Text , subtitle :: Text , imageUrl :: Text - , button :: Maybe RenderButton + , maybeButton :: Maybe RenderButton } diff --git a/Web/View/LandingPages/Edit.hs b/Web/View/LandingPages/Edit.hs index c58bd48..e3b4336 100644 --- a/Web/View/LandingPages/Edit.hs +++ b/Web/View/LandingPages/Edit.hs @@ -24,8 +24,8 @@ instance View EditView where where landingPage = landingPageWithRecords.landingPage paragraphCtas = landingPageWithRecords.paragraphCtas - paragraphQuotes = landingPageWithRecords.paragraphQuotes paragraphHeroImages = landingPageWithRecords.paragraphHeroImages + paragraphQuotes = landingPageWithRecords.paragraphQuotes breadcrumb = renderBreadcrumb [ breadcrumbLink "Landing Pages" LandingPagesAction @@ -95,8 +95,8 @@ renderForm landingPage paragraphCtas paragraphQuotes paragraphHeroImages formSta orderAndRenderParagraphs :: [ParagraphCta] -> [ParagraphQuote] -> [ParagraphHeroImage] -> Html orderAndRenderParagraphs paragraphCtas paragraphQuotes paragraphHeroImages = ctas - ++ quotes ++ heroImages + ++ quotes |> sortOn fst |> fmap snd |> mconcat @@ -105,14 +105,12 @@ orderAndRenderParagraphs paragraphCtas paragraphQuotes paragraphHeroImages = ctas = paragraphCtas |> fmap (\paragraph -> (paragraph.weight, paragraphTitleAndOps EditParagraphCtaAction DeleteParagraphCtaAction paragraph.id paragraph.title ("CTA" :: Text))) - quotes = paragraphQuotes - |> fmap (\paragraph -> (paragraph.weight, paragraphTitleAndOps EditParagraphQuoteAction DeleteParagraphQuoteAction paragraph.id paragraph.subtitle ("Quote" :: Text))) - heroImages = paragraphHeroImages |> fmap (\paragraph -> (paragraph.weight, paragraphTitleAndOps EditParagraphHeroImageAction DeleteParagraphHeroImageAction paragraph.id paragraph.title ("Hero Image" :: Text))) - - + quotes = paragraphQuotes + |> fmap (\paragraph -> (paragraph.weight, paragraphTitleAndOps EditParagraphQuoteAction DeleteParagraphQuoteAction paragraph.id paragraph.subtitle ("Quote" :: Text))) + -- Show the paragraph title and the operations to perform on it. paragraphTitleAndOps :: (Show (PrimaryKey record), HasPath controller) => (Id' record -> controller) -> (Id' record -> controller) -> Id' record -> Text -> Text -> Html paragraphTitleAndOps editAction deleteAction id title type_ = @@ -142,7 +140,7 @@ orderAndRenderParagraphs paragraphCtas paragraphQuotes paragraphHeroImages = sortableHandle = if - length ctas + length quotes + length heroImages > 1 + length ctas + length heroImages + length quotes > 1 then [hsx|
diff --git a/Web/View/LandingPages/Show.hs b/Web/View/LandingPages/Show.hs index 1fd51ca..6e66069 100644 --- a/Web/View/LandingPages/Show.hs +++ b/Web/View/LandingPages/Show.hs @@ -2,10 +2,10 @@ module Web.View.LandingPages.Show where import Web.Element.Cta import Web.Element.ElementWrap +import Web.Element.HeroImage import Web.Element.Link import Web.Element.Types import Web.Element.Quote -import Web.Element.HeroImage import Web.Types import Web.View.Prelude @@ -44,7 +44,7 @@ instance View ShowView where orderAndRenderParagraphs :: (?context::ControllerContext) => LandingPageWithRecords -> Html orderAndRenderParagraphs landingPageWithRecords = - ctas ++ quotes ++ heroImages + ctas ++ heroImages ++ quotes -- Order by weight. |> sortOn fst |> fmap snd @@ -58,17 +58,17 @@ orderAndRenderParagraphs landingPageWithRecords = ) ) - quotes = landingPageWithRecords.paragraphQuotes + heroImages = landingPageWithRecords.paragraphHeroImages |> fmap (\paragraph -> ( paragraph.weight - , renderParagraphQuote paragraph + , renderParagraphHeroImage paragraph ) ) - heroImages = landingPageWithRecords.paragraphHeroImages + quotes = landingPageWithRecords.paragraphQuotes |> fmap (\paragraph -> ( paragraph.weight - , renderParagraphHeroImage paragraph + , renderParagraphQuote paragraph ) ) @@ -96,20 +96,19 @@ renderParagraphQuote paragraphQuote = renderParagraphHeroImage :: ParagraphHeroImage -> Html renderParagraphHeroImage paragraphHeroImage = - let - button = case paragraphHeroImage.link of - Just linkText -> - Just RenderButton - { text = "Read More" - , url = linkText - , isPrimary = True - } - _ -> Nothing - in RenderHeroImage { title = paragraphHeroImage.title , subtitle = paragraphHeroImage.subtitle |> fromMaybe "" , imageUrl = paragraphHeroImage.imageUrl |> fromMaybe "" - , button = button + , maybeButton = maybeButton } |> Web.Element.HeroImage.render + where + maybeButton = case paragraphHeroImage.link of + Just linkText -> + Just RenderButton + { text = "Read More" + , url = linkText + , isPrimary = True + } + _ -> Nothing diff --git a/Web/View/StyleGuide/Index.hs b/Web/View/StyleGuide/Index.hs index 3f766cc..85eeca0 100644 --- a/Web/View/StyleGuide/Index.hs +++ b/Web/View/StyleGuide/Index.hs @@ -4,9 +4,9 @@ import Web.Element.Types import Web.View.Prelude import Web.Element.Cta +import Web.Element.HeroImage import Web.Element.PageTitle import Web.Element.Quote -import Web.Element.HeroImage data IndexView = IndexView { } @@ -68,7 +68,7 @@ instance View IndexView where { title = "This is title" , subtitle = "This is subtitle" , imageUrl = "/styleGuideImages/8f8827de-e5d4-4ee7-b0a3-abae36274338" - , button = Just RenderButton + , maybeButton = Just RenderButton { text = "Read more" , url = "/" , isPrimary = True From 2569a54a5d7b75e774498c3d01d828af35607568 Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Fri, 19 Jul 2024 14:51:23 +0700 Subject: [PATCH 07/12] PR fixes --- Web/Element/HeroImage.hs | 17 +++++++++-------- Web/Element/Types.hs | 8 ++++---- Web/View/LandingPages/Show.hs | 17 ++++++++--------- Web/View/StyleGuide/Index.hs | 2 +- 4 files changed, 22 insertions(+), 22 deletions(-) diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs index 9ab6373..c22c295 100644 --- a/Web/Element/HeroImage.hs +++ b/Web/Element/HeroImage.hs @@ -7,10 +7,10 @@ import Web.Element.Types import Web.Element.Button render :: RenderHeroImage -> Html -render record@RenderHeroImage {title, subtitle, maybeButton, imageUrl} = +render record@RenderHeroImage {title, maybeSubtitle, maybeButton, imageUrl} = titleWrapped ++ subTitleWrapped - ++ buttonHtml + ++ renderedButton |> wrapVerticalSpacingBig AlignNone |> renderImageAndContent (pathTo $ RenderImageStyleAction 1536 466 imageUrl signed) where @@ -22,13 +22,14 @@ render record@RenderHeroImage {title, subtitle, maybeButton, imageUrl} = |> wrapTextFontWeight FontWeightBold |> wrapTextResponsiveFontSize TextSizeSm - subTitleWrapped = cs subtitle - |> wrapTextFontWeight FontWeightMedium - |> wrapTextResponsiveFontSize TextSizeXl + subTitleWrapped = maybeSubtitle + |> fmap (\subtitle -> cs subtitle + |> wrapTextFontWeight FontWeightMedium + |> wrapTextResponsiveFontSize TextSizeXl + ) + |> fromMaybe "" - buttonHtml = case maybeButton of - Just btn -> Web.Element.Button.render btn - Nothing -> "" + renderedButton = maybeButton |> fmap Web.Element.Button.render |> fromMaybe "" renderImageAndContent :: Text -> Html -> Html diff --git a/Web/Element/Types.hs b/Web/Element/Types.hs index 68ee504..35539f6 100644 --- a/Web/Element/Types.hs +++ b/Web/Element/Types.hs @@ -61,10 +61,10 @@ data RenderQuote = RenderQuote } data RenderHeroImage = RenderHeroImage - { title :: Text - , subtitle :: Text - , imageUrl :: Text - , maybeButton :: Maybe RenderButton + { title :: Text + , maybeSubtitle :: Maybe Text + , imageUrl :: Text + , maybeButton :: Maybe RenderButton } diff --git a/Web/View/LandingPages/Show.hs b/Web/View/LandingPages/Show.hs index 6e66069..89e8484 100644 --- a/Web/View/LandingPages/Show.hs +++ b/Web/View/LandingPages/Show.hs @@ -98,17 +98,16 @@ renderParagraphHeroImage :: ParagraphHeroImage -> Html renderParagraphHeroImage paragraphHeroImage = RenderHeroImage { title = paragraphHeroImage.title - , subtitle = paragraphHeroImage.subtitle |> fromMaybe "" + , maybeSubtitle = paragraphHeroImage.subtitle , imageUrl = paragraphHeroImage.imageUrl |> fromMaybe "" , maybeButton = maybeButton } |> Web.Element.HeroImage.render where - maybeButton = case paragraphHeroImage.link of - Just linkText -> - Just RenderButton - { text = "Read More" - , url = linkText - , isPrimary = True - } - _ -> Nothing + maybeButton = paragraphHeroImage.link |> fmap (\linkText -> + RenderButton + { text = "Read More" + , url = linkText + , isPrimary = True + } + ) diff --git a/Web/View/StyleGuide/Index.hs b/Web/View/StyleGuide/Index.hs index 85eeca0..7a9a594 100644 --- a/Web/View/StyleGuide/Index.hs +++ b/Web/View/StyleGuide/Index.hs @@ -66,7 +66,7 @@ instance View IndexView where heroImage = RenderHeroImage { title = "This is title" - , subtitle = "This is subtitle" + , maybeSubtitle = "This is subtitle" , imageUrl = "/styleGuideImages/8f8827de-e5d4-4ee7-b0a3-abae36274338" , maybeButton = Just RenderButton { text = "Read more" From aea4fa863696f2ccda34a7db03b94b37b843c8d5 Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Fri, 19 Jul 2024 15:12:31 +0700 Subject: [PATCH 08/12] Adjust quote logic --- Web/Controller/ParagraphQuotes.hs | 65 ++++++++++++++----------------- Web/View/ParagraphQuotes/Form.hs | 2 +- 2 files changed, 30 insertions(+), 37 deletions(-) diff --git a/Web/Controller/ParagraphQuotes.hs b/Web/Controller/ParagraphQuotes.hs index 0728df5..688c35a 100644 --- a/Web/Controller/ParagraphQuotes.hs +++ b/Web/Controller/ParagraphQuotes.hs @@ -22,44 +22,10 @@ instance Controller ParagraphQuotesController where 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 -> 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 } + createOrUpdateParagraphQuoteAction (Just paragraphQuoteId) action CreateParagraphQuoteAction = do - let uploadImage = uploadToStorageWithOptions $ def - { 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 -> 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 } + createOrUpdateParagraphQuoteAction Nothing action DeleteParagraphQuoteAction { paragraphQuoteId } = do paragraphQuote <- fetch paragraphQuoteId @@ -74,3 +40,30 @@ buildParagraphQuote paragraphQuote = paragraphQuote |> validateField #imageUrl nonEmpty |> return +createOrUpdateParagraphQuoteAction :: (?modelContext :: ModelContext, ?context :: ControllerContext) => Maybe (Id ParagraphQuote) -> IO () +createOrUpdateParagraphQuoteAction maybeParagraphQuoteId = do + let uploadImage = uploadToStorageWithOptions $ def + { preprocess = applyImageMagick "jpg" ["-resize", "1024x1024^", "-gravity", "north", "-extent", "1024x1024", "-quality", "85%", "-strip"] } + + formStatus <- getAndClearFormStatus + + paragraphQuote <- case maybeParagraphQuoteId of + Just id -> fetch id + Nothing -> pure $ newRecord @ParagraphQuote + + paragraphQuote + |> uploadImage #imageUrl + >>= buildParagraphQuote + >>= ifValid \case + Left paragraphQuote -> do + setFormStatus FormStatusError + if isJust maybeParagraphQuoteId + then render EditView { .. } + else render NewView { .. } + Right paragraphQuote -> do + paragraphQuote <- case maybeParagraphQuoteId of + Just _ -> paragraphQuote |> updateRecord + Nothing -> paragraphQuote |> createRecord + setSuccessMessage "Hero Image saved" + -- We don't setFormStatus, since we redirect to a new page. + redirectTo EditLandingPageAction { landingPageId = paragraphQuote.landingPageId } \ No newline at end of file diff --git a/Web/View/ParagraphQuotes/Form.hs b/Web/View/ParagraphQuotes/Form.hs index 2d3bc15..5f59220 100644 --- a/Web/View/ParagraphQuotes/Form.hs +++ b/Web/View/ParagraphQuotes/Form.hs @@ -28,7 +28,7 @@ renderForm paragraphQuote isImageRequired formStatus = formFor paragraphQuote [h
- {renderSubmitButtonwithFormStatus submitButton formStatus} + {renderSubmitButtonwithFormStatus (submitButton {label = "Save Quote"}) formStatus} |] |> wrapVerticalSpacing AlignNone |> wrapContainerWide From 6b9fc0de61b974ddd3dc3842899add8008a8d19b Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov <81006789+andreytroeglazov@users.noreply.github.com> Date: Fri, 19 Jul 2024 19:25:54 +0700 Subject: [PATCH 09/12] Improve Paragraphs breadcrumbs (#56) --- Web/Controller/ParagraphCtas.hs | 4 ++++ Web/Controller/ParagraphHeroImages.hs | 4 ++++ Web/Controller/ParagraphQuotes.hs | 3 +++ Web/View/ParagraphCtas/Edit.hs | 5 ++++- Web/View/ParagraphCtas/New.hs | 5 ++++- Web/View/ParagraphHeroImages/Edit.hs | 5 ++++- Web/View/ParagraphHeroImages/New.hs | 5 ++++- Web/View/ParagraphQuotes/Edit.hs | 7 +++++-- Web/View/ParagraphQuotes/New.hs | 5 ++++- 9 files changed, 36 insertions(+), 7 deletions(-) diff --git a/Web/Controller/ParagraphCtas.hs b/Web/Controller/ParagraphCtas.hs index a3406d7..a5b1d6d 100644 --- a/Web/Controller/ParagraphCtas.hs +++ b/Web/Controller/ParagraphCtas.hs @@ -15,6 +15,7 @@ instance Controller ParagraphCtasController where -- Get all landing pages, so we can select the one we want to link to. landingPages <- query @LandingPage |> fetch + landingPage <- fetch paragraphCta.landingPageId render NewView { .. } @@ -23,6 +24,7 @@ instance Controller ParagraphCtasController where -- Get all landing pages, so we can select the one we want to link to. landingPages <- query @LandingPage |> fetch + landingPage <- fetch paragraphCta.landingPageId render EditView { .. } @@ -33,6 +35,7 @@ instance Controller ParagraphCtasController where |> ifValid \case Left paragraphCta -> do landingPages <- query @LandingPage |> fetch + landingPage <- fetch paragraphCta.landingPageId render EditView { .. } Right paragraphCta -> do paragraphCta <- paragraphCta |> updateRecord @@ -46,6 +49,7 @@ instance Controller ParagraphCtasController where |> ifValid \case Left paragraphCta -> do landingPages <- query @LandingPage |> fetch + landingPage <- fetch paragraphCta.landingPageId render NewView { .. } Right paragraphCta -> do paragraphCta <- paragraphCta |> createRecord diff --git a/Web/Controller/ParagraphHeroImages.hs b/Web/Controller/ParagraphHeroImages.hs index 891b9d4..daf2d23 100644 --- a/Web/Controller/ParagraphHeroImages.hs +++ b/Web/Controller/ParagraphHeroImages.hs @@ -12,6 +12,7 @@ instance Controller ParagraphHeroImagesController where |> set #weight weight let formStatus = FormStatusNotSubmitted + landingPage <- fetch paragraphHeroImage.landingPageId render NewView { .. } @@ -19,6 +20,8 @@ instance Controller ParagraphHeroImagesController where paragraphHeroImage <- fetch paragraphHeroImageId -- Get from the session, if the form was submitted successfully. formStatus <- getAndClearFormStatus + landingPage <- fetch paragraphHeroImage.landingPageId + render EditView { .. } action UpdateParagraphHeroImageAction { paragraphHeroImageId } = do @@ -56,6 +59,7 @@ createOrUpdateParagraphHeroImageAction maybeParagraphHeroImageId = do >>= ifValid \case Left paragraphHeroImage -> do setFormStatus FormStatusError + landingPage <- fetch paragraphHeroImage.landingPageId if isJust maybeParagraphHeroImageId then render EditView { .. } else render NewView { .. } diff --git a/Web/Controller/ParagraphQuotes.hs b/Web/Controller/ParagraphQuotes.hs index 688c35a..6ef5017 100644 --- a/Web/Controller/ParagraphQuotes.hs +++ b/Web/Controller/ParagraphQuotes.hs @@ -12,11 +12,13 @@ instance Controller ParagraphQuotesController where |> set #weight weight let formStatus = FormStatusNotSubmitted + landingPage <- fetch paragraphQuote.landingPageId render NewView { .. } action EditParagraphQuoteAction { paragraphQuoteId } = do paragraphQuote <- fetch paragraphQuoteId + landingPage <- fetch paragraphQuote.landingPageId -- Get from the session, if the form was submitted successfully. formStatus <- getAndClearFormStatus render EditView { .. } @@ -57,6 +59,7 @@ createOrUpdateParagraphQuoteAction maybeParagraphQuoteId = do >>= ifValid \case Left paragraphQuote -> do setFormStatus FormStatusError + landingPage <- fetch paragraphQuote.landingPageId if isJust maybeParagraphQuoteId then render EditView { .. } else render NewView { .. } diff --git a/Web/View/ParagraphCtas/Edit.hs b/Web/View/ParagraphCtas/Edit.hs index eaac7ab..ad8b61c 100644 --- a/Web/View/ParagraphCtas/Edit.hs +++ b/Web/View/ParagraphCtas/Edit.hs @@ -7,6 +7,7 @@ import Web.Element.ElementWrap data EditView = EditView { paragraphCta :: ParagraphCta , landingPages :: [LandingPage] + , landingPage :: LandingPage } instance View EditView where @@ -17,7 +18,9 @@ instance View EditView where |] where breadcrumb = renderBreadcrumb - [ breadcrumbText "Edit Cta" + [ breadcrumbText "Landing Page" + , breadcrumbLink (cs landingPage.title) (EditLandingPageAction landingPage.id) + , breadcrumbText "Edit CTA" ] renderForm :: ParagraphCta -> [LandingPage] -> Html diff --git a/Web/View/ParagraphCtas/New.hs b/Web/View/ParagraphCtas/New.hs index 28432f6..95b668d 100644 --- a/Web/View/ParagraphCtas/New.hs +++ b/Web/View/ParagraphCtas/New.hs @@ -6,6 +6,7 @@ import Web.Element.ElementWrap data NewView = NewView { paragraphCta :: ParagraphCta , landingPages :: [LandingPage] + , landingPage :: LandingPage } instance View NewView where @@ -16,7 +17,9 @@ instance View NewView where |] where breadcrumb = renderBreadcrumb - [ breadcrumbText "New Cta" + [ breadcrumbText "Landing Page" + , breadcrumbLink (cs landingPage.title) (EditLandingPageAction landingPage.id) + , breadcrumbText "New CTA" ] renderForm :: ParagraphCta -> [LandingPage] -> Html diff --git a/Web/View/ParagraphHeroImages/Edit.hs b/Web/View/ParagraphHeroImages/Edit.hs index e8f740c..a7c9336 100644 --- a/Web/View/ParagraphHeroImages/Edit.hs +++ b/Web/View/ParagraphHeroImages/Edit.hs @@ -5,6 +5,7 @@ import Web.View.ParagraphHeroImages.Form data EditView = EditView { paragraphHeroImage :: ParagraphHeroImage , formStatus :: FormStatus + , landingPage :: LandingPage } instance View EditView where @@ -15,5 +16,7 @@ instance View EditView where |] where breadcrumb = renderBreadcrumb - [ breadcrumbText "Edit Hero Image" + [ breadcrumbText "Landing Page" + , breadcrumbLink (cs landingPage.title) (EditLandingPageAction landingPage.id) + , breadcrumbText "Edit Hero Image" ] diff --git a/Web/View/ParagraphHeroImages/New.hs b/Web/View/ParagraphHeroImages/New.hs index 95341af..a091623 100644 --- a/Web/View/ParagraphHeroImages/New.hs +++ b/Web/View/ParagraphHeroImages/New.hs @@ -6,6 +6,7 @@ import Web.View.ParagraphHeroImages.Form data NewView = NewView { paragraphHeroImage :: ParagraphHeroImage , formStatus :: FormStatus + , landingPage :: LandingPage } instance View NewView where @@ -16,6 +17,8 @@ instance View NewView where |] where breadcrumb = renderBreadcrumb - [ breadcrumbText "New Hero Image" + [ breadcrumbText "Landing Page" + , breadcrumbLink (cs landingPage.title) (EditLandingPageAction landingPage.id) + , breadcrumbText "New Hero Image" ] diff --git a/Web/View/ParagraphQuotes/Edit.hs b/Web/View/ParagraphQuotes/Edit.hs index 690d85b..6053f5f 100644 --- a/Web/View/ParagraphQuotes/Edit.hs +++ b/Web/View/ParagraphQuotes/Edit.hs @@ -5,6 +5,7 @@ import Web.View.ParagraphQuotes.Form data EditView = EditView { paragraphQuote :: ParagraphQuote , formStatus :: FormStatus + , landingPage :: LandingPage } instance View EditView where @@ -15,5 +16,7 @@ instance View EditView where |] where breadcrumb = renderBreadcrumb - [ breadcrumbText "Edit Quote" - ] + [ breadcrumbText "Landing Page" + , breadcrumbLink (cs landingPage.title) (EditLandingPageAction landingPage.id) + , breadcrumbText "Edit Quote" + ] \ No newline at end of file diff --git a/Web/View/ParagraphQuotes/New.hs b/Web/View/ParagraphQuotes/New.hs index a88907b..0b0ca6a 100644 --- a/Web/View/ParagraphQuotes/New.hs +++ b/Web/View/ParagraphQuotes/New.hs @@ -6,6 +6,7 @@ import Web.View.ParagraphQuotes.Form data NewView = NewView { paragraphQuote :: ParagraphQuote , formStatus :: FormStatus + , landingPage :: LandingPage } instance View NewView where @@ -16,6 +17,8 @@ instance View NewView where |] where breadcrumb = renderBreadcrumb - [ breadcrumbText "New Quote" + [ breadcrumbText "Landing Page" + , breadcrumbLink (cs landingPage.title) (EditLandingPageAction landingPage.id) + , breadcrumbText "New Quote" ] From 2437d73bbee106690653c51dd2acef599329c3eb Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Thu, 17 Oct 2024 15:42:16 +0700 Subject: [PATCH 10/12] Adjust code --- .gitignore | 1 + Web/Element/HeroImage.hs | 18 ++++++++++-------- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/.gitignore b/.gitignore index c1b4e89..0d39432 100644 --- a/.gitignore +++ b/.gitignore @@ -25,6 +25,7 @@ static/app.css static/articles static/paragraph_quotes +static/paragraph_hero_images # @todo: Fix the creation of duplicates static/styleGuideImages/imageStyles diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs index c22c295..ae3328a 100644 --- a/Web/Element/HeroImage.hs +++ b/Web/Element/HeroImage.hs @@ -8,11 +8,14 @@ import Web.Element.Button render :: RenderHeroImage -> Html render record@RenderHeroImage {title, maybeSubtitle, maybeButton, imageUrl} = - titleWrapped - ++ subTitleWrapped - ++ renderedButton - |> wrapVerticalSpacingBig AlignNone - |> renderImageAndContent (pathTo $ RenderImageStyleAction 1536 466 imageUrl signed) + [ titleWrapped + , subTitleWrapped + , renderedButton + ] + |> catMaybes + |> mconcat + |> wrapVerticalSpacingBig AlignNone + |> renderImageAndContent (pathTo $ RenderImageStyleAction 1536 466 imageUrl signed) where -- Sign the image URL to prevent tampering. signed = signImageUrl imageUrl 1536 466 @@ -21,16 +24,15 @@ render record@RenderHeroImage {title, maybeSubtitle, maybeButton, imageUrl} = |> wrapHeaderTag 1 |> wrapTextFontWeight FontWeightBold |> wrapTextResponsiveFontSize TextSizeSm + |> Just subTitleWrapped = maybeSubtitle |> fmap (\subtitle -> cs subtitle |> wrapTextFontWeight FontWeightMedium |> wrapTextResponsiveFontSize TextSizeXl ) - |> fromMaybe "" - - renderedButton = maybeButton |> fmap Web.Element.Button.render |> fromMaybe "" + renderedButton = maybeButton |> fmap Web.Element.Button.render renderImageAndContent :: Text -> Html -> Html renderImageAndContent imageUrl items = From 82ff048f283b6a65f99c0ddb2f0ded89ff62caeb Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Thu, 17 Oct 2024 15:44:05 +0700 Subject: [PATCH 11/12] Change vars --- Web/Element/HeroImage.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs index ae3328a..19a403f 100644 --- a/Web/Element/HeroImage.hs +++ b/Web/Element/HeroImage.hs @@ -9,8 +9,8 @@ import Web.Element.Button render :: RenderHeroImage -> Html render record@RenderHeroImage {title, maybeSubtitle, maybeButton, imageUrl} = [ titleWrapped - , subTitleWrapped - , renderedButton + , maybeSubTitleWrapped + , maybeRenderedButton ] |> catMaybes |> mconcat @@ -26,13 +26,13 @@ render record@RenderHeroImage {title, maybeSubtitle, maybeButton, imageUrl} = |> wrapTextResponsiveFontSize TextSizeSm |> Just - subTitleWrapped = maybeSubtitle + maybeSubTitleWrapped = maybeSubtitle |> fmap (\subtitle -> cs subtitle |> wrapTextFontWeight FontWeightMedium |> wrapTextResponsiveFontSize TextSizeXl ) - renderedButton = maybeButton |> fmap Web.Element.Button.render + maybeRenderedButton = maybeButton |> fmap Web.Element.Button.render renderImageAndContent :: Text -> Html -> Html renderImageAndContent imageUrl items = From 4ef1251887d29ae83ee518ed64f4a24b7a87607f Mon Sep 17 00:00:00 2001 From: Andrey Troeglazov Date: Thu, 17 Oct 2024 17:31:02 +0700 Subject: [PATCH 12/12] Adjust logic for null values --- Web/Element/HeroImage.hs | 6 +++--- Web/View/LandingPages/Show.hs | 8 ++++---- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/Web/Element/HeroImage.hs b/Web/Element/HeroImage.hs index 19a403f..dd46384 100644 --- a/Web/Element/HeroImage.hs +++ b/Web/Element/HeroImage.hs @@ -26,11 +26,11 @@ render record@RenderHeroImage {title, maybeSubtitle, maybeButton, imageUrl} = |> wrapTextResponsiveFontSize TextSizeSm |> Just - maybeSubTitleWrapped = maybeSubtitle - |> fmap (\subtitle -> cs subtitle + maybeSubTitleWrapped = case maybeSubtitle of + Just subtitle | not (null subtitle) -> Just $ cs subtitle |> wrapTextFontWeight FontWeightMedium |> wrapTextResponsiveFontSize TextSizeXl - ) + _ -> Nothing maybeRenderedButton = maybeButton |> fmap Web.Element.Button.render diff --git a/Web/View/LandingPages/Show.hs b/Web/View/LandingPages/Show.hs index 89e8484..7ed3908 100644 --- a/Web/View/LandingPages/Show.hs +++ b/Web/View/LandingPages/Show.hs @@ -104,10 +104,10 @@ renderParagraphHeroImage paragraphHeroImage = } |> Web.Element.HeroImage.render where - maybeButton = paragraphHeroImage.link |> fmap (\linkText -> - RenderButton + maybeButton = case paragraphHeroImage.link of + Just link | not (null link) -> Just $ RenderButton { text = "Read More" - , url = linkText + , url = link , isPrimary = True } - ) + _ -> Nothing