Merge branch 'master' of github.com:digitallyinduced/ihp

digitallyinduced · Oct 2, 2021 · fd94c7b · fd94c7b
2 parents 79af13e + 4911390
commit fd94c7b
Show file tree

Hide file tree

Showing 7 changed files with 85 additions and 11 deletions.
diff --git a/Guide/layout.html b/Guide/layout.html
@@ -260,8 +260,9 @@
  position: absolute;
  width: 100%;
  height: fit-content;
- margin-top: 70px;
+ margin-top: 64px;
  padding-top: 0;
+ z-index: 1000;
  }
  .nav-column.visible, #mobile-navbar {
  background-color: #f5f6f6;
@@ -271,6 +272,7 @@
  #mobile-navbar .nav-logo .nav-logo-lambda { font-size: 2rem; }
  #mobile-navbar .nav-logo .nav-logo-name { font-size: 1rem; }
 
+ main { padding-top: 74px; }
  @media (min-width: 768px) {
  #mobile-navbar { display: none }
  .nav-column {
@@ -308,12 +310,21 @@
  background-color: hsla(192, 81%, 26%, 0.8)
  }
 
- .DocSearch.DocSearch-Button {
- margin-left: 0;
- position: fixed;
- }
  #search-container {
- margin-top: 70px;
+ position: absolute;
+ top: 80px;
+ right: 1rem;
+ }
+
+ @media (min-width: 768px) {
+ .DocSearch.DocSearch-Button {
+ margin-left: 0;
+ position: fixed;
+ }
+ #search-container {
+ margin-top: 70px;
+ position: initial;
+ }
  }
  </style>
 

