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", "link"]
+    |> validateField #title nonEmpty
+    |> validateField #imageUrl nonEmpty
+    |> return
+

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

Web/Element/HeroImage.hs

@@ -0,0 +1,55 @@
+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} =
+     titleWrapped
+        ++ subTitleWrapped
+        ++ buttonHtml
+        |> wrapVerticalSpacingBig AlignNone
+        |> renderImageAndContent (pathTo $ RenderImageStyleAction 1536 466 imageUrl signed)
+    where
+        -- Sign the image URL to prevent tampering.
+        signed = signImageUrl imageUrl 1536 466
+
+        titleWrapped = cs title
+            |> wrapHeaderTag 1
+            |> wrapTextFontWeight FontWeightBold
+            |> wrapTextResponsiveFontSize TextSizeSm
+
+        subTitleWrapped = cs subtitle
+            |> wrapTextFontWeight FontWeightMedium
+            |> wrapTextResponsiveFontSize TextSizeXl
+
+        buttonHtml = case button of
+            Just btn -> Web.Element.Button.render btn
+            Nothing -> mempty
+
+
+renderImageAndContent :: Text -> Html -> Html
+renderImageAndContent imageUrl items =
+    [hsx|
+        <div class="grid grid-rows-1">
+            <figure class="row-start-1 col-start-1 child-object-cover">
+                {image}
+            </figure>
+
+            <div class="row-start-1 col-start-1 z-10 flex flex-col justify-center">
+                <div class="container-wide w-full">
+                    <div class="max-w-prose my-6 md:my-8 p-6 md:p-8 lg:p-10 bg-white/90 flex flex-col gap-3 md:gap-4 lg:gap-5 rounded-lg">
+                        {items}
+                    </div>
+                </div>
+            </div>
+        </div>
+    |]
+    where
+        image = [hsx|<img src={imageUrl} class="w-full h-full" />|]
+
+

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
@@ -60,6 +60,13 @@ data RenderQuote = RenderQuote
     , imageUrl :: Text
     }
 
+data RenderHeroImage = RenderHeroImage
+    { title    :: Text
+    , subtitle :: Text
+    , imageUrl :: Text
+    , button :: Maybe RenderButton
+    }
+
 
 -- @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">