Modernize repo, before converting to ihp-cms-starter (#42)

.gitignore

@@ -26,6 +26,9 @@ static/app.css
 static/articles
 static/paragraph_quotes
 
+# @todo: Fix the creation of duplicates
+static/styleGuideImages/imageStyles
+
 Application/Migration
 
 # JWT

Application/Helper/Controller.hs

@@ -18,11 +18,6 @@ fetchLandingPageWithRecords landingPageId = do
     landingPage <- fetch landingPageId
     paragraphCtas <- fetch landingPage.paragraphCtasRefLandingPages
 
-    -- Landing pages referenced by ParagraphCta.refLandingPageId
-    paragraphCtaRefLandingPages <- query @LandingPage
-        |> filterWhereIn (#id, map (get #refLandingPageId) paragraphCtas)
-        |> fetch
-
     paragraphQuotes <- fetch landingPage.paragraphQuotes
 
     return $ LandingPageWithRecords { .. }

Application/Helper/Icons.hs

@@ -0,0 +1,78 @@
+module Application.Helper.Icons where
+
+import IHP.ViewPrelude
+
+{-| Heroicons - Pencil
+-}
+edit :: Html
+edit = [hsx|
+<svg title="Edit" xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 24 24" stroke-width="1.5" stroke="currentColor" class="bg-white w-10 h-10 p-2 rounded-lg stroke-orange-400 hover:stroke-orange-600">
+  <path stroke-linecap="round" stroke-linejoin="round" d="M16.862 4.487l1.687-1.688a1.875 1.875 0 112.652 2.652L6.832 19.82a4.5 4.5 0 01-1.897 1.13l-2.685.8.8-2.685a4.5 4.5 0 011.13-1.897L16.863 4.487zm0 0L19.5 7.125" />
+</svg>
+|]
+
+{-| Heroicons - Trash
+-}
+delete :: Html
+delete = [hsx|
+<svg title="Delete" xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 24 24" stroke-width="1.5" stroke="currentColor" class="bg-white w-10 h-10 p-2 rounded-lg stroke-black hover:stroke-gray-500">
+  <path stroke-linecap="round" stroke-linejoin="round" d="M14.74 9l-.346 9m-4.788 0L9.26 9m9.968-3.21c.342.052.682.107 1.022.166m-1.022-.165L18.16 19.673a2.25 2.25 0 01-2.244 2.077H8.084a2.25 2.25 0 01-2.244-2.077L4.772 5.79m14.456 0a48.108 48.108 0 00-3.478-.397m-12 .562c.34-.059.68-.114 1.022-.165m0 0a48.11 48.11 0 013.478-.397m7.5 0v-.916c0-1.18-.91-2.164-2.09-2.201a51.964 51.964 0 00-3.32 0c-1.18.037-2.09 1.022-2.09 2.201v.916m7.5 0a48.667 48.667 0 00-7.5 0" />
+</svg>
+|]
+
+
+{-| Heroicons - Clock
+-}
+clock :: Html
+clock = [hsx|
+<svg xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 24 24" stroke-width="1.5" stroke="currentColor" class="w-6 h-6 stroke-text-pp-blue">
+  <path stroke-linecap="round" stroke-linejoin="round" d="M12 6v6h4.5m4.5 0a9 9 0 11-18 0 9 9 0 0118 0z" />
+</svg>
+|]
+
+{-| Heroicons - Plus Circle
+-}
+add :: Html
+add = [hsx|
+<svg xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 24 24" stroke-width="1.5" stroke="currentColor" class="w-6 h-6 stroke-text-black">
+  <path stroke-linecap="round" stroke-linejoin="round" d="M12 9v6m3-3H9m12 0a9 9 0 11-18 0 9 9 0 0118 0z" />
+</svg>
+|]
+
+{-| Heroicons - Bars-2
+-}
+bars :: Html
+bars = [hsx|
+<svg title="Click to drag and drop" xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 24 24" stroke-width="1.5" stroke="currentColor" data-slot="icon" class="w-6 h-6">
+  <path stroke-linecap="round" stroke-linejoin="round" d="M3.75 6.75h16.5M3.75 12h16.5m-16.5 5.25h16.5" />
+</svg>
+|]
+
+{-| Heroicons - Eye
+-}
+view :: Html
+view = [hsx|
+<svg xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 24 24" stroke-width="1.5" stroke="currentColor" class="bg-white w-10 h-10 p-2 rounded-lg stroke-orange-400 hover:stroke-orange-600">
+  <path stroke-linecap="round" stroke-linejoin="round" d="M2.036 12.322a1.012 1.012 0 010-.639C3.423 7.51 7.36 4.5 12 4.5c4.638 0 8.573 3.007 9.963 7.178.07.207.07.431 0 .639C20.577 16.49 16.64 19.5 12 19.5c-4.638 0-8.573-3.007-9.963-7.178z" />
+  <path stroke-linecap="round" stroke-linejoin="round" d="M15 12a3 3 0 11-6 0 3 3 0 016 0z" />
+</svg>
+|]
+
+{-| Heroicons - arrows-up-down
+-}
+arrowsUpDown :: Html
+arrowsUpDown = [hsx|
+<svg title="Re-order" xmlns="http://www.w3.org/2000/svg" fill="none" viewBox="0 0 24 24" stroke-width="1.5" stroke="currentColor" data-slot="icon" class="bg-white w-10 h-10 p-2 rounded-lg stroke-orange-400 hover:stroke-orange-600">
+  <path stroke-linecap="round" stroke-linejoin="round" d="M3 7.5 7.5 3m0 0L12 7.5M7.5 3v13.5m13.5 0L16.5 21m0 0L12 16.5m4.5 4.5V7.5" />
+</svg>
+|]
+
+{-| https://iconmonstr.com/quote-3-svg/
+-}
+quotationSign :: Html
+quotationSign = [hsx|
+    <svg xmlns="http://www.w3.org/2000/svg" width="48" height="48" viewBox="0 0 24 24" class="fill-gray-300">
+        <path d="M9.983 3v7.391c0 5.704-3.731 9.57-8.983 10.609l-.995-2.151c2.432-.917 3.995-3.638 3.995-5.849h-4v-10h9.983zm14.017 0v7.391c0 5.704-3.748 9.571-9 10.609l-.996-2.151c2.433-.917 3.996-3.638 3.996-5.849h-3.983v-10h9.983z"/>
+    </svg>
+
+|]

Application/Helper/View.hs

@@ -5,6 +5,7 @@ import "cryptonite" Crypto.PubKey.RSA.PKCS15 as RSA
 import "cryptonite" Crypto.Hash.Algorithms as Hash.Algorithms
 import Data.ByteString.Base64 as Base64
 import Application.Helper.Controller
+import qualified Text.MMark as MMark
 
 -- Here you can add functions which are available in all your views
 
@@ -14,4 +15,9 @@ signImageUrl imageUrl width height= case RSA.sign Nothing (Just Hash.Algorithms.
     Left msg -> error $ "Cannot sign image URL, private key is invalid:" <> show msg
     Right signature -> signature |> Base64.encode |> cs
     where
-        size = show width <> "x" <> show height
+        size = show width <> "x" <> show height
+
+renderMarkdown text = case text |> MMark.parse "" of
+        -- On error, render the text as is.
+        Left error -> cs text
+        Right markdown -> MMark.render markdown |> tshow |> preEscapedToHtml

Web/Controller/ParagraphCtas.hs

@@ -1,15 +1,10 @@
 module Web.Controller.ParagraphCtas where
 
 import Web.Controller.Prelude
-import Web.View.ParagraphCtas.Index
 import Web.View.ParagraphCtas.New
 import Web.View.ParagraphCtas.Edit
-import Web.View.ParagraphCtas.Show
 
 instance Controller ParagraphCtasController where
-    action ParagraphCtaAction = do
-        paragraphCtas <- query @ParagraphCta |> fetch
-        render IndexView { .. }
 
     action NewParagraphCtaAction { landingPageId } = do
         weight <- getParagraphsCount landingPageId
@@ -23,10 +18,6 @@ instance Controller ParagraphCtasController where
 
         render NewView { .. }
 
-    action ShowParagraphCtaAction { paragraphCtaId } = do
-        paragraphCta <- fetch paragraphCtaId
-        render ShowView { .. }
-
     action EditParagraphCtaAction { paragraphCtaId } = do
         paragraphCta <- fetch paragraphCtaId
 

Web/Controller/ParagraphQuotes.hs

@@ -1,16 +1,10 @@
 module Web.Controller.ParagraphQuotes where
 
 import Web.Controller.Prelude
-import Web.View.ParagraphQuotes.Index
 import Web.View.ParagraphQuotes.New
 import Web.View.ParagraphQuotes.Edit
-import Web.View.ParagraphQuotes.Show
 
 instance Controller ParagraphQuotesController where
-    action ParagraphQuotesAction = do
-        paragraphQuotes <- query @ParagraphQuote |> fetch
-        render IndexView { .. }
-
     action NewParagraphQuoteAction { landingPageId } = do
         weight <- getParagraphsCount landingPageId
         let paragraphQuote = newRecord
@@ -19,10 +13,6 @@ instance Controller ParagraphQuotesController where
 
         render NewView { .. }
 
-    action ShowParagraphQuoteAction { paragraphQuoteId } = do
-        paragraphQuote <- fetch paragraphQuoteId
-        render ShowView { .. }
-
     action EditParagraphQuoteAction { paragraphQuoteId } = do
         paragraphQuote <- fetch paragraphQuoteId
         render EditView { .. }
@@ -40,7 +30,7 @@ instance Controller ParagraphQuotesController where
                 Left paragraphQuote -> render EditView { .. }
                 Right paragraphQuote -> do
                     paragraphQuote <- paragraphQuote |> updateRecord
-                    setSuccessMessage "ParagraphQuote updated"
+                    setSuccessMessage "Quote updated"
                     redirectTo EditLandingPageAction { landingPageId = paragraphQuote.landingPageId }
 
     action CreateParagraphQuoteAction = do
@@ -56,13 +46,13 @@ instance Controller ParagraphQuotesController where
                 Left paragraphQuote -> render NewView { .. }
                 Right paragraphQuote -> do
                     paragraphQuote <- paragraphQuote |> createRecord
-                    setSuccessMessage "ParagraphQuote created"
+                    setSuccessMessage "Quote created"
                     redirectTo EditLandingPageAction { landingPageId = paragraphQuote.landingPageId }
 
     action DeleteParagraphQuoteAction { paragraphQuoteId } = do
         paragraphQuote <- fetch paragraphQuoteId
         deleteRecord paragraphQuote
-        setSuccessMessage "ParagraphQuote deleted"
+        setSuccessMessage "Quote deleted"
         redirectTo EditLandingPageAction { landingPageId = paragraphQuote.landingPageId }
 
 buildParagraphQuote paragraphQuote = paragraphQuote

Web/Controller/StyleGuide.hs

@@ -0,0 +1,9 @@
+module Web.Controller.StyleGuide where
+
+import Web.Controller.Prelude
+import Web.View.StyleGuide.Index
+
+instance Controller StyleGuideController where
+    action StyleGuideAction = do
+        render IndexView { .. }
+

Web/Element/Button.hs

@@ -0,0 +1,41 @@
+module Web.Element.Button where
+
+import Web.Controller.Prelude
+import Web.Element.Types
+import Web.View.Prelude
+
+-- RenderButton
+
+render :: RenderButton ->  Html
+render record@RenderButton {text, url, isPrimary}  =
+    renderButtonHelper url text isPrimary
+
+
+-- Button to Action
+
+renderButtonAction :: (HasPath controller) => controller -> Text ->  Html
+renderButtonAction action text  =
+    renderButtonHelper (pathTo action) text False
+
+
+renderButtonPrimaryAction :: (HasPath controller) => controller -> Text ->  Html
+renderButtonPrimaryAction action text  =
+    renderButtonHelper (pathTo action) text True
+
+
+renderButtonHelper :: Text -> Text ->  Bool -> Html
+renderButtonHelper url text isPrimary  =
+    [hsx|
+        <div class="inline-block button-wrapper">
+            <a class={classes'} href={url}>
+                <div>{text}</div>
+            </a>
+        </div>
+
+    |]
+    where classes' = classes
+            [ "flex flex-row items-center gap-x-4 rounded-lg px-6 py-3 text-xl border-2 border-blue-500 hover:bg-blue-600 w-fit"
+            , ("bg-blue-500 text-white", isPrimary)
+            , ("text-blue-900 bg-white hover:text-white", not isPrimary)
+            ]
+

Web/Element/Cta.hs

@@ -0,0 +1,34 @@
+module Web.Element.Cta where
+
+import Web.View.Prelude
+
+import Web.Element.Button
+import Web.Element.ElementWrap
+import Web.Element.Types
+
+
+render :: RenderCta -> Html
+render record@RenderCta {title, body, button} =
+    titleWrapped
+        ++ bodyWrapped
+        ++ Web.Element.Button.render button
+        |> wrapVerticalSpacing AlignCenter
+        |> \e -> [hsx|<div class={classes'}>{e}</div>|]
+        |> wrapContainerNarrow
+    where
+        classes' = classes
+            [ (getBackgroundColor Gray100, True)
+            , "relative rounded-lg border border-gray-300 w-full h-full overflow-hidden p-6 md:px-8"
+            ]
+
+        titleWrapped = cs title
+            |> wrapTextResponsiveFontSize TextSize3xl
+            |> wrapTextCenter
+            |> wrapTextFontWeight FontWeightBold
+
+        bodyWrapped = body
+            |> renderMarkdown
+            |> wrapProse
+
+
+