Big change on Components logic.

Components are now a state monad with a map of css elements. At runtime,
css is gathered from the different components without duplication and
rendered. This should provide a scalable solution. Care should be taken
when naming a new component as overlapping names would not be both
rendered.
This commit is contained in:
Etienne Werly 2023-06-07 20:03:32 +02:00
parent 2d19db1362
commit 1a445dd1a1
21 changed files with 505 additions and 114 deletions

View file

@ -2,8 +2,8 @@
A personal CMS written in Haskell. The most prominent libraries used are
* [Hakyll](https://hackage.haskell.org/package/hakyll), a static site compiler.
* [Shakespeare](https://hackage.haskell.org/package/shakespeare) (Hamlet) to generate html
* [Hakyll](https://hackage.haskell.org/package/hakyll), a static site compiler,
* [Blaze](https://hackage.haskell.org/package/blaze-html) to generate html,
* [Clay](https://hackage.haskell.org/package/clay) to preprocess css
## Building

View file

@ -2,21 +2,33 @@ module Main
( main
) where
import Data.Hashable
import Data.String
import Hakyll
import Text.Blaze.Html5 ( Html )
import Core.Compilers
import Core.Routers
import Core.Components
import Core.Render ( toCss )
import Kit.Templates.Index ( indexTemplate )
import Kit.Templates.Post ( postTemplate )
allTemplates :: [Component Html]
allTemplates = [postTemplate, indexTemplate]
allCss :: String
allCss = toCss . mconcat $ allTemplates
css :: Compiler (Item String)
css = makeItem allCss
cssHash :: Identifier
cssHash = fromString . show . hash $ allCss
main :: IO ()
main = hakyll $ do
match "src/Kit/Pages/*.hs" $ do
route $ moveFromToWithExtension "src/Kit/Pages/" "" "html"
compile runGHC
match "src/Css/*.hs" $ do
route $ moveFromToWithExtension "src/Css/" "css/" "css"
compile runGHC
match "src/Kit/Templates/*.hs"
$ compile
$ runGHC
@ -28,3 +40,14 @@ main = hakyll $ do
compile
$ pandocCompiler
>>= loadAndApplyTemplate "src/Kit/Templates/Post.hs" defaultContext
. fmap demoteHeaders
create ["index"] $ do
route $ constRoute "index.html"
compile
$ makeItem ""
>>= loadAndApplyTemplate "src/Kit/Templates/Index.hs" defaultContext
create [cssHash] $ do
route $ constRoute "css/default.css"
compile css

View file

@ -1,6 +1,6 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.4.
-- This file has been generated from package.yaml by hpack version 0.35.1.
--
-- see: https://github.com/sol/hpack
@ -19,11 +19,19 @@ library
exposed-modules:
Core.Colors
Core.Compilers
Core.Components
Core.Render
Core.Routers
Css.Default
Kit.Atoms.BreakpointQueries
Kit.Atoms.Button
Kit.Pages.Index
Kit.Atoms.ButtonLink
Kit.Atoms.Fonts
Kit.Atoms.Stylesheet
Kit.Atoms.Typography
Kit.Constants.Breakpoints
Kit.Constants.Spacing
Kit.Templates.Index
Kit.Templates.Post
Routes
other-modules:
@ -31,7 +39,7 @@ library
hs-source-dirs:
src
default-extensions:
OverloadedStrings QuasiQuotes FlexibleInstances
OverloadedStrings FlexibleInstances
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
build-depends:
ansi-terminal
@ -40,8 +48,10 @@ library
, blaze-html
, clay
, colour
, containers
, hakyll
, shakespeare
, hashable
, mtl
, text
default-language: Haskell2010
@ -52,7 +62,7 @@ executable etienne-moqueur-exe
hs-source-dirs:
app
default-extensions:
OverloadedStrings QuasiQuotes FlexibleInstances
OverloadedStrings FlexibleInstances
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
ansi-terminal
@ -61,9 +71,11 @@ executable etienne-moqueur-exe
, blaze-html
, clay
, colour
, containers
, etienne-moqueur
, hakyll
, shakespeare
, hashable
, mtl
, text
default-language: Haskell2010
@ -75,7 +87,7 @@ test-suite etienne-moqueur-test
hs-source-dirs:
test
default-extensions:
OverloadedStrings QuasiQuotes FlexibleInstances
OverloadedStrings FlexibleInstances
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
build-depends:
ansi-terminal
@ -84,8 +96,10 @@ test-suite etienne-moqueur-test
, blaze-html
, clay
, colour
, containers
, etienne-moqueur
, hakyll
, shakespeare
, hashable
, mtl
, text
default-language: Haskell2010

View file

@ -21,13 +21,15 @@ extra-source-files:
dependencies:
- base >= 4.7 && < 5
- hakyll
- shakespeare
- clay
- text
- blaze-html
- array
- colour
- ansi-terminal
- mtl
- containers
- hashable
ghc-options:
- -Wall
@ -42,7 +44,6 @@ ghc-options:
default-extensions:
OverloadedStrings
QuasiQuotes
FlexibleInstances
library:

View file

@ -8,8 +8,8 @@ This first post has two objectives:
* It is for me: a way to keep notes and to populate this site with real content.
* It is for others: a resource to gather ideas and such.
## What?
### A personal website
# What?
## A personal website
It'd be a website that compiles some personal posts. It should be
* A landing page (a personal one, not professional)
@ -18,52 +18,52 @@ It'd be a website that compiles some personal posts. It should be
* Music?
* A pattern guide / style guide
### A lightweight static site
## A lightweight static site
* Very humble resources, smallest footprint possible.
* Static content
* If possible, no JS!
### Landing page
## Landing page
* Social handles
* Short bio
* Photo
### Blog
## Blog
* Content written in md
* Tags
* Archives and per-tag browsing
### Photo
## Photo
* Galleries (& tags?)
* Thumbnails for easy loading
* AVIF, or at least the lightest formats possible
### Music
## Music
Could be a place to share creations...
### Pattern guide
## Pattern guide
A place to include all atomic components, with short doc, source code and lineage
## Why?
# Why?
* As an ambitious project
* As a Haskell project
* As a replacement of social nets
* As a way to try to go lightweight on a full-scale site
## Who?
# Who?
Friends who want to check my photos, randos of the net that want to see dotfiles or notmuch setups...
### Languages?
## Languages?
The blog posts would be in english, except maybe articles about birds or whatnot? The photo galleries... english? french? The landing page?
**As a first goal, a working instance with english. Goal to go full multi-lang support**
## How?
### Haskell
# How?
## Haskell
* Hakyll for static site compilation & deployment
* Blaze + Clay for markup & styling
@ -71,12 +71,12 @@ The blog posts would be in english, except maybe articles about birds or whatnot
* I want a full kit!
* A [frontend workshop](https://bradfrost.com/blog/post/a-frontend-workshop-environment/) to display components. Should make it easy to add doc, include source code and present lineage.
### Easy workflow
## Easy workflow
* Articles should be easy to write as plain md files, no fuss
* Photo galleries should be just folders with a photo and a md/yaml with the same name for title description *etc*.
### Should be possible to scale
## Should be possible to scale
* Component based
* Differentiate the component mechanisms and the site building: a project 'component' which deploys as an accessible lib for the other, and a project 'site' which depends on component and builds and deploys the site.
@ -89,10 +89,10 @@ There should be at least four projects:
3. **content**: mainly a Hakyll core with easy-to-add content.
4. **workshop**: an automated frontend workshop maker that binds well with Hakyll.
## When?
# When?
No hurry, I'd like to make it in under a year though...
## Project launch
# Project launch
Above was the first brief I made, and as I launch the project a few things have already changed.
* I will use Hamlet in place of Blaze, even though Blaze is used as Hamlet renders to the Html type defined in Blaze.
@ -114,4 +114,3 @@ ___src/___Core/... (Backend: compilers, routers, renderers and such)
| |_photo1.md (photo metadata)
|_album2/...
```

View file

@ -0,0 +1,105 @@
---
title: My note taking setup
description: This post presents the tools I use to take everyday notes
---
In this post I present the setup I use to keep notes of ideas, notions *etc*. It uses **vim** with a selected set of plugins, to achieve a minimalistic implementation of the [Zettelkasten](https://en.wikipedia.org/wiki/Zettelkasten) method.
# An overview of Zettelkasten
Behind this name lies a simple idea: instead of trying to classify notes in folders, or by tag and being limited by one particular classification, let the notes all live in a same large box and just be interested in the *metadata*: which notes link to which.
This way of keeping notes seems to be quite popular right now, and I must say I liked the idea that a note could just be dumped in a folder with just a few links to other notion to make it have its importance. I really lightens the burden of starting the process of writing something as it does not have to be classified yet, but will just classify itself in the process.
So, what properties should a Zettelkasten system have?
* Each note must have a unique identifier, to be unambiguously referenced.
* It should be easy to reference a note in another.
* It should be easy to look for an existing note with full text searches.
* Ideally, it should be easy to have access to notes that point to a particular note (find backlinks).
* The full graph structure of the notes should be accessible.
At the time of writing, the last point is not yet implemented but the others are, to some extent.
# Core vim plugins
At the core of this system is really one plugin by [Michal Hoftlich](https://github.com/michal-h21) who did all the work with [vim-zettel](https://github.com/michal-h21/vim-zettel). This plugin takes care of all the necessities: the four first points of the bullet list above. It depends on other plugins too:
* [vimwiki](https://vimwiki.github.io/) which allows to work with a wiki structure in `vim`,
* [fzf.vim](https://vimwiki.github.io/) to make full text fuzzy searches in notes
Once all of those are installed, here are a couple tweaks I made:
## vim-zettel options
For the unique identifier, I chose to have a timestamp in front of the note title. Each note is then a `md` file with a `yaml` frontmatter that contains useful information:
* the note title,
* the date and time of creation,
* a type, which is generally "note", but can have other values (see below)
After this frontmatter, there is a list of "tags" which are just links to other notes that can have a more general subject. This should allow for some structure emergence later on. Then the title, the note contents, and finally some references which would be pointing to particular resources: books, articles, videos *etc*. This default format is defined in a template note which vim-zettel will use upon creating a note.
For full text search, instead of choosing the default silver searcher, I configured vim-zettel to call ripgrep as it is what I had already installed.
Additionally, I configured some useful keybindings to create a new note, open an existing one, include a reference to a note and add the backlinks to a note. All these functionalities are offered by the plugin and I merely assigned some keys to call them.
## vimwiki options
For vimwiki, I chose to use the `markdown` syntax as it is not the choice by default, added the `markdown` filetype to the created files (by default they only have a `vimwiki` filetype), and disabled some mappings to navigate links as they used the `<tab>` key and I needed it to expand snippets.
## fzf options
I left fzf mostly untouched, and just added a keybinding to look for available snippets, with a cheatsheet purpose.
# Convenience vim plugins
To make the setup enjoyable to use I also added some convenience plugins:
* Snippets with [ultisnips](https://github.com/SirVer/ultisnips) which allow to expand some keywords to recurring patterns. I use it for sections, links, formatting and such.
* [AutoComplPop](https://github.com/vim-scripts/AutoComplPop) which just pops the completion menu automatically. Useful to auto complete words.
* [PaperColor](https://github.com/NLKNguyen/papercolor-theme) theme, in its dark variation, purely aesthetic.
* [Goyo](https://github.com/junegunn/goyo.vim) which makes vim's interface very minimalistic: no bars, no line numbers, centred text and that's it.
* [vim-markdown](https://github.com/preservim/vim-markdown) which makes working with `md` files so much easier.
I plan to also add [vimwiki-sync](https://github.com/michal-h21/vimwiki-sync) as it would allow me to easily sync my notes between different computers.
And really that's it!
# Typical workflow
## Note types
OK, so how do I typically use this setup? At the moment, I find I conceptually distinguish between three types of notes (also they are all located in the same folder):
* plain notes: short, on the fly, written down ideas. They are the core of the process. Their type is `note`.
* references: those are special notes pointing to an external resource. I can either make one by hand, or I automated crafting them directly from firefox (see below). Their type is `ref`.
* hubs: those special notes are not new ideas but are notions that are pointed to by a lot of other notes. At the moment I am sill unclear how to gracefully deal with those, but I have some clues. Their type is `hub`.
## New notes
When I have an idea I will fire up vim with the note taking `vimrc` setup (I aliased it to `ztl`), and I can create a new note and write down the idea. I can also start by looking if a note with a similar idea doesn't already exist, or point to related notes while writing.
I try to keep the notes short, and limited to one idea, as is recommended by the Zettelkasten system. It also makes it way less intimidating to write a note!
## Tags and hubs
In each note, I also have a "tags" line, in which I write keywords relating to the idea. If I'm sure the keyword has never been used I just write it plain and (in normal mode) then press `Enter` so that vimwiki transforms it to a link. `Enter` again and I can open up the link and just save it in place. It creates an empty file with the name of the new tag.
If, however, I think or know I have created the note before I can look for and link to it with vim-zettel. I can also directly reference another note in the tags if the subject is similar.
After some time, I should see the importance of different tags emerge, as being pointed to by many notes. At which point I can open this particular note, and if it is empty give it the `hub` status with some words on the meaning of the hub, and possibly a list of backlinks pointing to that hub.
## References
To add new references, typically in the form of an online article, I installed the [BibItNow](https://addons.mozilla.org/fr/firefox/addon/bibitnow/) firefox extension, which is an easy way to create bibliographic references from online pages or articles. I wrote myself a template (`ref.bnfa`) that I can import in BibItNow that would present the information as a note with type `ref`. That way, I just have to press `Alt+Q` on a page I want to keep a note of to download it as a new reference.
To have a good filename I tweaked the BibKey settings so that the created reference can be readily saved in my notes.
# How to use
My source files are accessible on [this repo](https://git.moqueur.chat/etienne/zettelnotes.git). Feel free to grab them and have a look! To replicate the system:
* Dependencies: vim (possibly neovim), rg.
* Launch `vim -u path/to/vimrc -c PlugInstall`, and vim should take care of everything.
* Just call `vim -u path/to/vimrc` to enter the note taking environment!

29
src/Core/Components.hs Normal file
View file

@ -0,0 +1,29 @@
module Core.Components
( Component(..)
, new
) where
import Clay ( Css(..)
, compact
, renderWith
)
import Control.Monad.State.Lazy
import qualified Data.Map as Map
import Text.Blaze.Html.Renderer.String
import Text.Blaze.Html5 ( Html(..) )
type CssMap = Map.Map String Css
type Component = State CssMap
instance Semigroup a => Semigroup (Component a) where
parent <> child = (<>) <$> parent <*> child
instance Monoid a => Monoid (Component a) where
mempty = new "mempty" mempty mempty
new :: String -> Css -> a -> Component a
new name css html = do
cssMap <- get
put (Map.insert name css cssMap)
return html

View file

@ -1,20 +1,36 @@
module Core.Render
( renderHamlet
, renderClay
( putHtml
, toCss
, putCss
) where
import Clay ( Css
, compact
, renderWith
)
import qualified Data.Text.Lazy.IO as T
( putStr )
import Routes
import Control.Monad.State.Lazy
import Core.Components
import qualified Data.Map as Map
import Data.Text.Lazy ( unpack )
import Text.Blaze.Html.Renderer.String
import Text.Hamlet ( HtmlUrl )
import Text.Blaze.Html5 ( Html )
renderHamlet :: HtmlUrl Route -> IO ()
renderHamlet ham = putStr . renderHtml $ ham render
-- |render a Component's Html
putHtml :: Component Html -> IO ()
putHtml c = putStr . renderHtml . evalState c $ Map.empty
renderClay :: Css -> IO ()
renderClay = T.putStr . renderWith compact []
-- |Return a Component's Css as a String
toCss :: Component a -> String
toCss = unpack . toCssText
where
toCssText c =
renderWith compact []
. mconcat
. map snd
. Map.toList
. execState c
$ Map.empty
-- |render a Component's Css
putCss :: Component a -> IO ()
putCss = putStr . toCss

View file

@ -1,14 +1,13 @@
module Css.Default
( main
( defaultCss
) where
import Clay
import Core.Render ( renderClay )
import Kit.Atoms.Button ( buttonCss )
import qualified Clay.Pseudo as P
import Kit.Atoms.Typography
defaultCss :: Css
defaultCss = do
buttonCss
main :: IO ()
main = renderClay defaultCss
star # P.root ? defaultFontStyle
headings

View file

@ -0,0 +1,22 @@
module Kit.Atoms.BreakpointQueries
( breakpointS
, breakpointM
, breakpointL
, breakpointXL
, breakpointXXL
) where
import Clay.Media
import Clay.Stylesheet ( Css
, query
)
import Kit.Constants.Breakpoints
breakpointS, breakpointM, breakpointL, breakpointXL, breakpointXXL
:: Css -> Css
breakpointS = query screen [minWidth s]
breakpointM = query screen [minWidth m]
breakpointL = query screen [minWidth l]
breakpointXL = query screen [minWidth xl]
breakpointXXL = query screen [minWidth xxl]

View file

@ -1,17 +1,17 @@
module Kit.Atoms.Button (buttonWithText, buttonCss) where
module Kit.Atoms.Button
( buttonWithText
) where
import Routes
import Clay as C
import Core.Components
import Routes
import Text.Blaze.Html5 as H
import Text.Hamlet
import Clay
buttonWithText :: String -> HtmlUrl Route
buttonWithText text = [hamlet|
<button>#{text}
|]
buttonCss :: Css
buttonCss = button ? do
css :: Css
css = C.button ? do
backgroundColor blue
color white
fontWeight bold
buttonWithText :: Html -> Component Html
buttonWithText = new "buttonWithText" css . H.button

View file

@ -0,0 +1,27 @@
module Kit.Atoms.ButtonLink
( buttonLink
) where
import Clay as C
hiding ( (!) )
import Core.Components
import Routes
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
-- |Create a link with a button shape. Takes the route and inner content as arguments.
buttonLinkHtml :: Route -> Html -> Html
buttonLinkHtml ref = H.a ! class_ "button" ! A.href (stringValue . path $ ref)
css :: Css
css = C.a # byClass "button" ? do
display inlineBlock
padding (C.em 0.35) (C.em 1.2) (C.em 0.35) (C.em 1.2)
border (C.em 0.1) solid C.red
margin (C.em 0) (C.em 0.3) (C.em 0.3) (C.em 0)
-- borderRadius (C.em 0.12)
textDecoration none
textAlign center
buttonLink :: Route -> Html -> Component Html
buttonLink ref = new "buttonLink" css . buttonLinkHtml ref

12
src/Kit/Atoms/Fonts.hs Normal file
View file

@ -0,0 +1,12 @@
module Kit.Atoms.Fonts
( standardFont
, codeFont
) where
import Clay
standardFont :: Css
standardFont = fontFamily [] [sansSerif]
codeFont :: Css
codeFont = fontFamily [] [monospace]

View file

@ -0,0 +1,11 @@
module Kit.Atoms.Stylesheet
( stylesheet
) where
import Routes
import Text.Blaze.Html5
import Text.Blaze.Html5.Attributes
stylesheet :: Route -> Html
stylesheet route =
link ! rel "stylesheet" ! (href . stringValue . path $ route)

View file

@ -0,0 +1,43 @@
module Kit.Atoms.Typography
( defaultFontStyle
, regularFont
, codeFont
, headings
) where
import Clay hiding ( scale )
import Kit.Atoms.BreakpointQueries
import Kit.Constants.Spacing
defaultFontStyle :: Css
defaultFontStyle = do
regularFont
-- fontSize fontXS
-- breakpointM $ fontSize fontM
-- breakpointXXL $ fontSize fontXXL
regularFont :: Css
regularFont = do
fontFamily [] [sansSerif]
lineHeight regularLineHeight
fontSize $ fontXS @+@ (0.3 *@ vw 1)
codeFont :: Css
codeFont = do
fontFamily [] [monospace]
lineHeight (unitless 1)
scaleUp, scaleDown :: [Size LengthUnit]
scaleUp = iterate (scale *@) (em 1)
scaleDown = iterate (@/ scale) (em 1)
headings :: Css
headings =
mconcat
$ zipWith (?) [h4, h3, h2, h1]
$ tail
$ (>> lineHeight lowLineHeight)
. (>> fontWeight (weight 400))
. fontSize
<$> scaleUp

View file

@ -0,0 +1,24 @@
module Kit.Constants.Breakpoints
( s
, m
, l
, xl
, xxl
, breakpoints
) where
import Clay.Size
-- |Breakpoints used for responsive design. As the design is mobile-first, 'Breakpoint's should be used in a min-width query.
-- |'Breakpoint' is just an alias for a size in pixels.
type Breakpoint = Size LengthUnit
s, m, l, xl, xxl :: Breakpoint
s = px 480
m = px 768
l = px 960
xl = px 1280
xxl = px 1536
breakpoints :: [Breakpoint]
breakpoints = [s, m, l, xl, xxl]

View file

@ -0,0 +1,41 @@
module Kit.Constants.Spacing
( fontXS
, fontM
, fontXXL
, scale
, regularLineHeight
, lowLineHeight
, tiny
, small
, regular
, large
, huge
) where
import Clay.Size
import Prelude hiding ( rem )
-- |The spacing relates to font sizes and negative space.
-- |Scaling of the font size for larger screens.
fontXS, fontM, fontXXL :: Size LengthUnit
fontXS = rem 1
fontM = rem 1.25
fontXXL = rem 1.625
-- |Line heights
regularLineHeight, lowLineHeight :: Size a
regularLineHeight = unitless 1.5
lowLineHeight = unitless 1.2
-- |Modular scaling for font levels
scale :: Double
scale = 1.2
-- |Vertical spaces sizes
tiny, small, regular, large, huge :: Size LengthUnit
tiny = ex 0.25
small = ex 0.5
regular = ex 1
large = ex 2
huge = ex 4

View file

@ -1,20 +0,0 @@
module Kit.Pages.Index (main) where
import Routes
import Kit.Atoms.Button
import Core.Render (renderHamlet)
import Text.Hamlet
index :: HtmlUrl Route
index = [hamlet|
$doctype 5
<html>
<head>
<title>Very first try
<link rel=stylesheet href=@{DefaultStylesheet}>
<body>
^{buttonWithText "Click!"}
|]
main :: IO ()
main = renderHamlet index

View file

@ -0,0 +1,33 @@
module Kit.Templates.Index
( main
, indexTemplate
) where
import Core.Components
import Core.Render ( putHtml )
import Css.Default
import Kit.Atoms.Button
import Kit.Atoms.ButtonLink
import Kit.Atoms.Stylesheet
import Routes
import Text.Blaze.Html5 as H
hiding ( main )
import Text.Blaze.Html5.Attributes as A
indexHtml :: Html -> Html
indexHtml h = docTypeHtml $ do
H.head $ do
H.title "Very first try"
stylesheet DefaultStylesheet
body $ do
h
index :: Component (Html -> Html)
index = new "index" defaultCss indexHtml
indexTemplate :: Component Html
indexTemplate =
index <*> buttonWithText "Click!" <> buttonLink Blog "All posts"
main :: IO ()
main = putHtml indexTemplate

View file

@ -1,23 +1,29 @@
module Kit.Templates.Post (postHamlet, main) where
module Kit.Templates.Post
( postTemplate
, main
) where
import Core.Render (renderHamlet)
import Routes
import Text.Hamlet (HtmlUrl, hamlet)
import Core.Components
import Core.Render ( putHtml )
import Routes
postHamlet :: HtmlUrl Route
postHamlet = [hamlet|
$doctype 5
<html>
<head>
<title>
\$title$
<link rel=stylesheet href=@{DefaultStylesheet}>
<meta charset=utf-8>
<body>
<h1>
\$title$
\$body$
|]
import Kit.Atoms.Stylesheet
import Text.Blaze.Html5 as H
hiding ( main )
import Text.Blaze.Html5.Attributes as A
postHtml :: Html
postHtml = docTypeHtml $ do
H.head $ do
H.title "$title$"
stylesheet DefaultStylesheet
meta ! charset "utf-8"
body $ do
h1 "$title$"
"$body$"
postTemplate :: Component Html
postTemplate = new "postTemplate" mempty postHtml
main :: IO ()
main = renderHamlet postHamlet
main = putHtml postTemplate

View file

@ -1,16 +1,22 @@
module Routes
( Route(..)
, render
, path
) where
import Data.Text ( pack )
import Text.Hamlet ( Render )
import GHC.Exts ( IsString(..) )
data Route = Home
| Blog
| DefaultStylesheet
| Post String
| ExternalRoute String
render :: Render Route
render Home _ = "/"
render DefaultStylesheet _ = "/css/default.css"
render (Post postId) _ = "/posts/" <> pack postId
instance IsString Route where
fromString = ExternalRoute
path :: Route -> String
path Home = "/"
path Blog = "/posts"
path DefaultStylesheet = "/css/default.css"
path (Post postId) = "/posts/" <> postId
path (ExternalRoute addr ) = addr