closer
This commit is contained in:
parent
d201cf8b1b
commit
2bdc881cc9
3 changed files with 54 additions and 51 deletions
25
Shakefile.hs
25
Shakefile.hs
|
@ -28,6 +28,7 @@ import Text.Pandoc.Definition ( Pandoc(..)
|
|||
)
|
||||
import Text.Pandoc.Extensions ( getDefaultExtensions )
|
||||
import Text.Pandoc.Options ( ReaderOptions(..)
|
||||
, WriterOptions(..)
|
||||
, TrackChanges(RejectChanges)
|
||||
)
|
||||
import qualified Text.Pandoc.Readers as Readers
|
||||
|
@ -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
|
||||
tocRequested :: Text -> Bool
|
||||
tocRequested fc =
|
||||
let toc = fc & T.lines
|
||||
& map T.toLower
|
||||
& filter (T.isPrefixOf (T.pack "#options: "))
|
||||
& 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 =
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue