generator/Site/Body.hs

   1 module Site.Body where
   2
   3 import Data.List qualified as List
   4 import Data.Map.Strict qualified as Map
   5 import Data.Text qualified as Text
   6 import Data.Time qualified as Time
   7 import Ema
   8 import Ema qualified
   9 import Network.URI.Slug (decodeSlug, encodeSlug)
  10 import PyF
  11 import Relude
  12 import Text.Blaze qualified as B
  13 import Text.Blaze.Html5 ((!))
  14 import Text.Blaze.Html5 qualified as H
  15 import Text.Blaze.Html5.Attributes qualified as A
  16 import Prelude ()
  17
  18 import Site.Model
  19 import Utils.Html
  20
  21 renderBody :: Model -> Route -> Content -> H.Html
  22 renderBody model@Model{..} route Content{..} =
  23   -- The "overflow-y-scroll" makes the scrollbar visible always, so as to
  24   -- avoid content shifts when switching to routes with suddenly scrollable content.
  25   H.body
  26     ! classes
  27       [ "bg-gray-50"
  28       , "flex"
  29       , "flex-col"
  30       , "overflow-y-scroll"
  31       , "font-sans"
  32       , --, "max-w-prose"
  33         --, "mx-auto"
  34         "text-xs"
  35       , "mx-4"
  36       , "px-4"
  37       , "block"
  38       ]
  39     $ do
  40       --renderNav model route
  41       renderBodyHead
  42       H.hr
  43       contentHtml
  44   where
  45     -- H.hr
  46     -- renderBodyFoot
  47
  48     renderBodyHead =
  49       H.nav
  50         ! classes
  51           [ "text-xs"
  52           ]
  53         $ case route of
  54           RoutePage page
  55             | Just{} <- Map.lookup page modelPosts ->
  56               html ("post" : page)
  57           RouteSpecial page
  58             | Just{} <- Map.lookup page modelSpecials ->
  59               html page
  60           RouteFilter filt@Filter{..}
  61             | maybe True (`elem` allTagsModel) filterTag ->
  62               html $ "list" : encodeFilter filt
  63           RouteFeeds -> html ["feeds"]
  64           RouteFilterAtom filt@Filter{..}
  65             | maybe True (`elem` allTagsModel) filterTag ->
  66               html $ "feed" : encodeFilter filt
  67           _notFound ->
  68             --error [fmt|Route {notFound:s} does not exist.|]
  69             html ["not-found"]
  70       where
  71         allTagsModel = allTags model
  72         html slugs =
  73           H.ul
  74             ! classes
  75               [ "items-start"
  76               , "flex"
  77               , "flex-wrap"
  78               , "justify-start"
  79               ]
  80             $ mconcat $
  81               List.intersperse
  82                 "/"
  83                 [ H.li ! classes (if path == [] then ["pr-2"] else ["px-2"]) $
  84                   H.a ! A.href (B.toValue $ encodeSlugs path) $
  85                     H.text $ encodeSlug slug
  86                 | (slug, path) <-
  87                     List.zip
  88                       (decodeSlug (Text.toLower orgName) : slugs)
  89                       (List.inits slugs)
  90                 ]
  91     renderBodyFoot =
  92       H.footer
  93         ! classes
  94           [ "border-t-2"
  95           , "flex"
  96           , "flex-row"
  97           , "justify-between"
  98           , "mt-4"
  99           , "text-sm"
 100           , "clear-left"
 101           ]
 102         $ do
 103           {-
 104           H.a
 105             ! classes ["hover:bg-blue-100", "text-blue-600"]
 106             ! A.href [fmt|{Ema.routeUrl model $ Right @FilePath route:s}#top|]
 107             $ "Back to top"
 108           -}
 109           H.span
 110             ! classes ["text-gray-600"]
 111             $ [fmt|Generated: {maybe "dynamically"
 112               (Time.formatTime Time.defaultTimeLocale "%F")
 113               modelTime
 114             }|]
 115           H.span do
 116             "The "
 117             H.a
 118               ! A.href [fmt|https://git.code.{domainName}/~julm/sourcephile-web|]
 119               $ "code for this site"
 120             " is "
 121             H.a
 122               ! A.href "https://spdx.org/licenses/AGPL-3.0-or-later.html"
 123               $ "AGPL-3.0-or-later"
 124             "."
 125
 126 {-
 127 renderNav :: Model -> Route -> H.Html
 128 renderNav model route =
 129   H.div ! A.id "top" ! classes ["bg-gray-500"] $
 130     H.nav
 131       ! classes
 132         [ "flex"
 133         , "flex-col"
 134         , "items-stretch"
 135         , "max-w-6xl"
 136         , "mx-auto"
 137         , "sm:flex-row"
 138         , "sm:h-16"
 139         , "sm:justify-between"
 140         ]
 141       $ do
 142         H.span
 143           ! classes
 144             [ "flex"
 145             , "flex-col"
 146             , "items-stretch"
 147             , "sm:flex-row"
 148             , "sm:justify-start"
 149             ]
 150           $ headLinks
 151             [
 152               ( A.href "#"
 153               , do
 154                   --H.img
 155                   --  ! classes ["w-10", "h-10", "mr-4", "rounded-full"]
 156                   --  ! A.src "/static/img/my_avatar.jpg"
 157                   --  ! A.alt "logo"
 158                   [fmt|{orgName}|]
 159               )
 160             , (hrefRoute model $ RouteFilter noFilter, "All Posts")
 161             , (hrefRoute model $ RouteFilter noFilter{filterTag = Just $ Tag "non-tech"}, "Non-Tech")
 162             , (hrefRoute model $ RouteFilter noFilter{filterTag = Just $ Tag "tech"}, "Tech")
 163             , (hrefRoute model $ RouteSpecial ["projects"], "Projects")
 164             ]
 165         H.span ! classes ["flex", "flex-row", "justify-items-center"] $
 166           headLinks
 167             [ (A.title "Atom" <> hrefRoute model RouteFeeds, openIconic "rss")
 168             , (A.title "IRC" <> A.href [fmt|irc://irc.geeknode.org/#sourcephile|], openIconic "chat")
 169             , (A.title "XMPP" <> A.href [fmt|xmpp:sourcephile@{domainName}?join|], openIconic "chat")
 170             , (A.title "Mail" <> A.href [fmt|mailto:contact@{domainName}|], openIconic "envelope-closed")
 171             , (A.title "Git" <> A.href [fmt|https://git.code.{domainName}|], openIconic "fork")
 172             ]
 173   where
 174     headLinks = mapM_ $ \(attrs, html) ->
 175       H.a
 176         ! smallCaps
 177           [ "flex"
 178           , "flex-row"
 179           , "hover:bg-blue-600"
 180           , "items-center"
 181           , "justify-center"
 182           , "justify-items-center"
 183           , "p-4"
 184           , "sm:w-auto"
 185           , "text-lg"
 186           , "text-white"
 187           , "w-full"
 188           ]
 189         ! A.style "font-variant: small-caps"
 190         ! attrs
 191         $ html ! classes ["w-4"]
 192 -}