diff --git a/.gitignore b/.gitignore
index bb5e6a8..70863a7 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,4 +4,5 @@ _optim/
src/archive.org
.direnv/
_shake/
-.shake/
\ No newline at end of file
+.shake/
+dist-newstyle/
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..6f65a3a
--- /dev/null
+++ b/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.
diff --git a/Shakefile.hs b/Shakefile.hs
deleted file mode 100644
index 6b38e66..0000000
--- a/Shakefile.hs
+++ /dev/null
@@ -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:Home | Slides | About@@"
- 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:@@"
- ]
-
-tpltxt :: Text
-tpltxt = T.unlines [
- "$if(toc)$"
- , ""
- , "$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"]
diff --git a/Shakefile.hs b/Shakefile.hs
new file mode 120000
index 0000000..920a28d
--- /dev/null
+++ b/Shakefile.hs
@@ -0,0 +1 @@
+app/Shakefile.hs
\ No newline at end of file
diff --git a/app/Shakefile.hs b/app/Shakefile.hs
new file mode 100644
index 0000000..6b38e66
--- /dev/null
+++ b/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:Home | Slides | About@@"
+ 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:@@"
+ ]
+
+tpltxt :: Text
+tpltxt = T.unlines [
+ "$if(toc)$"
+ , ""
+ , "$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"]
diff --git a/build.sh b/build.sh
index 71b68d1..0bc2c8f 100755
--- a/build.sh
+++ b/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 "$@"
diff --git a/her-esy-fun.cabal b/her-esy-fun.cabal
new file mode 100644
index 0000000..3542435
--- /dev/null
+++ b/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
diff --git a/nix/sources.json b/nix/sources.json
index 58f2808..3d1f87d 100644
--- a/nix/sources.json
+++ b/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///archive/.tar.gz"
+ },
"niv": {
"branch": "master",
"description": "Easy dependency management for Nix projects",
@@ -12,15 +24,15 @@
"url_template": "https://github.com///archive/.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///archive/.tar.gz"
},
"shake": {
diff --git a/nix/sources.nix b/nix/sources.nix
index 8a725cb..b64b8f8 100644
--- a/nix/sources.nix
+++ b/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`.
+ fetch_local = spec: spec.path;
- $ niv modify -a type=tarball -a builtin=true
- ''
- builtins_fetchTarball { inherit (spec) url sha256; };
+ 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'';
- fetch_builtin-url = spec:
- builtins.trace
- ''
- WARNING:
- The niv type "builtin-url" will soon be deprecated. You should
- instead use `builtin = true`.
-
- $ niv modify -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); }
diff --git a/shell.nix b/shell.nix
index 45bcfbe..5f6a20a 100644
--- a/shell.nix
+++ b/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
diff --git a/src/drafts/XXX-code-architecture/index.org b/src/drafts/XXX-code-architecture/index.org
new file mode 100644
index 0000000..ba234c2
--- /dev/null
+++ b/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.
diff --git a/src/drafts/XXXX-programming-choices/index.org b/src/drafts/XXXX-programming-choices/index.org
index 47a738e..a0e9968 100644
--- a/src/drafts/XXXX-programming-choices/index.org
+++ b/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