moved from String to Text everywhere

README.md

@@ -1,3 +1,5 @@
+my personal website, made with [achille](https://acatalepsie.fr/projects/achille).
+
 ## todo
 
 - dark theme

content/posts/2020-09-26-syndication.rst

@@ -4,7 +4,7 @@ description: Where I setup an Atom feed
 ---
 
 I stumbled upon Matt Webb's `About Feeds <https://aboutfeeds.com/>`_ and
-realized I've been missing out on the power of web syndication for quite some
+realized I had been missing out on the power of web syndication for quite some
 time. Turns out most sites still make their feed available in one way or
 another. This allows anyone to subscribe to the content they are interested in
 without having to rely on a centralized platform. No more checking out one's

content/projects/achille/pages/3-a-blog-from-scratch.markdown

@@ -21,6 +21,7 @@ of our markdown files:
 
 ```haskell
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAny #-}
 
 import GHC.Generics
 import Data.Aeson
@@ -28,9 +29,7 @@ import Data.Text (Text)
 
 data Meta = Meta
   { title :: Text
-  } deriving (Generic)
+  } deriving (Generic, FromJSON)
-
-instance FromJSON Meta
 ```
 
 This way we enfore correct metadata when retrieving the content of our files.
@@ -39,7 +38,7 @@ generator to proceed:
 
 ```markdown
 ---
-title: Something about efficiency
+title: My first blogpost!
 ---
 ```
 
@@ -51,17 +50,17 @@ Then we create a generic template for displaying a page, thanks to lucid:
 
 import Lucid.Html5
 
-renderPost :: Text -> Text -> Html a
+renderPost :: Text -> Text -> Html ()
 renderPost title content = wrapContent do
   h1_ $ toHtml title
   toHtmlRaw content
 
-renderIndex :: [(Text, FilePath)] -> Html a
+renderIndex :: [(Text, FilePath)] -> Html ()
 renderIndex = wrapContent .
   ul_ . mconcat . map \(title, path) ->
     li_ $ a_ [href_ path] $ toHtml title
 
-wrapContent :: Html a -> Html a
+wrapContent :: Html () -> Html ()
 wrapContent content = doctypehtml_ do
     head_ do
         meta_ [charset_ "utf-8"]

site.cabal

@@ -16,6 +16,7 @@ executable site
                      , Config
                      , Visual
                      , Templates
+                     , Readings
   build-depends:       base >=4.12 && <4.13
                      , filepath
                      , achille
@@ -25,7 +26,6 @@ executable site
                      , text
                      , bytestring
                      , filepath
-                     , frontmatter
                      , aeson
                      , yaml
                      , binary
@@ -34,13 +34,14 @@ executable site
                      , feed
                      , time
                      , lucid
-                     , binary-instances
   extensions:          BlockArguments
                      , TupleSections
                      , OverloadedStrings
                      , ScopedTypeVariables
                      , DeriveGeneric
                      , DeriveAnyClass
+                     , RecordWildCards
+                     , NamedFieldPuns
   ghc-options:       -threaded
                      -j8
                      -O2

src/Main.hs

@@ -1,6 +1,5 @@
 module Main where
 
-import qualified Data.Yaml as Yaml
 import Lucid
 
 import Common
@@ -10,6 +9,7 @@ import Config (config, ropts, wopts, SiteConfig(title))
 import qualified Posts
 import qualified Projects
 import qualified Visual
+import qualified Readings
 
 
 main :: IO ()
@@ -27,9 +27,4 @@ main = achilleWith config do
     Visual.build
     Projects.build
     Posts.build
-
+    Readings.build
-    -- reading list
-    matchFile "readings.yaml" $ readBS
-        >>= (liftIO . Yaml.decodeThrow)
-        <&> renderReadings
-        >>= saveFileAs (-<.> "html")

src/Projects.hs

@@ -1,22 +1,29 @@
 module Projects (build) where
 
+import Lucid
 import Data.Char (digitToInt)
+import qualified Data.Map.Strict as Map
 
 import Common
 import Types
 import Config
 import Templates
-import Lucid
+
+data Project = Project 
+    { title    :: Text
+    , subtitle :: Text
+    , year     :: Text
+    , labels   :: Map.Map Text Text
+    } deriving (Generic, Eq, FromJSON, Binary)
 
 
-getKey :: String -> (Int, String)
+build :: Task IO ()
-getKey xs = getKey' 0 xs
+build = do
-    where
+    projects <- matchDir "projects/*/" buildProject
-        getKey' :: Int -> String -> (Int, String)
+
-        getKey' k (x : xs) | x >= '0' && x <= '9' =
+    watch projects $ match_ "./projects.rst" do
-            getKey' (k * 10 +  digitToInt x) xs
+        intro <- compilePandocWith def wopts
-        getKey' k ('-' : xs) = (k, xs)
+        write "projects.html" (renderIndex intro projects)
-        getKey' k xs         = (k, xs)
 
 
 buildProject :: Recipe IO a (Project, FilePath)
@@ -28,35 +35,67 @@ buildProject = do
 
     watch children $ matchFile "index.*" do
         (meta, doc) <- readPandocMetadataWith ropts
-        renderPandocWith wopts doc <&> renderProject meta children
+
+        renderPandocWith wopts doc
+            <&> renderProject meta children
             >>= saveFileAs (-<.> "html")
-            >> (meta,) <$> getCurrentDir
+
+        (meta,) <$> getCurrentDir
     where
-        buildChildren :: String -> Recipe IO a [(String, FilePath)]
+        buildChildren :: String -> Recipe IO a [(Text, FilePath)]
         buildChildren name = match "pages/*" do
             filepath <- getInput
             let (key, file) = getKey $ takeFileName filepath
             (TitledPage title _, doc) <- readPandocMetadataWith ropts
             renderPandocWith wopts doc
                 <&> toHtmlRaw
-                <&> outerWith (def {Config.title = fromString title})
+                <&> outerWith (def {Config.title = title})
                 >>= saveFileAs (const $ file -<.> "html")
                 <&> (title,)
 
-            -- sorted = sortBy (\(_, x, _, _, _) (_, y, _, _, _) -> compare x y) children
 
-            -- match "pages/*" do
+renderProject :: Project -> [(Text, FilePath)] -> Text -> Html ()
-            --     renderPandocWith wopts doc
+renderProject Project{..} children content =
-            --         <&> outerWith (def {title = name})
+    outerWith def { Config.title       = title
-            --         >>= saveFileAs (const $ file -<.> "html")
+                  , Config.description = subtitle
-            --         <&> (name,)
+                  } do
-            --         -}
+        header_ [class_ "project"] do
+            div_ (img_ [src_ "logo.svg"])
+            div_ do
+                h1_ (toHtml title)
+                p_  (toHtml subtitle)
+                ul_ $ forM_ (Map.toList labels) \(k, v) -> li_ do
+                    toHtml k <> ": "
+                    if k == "repo" then
+                        a_ [href_ $ "https://github.com/" <> v]
+                            $ toHtml v
+                    else toHtml v
+        when (length children > 0) $
+            ol_ [class_ "pages"] $ forM_ children \(title, path) ->
+                li_ $ a_ [href_ (fromString path)] (toHtml title)
+        toHtmlRaw content
 
 
-build :: Task IO ()
+renderIndex :: Text -> [(Project, FilePath)] -> Html ()
-build = do
+renderIndex intro projects =
-    projects <- matchDir "projects/*/" buildProject
+    outerWith def { Config.title = "projects"
+                  , Config.description = intro
+                  } do
+        toHtmlRaw intro
+        ul_ [class_ "projects"] $ forM_ projects projectLink
+    where
+        projectLink :: (Project, FilePath) -> Html ()
+        projectLink (Project{..}, path) =
+            li_ $ a_ [href_ (fromString path)] do
+                div_ $ img_ [src_ (fromString $ path </> "logo.svg")]
+                div_ $ h2_ (toHtml title) >> p_  (toHtml subtitle)
 
