Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
executable file 189 lines (155 sloc) 5.9 KB
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Monad.Extra
import Data.List
import Data.Monoid
import Data.String
import Hakyll
import Hakyll.Core.UnixFilter
import Hakyll.Web.Pandoc.Biblio
import System.Directory
import System.Exit
import System.FilePath
import System.Process
import Text.Pandoc.Options
import qualified GHC.IO.Encoding as E
--------------------------------------------------------------------------------
main :: IO ()
main = do
E.setLocaleEncoding E.utf8
processAgdaPosts
hakyllMain
hakyllMain :: IO ()
hakyllMain = hakyll $ (>>)<*>id $ do
match "images/*" $ do
route idRoute
compile copyFileCompiler
match "files/*" $ do
route idRoute
compile copyFileCompiler
match "css/*" $ do
route idRoute
compile compressCssCompiler
match "pages/*" $ do
route $ setExtension "html"
`composeRoutes` gsubRoute "pages/" (const "")
compile $ getResourceBody
>>= myPandocCompiler
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
match "posts/*.md" $ do
route $ setExtension "html"
compile $ getResourceBody
>>= myPandocCompiler
>>= loadAndApplyTemplate "templates/post.html" postCtx
>>= loadAndApplyTemplate "templates/default.html" postCtx
>>= relativizeUrls
-- markdown files generated by Agda
match (fromString $ agdaOutputDir </> "*.md") $ do
route $ setExtension "html"
`composeRoutes` gsubRoute (agdaOutputDir </> "") (const "posts")
compile $ getResourceBody
>>= myPandocCompiler
>>= loadAndApplyTemplate "templates/post.html" postCtx
>>= loadAndApplyTemplate "templates/default.html" postCtx
>>= relativizeUrls
-- css files generated by Agda
match (fromString $ agdaOutputDir </> "*.css") $ do
route $ gsubRoute (agdaOutputDir </> "") (const "posts")
compile compressCssCompiler
-- html files generated by Agda
match (fromString $ agdaOutputDir </> "*.html") $ do
route $ gsubRoute (agdaOutputDir </> "") (const "posts")
compile copyFileCompiler
match "publications/*" $ do
route $ setExtension "html"
compile $ getResourceBody
>>= myPandocCompiler
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
match "talks/*" $ do
route $ setExtension "html"
compile $ getResourceBody
>>= myPandocCompiler
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
match "publications.html" $ do
route idRoute
compile $ do
publications <- recentFirst =<< loadAll "publications/*"
talks <- recentFirst =<< loadAll "talks/*"
let publicationsCtx = mconcat
[ listField "publications" publicationCtx (return publications)
, listField "talks" publicationCtx (return talks)
, defaultContext
]
getResourceBody
>>= applyAsTemplate publicationsCtx
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
match "index.html" $ do
route idRoute
compile $ do
plainPosts <- loadAll "posts/*"
agdaPosts <- loadAll $ fromString (agdaOutputDir </> "*.md")
posts <- recentFirst $ plainPosts ++ agdaPosts
let indexContext = mconcat
[ listField "posts" postCtx (return posts)
, defaultContext
]
getResourceBody
>>= applyAsTemplate indexContext
>>= loadAndApplyTemplate "templates/default.html" defaultContext
>>= relativizeUrls
match "templates/*" $ compile templateCompiler
--------------------------------------------------------------------------------
postCtx :: Context String
postCtx =
dateField "date" "%B %e, %Y" `mappend`
defaultContext
publicationCtx :: Context String
publicationCtx =
dateField "date" "%B %Y" `mappend`
defaultContext
myPandocCompiler :: Item String -> Compiler (Item String)
myPandocCompiler mdBody = do
writePandoc <$> readPandocWith ropt mdBody
where
ropt = defaultHakyllReaderOptions
{ readerExtensions = enableExtension Ext_tex_math_dollars
$ enableExtension Ext_tex_math_double_backslash
$ enableExtension Ext_latex_macros
$ enableExtension Ext_lists_without_preceding_blankline
$ readerExtensions defaultHakyllReaderOptions
}
--------------------------------------------------------------------------------
agdaCommand :: String
agdaCommand = "agda"
agdaInputDir :: String
agdaInputDir = "agda-posts"
agdaOutputDir :: String
agdaOutputDir = "_agda"
agdaOptions :: String -> [String]
agdaOptions fileName =
[ "--html"
, "--html-highlight=auto"
, "--html-dir=" ++ agdaOutputDir
, "-i" ++ agdaInputDir
, agdaInputDir </> fileName
]
-- Process a .lagda.md file into markdown by calling Agda
processAgdaPosts :: IO ()
processAgdaPosts = do
files <- listDirectory agdaInputDir
let agdaFiles = filter (".lagda.md" `isSuffixOf`) files
forM_ agdaFiles processAgdaPost
processAgdaPost :: FilePath -> IO ()
processAgdaPost agdaFile = do
exitCode <- readProcessWithExitCode agdaCommand (agdaOptions agdaFile) mempty
case exitCode of
(ExitFailure _ , err , _) -> do
putStrLn $ "Failed to process " ++ agdaFile
putStrLn err
(ExitSuccess , out , _) -> do
putStrLn out
You can’t perform that action at this time.