diff --git a/Guide/view.markdown b/Guide/view.markdown
@@ -271,6 +271,7 @@ To dynamically manage meta tags like `<meta property="og:description" content="d
  <title>App</title>
 
  <!-- ADD THIS: -->
+ {descriptionOrDefault "default meta description"}
  {ogTitleOrDefault "default title"}
  {ogTypeOrDefault "article"}
  {ogDescriptionOrDefault "Hello world"}

diff --git a/IHP/FetchRelated.hs b/IHP/FetchRelated.hs
@@ -178,6 +178,31 @@ instance (relatedModel ~ GetModelByTableName relatedTable, Table relatedModel) =
  pure (updateField @relatedField result model)
  mapM fetchRelated models
 
+-- Fetches a related record
+--
+-- Given a specific post, we can fetch the post and all its comments like this:
+--
+-- > let postId :: Id Post = ...
+-- > 
+-- > post <- fetch postId
+-- > >>= fetchRelated #comments
+--
+-- This Haskell code will trigger the following SQL queries to be executed:
+--
+-- > SELECT posts.* FROM posts WHERE id = ? LIMIT 1
+-- > SELECT comments.* FROM comments WHERE post_id = ?
+--
+-- In the view we can just access the comments like this:
+--
+-- > [hsx|
+-- > <h1>{get #title post}</h1>
+-- > <h2>Comments:</h2>
+-- > {post |> get #comments}
+-- > |]
+--
+-- The @post |> get #comments@ returns a list of the comments belonging to the post.
+-- The type of post is @Include "comments"@ Post instead of the usual @Post@. This way the state of a fetched nested resource is tracked at the type level.
+--
 fetchRelated :: forall model field fieldValue fetchModel. (
  ?modelContext :: ModelContext,
  UpdateField field model (Include field model) fieldValue (FetchResult fieldValue fetchModel),

diff --git a/IHP/PageHead/ControllerFunctions.hs b/IHP/PageHead/ControllerFunctions.hs
@@ -5,6 +5,7 @@ Copyright: (c) digitally induced GmbH, 2021
 -}
 module IHP.PageHead.ControllerFunctions
 ( setTitle
+, setDescription
 , setOGTitle
 , setOGType
 , setOGDescription
@@ -37,6 +38,9 @@ import IHP.Controller.Context
 setTitle :: (?context :: ControllerContext) => Text -> IO ()
 setTitle title = putContext (PageTitle title)
 
+setDescription :: (?context :: ControllerContext) => Text -> IO ()
+setDescription description = putContext (PageDescription description)
+
 setOGTitle :: (?context :: ControllerContext) => Text -> IO ()
 setOGTitle title = putContext (OGTitle title)
 

diff --git a/IHP/PageHead/Types.hs b/IHP/PageHead/Types.hs
@@ -8,6 +8,8 @@ import IHP.Prelude
 
 newtype PageTitle = PageTitle Text
 
+newtype PageDescription = PageDescription Text
+
 newtype OGTitle = OGTitle Text
 
 newtype OGType = OGType Text

diff --git a/IHP/PageHead/ViewFunctions.hs b/IHP/PageHead/ViewFunctions.hs
@@ -7,6 +7,7 @@ module IHP.PageHead.ViewFunctions
 ( pageTitle
 , pageTitleOrDefault
 , pageTitleOrNothing
+, descriptionOrDefault
 , ogTitleOrDefault
 , ogTypeOrDefault
 , ogDescriptionOrDefault
@@ -109,6 +110,35 @@ ogTitleOrDefault defaultValue = [hsx|<meta property="og:title" content={content}
  Just (OGTitle title) -> title
  Nothing -> defaultValue
 
+-- | Returns @<meta name="description" content="Lorem Ipsum">@ element. The description can be set using @setDescription "my description"@ from the view.
+--
+-- You can use this inside your Layout like this:
+--
+-- > [hsx|
+-- > <head>
+-- > <title>{pageTitle}</title>
+-- > {descriptionOrDefault "CO2 Database"}
+-- > </head>
+-- > |]
+--
+--
+-- *View-specific description:*
+-- 
+-- You can override the default description inside the view by calling 'setDescription' inside the 'beforeRender' hook:
+--
+-- > module JobSite.View.JobPositions.Show where
+-- > 
+-- > instance View ShowView where
+-- > beforeRender ShowView { .. } = do
+-- > setDescription "The CO2 Footprint of beef is about 67kg CO2 per 1kg of beef."
+-- > 
+-- > html ShowView { .. } = [hsx|..|]
+descriptionOrDefault :: (?context :: ControllerContext) => Text -> Html
+descriptionOrDefault defaultValue = [hsx|<meta name="description" content={content}/>|]
+ where
+ content = case maybeFromFrozenContext @PageDescription of
+ Just (PageDescription description) -> description
+ Nothing -> defaultValue
 
 -- | Returns the meta og:type element. The og:type can be set using @setOGType "data"@ from the view.
 --
@@ -195,8 +225,8 @@ ogDescriptionOrDefault defaultValue = [hsx|<meta property="og:description" conte
 -- > setOGUrl (urlTo ShowAction { .. })
 -- > 
 -- > html ShowView { .. } = [hsx|..|]
-ogUrl :: (?context :: ControllerContext) => Text -> Html
-ogUrl defaultValue = case maybeFromFrozenContext @OGUrl of
+ogUrl :: (?context :: ControllerContext) => Html
+ogUrl = case maybeFromFrozenContext @OGUrl of
  Just (OGUrl url) -> [hsx|<meta property="og:url" content={url}/>|]
  Nothing -> mempty
 
@@ -225,7 +255,7 @@ ogUrl defaultValue = case maybeFromFrozenContext @OGUrl of
 -- > setOGImage "https://example.com/image.png"
 -- > 
 -- > html ShowView { .. } = [hsx|..|]
-ogImage :: (?context :: ControllerContext) => Text -> Html
-ogImage defaultValue = case maybeFromFrozenContext @OGImage of
+ogImage :: (?context :: ControllerContext) => Html
+ogImage = case maybeFromFrozenContext @OGImage of
  Just (OGImage url) -> [hsx|<meta property="og:image" content={url}/>|]
  Nothing -> mempty
diff --git a/IHP/View/Form.hs b/IHP/View/Form.hs
@@ -264,9 +264,10 @@ submitButton :: forall model id. (?formContext :: FormContext model, HasField "m
 submitButton =
  let
  modelName = IHP.ModelSupport.getModelName @model
+ buttonText = modelName |> humanize -- We do this to turn 'Create ProjectTask' into 'Create Project Task'
  isNew = IHP.ModelSupport.isNew (model ?formContext)
  in SubmitButton
- { label = cs $ (if isNew then "Create " else "Save ") <> modelName
+ { label = cs $ (if isNew then "Create " else "Save ") <> buttonText
  , buttonClass = mempty
  , cssFramework = get #cssFramework ?formContext
  }