diff --git a/Web/Controller/LandingPages.hs b/Web/Controller/LandingPages.hs index 5ae740f..f642ecc 100644 --- a/Web/Controller/LandingPages.hs +++ b/Web/Controller/LandingPages.hs @@ -4,6 +4,7 @@ import Web.Controller.Prelude import Web.View.LandingPages.Index import Web.View.LandingPages.New import Web.View.LandingPages.Edit +import Web.View.LandingPages.Order import Web.View.LandingPages.Show instance Controller LandingPagesController where @@ -51,42 +52,6 @@ instance Controller LandingPagesController where Right landingPage -> do landingPage <- landingPage |> updateRecord - -- After we update the Landing page, we can set the order of the paragraphs. - let params = paramListOrNothing @UUID "paragraphId" - - case catMaybes params of - [] -> do - -- No paragraphs to update. - pure () - - uuids -> do - -- We need to update the weight of the paragraphs, - -- So load them. - landingPageWithRecords <- fetchLandingPageWithRecords landingPageId - - -- Iterate over all paragraphs, and update the weight. - forEach landingPageWithRecords.paragraphCtas updateParagraph - forEach landingPageWithRecords.paragraphQuotes updateParagraph - - where - updateParagraph :: forall record. - ( HasField "id" record (Id record) - , SetField "weight" record Int - , CanUpdate record - , PrimaryKey (GetTableName record) ~ UUID - , ?modelContext :: ModelContext - ) => record -> IO () - updateParagraph paragraph = do - let uuid :: UUID = unpackId paragraph.id - let weight = elemIndex uuid uuids |> fromMaybe 0 - - paragraph - |> set #weight weight - |> updateRecord - - - pure () - setSuccessMessage "LandingPage updated" setFormStatus FormStatusSuccess redirectTo EditLandingPageAction { .. } @@ -112,6 +77,51 @@ instance Controller LandingPagesController where setSuccessMessage "LandingPage deleted" redirectTo LandingPagesAction + action ShowOrderLandingPageParagraphsAction { .. } = do + landingPageWithRecords <- fetchLandingPageWithRecords landingPageId + + render OrderParagraphsView { .. } + + action UpdateOrderLandingPageParagraphsAction { .. } = do + landingPageWithRecords <- fetchLandingPageWithRecords landingPageId + + let params = paramListOrNothing @UUID "paragraphId" + + case catMaybes params of + [] -> do + -- No paragraphs to update. + pure () + + uuids -> do + -- We need to update the weight of the paragraphs, + -- So load them. + landingPageWithRecords <- fetchLandingPageWithRecords landingPageId + + -- Iterate over all paragraphs, and update the weight. + forEach landingPageWithRecords.paragraphCtas updateParagraph + forEach landingPageWithRecords.paragraphQuotes updateParagraph + + setSuccessMessage "Paragraphs updated" + redirectTo ShowOrderLandingPageParagraphsAction { .. } + + where + updateParagraph :: forall record. + ( HasField "id" record (Id record) + , SetField "weight" record Int + , CanUpdate record + , PrimaryKey (GetTableName record) ~ UUID + , ?modelContext :: ModelContext + ) => record -> IO () + updateParagraph paragraph = do + let uuid :: UUID = unpackId paragraph.id + let weight = elemIndex uuid uuids |> fromMaybe 0 + + paragraph + |> set #weight weight + |> updateRecord + + pure () + buildLandingPage landingPage = landingPage |> fill @'["title"] |> validateField #title nonEmpty diff --git a/Web/Element/SubmitButton.hs b/Web/Element/SubmitButton.hs index 584fd9e..ce93aea 100644 --- a/Web/Element/SubmitButton.hs +++ b/Web/Element/SubmitButton.hs @@ -6,8 +6,8 @@ import Application.Helper.Icons import Web.Element.ElementWrap import Web.Element.Types -renderSubmitButtonwithFormStatus :: SubmitButton -> FormStatus -> Html -renderSubmitButtonwithFormStatus submitButton formStatus = [hsx| +renderSubmitButtonWithFormStatus :: SubmitButton -> FormStatus -> Html +renderSubmitButtonWithFormStatus submitButton formStatus = [hsx| {submitButton} {- We show only one of these messages -} diff --git a/Web/Types.hs b/Web/Types.hs index 5878b64..8881b2b 100644 --- a/Web/Types.hs +++ b/Web/Types.hs @@ -46,6 +46,9 @@ data LandingPagesController | EditLandingPageAction { landingPageId :: !(Id LandingPage) } | UpdateLandingPageAction { landingPageId :: !(Id LandingPage) } | DeleteLandingPageAction { landingPageId :: !(Id LandingPage) } + -- Order of paragraphs, and update of it. + | ShowOrderLandingPageParagraphsAction { landingPageId :: !(Id LandingPage) } + | UpdateOrderLandingPageParagraphsAction { landingPageId :: !(Id LandingPage) } deriving (Eq, Show, Data) data ParagraphCtasController @@ -80,6 +83,7 @@ data SessionsController | CreateSessionAction | DeleteSessionAction deriving (Eq, Show, Data) + data UsersController = UsersAction | NewUserAction diff --git a/Web/View/LandingPages/Edit.hs b/Web/View/LandingPages/Edit.hs index 45d1e4f..e461c89 100644 --- a/Web/View/LandingPages/Edit.hs +++ b/Web/View/LandingPages/Edit.hs @@ -16,15 +16,13 @@ data EditView = EditView instance View EditView where html EditView { .. } = [ header - , renderForm landingPage paragraphCtas paragraphQuotes formStatus + , renderForm landingPageWithRecords formStatus ] |> mconcat |> wrapVerticalSpacing AlignNone |> wrapContainerWide where landingPage = landingPageWithRecords.landingPage - paragraphCtas = landingPageWithRecords.paragraphCtas - paragraphQuotes = landingPageWithRecords.paragraphQuotes breadcrumb = renderBreadcrumb [ breadcrumbLink "Landing Pages" LandingPagesAction @@ -46,36 +44,33 @@ instance View EditView where |> mconcat |> wrapHorizontalSpacingTiny AlignBaseline -renderForm :: LandingPage -> [ParagraphCta] -> [ParagraphQuote] -> FormStatus -> Html -renderForm landingPage paragraphCtas paragraphQuotes formStatus = formFor landingPage body +renderForm :: LandingPageWithRecords -> FormStatus -> Html +renderForm landingPageWithRecords formStatus = formFor landingPage body where - body :: (?formContext :: FormContext LandingPage) => Html - body = [hsx| - {(textField #title)} + landingPage = landingPageWithRecords.landingPage + paragraphCtas = landingPageWithRecords.paragraphCtas + paragraphQuotes = landingPageWithRecords.paragraphQuotes -
- {paragraphs} -
+ body :: (?formContext :: FormContext LandingPage) => Html + body = + [ [hsx|{(textField #title)}|] + , paragraphs |> wrapHorizontalPadding |> wrapBorder RoundedCornerNone - { renderSubmitButtonwithFormStatus + , renderSubmitButtonWithFormStatus (submitButton {label = "Save Landing page"}) formStatus - } - |] + ] + |> mconcat |> wrapVerticalSpacing AlignNone paragraphs = [ addParagraphs - , [hsx| - - |] + , orderAndRenderParagraphs paragraphCtas paragraphQuotes |> wrapListOl + , reOrderLink ] |> mconcat |> wrapVerticalSpacing AlignNone - addParagraphs = [ cs ("Paragraphs" :: Text) |> wrapHeaderTag 3 , paragraphButtons @@ -90,6 +85,16 @@ renderForm landingPage paragraphCtas paragraphQuotes formStatus = formFor landin |> mconcat |> wrapHorizontalSpacing AlignCenter + reOrderLink = if countParagraphs landingPageWithRecords > 1 + then renderLinkAction (ShowOrderLandingPageParagraphsAction landingPage.id) "Re-Order" + else "" + + +countParagraphs :: LandingPageWithRecords -> Int +countParagraphs LandingPageWithRecords { paragraphCtas, paragraphQuotes } = + length paragraphCtas + length paragraphQuotes + + orderAndRenderParagraphs :: [ParagraphCta] -> [ParagraphQuote] -> Html orderAndRenderParagraphs paragraphCtas paragraphQuotes = ctas @@ -111,15 +116,11 @@ orderAndRenderParagraphs paragraphCtas paragraphQuotes = paragraphTitleAndOps :: (Show (PrimaryKey record), HasPath controller) => (Id' record -> controller) -> (Id' record -> controller) -> Id' record -> Text -> Text -> Html paragraphTitleAndOps editAction deleteAction id title type_ = [hsx| -
  • {body}
    • +
  • {body}
    • |] where body = [hsx| - {sortableHandle} - - - {title} ({type_}) {operations} |] @@ -134,18 +135,4 @@ orderAndRenderParagraphs paragraphCtas paragraphQuotes = - sortableHandle = - if - length ctas + length quotes > 1 - then - [hsx| -
    -
    - - - -
    -
    - |] - else - mempty + diff --git a/Web/View/LandingPages/Order.hs b/Web/View/LandingPages/Order.hs new file mode 100644 index 0000000..cb02a0a --- /dev/null +++ b/Web/View/LandingPages/Order.hs @@ -0,0 +1,70 @@ +module Web.View.LandingPages.Order where + +import Web.Element.Cta +import Web.Element.ElementWrap +import Web.Element.Link +import Web.Element.Types +import Web.Element.Quote +import Web.Element.ElementWrap +import Web.Types +import Web.View.Prelude + +data OrderParagraphsView = OrderParagraphsView { landingPageWithRecords :: LandingPageWithRecords } + +instance View OrderParagraphsView where + html OrderParagraphsView { .. } = + [ header + , orderAndRenderParagraphs landingPageWithRecords + ] + |> mconcat + |> wrapVerticalSpacing AlignNone + |> wrapContainerWide + where + landingPage = landingPageWithRecords.landingPage + + breadcrumb = renderBreadcrumb + [ breadcrumbLink "LandingPages" LandingPagesAction + , breadcrumbText "Show LandingPage" + ] + + header = + [ breadcrumb + , titleAndEdit + ] + |> mconcat + |> wrapVerticalSpacing AlignNone + |> wrapContainerWide + + + titleAndEdit = + [ cs ("Re-Order Paragraphs" :: Text) |> wrapHeaderTag 1 + , renderLinkAction (EditLandingPageAction landingPage.id) "back" + ] + |> mconcat + |> wrapHorizontalSpacingTiny AlignBaseline + + +orderAndRenderParagraphs :: (?context::ControllerContext) => LandingPageWithRecords -> Html +orderAndRenderParagraphs landingPageWithRecords = + ctas ++ quotes + -- Order by weight. + |> sortOn fst + |> fmap snd + |> fmap wrapSortableListLi + |> mconcat + |> wrapSortableList + where + + ctas = landingPageWithRecords.paragraphCtas + |> fmap (\paragraph -> + ( paragraph.weight + , cs paragraph.title + ) + ) + + quotes = landingPageWithRecords.paragraphQuotes + |> fmap (\paragraph -> + ( paragraph.weight + , cs paragraph.body + ) + ) diff --git a/Web/View/ParagraphQuotes/Form.hs b/Web/View/ParagraphQuotes/Form.hs index 2d3bc15..c9e0ef6 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 formStatus} |] |> wrapVerticalSpacing AlignNone |> wrapContainerWide diff --git a/tailwind/tailwind.config.js b/tailwind/tailwind.config.js index 1a1e9d4..06671d9 100644 --- a/tailwind/tailwind.config.js +++ b/tailwind/tailwind.config.js @@ -9,6 +9,7 @@ module.exports = { content: [ "Web/Element/**/*.hs", "Web/View/**/*.hs", + "Application/Helper/Icons.hs", ], safelist: [ // Add custom class names.