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

git-annex in flupe@gozom:~/dev/acatalepsie

This commit is contained in:
flupe 2021-03-17 21:49:22 +01:00
parent 0f4d94eb28
commit a6242afd41
15 changed files with 264 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -4,3 +4,4 @@ dist-newstyle
_site
*.local
*~
*.agdai

5
README.md
View File

@ -9,7 +9,10 @@ nix-env -if release.nix
- dark theme
- faster thumbnail generation with openCV
- generic feed generation
- indieweb interactions (webmentions, etc)
- bin packing / grid system for galery
- better gallery (albums, webzines, media types, layouts, etc)
- tag/category/search system
- tag/category/search engine
- parallelization
- draft builds + live server

19
acatalepsie.nix
View File

@ -1,19 +0,0 @@
{ mkDerivation, achille, aeson, base, binary, bytestring
, containers, data-default, directory, feed, filepath, lucid
, optparse-applicative, pandoc, pandoc-types, process, sort, stdenv
, text, time, yaml
}:
mkDerivation {
pname = "site";
version = "0.1.0.0";
src = ./.;
isLibrary = false;
isExecutable = true;
executableHaskellDepends = [
achille aeson base binary bytestring containers data-default
directory feed filepath lucid optparse-applicative pandoc
pandoc-types process sort text time yaml
];
license = "unknown";
hydraPlatforms = stdenv.lib.platforms.none;
}

62
content/assets/theme.css
View File

