save
This commit is contained in:
parent
1e0d4c8fad
commit
1eb4a6de5a
2 changed files with 85 additions and 31 deletions
111
Shakefile.hs
111
Shakefile.hs
|
@ -1,4 +1,7 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
import Protolude hiding ((*>))
|
||||||
|
|
||||||
import Development.Shake
|
import Development.Shake
|
||||||
import Development.Shake.Command
|
import Development.Shake.Command
|
||||||
|
@ -8,8 +11,9 @@ import Development.Shake.Util
|
||||||
import Data.Default (Default(def))
|
import Data.Default (Default(def))
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Text as T
|
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 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.Extensions (getDefaultExtensions)
|
||||||
import Text.Pandoc.Options (ReaderOptions(..),TrackChanges(RejectChanges))
|
import Text.Pandoc.Options (ReaderOptions(..),TrackChanges(RejectChanges))
|
||||||
import qualified Text.Pandoc.Readers as Readers
|
import qualified Text.Pandoc.Readers as Readers
|
||||||
|
@ -20,42 +24,91 @@ main = do
|
||||||
let shOpts = shakeOptions { shakeVerbosity = Chatty, shakeLintInside = ["\\"] }
|
let shOpts = shakeOptions { shakeVerbosity = Chatty, shakeLintInside = ["\\"] }
|
||||||
shakeArgs shOpts buildRules
|
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 :: Rules ()
|
||||||
buildRules = do
|
buildRules = do
|
||||||
|
let
|
||||||
|
siteDir = "_site"
|
||||||
|
optimDir = "_optim"
|
||||||
|
build = (</>) siteDir
|
||||||
phony "clean" $ do
|
phony "clean" $ do
|
||||||
putInfo "Cleaning files in _site and _optim"
|
putInfo "Cleaning files in _site and _optim"
|
||||||
removeFilesAfter "_site" ["//*"]
|
removeFilesAfter siteDir ["//*"]
|
||||||
removeFilesAfter "_optim" ["//*"]
|
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
|
-- buildPosts
|
||||||
-- allPosts <- buildPosts
|
-- allPosts <- buildPosts
|
||||||
-- buildIndex allPosts
|
-- buildIndex allPosts
|
||||||
-- buildFeed allPosts
|
-- buildFeed allPosts
|
||||||
-- copyStaticFiles
|
-- copyStaticFiles
|
||||||
|
|
||||||
data Post = Post { postTitle :: T.Text
|
-- data Post = Post { postTitle :: T.Text
|
||||||
, postAuthor :: T.Text
|
-- , postAuthor :: T.Text
|
||||||
, postDate :: T.Text
|
-- , postDate :: T.Text
|
||||||
}
|
-- }
|
||||||
|
--
|
||||||
defaultReaderOpts t =
|
-- defaultReaderOpts t =
|
||||||
def { readerExtensions = getDefaultExtensions t
|
-- def { readerExtensions = getDefaultExtensions t
|
||||||
, readerStandalone = True }
|
-- , readerStandalone = True }
|
||||||
|
--
|
||||||
orgToHTML :: T.Text -> PandocPure T.Text
|
-- orgToHTML :: T.Text -> PandocPure T.Text
|
||||||
orgToHTML txt = Readers.readOrg (defaultReaderOpts "org") txt
|
-- orgToHTML txt = Readers.readOrg (defaultReaderOpts "org") txt
|
||||||
>>= Writers.writeHtml5String def
|
-- >>= Writers.writeHtml5String def
|
||||||
|
--
|
||||||
-- | Load a post, process metadata, write it to output, then return the post object
|
-- -- | Load a post, process metadata, write it to output, then return the post object
|
||||||
-- Detects changes to either post content or template
|
-- -- Detects changes to either post content or template
|
||||||
buildPost :: FilePath -> Action ()
|
-- buildPost :: FilePath -> Action ()
|
||||||
buildPost out = do
|
-- buildPost out = do
|
||||||
let org = "src/" <> (dropDirectory1 $ out -<.> "org")
|
-- let org = "src/" <> (dropDirectory1 $ out -<.> "org")
|
||||||
liftIO . putStrLn $ "Rebuilding post: " <> out
|
-- liftIO . putStrLn $ "Rebuilding post: " <> out
|
||||||
postContent <- readFile' org
|
-- postContent <- readFile' org
|
||||||
-- load post content and metadata as JSON blob
|
-- -- load post content and metadata as JSON blob
|
||||||
let pandocReturn = Pandoc.runPure $ orgToHTML . T.pack $ postContent
|
-- let pandocReturn = Pandoc.runPure $ orgToHTML . T.pack $ postContent
|
||||||
case pandocReturn of
|
-- case pandocReturn of
|
||||||
Left _ -> putError "BAD"
|
-- Left _ -> putError "BAD"
|
||||||
Right outData -> writeFile' out (T.unpack outData)
|
-- Right outData -> writeFile' out (T.unpack outData)
|
||||||
|
|
|
@ -1,11 +1,13 @@
|
||||||
{ pkgs ? import (fetchTarball https://github.com/NixOS/nixpkgs/archive/20.03.tar.gz) {} }:
|
{ pkgs ? import (fetchTarball https://github.com/NixOS/nixpkgs/archive/20.03.tar.gz) {} }:
|
||||||
let
|
let
|
||||||
|
pkgs1909 = import (fetchTarball https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz) {};
|
||||||
haskellDeps = ps : with ps; [
|
haskellDeps = ps : with ps; [
|
||||||
shake
|
shake
|
||||||
pandoc
|
pandoc
|
||||||
data-default
|
data-default
|
||||||
|
protolude
|
||||||
|
pkgs1909.haskellPackages.sws
|
||||||
];
|
];
|
||||||
pkgs1909 = import (fetchTarball https://github.com/NixOS/nixpkgs/archive/19.09.tar.gz) {};
|
|
||||||
ghc = pkgs.haskellPackages.ghcWithPackages haskellDeps;
|
ghc = pkgs.haskellPackages.ghcWithPackages haskellDeps;
|
||||||
in
|
in
|
||||||
pkgs.mkShell {
|
pkgs.mkShell {
|
||||||
|
@ -21,7 +23,6 @@ pkgs.mkShell {
|
||||||
ghc
|
ghc
|
||||||
git
|
git
|
||||||
direnv
|
direnv
|
||||||
pkgs1909.haskellPackages.sws
|
|
||||||
haskellPackages.shake
|
haskellPackages.shake
|
||||||
];
|
];
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in a new issue