Fixes
This commit is contained in:
Yann Esposito (Yogsototh)
parent
3a13435710
commit
aef6f81274
GPG Key ID:
7B19A4C650D59646
154
Shakefile.hs
154
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
|
||||
|
|
|
|||
|
|
@ -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 {
|
||||
|
|
|
|||
|
|
@ -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é.
|
||||
|
|
|
|||
|
|
@ -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 <iostream>
|
||||
#include <complex>
|
||||
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]]
|
||||
|
|
|
|||
Loading…
Reference in New Issue