Hero Image

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.

Application/Schema.sql

@@ -5,15 +5,13 @@ 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,
     password_hash TEXT NOT NULL,
     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;

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.

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
+

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|
+        <div class="flex flex-col sm:grid sm:grid-rows-1 md:grid-cols-2 gap-2 md:gap-8 lg:gap-10 overflow-hidden bg-gray-50">
+
+            <div class="w-full grid grid-rows-1">
+                <figure class="row-start-1 col-start-1 child-object-cover h-full">
+                    {image}
+                </figure>
+            </div>
+            <div class="pt-5 pb-8 px-5 lg:py-8 lg:max-w-lg my-auto">
+                {items}
+            </div>
+        </div>
+    |]
+    where
+        image = [hsx|<img src={imageUrl} class="w-full h-full" />|]
+
+

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

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
         ]
 

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

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

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|
                     <ul class="js-sortable">
-                        {orderAndRenderParagraphs paragraphCtas paragraphQuotes}
+                        {orderAndRenderParagraphs paragraphCtas paragraphQuotes paragraphHeroImages}
                     </ul>
                 |]
             ]
@@ -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|
                     <div class="sortable-handle">

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
+        |> 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

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

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