right track
This commit is contained in:
parent
4b8a5d3c89
commit
0e44c7d427
2 changed files with 58 additions and 18 deletions
76
Shakefile.hs
76
Shakefile.hs
|
@ -103,14 +103,26 @@ buildRules = do
|
||||||
getPost <- mkGetPost
|
getPost <- mkGetPost
|
||||||
getPosts <- mkGetPosts getPost
|
getPosts <- mkGetPosts getPost
|
||||||
getTemplate <- mkGetTemplate
|
getTemplate <- mkGetTemplate
|
||||||
alternatives $ do
|
|
||||||
-- build "articles.html" %> \out -> do
|
-- build "articles.html" %> \out -> do
|
||||||
-- css <- genAllDeps ["//*.css"]
|
-- css <- genAllDeps ["//*.css"]
|
||||||
-- posts <- getPosts ()
|
-- posts <- getPosts ()
|
||||||
-- need $ css <> map postUrl (sortByPostDate posts)
|
-- need $ css <> map postUrl (sortByPostDate posts)
|
||||||
-- let titles = toS $ T.intercalate "\n" $ map postTitle posts
|
-- let titles = toS $ T.intercalate "\n" $ map postTitle posts
|
||||||
-- writeFile' out titles
|
-- writeFile' out titles
|
||||||
build "//*.html" %> genHtmlAction getPost getTemplate
|
build "//*" %> \out -> do
|
||||||
|
let asset = dropDirectory1 out
|
||||||
|
case (takeExtension asset) of
|
||||||
|
".html" -> genHtmlAction getPost getTemplate out
|
||||||
|
".txt" -> do
|
||||||
|
txtExists <- doesFileExist (srcDir </> asset)
|
||||||
|
if txtExists
|
||||||
|
then copyFileChanged (srcDir </> asset) out
|
||||||
|
else genAsciiAction getPost out
|
||||||
|
".jpg" -> compressImage asset
|
||||||
|
".jpeg" -> compressImage asset
|
||||||
|
".gif" -> compressImage asset
|
||||||
|
".png" -> compressImage asset
|
||||||
|
_ -> copyFileChanged (srcDir </> asset) out
|
||||||
-- build "//*.org" %> copy
|
-- build "//*.org" %> copy
|
||||||
-- build "//*.jpg" %> copy
|
-- build "//*.jpg" %> copy
|
||||||
|
|
||||||
|
@ -136,27 +148,53 @@ genHtmlAction
|
||||||
:: (FilePath -> Action BlogPost)
|
:: (FilePath -> Action BlogPost)
|
||||||
-> (FilePath -> Action Template) -> [Char] -> Action ()
|
-> (FilePath -> Action Template) -> [Char] -> Action ()
|
||||||
genHtmlAction getPost getTemplate out = do
|
genHtmlAction getPost getTemplate out = do
|
||||||
template <- getTemplate ("templates" </> "main.mustache")
|
let isPost = takeDirectory1 (dropDirectory1 out) == "post"
|
||||||
|
template <- getTemplate ("templates" </> if isPost then "post.mustache" else "main.mustache")
|
||||||
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
|
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
|
||||||
liftIO $ putText $ "need: " <> (toS srcFile) <> " -> " <> (toS out)
|
liftIO $ putText $ "need: " <> (toS srcFile) <> " -> " <> (toS out)
|
||||||
need [srcFile]
|
need [srcFile]
|
||||||
bp <- getPost srcFile
|
bp <- getPost srcFile
|
||||||
innerHtml <- genHtml bp
|
innerHtml <- genHtml bp
|
||||||
let htmlContent =
|
let htmlContent =
|
||||||
renderMustache template $ object [ "title" .= postTitle bp
|
renderMustache template
|
||||||
, "authors" .= postAuthors bp
|
$ object [ "title" .= postTitle bp
|
||||||
, "date" .= postDate bp
|
, "authors" .= postAuthors bp
|
||||||
, "body" .= innerHtml
|
, "date" .= postDate bp
|
||||||
]
|
, "body" .= innerHtml
|
||||||
|
]
|
||||||
writeFile' out (toS htmlContent)
|
writeFile' out (toS htmlContent)
|
||||||
|
|
||||||
|
genAscii :: (MonadIO m, MonadFail m) => BlogPost -> m Text
|
||||||
|
genAscii bp = do
|
||||||
|
eitherAscii <- liftIO $ Pandoc.runIO $ Writers.writePlain def (postBody bp)
|
||||||
|
case eitherAscii of
|
||||||
|
Left _ -> fail "BAD"
|
||||||
|
Right innerAscii -> return innerAscii
|
||||||
|
|
||||||
|
|
||||||
|
genAsciiAction
|
||||||
|
:: (FilePath -> Action BlogPost)
|
||||||
|
-> [Char] -> Action ()
|
||||||
|
genAsciiAction getPost out = do
|
||||||
|
let srcFile = srcDir </> (dropDirectory1 (out -<.> "org"))
|
||||||
|
need [srcFile]
|
||||||
|
bp <- getPost srcFile
|
||||||
|
innerAscii <- genAscii bp
|
||||||
|
let preamble = postTitle bp <> "\n"
|
||||||
|
<> postDate bp <> "\n\n"
|
||||||
|
writeFile' out (toS (preamble <> toS innerAscii))
|
||||||
|
|
||||||
allHtmlAction :: Action ()
|
allHtmlAction :: Action ()
|
||||||
allHtmlAction = do
|
allHtmlAction = do
|
||||||
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
|
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
|
||||||
let allHtmlFiles = map (-<.> "html") allOrgFiles
|
let allHtmlFiles = map (-<.> "html") allOrgFiles
|
||||||
need (map build (allHtmlFiles
|
need (map build allHtmlFiles)
|
||||||
-- <> ["articles.html"]
|
|
||||||
))
|
allAsciiAction :: Action ()
|
||||||
|
allAsciiAction = do
|
||||||
|
allOrgFiles <- getDirectoryFiles srcDir ["//*.org"]
|
||||||
|
let allAsciiFiles = map (-<.> "txt") allOrgFiles
|
||||||
|
need (map build allAsciiFiles)
|
||||||
|
|
||||||
compressImage :: CmdResult b => FilePath -> Action b
|
compressImage :: CmdResult b => FilePath -> Action b
|
||||||
compressImage img = do
|
compressImage img = do
|
||||||
|
@ -181,14 +219,16 @@ allRule :: Rules ()
|
||||||
allRule =
|
allRule =
|
||||||
phony "all" $ do
|
phony "all" $ do
|
||||||
allAssets <- filter (/= ".DS_Store") <$> getDirectoryFiles srcDir ["//*.*"]
|
allAssets <- filter (/= ".DS_Store") <$> getDirectoryFiles srcDir ["//*.*"]
|
||||||
forM_ allAssets $ \asset ->
|
need (map build allAssets)
|
||||||
case (takeExtension asset) of
|
-- forM_ allAssets $ \asset ->
|
||||||
".jpg" -> compressImage asset
|
-- case (takeExtension asset) of
|
||||||
".jpeg" -> compressImage asset
|
-- ".jpg" -> compressImage asset
|
||||||
".gif" -> compressImage asset
|
-- ".jpeg" -> compressImage asset
|
||||||
".png" -> compressImage asset
|
-- ".gif" -> compressImage asset
|
||||||
_ -> copyFileChanged (srcDir </> asset) (siteDir </> asset)
|
-- ".png" -> compressImage asset
|
||||||
|
-- _ -> copyFileChanged (srcDir </> asset) (siteDir </> asset)
|
||||||
allHtmlAction
|
allHtmlAction
|
||||||
|
allAsciiAction
|
||||||
|
|
||||||
cleanRule :: Rules ()
|
cleanRule :: Rules ()
|
||||||
cleanRule =
|
cleanRule =
|
||||||
|
|
Loading…
Reference in a new issue