@ -13,7 +13,7 @@
}
body {
font: 15px Inter, sans-serif, "é";
font: 16px Inter, sans-serif, "é";
line-height: 1.54;
margin: 0;
height: 100vh;
@ -43,6 +43,10 @@ main > section {
counter-reset: subsection;
}
main :first-child {
margin-top: 0;
}
main ::selection {
background: var(--yellow);
color: var(--black);
@ -124,7 +128,7 @@ strong {color: var(--darker)}
#hd nav a:hover {border-bottom:2px solid var(--yellow)}
main, #ft {
main, #ft, .breadcrumb {
padding: 2em 1em;
max-width: var(--width);
box-sizing: border-box;
@ -229,9 +233,11 @@ dt {text-align: right; font-weight: 500;}
dd {margin:0}
dd p {margin:0}
code {font: .9em "Source Code Pro", monospace}
code, pre.Agda {font: .9em "Source Code Pro", monospace}
pre.Agda a {font-weight: inherit; text-decoration: none}
pre.Agda a[href]:hover { background: var(--yellow) }
code, pre.sourceCode {
code, pre.sourceCode, pre.Agda {
background: #eceff4;
border-radius: 3px;
}
@ -252,12 +258,18 @@ pre > code {display: block}
#ft svg:hover {opacity:1}
pre.sourceCode {
margin:1em 0;
margin:2em 0;
padding: .8em 0;
line-height: 1;
overflow: auto;
}
pre.Agda {
margin: 2em 0;
padding: .8em 1em;
overflow: auto;
}
pre.sourceCode > code {
display: inline-block;
margin: 0 1em;
@ -290,13 +302,24 @@ section.visual {
grid-template-columns: repeat(auto-fill, minmax(300px, 1fr));
}
section.visual.tiny {
align-items: stretch;
grid-template-columns: repeat(auto-fill, minmax(160px, 1fr));
}
section.visual figure { margin: 0 }
section.visual.tiny figure { margin: 0; border-radius: 5px; overflow: hidden; }
figure img {
max-width: 100%;
height: auto;
/* aspect-ratio: attr(width) / attr(height); */
vertical-align: top;
}
section.visual.tiny img {object-fit: cover}
p.right {text-align: right}
section.visual.tiny figure img { height: 100% }
.admonition {
border-left: 3px solid var(--yellow);
@ -319,19 +342,20 @@ figure img {
.bn {color:#40a070}
.cf {color:#007020; font-weight: bold; }
.ch {color:#4070a0}
.cn {color:#880000}
.co {color:#60a0b0; font-style: italic; }
.cn, .Agda .InductiveConstructor {color:#880000}
.co, .Agda .Comment {color:#60a0b0; font-style: italic; }
.cv {color:#60a0b0; font-weight: bold; font-style: italic; }
.do {color:#ba2121; font-style: italic; }
.dt {color:#902000}
.dt, .Agda .PrimitiveType
, .Agda .Datatype {color:#902000}
.dv {color:#40a070}
.er {color:#f00; font-weight: bold; }
.fl {color:#40a070; }
.fu {color:#06287e; }
.fu, .Agda .Function {color:#06287e; }
.in {color:#60a0b0; font-weight: bold; font-style: italic; }
.kw {color:#007020; }
.kw, .Agda .Keyword {color:#007020; }
.op {color:#666}
.ot {color:#007020}
.ot, .Agda .Symbol {color:#007020}
.pp {color:#bc7a00}
.sc {color:#4070a0}
.ss {color:#bb6688}
@ -353,5 +377,21 @@ table.books tr td:first-child {
color: var(--blacker);
font-weight: 500;
}
.breadcrumb {
padding-bottom: 0;
padding-top: 1em;
}
.breadcrumb .sep {
color: #999;
padding: 0 .5em;
cursor: default;
}
main > header h1 {line-height: 1.3}
main > header p {font-style: italic; padding-left: .5em; margin: .2em 0 0 }
main > header time {font-weight: 500 }
table.books tr td:nth-child(3),
table.books tr td:last-child {text-align: center;color: var(--yellow)}

1
content/index.rst
View File

@ -1 +0,0 @@
Oh god why

8
content/readings.yaml
View File

@ -1,3 +1,11 @@
- title: Machine Sex and Other Stories
author: Candas Jane Dorsey
- title: Art
author: Yasmina Reza
- title: Histoire de ta bêtise
author: François Bégaudeau
- title: Le Discours
author: Fabrice Caro
- title: Ayoade on Ayoade
author: Richard Ayoade
- title: Antkind

16
release.nix
View File

@ -1,16 +0,0 @@
let
compiler = "ghc884";
rev = "b78e08e981a9ad31036fc6c6fb880c1315b4ebea";
overlay = _: pkgs: {
haskellPackages = pkgs.haskellPackages.override {
overrides = self: super: rec {
achille = self.callPackage ../achille/achille.nix {};
};
};
};
nixpkgs =
import (builtins.fetchTarball {
url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
}) { overlays = [ overlay ] ; };
in nixpkgs.haskellPackages.callPackage ./acatalepsie.nix {}

18
site.cabal
View File

@ -17,6 +17,7 @@ executable site
, Visual
, Templates
, Readings
, Route
build-depends: base >= 4.12 && < 5
, filepath
, achille
@ -37,15 +38,14 @@ executable site
, optparse-applicative
, process
, directory
extensions: BlockArguments
, TupleSections
, OverloadedStrings
, ScopedTypeVariables
, DeriveGeneric
, DeriveAnyClass
, RecordWildCards
, NamedFieldPuns
default-extensions: BlockArguments
, TupleSections
, OverloadedStrings
, ScopedTypeVariables
, DeriveGeneric
, DeriveAnyClass
, RecordWildCards
, NamedFieldPuns
ghc-options: -threaded
-j8
-O2
default-language: Haskell2010

5
src/Common.hs
View File

@ -12,11 +12,13 @@ module Common
, module Data.Binary
, module GHC.Generics
, module Data.Aeson.Types
, toDate
) where
import Achille
import Achille.Task.Pandoc
import Data.Time (UTCTime, defaultTimeLocale, formatTime, rfc822DateFormat)
import Data.Aeson.Types (FromJSON)
import GHC.Generics (Generic)
import Data.Binary (Binary)
@ -28,3 +30,6 @@ import Data.Text (Text)
import Data.Maybe (fromMaybe, mapMaybe)
import System.FilePath
import Lucid (Html)
toDate :: UTCTime -> String
toDate = formatTime defaultTimeLocale rfc822DateFormat

8
src/Config.hs
View File

@ -4,14 +4,18 @@ import Data.Default
import Data.Text (Text)
import Text.Pandoc.Options as Pandoc
import Achille (Config(..))
import Route
config :: Achille.Config
config = def
{ deployCmd = Just "rsync -avzzr _site/ --chmod=755 acatalepsie:/var/www/html"
{ deployCmd = Just "rsync -avzzr ~/dev/acatalepsie/_site/ --chmod=755 acatalepsie:/var/www/html"
, contentDir = root <> "content"
, outputDir = root <> "_site"
, cacheFile = root <> ".cache"
, ignore = [ "**/*.agdai"
, "**/*~"
]
} where root = "/home/flupe/dev/acatalepsie/"
@ -26,6 +30,7 @@ data SiteConfig = SiteConfig
{ title :: Text
, description :: Text
, image :: Text
, route :: Route
}
instance Default SiteConfig where
@ -33,4 +38,5 @@ instance Default SiteConfig where
{ title = "sbbls"
, description = "my personal web space, for your enjoyment"
, image = "https://acatalepsie.fr/assets/card.png"
, route = IndexRoute
}

13
src/Main.hs
View File

@ -17,12 +17,13 @@ import qualified Projects
import qualified Visual
import qualified Readings
type ShowDrafts = Bool
data Cmd
= Build ShowDrafts -- ^ Build the site
| Deploy -- ^ Deploy to the server
| Clean -- ^ Delete all artefacts
| Deploy -- ^ Deploy to the server
| Clean -- ^ Delete all artefacts
deriving (Eq, Show)
@ -39,8 +40,7 @@ main = customExecParser p opts >>= \case
Deploy -> mapM_ Process.callCommand (deployCmd config)
Clean -> removePathForcibly (outputDir config)
>> removePathForcibly (cacheFile config)
Build showDrafts ->
void $ runTask [] config (build showDrafts)
Build showDrafts -> void $ runTask [] config (build showDrafts)
where
opts = info (cli <**> helper) $ fullDesc <> header desc
p = prefs showHelpOnEmpty
@ -51,6 +51,7 @@ build :: ShowDrafts -> Task IO String
build showDrafts = do
-- static assets
match_ "assets/*" copyFile
match_ "static/*" copyFile
-- quid page
match_ "./quid.rst" \src ->
@ -59,7 +60,7 @@ build showDrafts = do
<&> outerWith def {Config.title = "quid"}
>>= write (src -<.> "html")
Visual.build
lastImages <- Visual.build
Projects.build
Posts.build showDrafts
Posts.build showDrafts lastImages
Readings.build

95
src/Posts.hs
View File

@ -1,21 +1,31 @@
module Posts (build) where
module Posts where
import Data.Aeson.Types (FromJSON)
import Data.Binary (Binary, put, get)
import Data.Time (UTCTime, defaultTimeLocale)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Format (rfc822DateFormat, formatTime)
import Data.List (isPrefixOf)
import GHC.Generics
import Lucid
import Text.Atom.Feed as Atom
import Text.Feed.Types (Feed(..))
import Text.Feed.Export (textFeed)
import qualified Achille.Internal.IO as AchilleIO
import Common
import Config (ropts, wopts)
import Visual (Image(..))
import qualified Config
import Templates
import Route
import System.FilePath
import System.Directory ( setCurrentDirectory
, getTemporaryDirectory
, renameDirectory
, createDirectoryIfMissing
)
-- metadata used for parsing YAML headers
data PostMeta = PostMeta
@ -39,25 +49,57 @@ instance IsTimestamped Post where timestamp = postDate
buildPost :: FilePath -> Task IO Post
buildPost src = do
copyFile src
(PostMeta title draft desc, pandoc) <- readPandocMetadataWith ropts src
content <- renderPandocWith wopts pandoc
let ext = takeExtensions src
if ".lagda.md" `isPrefixOf` ext then processAgda src
else do
(PostMeta title draft desc, pandoc) <- readPandocMetadataWith ropts src
content <- renderPandocWith wopts pandoc
let date = timestamp src
pure (renderPost date title content)
>>= write (src -<.> "html")
<&> Post title date (fromMaybe False draft) Nothing content
pure (renderPost title src content)
>>= write (src -<.> "html")
<&> Post title (timestamp src) (fromMaybe False draft) Nothing content
where
processAgda :: FilePath -> Task IO Post
processAgda src = do
spath <- toAbsolute src
odir <- getOutputDir <&> (</> dropExtensions src)
tmpdir <- liftIO getTemporaryDirectory <&> (</> "achille")
liftIO $ createDirectoryIfMissing False tmpdir
liftIO $ createDirectoryIfMissing False odir
liftIO $ AchilleIO.copyFile spath (tmpdir </> "index.lagda.md")
toDate :: UTCTime -> String
toDate = formatTime defaultTimeLocale rfc822DateFormat
-- agda --html needs to be invoked in the correct directory
liftIO $ setCurrentDirectory tmpdir
build :: Bool -> Task IO ()
build showDrafts = do
callCommand $
"agda --html "
<> "--html-dir=. "
<> "--html-highlight=auto "
<> "index.lagda.md"
callCommand $ "cp " <> tmpdir <> "/* " <> odir
let tpath = odir </> "index.md"
(PostMeta title draft desc, pandoc) <- readAbsPandocMetadataWith ropts tpath
content <- renderPandocWith wopts pandoc
let date = timestamp src
pure (renderPost date title content)
>>= write (dropExtensions src </> "index.html")
<&> takeDirectory
<&> Post title date (fromMaybe False draft) Nothing content
build :: Bool -> [Image] -> Task IO ()
build showDrafts imgs = do
posts <- match "posts/*" buildPost
<&> filter (\p -> not (postDraft p) || showDrafts)
<&> recentFirst
watch posts $ match_ "index.rst" \src -> do
watch imgs $ watch posts $ match_ "index.rst" \src -> do
compilePandoc src
<&> renderIndex posts
<&> renderIndex imgs posts
>>= write (src -<.> "html")
now <- liftIO getCurrentTime
@ -84,18 +126,33 @@ build showDrafts = do
}
renderPost :: Text -> FilePath -> Text -> Html ()
renderPost title source content =
outerWith def { Config.title = title } do
h1_ $ toHtml title
toLink source "View source"
renderPost :: UTCTime -> Text -> Text -> Html ()
renderPost date title content =
outerWith def { Config.title = title, Config.route = PostRoute } do
header_ do
h1_ $ toHtml title
p_ do
"Posted on "
time_ $ toHtml (showDate date)
"."
toHtmlRaw content
renderIndex :: [Post] -> Text -> Html ()
renderIndex posts content =
renderIndex :: [Image] -> [Post] -> Text -> Html ()
renderIndex imgs posts content =
outer do
toHtmlRaw content
section_ [class_ "visual tiny"] $
forM_ imgs \Image{..} ->
figure_ $ a_ [href_ $ fromString imgPath] $ img_
[ src_ (fromString imgThumbPath)
, width_ (fromString $ show imgThumbWidth)
, height_ (fromString $ show imgThumbHeight)
]
p_ [class_ "right"] $ a_ [href_ "/visual.html"] "→ View more visual work"
h2_ "Latest posts"
ul_ [ id_ "pidx" ] $ forM_ posts \post ->
li_ do

6
src/Projects.hs
View File

@ -5,6 +5,7 @@ import Data.Char (digitToInt)
import qualified Data.Map.Strict as Map
import Common
import Route
import Types
import Config
import Templates
@ -48,7 +49,9 @@ buildProject src = do
(TitledPage title _, doc) <- readPandocMetadataWith ropts filepath
renderPandocWith wopts doc
<&> toHtmlRaw
<&> outerWith (def {Config.title = title})
<&> outerWith (def { Config.title = title
, Config.route = ProjectPageRoute title (ProjectRoute $ fromString name)
})
>>= write (filepath -<.> "html")
<&> (title,)
@ -57,6 +60,7 @@ renderProject :: Project -> [(Text, FilePath)] -> Text -> Html ()
renderProject Project{..} children content =
outerWith def { Config.title = title
, Config.description = subtitle
, Config.route = ProjectRoute title
} do
header_ [class_ "project"] do
div_ (img_ [src_ "logo.svg"])

7
src/Templates.hs
View File

@ -17,6 +17,7 @@ import Achille.Writable as Writable
import Lucid
import Lucid.Base (makeAttribute)
import Route
import Types
import Common
import Config
@ -45,7 +46,7 @@ outer :: Html () -> Html ()
outer = outerWith def
outerWith :: SiteConfig -> Html () -> Html ()
outerWith SiteConfig{title,..} content = doctypehtml_ do
outerWith SiteConfig{title,route,..} content = doctypehtml_ do
head_ do
meta_ [ name_ "viewport"
, content_ "width=device-width, initial-scale=1.0, user-scalable=yes"
@ -77,6 +78,8 @@ outerWith SiteConfig{title,..} content = doctypehtml_ do
a_ [ href_ "/readings.html" ] "Readings"
a_ [ href_ "/quid.html" ] "Quid"
breadcrumb route
main_ content
footer_ [ id_ "ft" ] do
@ -84,6 +87,6 @@ outerWith SiteConfig{title,..} content = doctypehtml_ do
a_ [ href_ "https://creativecommons.org/licenses/by-nc/2.0/" ]
"CC BY-NC 2.0"
" · "
a_ [ href_ "https://instagram.com/ba.bou.m/" ] "instagram"
a_ [ href_ "https://instagram.com/ba.bou.m/", rel_ "me" ] "instagram"
" · "
a_ [ href_ "/atom.xml" ] "feed"

119
src/Visual.hs
View File

@ -1,54 +1,107 @@
module Visual (build) where
module Visual (build, Image(..)) where
import Config
import Data.Time (UTCTime)
import Data.List (isSuffixOf)
import qualified Config
import Common
import Templates (outerWith, loading_)
import Lucid
import Route
thumbWidth :: Int
thumbWidth = 710
build :: Task IO ()
data Image = Image
{ imgPath :: FilePath
, imgThumbPath :: FilePath
, imgThumbWidth :: Int
, imgThumbHeight :: Int
, imgDate :: UTCTime
, imgNSFW :: Bool -- is the image nsfw?
} deriving (Generic, Eq, Binary)
data EntryMeta = EntryMeta
{ title :: Text
, date :: Text
, updated :: Maybe Text
} deriving (Generic, Eq, FromJSON)
data Entry = Entry
{ entryTitle :: Text
, entryContent :: Text
, entryItems :: [Image]
, entryDate :: UTCTime
, entryType :: Text
} deriving (Generic, Eq, Binary)
instance IsTimestamped Image where timestamp = imgDate
instance IsTimestamped Entry where timestamp = entryDate
build :: Task IO [Image]
build = do
pictures <- match "visual/*" \src -> do
copyFile src
callCommandWith
(\a b -> "convert " <> a <> " " <> b)
(-<.> "webp")
src
src' <- toAbsolute src
size <- (resized . read)
<$> readCommand "identify" ["-ping", "-format", "(%w, %h)", src']
callCommandWith
(\a b -> "convert -resize 710x " <> a <> " " <> b)
(-<.> "thumb.webp")
src
<&> timestamped
<&> fmap (size,)
path <- copyFile src
tpath <- callCommandWith (\a b -> "convert -resize 710x " <> a <> " " <> b)
(-<.> "thumb.webp")
src
apath <- toAbsolute src
size <- read <$> readCommand "identify" ["-ping", "-format", "(%w, %h)", apath]
let nsfw = "nsfw" `isSuffixOf` dropExtension src
pure (Image path tpath thumbWidth (thumbHeight size) (timestamp src) nsfw)
watch pictures $ match_ "./visual.rst" \src -> do
intro <- compilePandoc src
write "visual.html" $ renderVisual intro (recentFirst pictures)
-- webcomics/albums
entries <- matchDir "visual/*/" \src -> do
matchFile "index.markdown" \src -> do
(meta, doc) <- readPandocMetadata src
renderPandoc doc
<&> renderEntry meta
>>= write (src -<.> "html")
pure ()
watch pictures do
let sorted = filter (not . imgNSFW) $ recentFirst pictures
match_ "./visual.rst" \src -> do
intro <- compilePandoc src
write "visual.html" $ renderVisual intro sorted
return (take 4 sorted)
where
resized :: (Int, Int) -> (Int, Int)
resized (width, height) =
(thumbWidth, round $ fi height * fi thumbWidth / fi width)
where
fi :: Int -> Float
fi = fromIntegral
thumbHeight :: (Int, Int) -> Int
thumbHeight (width, height) = round (fi height * fi thumbWidth / fi width)
fi :: Int -> Float
fi = fromIntegral
renderVisual :: Text -> [Timestamped ((Int, Int), FilePath)] -> Html ()
renderEntry :: EntryMeta -> Text -> Html ()
renderEntry meta content =
outerWith def { Config.title = title meta
, Config.route = VEntryRoute
} do
header_ do
h1_ $ toHtml (title meta)
p_ $ toHtml (date meta)
toHtmlRaw content
hr_ []
renderVisual :: Text -> [Image] -> Html ()
renderVisual txt imgs =
outerWith def {title = "visual"} do
outerWith def {Config.title = "visual"} do
toHtmlRaw txt
hr_ []
section_ [class_ "visual"] $
forM_ imgs \ (Timestamped _ ((width, height), p)) ->
figure_ $ a_ [href_ (fromString (replaceExtensions p "webp"))] $ img_
[ src_ (fromString p)
, width_ (fromString $ show width)
, height_ (fromString $ show height)
forM_ imgs \Image{..} ->
figure_ $ a_ [href_ $ fromString imgPath] $ img_
[ src_ (fromString imgThumbPath)
, width_ (fromString $ show imgThumbWidth)
, height_ (fromString $ show imgThumbHeight)
, loading_ "lazy" ]