This commit is contained in:
Yann Esposito (Yogsototh) 2020-06-22 09:39:44 +02:00
parent 1e0d4c8fad
commit 1eb4a6de5a
Signed by untrusted user who does not match committer: yogsototh
GPG Key ID: 7B19A4C650D59646
2 changed files with 85 additions and 31 deletions

View File

@ -1,4 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
import Protolude hiding ((*>))
import Development.Shake
import Development.Shake.Command
@ -8,8 +11,9 @@ import Development.Shake.Util
import Data.Default (Default(def))
import qualified Data.Set as Set
import qualified Data.Text as T
import Text.Pandoc.Class (PandocPure)
import Text.Pandoc.Class (PandocPure,PandocMonad)
import qualified Text.Pandoc.Class as Pandoc
import Text.Pandoc.Definition (Pandoc(..),Block(..),Inline,nullMeta,docTitle,docDate,docAuthors)
import Text.Pandoc.Extensions (getDefaultExtensions)
import Text.Pandoc.Options (ReaderOptions(..),TrackChanges(RejectChanges))
import qualified Text.Pandoc.Readers as Readers
@ -20,42 +24,91 @@ main = do
let shOpts = shakeOptions { shakeVerbosity = Chatty, shakeLintInside = ["\\"] }
shakeArgs shOpts buildRules
data BlogPost =
BlogPost { postTitle :: T.Text
, postDate :: T.Text
, postAuthors :: [T.Text]
, postUrl :: FilePath
, postP :: Pandoc
}
inlineToText :: PandocMonad m => [Inline] -> m T.Text
inlineToText inline =
Writers.writeAsciiDoc def (Pandoc nullMeta [Plain inline])
buildRules :: Rules ()
buildRules = do
let
siteDir = "_site"
optimDir = "_optim"
build = (</>) siteDir
phony "clean" $ do
putInfo "Cleaning files in _site and _optim"
removeFilesAfter "_site" ["//*"]
removeFilesAfter "_optim" ["//*"]
removeFilesAfter siteDir ["//*"]
removeFilesAfter optimDir ["//*"]
getPost <- newCache $ \path -> do
fileContent <- readFile' path
eitherResult <- liftIO $ Pandoc.runIO $ Readers.readOrg def (T.pack fileContent)
case eitherResult of
Left _ -> liftIO $ putText "Problem"
Right pandoc@(Pandoc meta _) -> liftIO $ Pandoc.runIO $ do
title <- inlineToText $ docTitle meta
date <- inlineToText $ docDate meta
authors <- map inlineToText $ docAuthors meta
let url = dropExtension path
return $ BlogPost title date authors url pandoc
getPosts <- newCache $ \() ->
mapM getPost =<< getDirectoryFiles "" ["src/posts//*.org"]
let hsDeps = return ["AsciiArt.hs", "Index.hs", "Rot13.hs"]
cssDeps = map (siteDir </>) <$> getDirectoryFiles "" ["src/css/*.css"]
build "index.html" *> \out -> do
hs <- hsDeps
css <- cssDeps
posts <- getPosts ()
need $ hs
<> css
<> map ( combine "build"
. flip combine "index.html"
. postUrl ) posts
<> [build "atom.xml"]
writeFile' out
. renderHtml . index ""
. sortBy (\a b ->
compare (Down (postDate a)) (Down (postDate b)))
$ posts
build "src/css/*.css" *> \out ->
copyFile' (dropDirectory1 out) out
"_site//*.html" %> buildPost
-- "_site//*.html" %> buildPost
-- buildPosts
-- allPosts <- buildPosts
-- buildIndex allPosts
-- buildFeed allPosts
-- copyStaticFiles
data Post = Post { postTitle :: T.Text
, postAuthor :: T.Text
, postDate :: T.Text
}
defaultReaderOpts t =
def { readerExtensions = getDefaultExtensions t
, readerStandalone = True }
orgToHTML :: T.Text -> PandocPure T.Text
orgToHTML txt = Readers.readOrg (defaultReaderOpts "org") txt
>>= Writers.writeHtml5String def
-- | Load a post, process metadata, write it to output, then return the post object
-- Detects changes to either post content or template
buildPost :: FilePath -> Action ()
buildPost out = do
let org = "src/" <> (dropDirectory1 $ out -<.> "org")
liftIO . putStrLn $ "Rebuilding post: " <> out
postContent <- readFile' org
-- load post content and metadata as JSON blob
let pandocReturn = Pandoc.runPure $ orgToHTML . T.pack $ postContent
case pandocReturn of
Left _ -> putError "BAD"
Right outData -> writeFile' out (T.unpack outData)
-- data Post = Post { postTitle :: T.Text
-- , postAuthor :: T.Text
-- , postDate :: T.Text
-- }
--
-- defaultReaderOpts t =
-- def { readerExtensions = getDefaultExtensions t
-- , readerStandalone = True }
--
-- orgToHTML :: T.Text -> PandocPure T.Text
-- orgToHTML txt = Readers.readOrg (defaultReaderOpts "org") txt
-- >>= Writers.writeHtml5String def
--
-- -- | Load a post, process metadata, write it to output, then return the post object
-- -- Detects changes to either post content or template
-- buildPost :: FilePath -> Action ()
-- buildPost out = do
-- let org = "src/" <> (dropDirectory1 $ out -<.> "org")
-- liftIO . putStrLn $ "Rebuilding post: " <> out
-- postContent <- readFile' org
-- -- load post content and metadata as JSON blob
-- let pandocReturn = Pandoc.runPure $ orgToHTML . T.pack $ postContent
-- case pandocReturn of
-- Left _ -> putError "BAD"
-- Right outData -> writeFile' out (T.unpack outData)

View File

@ -1,11 +1,13 @@
{ pkgs ? import (fetchTarball https://github.com/NixOS/nixpkgs/archive/20.03.tar.gz) {} }:
let
pkgs1909 = import (fetchTarball https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz) {};
haskellDeps = ps : with ps; [
shake
pandoc
data-default
protolude
pkgs1909.haskellPackages.sws
];
pkgs1909 = import (fetchTarball https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz) {};
ghc = pkgs.haskellPackages.ghcWithPackages haskellDeps;
in
pkgs.mkShell {
@ -21,7 +23,6 @@ pkgs.mkShell {
ghc
git
direnv
pkgs1909.haskellPackages.sws
haskellPackages.shake
];
}