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