diff --git a/Shakefile.hs b/Shakefile.hs index aaef6cf..35e7efe 100644 --- a/Shakefile.hs +++ b/Shakefile.hs @@ -6,33 +6,28 @@ import Protolude import Development.Shake import Development.Shake.Command import Development.Shake.FilePath -import Development.Shake.Util import Control.Monad.Fail import Data.Aeson -import Text.Megaparsec +-- import qualified Text.Megaparsec as Megaparsec import Data.Default ( Default(def) ) -import qualified Data.Set as Set import qualified Data.Text as T import Text.Mustache -import Text.Pandoc.Class ( PandocPure, PandocMonad) +import Text.Pandoc.Class (PandocMonad) import qualified Text.Pandoc.Class as Pandoc import Text.Pandoc.Definition ( Pandoc(..) , Block(..) , Inline , nullMeta , docTitle - , lookupMeta , docDate , docAuthors ) -import Text.Pandoc.Extensions ( getDefaultExtensions ) import Text.Pandoc.Options ( ReaderOptions(..) , WriterOptions(..) - , TrackChanges(RejectChanges) + , ObfuscationMethod(..) ) import qualified Text.Pandoc.Readers as Readers -import qualified Text.Pandoc.Templates as PandocTemplates import qualified Text.Pandoc.Writers as Writers main :: IO () @@ -47,6 +42,9 @@ main = shakeArgs shOpts buildRules -- Configuration -- Should probably go in a Reader Monad +srcDir :: FilePath +srcDir = "src" + siteDir :: FilePath siteDir = "_site" @@ -82,57 +80,115 @@ getBlogpostFromMetas path toc pandoc@(Pandoc meta _) = do sortByPostDate :: [BlogPost] -> [BlogPost] sortByPostDate = - sortBy (\b a -> compare (Down (postDate a)) (Down (postDate b))) + sortBy (\a b-> compare (Down (postDate a)) (Down (postDate b))) 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 - allRule - getPost <- mkGetPost - getPosts <- mkGetPosts getPost - getTemplate <- mkGetTemplate - let cssDeps = map (siteDir ) <$> getDirectoryFiles "src" ["css/*.css"] - -- templateDeps = getDirectoryFiles "templates" ["*.mustache"] - build "//*.html" %> \out -> do - css <- cssDeps - -- templates <- templateDeps - template <- getTemplate ("templates" "main.mustache") - let srcFile = "src" (dropDirectory1 (replaceExtension out "org")) - liftIO $ putText $ "need: " <> (toS srcFile) <> " <- " <> (toS out) - need $ css <> [srcFile] - bp <- getPost srcFile - eitherHtml <- liftIO $ Pandoc.runIO $ Writers.writeHtml5String (def { writerTableOfContents = (postToc bp) }) (postBody bp) - case eitherHtml of - Left _ -> fail "BAD" - Right innerHtml -> - let htmlContent = renderMustache template $ object [ "title" .= postTitle bp - , "authors" .= postAuthors bp - , "date" .= postDate bp - , "body" .= innerHtml - ] - in writeFile' out (toS htmlContent) - build "articles.html" %> \out -> do - css <- cssDeps - posts <- getPosts () - need $ css <> map postUrl (sortByPostDate posts) - let titles = toS $ T.intercalate "\n" $ map postTitle posts - writeFile' out titles - build "css/*.css" %> \out -> do - let src = "src" (dropDirectory1 out) - dst = out - liftIO $ putText $ toS $ "src:" <> src <> " => dst: " <> dst - copyFile' src dst + cleanRule + -- build "//*" %> copy + allRule + getPost <- mkGetPost + getPosts <- mkGetPosts getPost + getTemplate <- mkGetTemplate + alternatives $ do + -- build "articles.html" %> \out -> do + -- css <- genAllDeps ["//*.css"] + -- posts <- getPosts () + -- need $ css <> map postUrl (sortByPostDate posts) + -- let titles = toS $ T.intercalate "\n" $ map postTitle posts + -- writeFile' out titles + build "//*.html" %> genHtmlAction getPost getTemplate + -- build "//*.org" %> copy + -- build "//*.jpg" %> copy + +copy :: FilePath -> Action () +copy out = do + let src = srcDir (dropDirectory1 out) + copyFileChanged src out + +genHtml :: (MonadIO m, MonadFail m) => BlogPost -> m Text +genHtml bp = do + eitherHtml <- liftIO $ + Pandoc.runIO $ + Writers.writeHtml5String + (def { writerTableOfContents = (postToc bp) + , writerEmailObfuscation = ReferenceObfuscation + }) + (postBody bp) + case eitherHtml of + Left _ -> fail "BAD" + Right innerHtml -> return innerHtml + +genHtmlAction + :: (FilePath -> Action BlogPost) + -> (FilePath -> Action Template) -> [Char] -> Action () +genHtmlAction getPost getTemplate out = do + template <- getTemplate ("templates" "main.mustache") + let srcFile = srcDir (dropDirectory1 (out -<.> "org")) + liftIO $ putText $ "need: " <> (toS srcFile) <> " -> " <> (toS out) + need [srcFile] + bp <- getPost srcFile + innerHtml <- genHtml bp + let htmlContent = + renderMustache template $ object [ "title" .= postTitle bp + , "authors" .= postAuthors bp + , "date" .= postDate bp + , "body" .= innerHtml + ] + writeFile' out (toS htmlContent) + +allHtmlAction :: Action () +allHtmlAction = do + allOrgFiles <- getDirectoryFiles srcDir ["//*.org"] + let allHtmlFiles = map (-<.> "html") allOrgFiles + need (map build (allHtmlFiles + -- <> ["articles.html"] + )) + +compressImage :: CmdResult b => FilePath -> Action b +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","320x320>" + , "-interlace","Plane" + , "-quality","85" + , "-define","filter:blur=0.75" + , "-filter","Gaussian" + , "-ordered-dither","o4x4,4" + , dst ] allRule :: Rules () allRule = phony "all" $ do - allOrgFiles <- getDirectoryFiles "src" ["//*.org"] - let allHtmlFiles = map (flip replaceExtension "html") allOrgFiles - need (map build (allHtmlFiles <> ["index.html", "articles.html"])) + allAssets <- filter (/= ".DS_Store") <$> getDirectoryFiles srcDir ["//*.*"] + forM_ allAssets $ \asset -> + case (takeExtension asset) of + ".jpg" -> compressImage asset + ".jpeg" -> compressImage asset + ".gif" -> compressImage asset + ".png" -> compressImage asset + _ -> copyFileChanged (srcDir asset) (siteDir asset) + allHtmlAction cleanRule :: Rules () cleanRule = @@ -161,7 +217,7 @@ mkGetPost :: Rules (FilePath -> Action BlogPost) mkGetPost = newCache $ \path -> do fileContent <- readFile' path let toc = tocRequested (toS fileContent) - eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg def (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 diff --git a/src/css/y.css b/src/css/y.css index 4336774..f349c5a 100644 --- a/src/css/y.css +++ b/src/css/y.css @@ -556,9 +556,10 @@ a,a:visited { color: var(--hl); } /* ---- SYNTAX HIGHLIGHTING ---- */ #table-of-contents { text-align: left; } + .org-rainbow-delimiters-depth-1, .org-rainbow-delimiters-depth-9, .org-css-selector, .org-builtin, -.IN_REVIEW { +.IN_REVIEW, .ex { color:var(--c); } @@ -573,7 +574,7 @@ a,a:visited { color: var(--hl); } } .org-rainbow-delimiters-depth-4, .org-diff-hunk-header, .org-sh-quoted-exec, -.CANCELED { +.CANCELED, .bu { color:var(--m); } .org-rainbow-delimiters-depth-5, .org-diff-removed, .TODO { diff --git a/src/posts/0002-troll-2/index.org b/src/posts/0002-troll-2/index.org index 2671b78..ed07fe5 100644 --- a/src/posts/0002-troll-2/index.org +++ b/src/posts/0002-troll-2/index.org @@ -44,9 +44,9 @@ goblins. Those costume looks very bad and cheap. So much you can only find them not terrorizing but funny and ridiculous. +#+ATTR_HTML: A goblin #+CAPTION: One goblin during the introduction scene of Troll 2 #+NAME: fig:troll-2-intro -#+ATTR_HTML: A goblin [[./Troll-2-intro.jpg]] Soon after that, you realize the acting of all actors is extremely bad. @@ -55,9 +55,9 @@ To give you an idea, the only equal bad acting I ever witnessed was while looking at amateurs first Youtube movies trying to follow a scenario. Apparently most actors were amateurs, it was their first and last movie. +#+ATTR_HTML: A bad acting demonstration #+CAPTION: One particularly terrible acting scene #+NAME: fig:bad-acting -#+ATTR_HTML: A bad acting demonstration [[file:bad-acting.png]] The dialog are, really something... @@ -83,9 +83,9 @@ They win against the monsters with, what I believe was a failed attempt at humor. It misses the point so bad, that the irony still make it funny. +#+ATTR_HTML: Eliott prevents his family to eat the food by urinating on the table #+CAPTION: Our hero save the day by urinating on the table. His family is frozen for 30s said grandpa, they were for 70s. #+NAME: fig:prevent-eating -#+ATTR_HTML: Eliott prevents his family to eat the food by urinating on the table [[./prevent-eating-scene.jpg]] Of course, the very last scene is a classical so terrible cliché. diff --git a/src/posts/0010-Haskell-Now/index.org b/src/posts/0010-Haskell-Now/index.org index 753128f..86da14f 100644 --- a/src/posts/0010-Haskell-Now/index.org +++ b/src/posts/0010-Haskell-Now/index.org @@ -1492,7 +1492,7 @@ The only way to work around this problem is to use some meta-programming trick, for example using the pre-processor. In C++ there is a better way, C++ templates: -#+BEGIN_SRC c++ +#+BEGIN_SRC cpp #include #include using namespace std; @@ -3880,9 +3880,7 @@ I will not argue much, but mainly, semantic versionning and Haskell versionning are just a "right to break things to your users". I don't want to talk a lot more about this, but, it would be nice if more -people would watch this talk[fn:9] related to versionning. - -[fn:9]: [[https://www.youtube.com/watch?v=oyLBGkS5ICk][Spec-ulation Keynote - Rich Hickey]] +people would watch this talk[fn:8] related to versionning. If you want to know more about Haskell versionning convention: https://pvp.haskell.org @@ -4082,30 +4080,32 @@ Thank you man. As of today, the definition of =IO= is no more visible into =base=. We have the following explanation in [[http://hackage.haskell.org/package/base-4.12.0.0/docs/src/GHC.IO.html][=GHC.IO.hs=]]: #+begin_quote -#+begin_src -The IO Monad is just an instance of the ST monad, where the state is -the real world. We use the exception mechanism (in GHC.Exception) to -implement IO exceptions. - -NOTE: The IO representation is deeply wired in to various parts of the -system. The following list may or may not be exhaustive: - -Compiler - types of various primitives in PrimOp.hs - -RTS - forceIO (StgStartup.cmm) - - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast - (Exception.cmm) - - raiseAsync (RaiseAsync.c) - -Prelude - GHC.IO.hs, and several other places including - GHC.Exception.hs. - -Libraries - parts of hslibs/lang. - ---SDM -#+end_src + #+begin_src + The IO Monad is just an instance of the ST monad, where the state is + the real world. We use the exception mechanism (in GHC.Exception) to + implement IO exceptions. + + NOTE: The IO representation is deeply wired in to various parts of the + system. The following list may or may not be exhaustive: + + Compiler - types of various primitives in PrimOp.hs + + RTS - forceIO (StgStartup.cmm) + - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast + (Exception.cmm) + - raiseAsync (RaiseAsync.c) + + Prelude - GHC.IO.hs, and several other places including + GHC.Exception.hs. + + Libraries - parts of hslibs/lang. + + --SDM + #+end_src #+end_quote [fn:7] Well, you'll certainly need to practice a bit to get used to them and to understand when you can use them and create your own. But you already made a big step in this direction. + +[fn:8] [[https://www.youtube.com/watch?v=oyLBGkS5ICk][Spec-ulation Keynote - Rich Hickey]]