This commit is contained in:
Yann Esposito (Yogsototh) 2020-06-23 09:15:03 +02:00
parent d201cf8b1b
commit 2bdc881cc9
Signed by untrusted user who does not match committer: yogsototh
GPG Key ID: 7B19A4C650D59646
3 changed files with 54 additions and 51 deletions

View File

@ -28,8 +28,9 @@ import Text.Pandoc.Definition ( Pandoc(..)
)
import Text.Pandoc.Extensions ( getDefaultExtensions )
import Text.Pandoc.Options ( ReaderOptions(..)
, TrackChanges(RejectChanges)
)
, WriterOptions(..)
, TrackChanges(RejectChanges)
)
import qualified Text.Pandoc.Readers as Readers
import qualified Text.Pandoc.Templates as PandocTemplates
import qualified Text.Pandoc.Writers as Writers
@ -59,8 +60,8 @@ data BlogPost =
, postDate :: T.Text
, postAuthors :: [T.Text]
, postUrl :: FilePath
, postToc :: Bool
, postBody :: Pandoc
-- , postToc :: Boolean
}
inlineToText :: PandocMonad m => [Inline] -> m T.Text
@ -68,13 +69,13 @@ inlineToText inline =
Writers.writeAsciiDoc def (Pandoc nullMeta [Plain inline])
getBlogpostFromMetas
:: (MonadIO m, MonadFail m) => [Char] -> Pandoc -> m BlogPost
getBlogpostFromMetas path pandoc@(Pandoc meta _) = do
:: (MonadIO m, MonadFail m) => [Char] -> Bool -> Pandoc -> m BlogPost
getBlogpostFromMetas path toc pandoc@(Pandoc meta _) = do
eitherBlogpost <- liftIO $ Pandoc.runIO $ do
title <- inlineToText $ docTitle meta
date <- inlineToText $ docDate meta
authors <- mapM inlineToText $ docAuthors meta
return $ BlogPost title date authors path pandoc
return $ BlogPost title date authors path toc pandoc
case eitherBlogpost of
Left _ -> fail "BAD"
Right bp -> return bp
@ -104,7 +105,7 @@ buildRules = do
liftIO $ putText $ "need: " <> (toS srcFile) <> " <- " <> (toS out)
need $ css <> [srcFile]
bp <- getPost srcFile
eitherHtml <- liftIO $ Pandoc.runIO $ Writers.writeHtml5String def (postBody bp)
eitherHtml <- liftIO $ Pandoc.runIO $ Writers.writeHtml5String (def { writerTableOfContents = (postToc bp) }) (postBody bp)
case eitherHtml of
Left _ -> fail "BAD"
Right innerHtml ->
@ -147,21 +148,23 @@ mkGetTemplate = newCache $ \path -> do
Left _ -> fail "BAD"
Right template -> return template
parseOptions :: Text -> [Text] -> Maybe Text
parseOptions fc =
fc & T.lines
& map T.toLower
& filter (T.isPrefixOf (T.pack "#options: "))
& head
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 options = parseOptions (toS fileContent)
let toc = tocRequested (toS fileContent)
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg def (toS fileContent)
case eitherResult of
Left _ -> fail "BAD"
Right pandoc -> getBlogpostFromMetas path pandoc
Right pandoc -> getBlogpostFromMetas path toc pandoc
mkGetPosts :: (FilePath -> Action b) -> Rules (() -> Action [b])
mkGetPosts getPost =

View File

@ -564,7 +564,7 @@ a,a:visited { color: var(--hl); }
.org-rainbow-delimiters-depth-2, .org-nix-builtin, .org-variable-name,
.org-haskell-definition, .org-haskell-operator, .org-function-name, .org-diff-changed,
.org-nix-attribute, .org-nxml-element-local-name {
.org-nix-attribute, .org-nxml-element-local-name, .op, .fu, .ot {
color:var(--b);
}
@ -579,15 +579,15 @@ a,a:visited { color: var(--hl); }
.org-rainbow-delimiters-depth-5, .org-diff-removed, .TODO {
color:var(--r);
}
.org-rainbow-delimiters-depth-6, .org-haskell-constructor {
.org-rainbow-delimiters-depth-6, .org-haskell-constructor, .dt {
color:var(--o);
}
.org-rainbow-delimiters-depth-7, .org-type, .org-constant, .org-diff-header,
.org-haskell-keyword, .org-haskell-type, .IN_PROGRESS {
.org-haskell-keyword, .org-haskell-type, .IN_PROGRESS, .kw {
color:var(--y);
}
.org-rainbow-delimiters-depth-8, .org-sh-heredoc, .org-diff-added, .org-string,
.org-doc, .org-keyword, .DONE {
.org-doc, .org-keyword, .DONE, .st {
color:var(--g);
}
@ -595,6 +595,6 @@ a,a:visited { color: var(--hl); }
.org-diff-none, .org-preprocessor, .org-comment-delimiter, .org-comment,
.org-outshine-level-1, .org-outshine-level-2, .org-outshine-level-3,
.org-outshine-level-4, .org-outshine-level-5, .org-outshine-level-6,
.org-outshine-level-7, .org-outshine-level-8, .org-outshine-level-9 {
.org-outshine-level-7, .org-outshine-level-8, .org-outshine-level-9, .co {
color:var(--fg0);
}

View File

@ -178,32 +178,32 @@ Otherwise, you can follow my advice to use nix:
4. Put the following =shell.nix= file inside it
#+begin_src nix :tangle shell.nix
{ nixpkgs ? import (fetchTarball https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz) {} }:
let
inherit (nixpkgs) pkgs;
inherit (pkgs) haskellPackages;
haskellDeps = ps: with ps; [
base
protolude
containers
];
ghc = haskellPackages.ghcWithPackages haskellDeps;
nixPackages = [
ghc
pkgs.gdb
haskellPackages.cabal-install
];
in
pkgs.stdenv.mkDerivation {
name = "env";
buildInputs = nixPackages;
shellHook = ''
export PS1="\n\[[hs:\033[1;32m\]\W\[\033[0m\]]> "
'';
}
{ nixpkgs ? import (fetchTarball https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz) {} }:
let
inherit (nixpkgs) pkgs;
inherit (pkgs) haskellPackages;
haskellDeps = ps: with ps; [
base
protolude
containers
];
ghc = haskellPackages.ghcWithPackages haskellDeps;
nixPackages = [
ghc
pkgs.gdb
haskellPackages.cabal-install
];
in
pkgs.stdenv.mkDerivation {
name = "env";
buildInputs = nixPackages;
shellHook = ''
export PS1="\n\[[hs:\033[1;32m\]\W\[\033[0m\]]> "
'';
}
#+end_src
5. In the =hsenv= directory, in a terminal, run =nix-shell --pure=.
@ -219,11 +219,11 @@ pkgs.stdenv.mkDerivation {
something like this:
#+begin_src
~/hsenv> nix-shell
[nix-shell:~/hsenv]$ ghci
GHCi, version 8.6.5: http://www.haskell.org/ghc/ :? for help
Prelude> import Protolude
Prelude Protolude>
~/hsenv> nix-shell
[nix-shell:~/hsenv]$ ghci
GHCi, version 8.6.5: http://www.haskell.org/ghc/ :? for help
Prelude> import Protolude
Prelude Protolude>
#+end_src
Congratulations you should be ready to start now.