瀏覽代碼

re-working

merge-yannesposito
父節點
當前提交
00d04794d3
簽署人: yogsototh GPG Key ID: 7B19A4C650D59646
  1. 3
      .gitignore
  2. 5
      CHANGELOG.md
  3. 497
      Shakefile.hs
  4. 1
      Shakefile.hs
  5. 497
      app/Shakefile.hs
  6. 7
      build.sh
  7. 43
      her-esy-fun.cabal
  8. 22
      nix/sources.json
  9. 78
      nix/sources.nix
  10. 4
      shell.nix
  11. 109
      src/drafts/XXX-code-architecture/index.org
  12. 1
      src/drafts/XXXX-programming-choices/index.org

3
.gitignore

@ -4,4 +4,5 @@ _optim/
src/archive.org
.direnv/
_shake/
.shake/
.shake/
dist-newstyle/

5
CHANGELOG.md

@ -0,0 +1,5 @@
# Revision history for her-esy-fun
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

497
Shakefile.hs

@ -1,497 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
import Protolude
import Development.Shake
import Development.Shake.FilePath
import Data.Time.Format.ISO8601 (iso8601Show)
import qualified Data.Time.Clock as Clock
import Control.Monad.Fail
import Data.Aeson
import Data.Default ( Default(def) )
import qualified Data.Text as T
import Text.Mustache
import Text.Pandoc.Class (PandocMonad)
import qualified Text.Pandoc.Class as Pandoc
import Text.Pandoc.Definition ( Pandoc(..)
, Block(..)
, Inline(..)
, MetaValue(..)
, nullMeta
, docTitle
, docDate
, docAuthors
, lookupMeta
)
import Text.Pandoc.Options ( ReaderOptions(..)
, WriterOptions(..)
, ObfuscationMethod(..)
, HTMLMathMethod(..)
)
import qualified Text.Pandoc.Readers as Readers
import Text.Pandoc.Walk (Walkable(..))
import qualified Text.Pandoc.Writers as Writers
import qualified Text.Pandoc.Templates as Templates
main :: IO ()
main = shakeArgs shOpts buildRules
where
shOpts =
shakeOptions
{ shakeVerbosity = Chatty
, shakeLintInside = ["\\"]
}
-- Configuration
-- Should probably go in a Reader Monad
srcDir :: FilePath
srcDir = "src"
siteDir :: FilePath
siteDir = "_site"
optimDir :: FilePath
optimDir = "_optim"
-- BlogPost data structure (a bit of duplication because the metas are in Pandoc)
data BlogPost =
BlogPost { postTitle :: T.Text
, postDate :: T.Text
, postAuthor :: T.Text
, postUrl :: FilePath
, postSrc :: FilePath
, postTags :: [T.Text]
, postDescr :: T.Text
, postToc :: Bool
, postBody :: Pandoc
}
inlineToText :: PandocMonad m => [Inline] -> m T.Text
inlineToText inline =
Writers.writeAsciiDoc def (Pandoc nullMeta [Plain inline])
reformatDate :: Text -> Text
reformatDate = T.takeWhile (/= ' ') . (T.dropAround dateEnvelope)
where
dateEnvelope ' ' = True
dateEnvelope '\n' = True
dateEnvelope '\t' = True
dateEnvelope '[' = True
dateEnvelope ']' = True
dateEnvelope _ = False
getBlogpostFromMetas
:: (MonadIO m, MonadFail m) => [Char] -> Bool -> Pandoc -> m BlogPost
getBlogpostFromMetas path toc pandoc@(Pandoc meta _) = do
eitherBlogpost <- liftIO $ Pandoc.runIO $ do
title <- fmap (T.dropEnd 1) $ inlineToText $ docTitle meta
date <- fmap reformatDate $ inlineToText $ docDate meta
author <- case head $ docAuthors meta of
Just m -> fmap T.strip $ inlineToText m
Nothing -> return ""
let tags = tagsToList $ lookupMeta "keywords" meta
description = descr $ lookupMeta "description" meta
url = "/" </> dropDirectory1 path -<.> "org"
return $ BlogPost title date author url path tags description toc pandoc
case eitherBlogpost of
Left _ -> fail "BAD"
Right bp -> return bp
where
tagsToList (Just (MetaList ms)) = map toStr ms
tagsToList _ = []
descr (Just (MetaString t)) = t
descr _ = ""
toStr (MetaString t) = t
toStr (MetaInlines inlines) = T.intercalate " " $ map inlineToTxt inlines
toStr _ = ""
inlineToTxt (Str t) = t
inlineToTxt _ = ""
sortByPostDate :: [BlogPost] -> [BlogPost]
sortByPostDate =
sortBy (\a b-> compare (postDate b) (postDate a))
build :: FilePath -> FilePath
build = (</>) siteDir
genAllDeps :: [FilePattern] -> Action [FilePath]
genAllDeps patterns = do
allMatchedFiles <- getDirectoryFiles srcDir patterns
allMatchedFiles &
filter ((/= "html") . takeExtension) &
filter (null . takeExtension) &
map (siteDir </>) &
return
buildRules :: Rules ()
buildRules = do
cleanRule
fastRule
allRule
fullRule
getPost <- mkGetPost
getPosts <- mkGetPosts getPost
getTemplate <- mkGetTemplate
build "**" %> \out -> do
let asset = dropDirectory1 out
case (takeExtension asset) of
".html" -> do
if out == siteDir </> "index.html"
then buildArchive getPosts getTemplate out
else genHtmlAction getPost getTemplate out
".pdf" -> do
txtExists <- doesFileExist (srcDir </> asset)
if txtExists
then copyFileChanged (srcDir </> asset) out
else genPdfAction getPost out
".gmi" -> do
fileExists <- doesFileExist (srcDir </> asset)
if fileExists
then copyFileChanged (srcDir </> asset) out
else if out == siteDir </> "index.gmi"
then buildGeminiArchive getPosts out
else genGeminiAction out
".jpg" -> compressImage asset
".jpeg" -> compressImage asset
".gif" -> compressImage asset
".png" -> compressImage asset
_ -> copyFileChanged (srcDir </> asset) out
optimDir </> "rss.xml" %> \_ -> do
needAll
command_[] "engine/pre-deploy.sh" []
welcomeTxt :: Text
welcomeTxt = toS $ T.intercalate "\n" $
[ "Welcome to my small place on the Internet."
]
buildArchive
:: (() -> Action [BlogPost])
-> (FilePath -> Action Template) -> [Char] -> Action ()
buildArchive getPosts getTemplate out = do
css <- genAllDeps ["//*.css"]
posts <- fmap sortByPostDate $ getPosts ()
need $ css <> map postSrc posts
let
title :: Text
title = "#+title: Yann Esposito's blog"
menu = "@@html:<a href=\"/index.html\">Home</a> | <a href=\"/slides.html\">Slides</a> | <a href=\"/about-me.html\">About</a>@@"
articleList = toS $ T.intercalate "\n" $ map postInfo posts
fileContent = title <> "\n\n" <> menu <> "\n\n" <> welcomeTxt <> "\n\n" <> articleList
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg (def { readerStandalone = True }) (toS fileContent)
bp <- case eitherResult of
Left _ -> fail "BAD"
Right pandoc -> getBlogpostFromMetas out False pandoc
innerHtml <- genHtml bp
template <- getTemplate ("templates" </> "main.mustache")
let htmlContent =
renderMustache template
$ object [ "title" .= postTitle bp
, "author" .= postAuthor bp
, "date" .= postDate bp
, "tags" .= postTags bp
, "description" .= postDescr bp
, "body" .= innerHtml
]
writeFile' out (toS htmlContent)
geminiMenu :: Text
geminiMenu = T.intercalate "\n"
[ "=> /index.gmi Home"
, "=> /gem-atom.xml Feed"
, "=> /slides.gmi Slides"
, "=> /about-me.gmi About me"
]
buildGeminiArchive
:: (() -> Action [BlogPost])
-> [Char] -> Action ()
buildGeminiArchive getPosts out = do
posts <- fmap sortByPostDate $ getPosts ()
need $ map postSrc posts
let
title :: Text
title = "# Yann Esposito's posts"
articleList = toS $ T.intercalate "\n" $ map postGeminiInfo posts
fileContent = title
<> "\n\n" <> welcomeTxt
<> "\n\n" <> geminiMenu
<> "\n\n" <> "## Articles"
<> "\n\n" <> articleList
writeFile' out (toS fileContent)
postGeminiInfo :: BlogPost -> Text
postGeminiInfo bp =
"=> " <> (toS (postUrl bp -<.> ".gmi")) <> " " <> date <> ": " <> (postTitle bp)
where
date = T.takeWhile (/= ' ') (postDate bp)
postInfo :: BlogPost -> Text
postInfo bp =
"| " <> date <> " | " <> orglink <> " |"
where
date = T.takeWhile (/= ' ') (postDate bp)
orglink = "[[file:" <> (toS (postUrl bp)) <> "][" <> (postTitle bp) <> "]]"
replaceLinks :: Pandoc -> Pandoc
replaceLinks = walk replaceOrgLink
where
replaceOrgLink :: Inline -> Inline
replaceOrgLink lnk@(Link attr inl (url,txt)) =
if takeExtension (toS url) == ".org"
then Link attr inl ((toS (toS url -<.> ".html")),txt)
else lnk
replaceOrgLink x = x
orgContentToText :: (MonadIO m, MonadFail m) => Text -> m Text
orgContentToText org = do
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg (def { readerStandalone = True }) org
pandoc <- case eitherResult of
Left _ -> fail "BAD"
Right p -> return p
eitherHtml <- liftIO $ Pandoc.runIO $
Writers.writeHtml5String (def {writerEmailObfuscation = ReferenceObfuscation}) pandoc
case eitherHtml of
Left _ -> fail "BAD"
Right innerHtml -> return innerHtml
postamble :: (MonadIO m, MonadFail m) => Text -> BlogPost -> m Text
postamble now bp =
orgContentToText $ unlines $
[ "@@html:<footer>@@"
, "@@html:<i>Any comment? Click on my email below and I'll add it.</i>@@"
, ""
, "| author | @@html:<span class=\"author\">@@ [[mailto:Yann Esposito <yann@esposito.host>?subject=yblog: " <> (postTitle bp) <> "][Yann Esposito <yann@esposito.host>]] @@html:</span>@@ |"
, "| gpg | [[file:files/publickey.txt][CB420F8005F1A662]] |"
, "| tags | " <> T.intercalate " " (map ("#"<>) (postTags bp)) <> " |"
, "| date | " <> postDate bp <> " |"
, "| rss | [[file:/rss.xml][RSS]] ([[https://validator.w3.org/feed/check.cgi?url=https%3A%2F%2Fher.esy.fun%2Frss.xml][validate]]) |"
, "| size | @@html:<span class=\"web-file-size\">XXK (html XXK, css XXK, img XXK)</span>@@ |"
, "| gz | @@html:<span class=\"gzweb-file-size\">XXK (html XXK, css XXK, img XXK)</span>@@ |"
, "| generated | " <> now <> " |"
, ""
, "@@html:</footer>@@"
]
tpltxt :: Text
tpltxt = T.unlines [
"$if(toc)$"
, "<nav id=\"$idprefix$TOC\" role=\"doc-toc\">"
, "$if(toc-title)$"
, "<h2 id=\"$idprefix$toc-title\">$toc-title$</h2>"
, "$endif$"
, "$table-of-contents$"
, "</nav>"
, "$endif$"
, "$body$"
]
getPostTpl :: IO (Templates.Template Text)
getPostTpl = do
etpl <- Templates.compileTemplate "blog.template" tpltxt
case etpl of
Left e -> fail e
Right tpl -> return tpl
genHtml :: (MonadIO m, MonadFail m) => BlogPost -> m Text
genHtml bp = do
let htmlBody = replaceLinks (postBody bp)
eitherHtml <- liftIO $ do
tpl <- getPostTpl
Pandoc.runIO $ do
Writers.writeHtml5String
(def { writerTableOfContents = postToc bp
, writerTemplate = Just tpl
, writerTOCDepth = 3
, writerEmailObfuscation = ReferenceObfuscation
, writerHTMLMathMethod = MathML
})
htmlBody
body <- case eitherHtml of
Left _ -> fail "BAD"
Right innerHtml -> return innerHtml
now <- liftIO Clock.getCurrentTime
footer <- postamble (toS (iso8601Show now)) bp
return (body <> footer)
origin :: Text
origin = "https://her.esy.fun"
geminiOrigin :: Text
geminiOrigin = "gemini://her.esy.fun"
genHtmlAction
:: (FilePath -> Action BlogPost)
-> (FilePath -> Action Template) -> [Char] -> Action ()
genHtmlAction getPost getTemplate out = do
let tplname = case takeDirectory1 (dropDirectory1 out) of
"posts" -> "post.mustache"
"slides" -> "slide.mustache"
"drafts" -> "post.mustache"
_ -> "main.mustache"
let templateFile = "templates" </> tplname
template <- getTemplate templateFile
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
liftIO $ putText $ "need: " <> (toS srcFile) <> " -> " <> (toS out)
need [srcFile,templateFile,"templates" </> "menu.mustache","Shakefile.hs"]
bp <- getPost srcFile
innerHtml <- genHtml bp
let htmlContent =
renderMustache template
$ object [ "title" .= postTitle bp
, "author" .= postAuthor bp
, "date" .= postDate bp
, "tags" .= postTags bp
, "description" .= postDescr bp
, "body" .= innerHtml
, "orgsource" .= T.pack (postUrl bp -<.> "org")
, "txtsource" .= T.pack (postUrl bp -<.> "gmi")
, "geminiurl" .= T.pack (toS geminiOrigin <> postUrl bp -<.> "gmi")
, "pdf" .= T.pack (postUrl bp -<.> "pdf")
, "permalink" .= T.pack (toS origin <> postUrl bp -<.> "html")
]
writeFile' out (toS htmlContent)
genPdfAction :: p -> [Char] -> Action ()
genPdfAction _getPost out = do
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
need [srcFile,"Shakefile.hs"]
command_ [] "pandoc"
["--pdf-engine=xelatex"
, "--resource-path=" <> takeDirectory srcFile
, srcFile
, "-H", "engine" </> "deeplist.tex"
, "-V", "mainfont:CMU Serif"
, "-V", "mainfontoptions:Renderer=OpenType, Mapping=tex-text, ItalicFeatures={Alternate = 0}, Ligatures={Common,Rare,Historic,Contextual},Contextuals=Inner,Alternate=1"
, "-V", "monofont:Menlo"
, "-V", "monofontoptions:Scale=0.7"
, "-o", out ]
-- genGemini :: (MonadIO m, MonadFail m) => BlogPost -> m Text
-- genGemini bp = do
-- eitherMd <- liftIO $ Pandoc.runIO $ Writers.writeMarkdown def (postBody bp)
-- case eitherMd of
-- Left _ -> fail "BAD"
-- Right innerMd -> return innerMd
genGeminiAction :: [Char] -> Action ()
genGeminiAction out = do
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
need [srcFile]
command_ [] "./engine/org2gemini.sh" [ srcFile, out ]
allHtmlAction :: Action ()
allHtmlAction = do
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
let allHtmlFiles = map (-<.> "html") allOrgFiles
need (map build allHtmlFiles)
allPdfAction :: Action ()
allPdfAction = do
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
let allHtmlFiles = map (-<.> "pdf") allOrgFiles
need (map build allHtmlFiles)
allGeminiAction :: Action ()
allGeminiAction = do
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
let allGeminiFiles = map (-<.> "gmi") allOrgFiles
need (map build $ allGeminiFiles <> ["index.gmi"])
compressImage :: FilePath -> Action ()
compressImage img = do
let src = srcDir </> img
dst = siteDir </> img
need [src]
let dir = takeDirectory dst
dirExists <- doesDirectoryExist dir
when (not dirExists) $
command [] "mkdir" ["-p", dir]
command_ [] "convert" [ src
, "-strip"
, "-resize","960x960>"
, "-interlace","Plane"
, "-quality","85"
, "-define","filter:blur=0.75"
, "-filter","Gaussian"
-- , "-ordered-dither","o4x4,4"
, dst ]
needFast :: Action ()
needFast = do
allAssets <- filter (/= ".DS_Store") <$> getDirectoryFiles srcDir ["**"]
need (map build $ allAssets <> ["index.html"])
allHtmlAction
allGeminiAction
fastRule :: Rules ()
fastRule =
withTargetDocs "generate html" $
phony "fast" $
needFast
needAll :: Action ()
needAll = do
needFast
allPdfAction
allGeminiAction
allRule :: Rules ()
allRule =
withTargetDocs "generate all, no optim" $
phony "all" $
needAll
fullRule :: Rules ()
fullRule =
withTargetDocs "generate all and optim" $
phony "full" $
need [optimDir </> "rss.xml"]
cleanRule :: Rules ()
cleanRule =
phony "clean" $ do
putInfo "Cleaning files in _site and _optim"
forM_ [siteDir,optimDir] $ flip removeFilesAfter ["**"]
mkGetTemplate :: Rules (FilePath -> Action Template)
mkGetTemplate = newCache $ \path -> do
fileContent <- readFile' path
header <- readFile' ("templates" </> "header.mustache")
menu <- readFile' ("templates" </> "menu.mustache")
let withIncludes = fileContent & toS & T.replace "{{>header}}" (toS header) & T.replace "{{>menu}}" (toS menu)
res = compileMustacheText "page" (toS withIncludes)
case res of
Left _ -> fail "BAD"
Right template -> return template
tocRequested :: Text -> Bool
tocRequested fc =
let toc = fc & T.lines
& map T.toLower
& filter (T.isPrefixOf (T.pack "#+options: "))
& head
& fmap (filter (T.isPrefixOf (T.pack "toc:")) . T.words)
in toc == Just ["toc:t"]
mkGetPost :: Rules (FilePath -> Action BlogPost)
mkGetPost = newCache $ \path -> do
fileContent <- readFile' path
let toc = tocRequested (toS fileContent)
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg (def { readerStandalone = True }) (toS fileContent)
case eitherResult of
Left _ -> fail "BAD"
Right pandoc -> getBlogpostFromMetas path toc pandoc
mkGetPosts :: (FilePath -> Action b) -> Rules (() -> Action [b])
mkGetPosts getPost =
newCache $ \() -> mapM getPost =<< getDirectoryFiles "" ["src/posts//*.org"]