-    watch projects $ match_ "./projects.rst" do
+
-        txt <- compilePandocWith def wopts
+getKey :: String -> (Int, String)
-        write "projects.html" $ renderProjects txt projects
+getKey xs = getKey' 0 xs
+    where
+        getKey' :: Int -> String -> (Int, String)
+        getKey' k (x : xs) | x >= '0' && x <= '9' =
+            getKey' (k * 10 +  digitToInt x) xs
+        getKey' k ('-' : xs) = (k, xs)
+        getKey' k xs         = (k, xs)

src/Readings.hs

@@ -0,0 +1,35 @@
+module Readings (build) where
+
+import qualified Data.Yaml as Yaml
+import Lucid
+import Common
+import Config
+import Templates
+
+
+data Book = Book
+    { title     :: Text
+    , author    :: Text
+    , rating    :: Maybe Int
+    } deriving (Generic, Show, FromJSON)
+
+
+build :: Recipe IO () FilePath
+build = matchFile "readings.yaml" $
+    readBS
+        >>= (liftIO . Yaml.decodeThrow)
+        <&> renderReadings
+        >>= saveFileAs (-<.> "html")
+
+
+renderReadings :: [Book] -> Html ()
+renderReadings books =
+    outerWith def { Config.title       = "readings"
+                  , Config.description = "books I've read"
+                  } do
+        table_ [ class_ "books" ] $
+            forM_ books \Book {title, author, rating} ->
+                tr_ do
+                    td_ (toHtml title)
+                    td_ (toHtml author)
+                    td_ (toHtml $ fromMaybe "." $ flip replicate '★' <$> rating)

