diff --git a/README.md b/README.md index cda5834..0f63246 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,5 @@ +my personal website, made with [achille](https://acatalepsie.fr/projects/achille). + ## todo - dark theme diff --git a/content/posts/2020-09-26-syndication.rst b/content/posts/2020-09-26-syndication.rst index dfc4202..c53453a 100644 --- a/content/posts/2020-09-26-syndication.rst +++ b/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 `_ 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 diff --git a/content/projects/achille/pages/3-a-blog-from-scratch.markdown b/content/projects/achille/pages/3-a-blog-from-scratch.markdown index 4393ee9..2dffcd5 100644 --- a/content/projects/achille/pages/3-a-blog-from-scratch.markdown +++ b/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) - -instance FromJSON Meta + } deriving (Generic, FromJSON) ``` 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"] diff --git a/site.cabal b/site.cabal index f3c2e8e..344e89b 100644 --- a/site.cabal +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 7cef20f..6789c03 100644 --- a/src/Main.hs +++ b/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 - - -- reading list - matchFile "readings.yaml" $ readBS - >>= (liftIO . Yaml.decodeThrow) - <&> renderReadings - >>= saveFileAs (-<.> "html") + Readings.build diff --git a/src/Projects.hs b/src/Projects.hs index f3d7658..05736ce 100644 --- a/src/Projects.hs +++ b/src/Projects.hs @@ -1,22 +1,29 @@ module Projects (build) where -import Data.Char (digitToInt) +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) -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) +build :: Task IO () +build = do + projects <- matchDir "projects/*/" buildProject + + watch projects $ match_ "./projects.rst" do + intro <- compilePandocWith def wopts + write "projects.html" (renderIndex intro projects) 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 - >>= saveFileAs (-<.> "html") - >> (meta,) <$> getCurrentDir + + renderPandocWith wopts doc + <&> renderProject meta children + >>= saveFileAs (-<.> "html") + + (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 - -- renderPandocWith wopts doc - -- <&> outerWith (def {title = name}) - -- >>= saveFileAs (const $ file -<.> "html") - -- <&> (name,) - -- -} +renderProject :: Project -> [(Text, FilePath)] -> Text -> Html () +renderProject Project{..} children content = + outerWith def { Config.title = title + , Config.description = subtitle + } 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 () -build = do - projects <- matchDir "projects/*/" buildProject +renderIndex :: Text -> [(Project, FilePath)] -> Html () +renderIndex intro projects = + 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 - write "projects.html" $ renderProjects txt projects + +getKey :: String -> (Int, String) +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) diff --git a/src/Readings.hs b/src/Readings.hs new file mode 100644 index 0000000..66a73c3 --- /dev/null +++ b/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) diff --git a/src/Templates.hs b/src/Templates.hs index 047ec8a..65eb9a0 100644 --- a/src/Templates.hs +++ b/src/Templates.hs @@ -1,10 +1,8 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} 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 ("" :: Text) diff --git a/src/Types.hs b/src/Types.hs index 9cb8eca..c502bdd 100644 --- a/src/Types.hs +++ b/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) + { title :: Text + , description :: Maybe Text + } deriving (Generic, Eq, FromJSON, Binary) --- | Book description for the readings page -data Book = Book - { title :: Text - , author :: Text - , rating :: Maybe Int - , completed :: Maybe ZonedTime - } deriving (Generic, Show, FromJSON)