1
Shakefile.hs

@ -0,0 +1 @@
app/Shakefile.hs

497
app/Shakefile.hs

@ -0,0 +1,497 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
import Protolude
import Development.Shake
import Development.Shake.FilePath
import Data.Time.Format.ISO8601 (iso8601Show)
import qualified Data.Time.Clock as Clock
import Control.Monad.Fail
import Data.Aeson
import Data.Default ( Default(def) )
import qualified Data.Text as T
import Text.Mustache
import Text.Pandoc.Class (PandocMonad)
import qualified Text.Pandoc.Class as Pandoc
import Text.Pandoc.Definition ( Pandoc(..)
, Block(..)
, Inline(..)
, MetaValue(..)
, nullMeta
, docTitle
, docDate
, docAuthors
, lookupMeta
)
import Text.Pandoc.Options ( ReaderOptions(..)
, WriterOptions(..)
, ObfuscationMethod(..)
, HTMLMathMethod(..)
)
import qualified Text.Pandoc.Readers as Readers
import Text.Pandoc.Walk (Walkable(..))
import qualified Text.Pandoc.Writers as Writers
import qualified Text.Pandoc.Templates as Templates
main :: IO ()
main = shakeArgs shOpts buildRules
where
shOpts =
shakeOptions
{ shakeVerbosity = Chatty
, shakeLintInside = ["\\"]
}
-- Configuration
-- Should probably go in a Reader Monad
srcDir :: FilePath
srcDir = "src"
siteDir :: FilePath
siteDir = "_site"
optimDir :: FilePath
optimDir = "_optim"
-- BlogPost data structure (a bit of duplication because the metas are in Pandoc)
data BlogPost =
BlogPost { postTitle :: T.Text
, postDate :: T.Text
, postAuthor :: T.Text
, postUrl :: FilePath
, postSrc :: FilePath
, postTags :: [T.Text]
, postDescr :: T.Text
, postToc :: Bool
, postBody :: Pandoc
}
inlineToText :: PandocMonad m => [Inline] -> m T.Text
inlineToText inline =
Writers.writeAsciiDoc def (Pandoc nullMeta [Plain inline])
reformatDate :: Text -> Text
reformatDate = T.takeWhile (/= ' ') . (T.dropAround dateEnvelope)
where
dateEnvelope ' ' = True
dateEnvelope '\n' = True
dateEnvelope '\t' = True
dateEnvelope '[' = True
dateEnvelope ']' = True
dateEnvelope _ = False
getBlogpostFromMetas
:: (MonadIO m, MonadFail m) => [Char] -> Bool -> Pandoc -> m BlogPost
getBlogpostFromMetas path toc pandoc@(Pandoc meta _) = do
eitherBlogpost <- liftIO $ Pandoc.runIO $ do
title <- fmap (T.dropEnd 1) $ inlineToText $ docTitle meta
date <- fmap reformatDate $ inlineToText $ docDate meta
author <- case head $ docAuthors meta of
Just m -> fmap T.strip $ inlineToText m
Nothing -> return ""
let tags = tagsToList $ lookupMeta "keywords" meta
description = descr $ lookupMeta "description" meta
url = "/" </> dropDirectory1 path -<.> "org"
return $ BlogPost title date author url path tags description toc pandoc
case eitherBlogpost of
Left _ -> fail "BAD"
Right bp -> return bp
where
tagsToList (Just (MetaList ms)) = map toStr ms
tagsToList _ = []
descr (Just (MetaString t)) = t
descr _ = ""
toStr (MetaString t) = t
toStr (MetaInlines inlines) = T.intercalate " " $ map inlineToTxt inlines
toStr _ = ""
inlineToTxt (Str t) = t
inlineToTxt _ = ""
sortByPostDate :: [BlogPost] -> [BlogPost]
sortByPostDate =
sortBy (\a b-> compare (postDate b) (postDate a))
build :: FilePath -> FilePath
build = (</>) siteDir
genAllDeps :: [FilePattern] -> Action [FilePath]
genAllDeps patterns = do
allMatchedFiles <- getDirectoryFiles srcDir patterns
allMatchedFiles &
filter ((/= "html") . takeExtension) &
filter (null . takeExtension) &
map (siteDir </>) &
return
buildRules :: Rules ()
buildRules = do
cleanRule
fastRule
allRule
fullRule
getPost <- mkGetPost
getPosts <- mkGetPosts getPost
getTemplate <- mkGetTemplate
build "**" %> \out -> do
let asset = dropDirectory1 out
case (takeExtension asset) of
".html" -> do
if out == siteDir </> "index.html"
then buildArchive getPosts getTemplate out
else genHtmlAction getPost getTemplate out
".pdf" -> do
txtExists <- doesFileExist (srcDir </> asset)
if txtExists
then copyFileChanged (srcDir </> asset) out
else genPdfAction getPost out
".gmi" -> do
fileExists <- doesFileExist (srcDir </> asset)
if fileExists
then copyFileChanged (srcDir </> asset) out
else if out == siteDir </> "index.gmi"
then buildGeminiArchive getPosts out
else genGeminiAction out
".jpg" -> compressImage asset
".jpeg" -> compressImage asset
".gif" -> compressImage asset
".png" -> compressImage asset
_ -> copyFileChanged (srcDir </> asset) out
optimDir </> "rss.xml" %> \_ -> do
needAll
command_[] "engine/pre-deploy.sh" []
welcomeTxt :: Text
welcomeTxt = toS $ T.intercalate "\n" $
[ "Welcome to my small place on the Internet."
]
buildArchive
:: (() -> Action [BlogPost])
-> (FilePath -> Action Template) -> [Char] -> Action ()
buildArchive getPosts getTemplate out = do
css <- genAllDeps ["//*.css"]
posts <- fmap sortByPostDate $ getPosts ()
need $ css <> map postSrc posts
let
title :: Text
title = "#+title: Yann Esposito's blog"
menu = "@@html:<a href=\"/index.html\">Home</a> | <a href=\"/slides.html\">Slides</a> | <a href=\"/about-me.html\">About</a>@@"
articleList = toS $ T.intercalate "\n" $ map postInfo posts
fileContent = title <> "\n\n" <> menu <> "\n\n" <> welcomeTxt <> "\n\n" <> articleList
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg (def { readerStandalone = True }) (toS fileContent)
bp <- case eitherResult of
Left _ -> fail "BAD"
Right pandoc -> getBlogpostFromMetas out False pandoc
innerHtml <- genHtml bp
template <- getTemplate ("templates" </> "main.mustache")
let htmlContent =
renderMustache template
$ object [ "title" .= postTitle bp
, "author" .= postAuthor bp
, "date" .= postDate bp
, "tags" .= postTags bp
, "description" .= postDescr bp
, "body" .= innerHtml
]
writeFile' out (toS htmlContent)
geminiMenu :: Text
geminiMenu = T.intercalate "\n"
[ "=> /index.gmi Home"
, "=> /gem-atom.xml Feed"
, "=> /slides.gmi Slides"
, "=> /about-me.gmi About me"
]
buildGeminiArchive
:: (() -> Action [BlogPost])
-> [Char] -> Action ()
buildGeminiArchive getPosts out = do
posts <- fmap sortByPostDate $ getPosts ()
need $ map postSrc posts
let
title :: Text
title = "# Yann Esposito's posts"
articleList = toS $ T.intercalate "\n" $ map postGeminiInfo posts
fileContent = title
<> "\n\n" <> welcomeTxt
<> "\n\n" <> geminiMenu
<> "\n\n" <> "## Articles"
<> "\n\n" <> articleList
writeFile' out (toS fileContent)
postGeminiInfo :: BlogPost -> Text
postGeminiInfo bp =
"=> " <> (toS (postUrl bp -<.> ".gmi")) <> " " <> date <> ": " <> (postTitle bp)
where
date = T.takeWhile (/= ' ') (postDate bp)
postInfo :: BlogPost -> Text
postInfo bp =
"| " <> date <> " | " <> orglink <> " |"
where
date = T.takeWhile (/= ' ') (postDate bp)
orglink = "[[file:" <> (toS (postUrl bp)) <> "][" <> (postTitle bp) <> "]]"
replaceLinks :: Pandoc -> Pandoc
replaceLinks = walk replaceOrgLink
where
replaceOrgLink :: Inline -> Inline
replaceOrgLink lnk@(Link attr inl (url,txt)) =
if takeExtension (toS url) == ".org"
then Link attr inl ((toS (toS url -<.> ".html")),txt)
else lnk
replaceOrgLink x = x
orgContentToText :: (MonadIO m, MonadFail m) => Text -> m Text
orgContentToText org = do
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg (def { readerStandalone = True }) org
pandoc <- case eitherResult of
Left _ -> fail "BAD"
Right p -> return p
eitherHtml <- liftIO $ Pandoc.runIO $
Writers.writeHtml5String (def {writerEmailObfuscation = ReferenceObfuscation}) pandoc
case eitherHtml of
Left _ -> fail "BAD"
Right innerHtml -> return innerHtml
postamble :: (MonadIO m, MonadFail m) => Text -> BlogPost -> m Text
postamble now bp =
orgContentToText $ unlines $
[ "@@html:<footer>@@"
, "@@html:<i>Any comment? Click on my email below and I'll add it.</i>@@"
, ""
, "| author | @@html:<span class=\"author\">@@ [[mailto:Yann Esposito <yann@esposito.host>?subject=yblog: " <> (postTitle bp) <> "][Yann Esposito <yann@esposito.host>]] @@html:</span>@@ |"
, "| gpg | [[file:files/publickey.txt][CB420F8005F1A662]] |"
, "| tags | " <> T.intercalate " " (map ("#"<>) (postTags bp)) <> " |"
, "| date | " <> postDate bp <> " |"
, "| rss | [[file:/rss.xml][RSS]] ([[https://validator.w3.org/feed/check.cgi?url=https%3A%2F%2Fher.esy.fun%2Frss.xml][validate]]) |"
, "| size | @@html:<span class=\"web-file-size\">XXK (html XXK, css XXK, img XXK)</span>@@ |"
, "| gz | @@html:<span class=\"gzweb-file-size\">XXK (html XXK, css XXK, img XXK)</span>@@ |"
, "| generated | " <> now <> " |"
, ""
, "@@html:</footer>@@"
]
tpltxt :: Text
tpltxt = T.unlines [
"$if(toc)$"
, "<nav id=\"$idprefix$TOC\" role=\"doc-toc\">"
, "$if(toc-title)$"
, "<h2 id=\"$idprefix$toc-title\">$toc-title$</h2>"
, "$endif$"
, "$table-of-contents$"
, "</nav>"
, "$endif$"
, "$body$"
]
getPostTpl :: IO (Templates.Template Text)
getPostTpl = do
etpl <- Templates.compileTemplate "blog.template" tpltxt
case etpl of
Left e -> fail e
Right tpl -> return tpl
genHtml :: (MonadIO m, MonadFail m) => BlogPost -> m Text
genHtml bp = do
let htmlBody = replaceLinks (postBody bp)
eitherHtml <- liftIO $ do
tpl <- getPostTpl
Pandoc.runIO $ do
Writers.writeHtml5String
(def { writerTableOfContents = postToc bp
, writerTemplate = Just tpl
, writerTOCDepth = 3
, writerEmailObfuscation = ReferenceObfuscation
, writerHTMLMathMethod = MathML
})
htmlBody
body <- case eitherHtml of
Left _ -> fail "BAD"
Right innerHtml -> return innerHtml
now <- liftIO Clock.getCurrentTime
footer <- postamble (toS (iso8601Show now)) bp
return (body <> footer)
origin :: Text
origin = "https://her.esy.fun"
geminiOrigin :: Text
geminiOrigin = "gemini://her.esy.fun"
genHtmlAction
:: (FilePath -> Action BlogPost)
-> (FilePath -> Action Template) -> [Char] -> Action ()
genHtmlAction getPost getTemplate out = do
let tplname = case takeDirectory1 (dropDirectory1 out) of
"posts" -> "post.mustache"
"slides" -> "slide.mustache"
"drafts" -> "post.mustache"
_ -> "main.mustache"
let templateFile = "templates" </> tplname
template <- getTemplate templateFile
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
liftIO $ putText $ "need: " <> (toS srcFile) <> " -> " <> (toS out)
need [srcFile,templateFile,"templates" </> "menu.mustache","Shakefile.hs"]
bp <- getPost srcFile
innerHtml <- genHtml bp
let htmlContent =
renderMustache template
$ object [ "title" .= postTitle bp
, "author" .= postAuthor bp
, "date" .= postDate bp
, "tags" .= postTags bp
, "description" .= postDescr bp
, "body" .= innerHtml
, "orgsource" .= T.pack (postUrl bp -<.> "org")
, "txtsource" .= T.pack (postUrl bp -<.> "gmi")
, "geminiurl" .= T.pack (toS geminiOrigin <> postUrl bp -<.> "gmi")
, "pdf" .= T.pack (postUrl bp -<.> "pdf")
, "permalink" .= T.pack (toS origin <> postUrl bp -<.> "html")
]
writeFile' out (toS htmlContent)
genPdfAction :: p -> [Char] -> Action ()
genPdfAction _getPost out = do
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
need [srcFile,"Shakefile.hs"]
command_ [] "pandoc"
["--pdf-engine=xelatex"
, "--resource-path=" <> takeDirectory srcFile
, srcFile
, "-H", "engine" </> "deeplist.tex"
, "-V", "mainfont:CMU Serif"
, "-V", "mainfontoptions:Renderer=OpenType, Mapping=tex-text, ItalicFeatures={Alternate = 0}, Ligatures={Common,Rare,Historic,Contextual},Contextuals=Inner,Alternate=1"
, "-V", "monofont:Menlo"
, "-V", "monofontoptions:Scale=0.7"
, "-o", out ]
-- genGemini :: (MonadIO m, MonadFail m) => BlogPost -> m Text
-- genGemini bp = do
-- eitherMd <- liftIO $ Pandoc.runIO $ Writers.writeMarkdown def (postBody bp)
-- case eitherMd of
-- Left _ -> fail "BAD"
-- Right innerMd -> return innerMd
genGeminiAction :: [Char] -> Action ()
genGeminiAction out = do
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
need [srcFile]
command_ [] "./engine/org2gemini.sh" [ srcFile, out ]
allHtmlAction :: Action ()
allHtmlAction = do
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
let allHtmlFiles = map (-<.> "html") allOrgFiles
need (map build allHtmlFiles)
allPdfAction :: Action ()
allPdfAction = do
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
let allHtmlFiles = map (-<.> "pdf") allOrgFiles
need (map build allHtmlFiles)
allGeminiAction :: Action ()
allGeminiAction = do
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
let allGeminiFiles = map (-<.> "gmi") allOrgFiles
need (map build $ allGeminiFiles <> ["index.gmi"])
compressImage :: FilePath -> Action ()
compressImage img = do
let src = srcDir </> img
dst = siteDir </> img
need [src]
let dir = takeDirectory dst
dirExists <- doesDirectoryExist dir
when (not dirExists) $
command [] "mkdir" ["-p", dir]
command_ [] "convert" [ src
, "-strip"
, "-resize","960x960>"
, "-interlace","Plane"
, "-quality","85"
, "-define","filter:blur=0.75"
, "-filter","Gaussian"
-- , "-ordered-dither","o4x4,4"
, dst ]
needFast :: Action ()
needFast = do
allAssets <- filter (/= ".DS_Store") <$> getDirectoryFiles srcDir ["**"]
need (map build $ allAssets <> ["index.html"])
allHtmlAction
allGeminiAction
fastRule :: Rules ()
fastRule =
withTargetDocs "generate html" $
phony "fast" $
needFast
needAll :: Action ()
needAll = do
needFast
allPdfAction
allGeminiAction
allRule :: Rules ()
allRule =
withTargetDocs "generate all, no optim" $
phony "all" $
needAll
fullRule :: Rules ()
fullRule =
withTargetDocs "generate all and optim" $
phony "full" $
need [optimDir </> "rss.xml"]
cleanRule :: Rules ()
cleanRule =
phony "clean" $ do
putInfo "Cleaning files in _site and _optim"
forM_ [siteDir,optimDir] $ flip removeFilesAfter ["**"]
mkGetTemplate :: Rules (FilePath -> Action Template)
mkGetTemplate = newCache $ \path -> do
fileContent <- readFile' path
header <- readFile' ("templates" </> "header.mustache")
menu <- readFile' ("templates" </> "menu.mustache")
let withIncludes = fileContent & toS & T.replace "{{>header}}" (toS header) & T.replace "{{>menu}}" (toS menu)
res = compileMustacheText "page" (toS withIncludes)
case res of
Left _ -> fail "BAD"
Right template -> return template
tocRequested :: Text -> Bool
tocRequested fc =
let toc = fc & T.lines
& map T.toLower
& filter (T.isPrefixOf (T.pack "#+options: "))
& head
& fmap (filter (T.isPrefixOf (T.pack "toc:")) . T.words)
in toc == Just ["toc:t"]
mkGetPost :: Rules (FilePath -> Action BlogPost)
mkGetPost = newCache $ \path -> do
fileContent <- readFile' path
let toc = tocRequested (toS fileContent)
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg (def { readerStandalone = True }) (toS fileContent)
case eitherResult of
Left _ -> fail "BAD"
Right pandoc -> getBlogpostFromMetas path toc pandoc
mkGetPosts :: (FilePath -> Action b) -> Rules (() -> Action [b])
mkGetPosts getPost =
newCache $ \() -> mapM getPost =<< getDirectoryFiles "" ["src/posts//*.org"]