src/Templates.hs

@@ -3,8 +3,6 @@
 {-# LANGUAGE TypeSynonymInstances     #-}
 {-# LANGUAGE FlexibleInstances        #-}
 {-# LANGUAGE MultiParamTypeClasses    #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
 
 module Templates where
 
@@ -39,57 +37,6 @@ property_ = makeAttribute "property"
 toLink :: FilePath -> Html () -> Html ()
 toLink url = a_ [ href_ (fromString $ "/" <> url) ]
 
-renderProject :: Project -> [(String, FilePath)] -> Text -> Html ()
-renderProject (project@Project{title,..}) children content =
-    outerWith def { Config.title       = fromString title
-                  , Config.description = fromString subtitle
-                  } do
-        header_ [ class_ "project" ] do
-            div_ (img_ [ src_ "logo.svg" ])
-            div_ do
-                h1_ (fromString title)
-                p_ (fromString subtitle)
-                ul_ $ forM_ (Map.toList labels) \(k, v) -> li_ do
-                    fromString k <> ": "
-                    if k == "repo" then
-                        a_ [ href_ (fromString $ "https://github.com/" <> v) ]
-                            $ fromString v
-                    else fromString v
-        when (length children > 0) $
-            ol_ [ class_ "pages" ] $ forM_ children \(t,l) ->
-                li_ $ a_ [ href_ (fromString l) ] (fromString t)
-        toHtmlRaw content
-
-renderReadings :: [Book] -> Html ()
-renderReadings books =
-    outerWith def { Config.title       = "readings"
-                  , Config.description = "books I've read"
-                  } do
-        table_ [ class_ "books" ] $
-            forM_ books \ Book {title,author,rating,completed} ->
-                tr_ do
-                    td_ (toHtml title)
-                    td_ (toHtml author)
-                    td_ $ fromString $ case rating of
-                        Just r  -> replicate r '★'
-                        Nothing -> "·"
-                    td_ $ fromString $ case completed of
-                        Just d  -> formatTime defaultTimeLocale "%m/%0Y"
-                                   $ zonedTimeToUTC d
-                        Nothing -> "·"
-
-renderProjects :: Text -> [(Project, FilePath)] -> Html ()
-renderProjects txt paths =
-    outer do
-        toHtmlRaw txt
-        ul_ [ class_ "projects" ] do
-            forM_ paths \(Project {title,..}, link) -> li_ $ a_ [ href_ (fromString link) ] $ do
-                div_ $ img_ [ src_ (fromString $ link </> "logo.svg") ]
-                div_ do
-                    h2_ (fromString title)
-                    p_  (fromString subtitle)
-                    -- H.ul $ forM_ (Map.toList $ Types.labels project) \(k, v) ->
-                    --     H.li $ (fromString k <> ": " <> fromString v)
 
 logo :: Html ()
 logo = toHtmlRaw ("<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\" height=\"19px\" width=\"29px\"><path d=\"M 2,2 A 5,5 0 0 1 7,7 L 7, 12 A 5, 5 0 0 1 2,17 M 7,7 A 5,5 0 0 1 12,2 L 22,2 A 5,5 0 0 1 27,7 L 27,12 A 5, 5 0 0 1 22,17 L 12,17\" style=\"stroke-width: 2; stroke-linecap: butt; stroke-linejoin: bevel; stroke: #fff\" fill=\"none\"/></svg>" :: Text)

src/Types.hs

@@ -1,32 +1,10 @@
-{-# LANGUAGE DuplicateRecordFields #-}
-
 module Types where
 
-import Data.Time.LocalTime (ZonedTime)
-import Data.Binary.Instances.Time ()
-import qualified Data.Map.Strict as Map
 import Common
 
--- | Full project description
-data Project = Project 
-    { title    :: String
-    , subtitle :: String
-    , year     :: String
-    , labels   :: Map.Map String String
-    , gallery  :: Maybe Bool
-    } deriving (Generic, Eq, Show, FromJSON, Binary)
-
-
 data TitledPage = TitledPage
-    { title       :: String
-    , description :: Maybe String
-    } deriving (Generic, Eq, Show, FromJSON, Binary)
-
-
--- | Book description for the readings page
-data Book = Book
     { title       :: Text
-    , author    :: Text
+    , description :: Maybe Text
-    , rating    :: Maybe Int
+    } deriving (Generic, Eq, FromJSON, Binary)
-    , completed :: Maybe ZonedTime
+
-    } deriving (Generic, Show, FromJSON)
+