Hero Image

Application/Helper/Controller.hs

@@ -19,19 +19,19 @@ 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
 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.

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 }

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

Web/View/ParagraphHeroImages/Edit.hs

@@ -11,7 +11,7 @@ instance View EditView where
     html EditView { .. } = [hsx|
         {breadcrumb}
         <h1>Edit Paragraph Hero Image</h1>
-        {renderForm paragraphHeroImage True formStatus}
+        {renderForm paragraphHeroImage False formStatus}
     |]
         where
             breadcrumb = renderBreadcrumb