7
build.sh

@ -1,3 +1,6 @@
#!/bin/sh
mkdir -p _shake
ghc --make Shakefile.hs -rtsopts -threaded -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake/build "$@"
# mkdir -p _shake
# ghc --make app/Shakefile.hs -rtsopts -threaded -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake/build "$@"
cabal v2-run -- her-esy-fun "$@"

43
her-esy-fun.cabal

@ -0,0 +1,43 @@
cabal-version: 2.4
name: her-esy-fun
version: 0.1.0.0
-- A short (one-line) description of the package.
-- synopsis:
-- A longer description of the package.
-- description:
-- A URL where users can report bugs.
-- bug-reports:
-- The license under which the package is released.
-- license:
author: Yann Esposito (Yogsototh)
maintainer: yann.esposito@gmail.com
-- A copyright notice.
-- copyright:
-- category:
extra-source-files: CHANGELOG.md
executable her-esy-fun
main-is: Shakefile.hs
-- Modules included in this executable, other than Main.
-- other-modules:
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:
build-depends: base ^>=4.14.1.0
, aeson
, pandoc
, pandoc-types
, shake
, data-default
, protolude
, stache
, text
, time
hs-source-dirs: app
default-language: Haskell2010

22
nix/sources.json

@ -1,4 +1,16 @@
{
"ghc.nix": {
"branch": "master",
"description": "Nix (shell) expression for working on GHC",
"homepage": "https://haskell.org/ghc/",
"owner": "alpmestan",
"repo": "ghc.nix",
"rev": "9adaf8abe53fa0618c1561919ddfbc4342fe144b",
"sha256": "0qmkkildzl21y88czgnschvi8mdkqrj9hgvpban58zzjnxw5s4nd",
"type": "tarball",
"url": "https://github.com/alpmestan/ghc.nix/archive/9adaf8abe53fa0618c1561919ddfbc4342fe144b.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"niv": {
"branch": "master",
"description": "Easy dependency management for Nix projects",
@ -12,15 +24,15 @@
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"nixpkgs": {
"branch": "nixpkgs-unstable",
"branch": "nixpkgs-20.09-darwin",
"description": "A read-only mirror of NixOS/nixpkgs tracking the released channels. Send issues and PRs to",
"homepage": "https://github.com/NixOS/nixpkgs",
"owner": "NixOS",
"repo": "nixpkgs-channels",
"rev": "a84cbb60f0296210be03c08d243670dd18a3f6eb",
"sha256": "04j07c98iy66hpzha7brz867dcl9lkflck43xvz09dfmlvqyzmiz",
"repo": "nixpkgs",
"rev": "e716ddfac4be879ffbae75c3914a538dd5d4d12e",
"sha256": "0c2090sz4nvd1bqa9bfz3b6mj0q8b7v4jzgsykn2hf291l3h94d6",
"type": "tarball",
"url": "https://github.com/NixOS/nixpkgs-channels/archive/a84cbb60f0296210be03c08d243670dd18a3f6eb.tar.gz",
"url": "https://github.com/NixOS/nixpkgs/archive/e716ddfac4be879ffbae75c3914a538dd5d4d12e.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"shake": {

78
nix/sources.nix

@ -12,36 +12,29 @@ let
else
pkgs.fetchurl { inherit (spec) url sha256; };
fetch_tarball = pkgs: spec:
if spec.builtin or true then
builtins_fetchTarball { inherit (spec) url sha256; }
else
pkgs.fetchzip { inherit (spec) url sha256; };
fetch_tarball = pkgs: name: spec:
let
ok = str: ! builtins.isNull (builtins.match "[a-zA-Z0-9+-._?=]" str);
# sanitize the name, though nix will still fail if name starts with period
name' = stringAsChars (x: if ! ok x then "-" else x) "${name}-src";
in
if spec.builtin or true then
builtins_fetchTarball { name = name'; inherit (spec) url sha256; }
else
pkgs.fetchzip { name = name'; inherit (spec) url sha256; };
fetch_git = spec:
builtins.fetchGit { url = spec.repo; inherit (spec) rev ref; };
fetch_builtin-tarball = spec:
builtins.trace
''
WARNING:
The niv type "builtin-tarball" will soon be deprecated. You should
instead use `builtin = true`.
$ niv modify <package> -a type=tarball -a builtin=true
''
builtins_fetchTarball { inherit (spec) url sha256; };
fetch_local = spec: spec.path;
fetch_builtin-url = spec:
builtins.trace
''
WARNING:
The niv type "builtin-url" will soon be deprecated. You should
instead use `builtin = true`.
fetch_builtin-tarball = name: throw
''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`.
$ niv modify ${name} -a type=tarball -a builtin=true'';
$ niv modify <package> -a type=file -a builtin=true
''
(builtins_fetchurl { inherit (spec) url sha256; });
fetch_builtin-url = name: throw
''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`.
$ niv modify ${name} -a type=file -a builtin=true'';
#
# Various helpers
@ -72,13 +65,23 @@ let
if ! builtins.hasAttr "type" spec then
abort "ERROR: niv spec ${name} does not have a 'type' attribute"
else if spec.type == "file" then fetch_file pkgs spec
else if spec.type == "tarball" then fetch_tarball pkgs spec
else if spec.type == "tarball" then fetch_tarball pkgs name spec
else if spec.type == "git" then fetch_git spec
else if spec.type == "builtin-tarball" then fetch_builtin-tarball spec
else if spec.type == "builtin-url" then fetch_builtin-url spec
else if spec.type == "local" then fetch_local spec
else if spec.type == "builtin-tarball" then fetch_builtin-tarball name
else if spec.type == "builtin-url" then fetch_builtin-url name
else
abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}";
# If the environment variable NIV_OVERRIDE_${name} is set, then use
# the path directly as opposed to the fetched source.
replace = name: drv:
let
saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name;
ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}";
in
if ersatz == "" then drv else ersatz;
# Ports of functions for older nix versions
# a Nix version of mapAttrs if the built-in doesn't exist
@ -87,13 +90,23 @@ let
listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set))
);
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295
range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1);
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257
stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1));
# https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269
stringAsChars = f: s: concatStrings (map f (stringToCharacters s));
concatStrings = builtins.concatStringsSep "";
# fetchTarball version that is compatible between all the versions of Nix
builtins_fetchTarball = { url, sha256 }@attrs:
builtins_fetchTarball = { url, name, sha256 }@attrs:
let
inherit (builtins) lessThan nixVersion fetchTarball;
in
if lessThan nixVersion "1.12" then
fetchTarball { inherit url; }
fetchTarball { inherit name url; }
else
fetchTarball attrs;
@ -115,13 +128,13 @@ let
then abort
"The values in sources.json should not have an 'outPath' attribute"
else
spec // { outPath = fetch config.pkgs name spec; }
spec // { outPath = replace name (fetch config.pkgs name spec); }
) config.sources;
# The "config" used by the fetchers
mkConfig =
{ sourcesFile ? ./sources.json
, sources ? builtins.fromJSON (builtins.readFile sourcesFile)
{ sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null
, sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile)
, pkgs ? mkPkgs sources
}: rec {
# The sources, i.e. the attribute set of spec name to spec
@ -130,5 +143,6 @@ let
# The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers
inherit pkgs;
};
in
mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); }

