flupe
/
acatalepsie
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

moved from String to Text everywhere

This commit is contained in:
flupe 2020-09-27 15:49:45 +02:00
parent 7c7aeae4e1
commit d3f3025e2d
9 changed files with 122 additions and 126 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
README.md
View File

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

2
content/posts/2020-09-26-syndication.rst
View File

@ -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

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

@ -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"]

5
site.cabal
View File

@ -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

9
src/Main.hs
View File

@ -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

95
src/Projects.hs
View File

@ -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)

35
src/Readings.hs Normal file
View File

@ -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)

59
src/Templates.hs
View File

@ -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 ("<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)

28
src/Types.hs
View File

@ -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)