4
shell.nix

@ -23,10 +23,10 @@ pkgs.mkShell {
perlPackages.URI
minify
niv
ghc
git
direnv
haskellPackages.shake
# ghc
# haskellPackages.shake
tmux
# for emacs dev
ripgrep

109
src/drafts/XXX-code-architecture/index.org

@ -0,0 +1,109 @@
#+TITLE: Are Services superior to Free Monads?
#+AUTHOR: Yann Esposito
#+EMAIL: yann@esposito.host
#+DATE: [2021-01-10 Sun]
#+KEYWORDS: haskell, clojure, architecture, programming
#+DESCRIPTION: Here is a simple description on how to architect a big functional programming application.
#+OPTIONS: auto-id:t toc:nil
#+begin_abstract
TODO
#+end_abstract
A recurring hot topic in the functional programming world is how to make
your code scale while keeping professionnal level of code quality.
Quite often in the functional programming we communities and talk people
are focusing on enhancing specifics...
To organise your code in a functional paradigm there are many concurrent proposals.
And structuring a code application is challenging.
The way you need to structure the code generally need to reach a few
properties.
1. You should make it easy to test your code
2. You need to support modern features any modern application is expected
to provide. Typically ability to write logs, if possible send structured
logs events.
3. The code should try to help people focalise on the business logic and
put aside irrelevant technical details.
4. Split your applications into smaller (ideal composable) components
5. Control accesses between different components of your applications
The design space is quite open.
In Haskell for example, there are different proposed solutions.
One of my preferred one to start with is the Handler
Pattern[fn:handler_pattern].
Because it doesn't need any advanced Haskell knowledge to understand.
And also it prevents a classical overabstraction haskell curse I often see
within Haskellers.
No premature abstraction here.
No typeclass.
The main principle behing it is that you create /handlers/.
Handlers are /component/ focused that each provide a set of methods and
functions already initialized.
[fn:handler_pattern]: https://jaspervdj.be/posts/2018-03-08-handle-pattern.html
* Monads, MTL, RIO, Handler Pattern, Free Monad
:PROPERTIES:
:CUSTOM_ID: monads--mtl--rio--handler-pattern--free-monad
:END:
There are a lot of solutions to architecture a program while keeping all
the best properties of functional programming as well as best professional
practices.
Here too, there are different level of looking at the problem of code
organisation.
On the very high level, an application is often understood as a set of
features.
But for all of thoses features to work together it is generally a lot of
work to organise them.
So we can descend the level to look at code organisation.
Files organisation, how to group them.
Structure of the code organisation.
How to put test, etc...
If you strive for composability you generally try to understand how to
group "components" and ask yourselve what a componentn should contain.
Here is a solution.
* Free Monads/Effect System
:PROPERTIES:
:CUSTOM_ID: free-monads-effect-system
:END:
Foreword, semantic vs syntax.
The kind of best way to talk about semantic and forget about the syntax is
to deal directly with a simplified representation of the AST.
Overall API:
#+begin_src clojure
(interpret-with
[effect-1 effect-2 ... effect-n]
(let [admin-user (get-in-config [:user :admin :user-id])
admin (get-user admin-user-id)
admin-email (get admin :email)]
(log "Admin email" admin-email)
admin-email))
#+end_src
It will be up to the actual instanciation of all =effect-*= to change the
interpretation of the body.
So some effect could have different interpreation of specific symbols.
So here we can imagine that =get-in-config=, =get-user= and =log= are
handlers specified in the effects.
One advantage is that to test your code you can simply use stubbed effects.
One can use a list users
Real effects and free monads are in fact more powerful than this example
is showing.
For example, within a free monad, even =let= semantic would be changed.
But let's not take this rabbit hole in this article right now.

1
src/drafts/XXXX-programming-choices/index.org

@ -1,6 +1,5 @@
#+Title: Programming experiences and choices
#+Author: Yann Esposito
#+Language: English
#+Select_tags: Programming, culture
* TODO Introduction

Loading…
取消
儲存