diff --git a/app/site.hs b/app/site.hs deleted file mode 100644 index 65fc672..0000000 --- a/app/site.hs +++ /dev/null @@ -1,110 +0,0 @@ -module Main where - --------------------------------------------------------------------------------- -{-# LANGUAGE OverloadedStrings #-} -import Data.Monoid -import Control.Monad (forM_) -import Hakyll -import HakyllBibTex -import System.Process -import Text.Pandoc.Options - -config :: Configuration -config = defaultConfiguration - { deployCommand = "echo `pwd`; ./scripts/deploy.sh" } - --------------------------------------------------------------------------------- -bibHeaders :: [(String, [String])] -bibHeaders = [ ("drafts" , [ "-c", "$type='UNPUBLISHED'" ] ) - , ("thesis" , [ "-c", "$type='PHDTHESIS'" ] ) - , ("pubs" , [ "-c", "($type='INPROCEEDINGS' | $type='ARTICLE') & $reviewed='yes'" ] ) - , ("invite" , [ "-c", "($type='INPROCEEDINGS' | $type='ARTICLE' | $type='INBOOK') & $reviewed='no'" ] ) - ] - -bibSources :: [String] -bibSources = [ "bibs/header.bib" - , "bibs/myrefs.bib" - ] - -contentSections :: [String] -contentSections = [ "contacts", "about", "news", "biblio" ] --------------------------------------------------------------------------------- -compass :: Compiler (Item String) -compass = - getResourceString >>= - withItemBody (unixFilter "sass" ["-s", "--scss", "--compass"]) - -b2bflags :: [String] -b2bflags = [ "--expand" - , "-c" - , "jh:'yes'" - , "-s" - , "$date" - , "-r" - ] - - -bib2bib :: [String] - -> Compiler (Item String) -bib2bib flags = (unsafeCompiler $ - readProcess "bib2bib" (bibSources ++ b2bflags ++ flags) "") - >>= makeItem - -bib2bibParse :: Item String - -> Compiler [Item BibEntry] -bib2bibParse file = - let (BibFile bf) = parseBibFile (itemBody file) in - sequence $ fmap makeItem bf - - --------------------------------------------------------------------------------- -main :: IO () -main = hakyllWith config $ do - match (fromGlob "files/**") $ do - route idRoute - compile copyFileCompiler - - match (fromGlob "images/**") $ do - route idRoute - compile copyFileCompiler - - match (fromGlob "css/*.scss") $ do - route $ setExtension "css" - compile $ compass - - match (fromGlob "content/*.md") $ do - route $ setExtension "html" - compile $ do - let secDiv = defaultHakyllWriterOptions { writerSectionDivs = True } - pandocCompilerWith defaultHakyllReaderOptions secDiv - >>= relativizeUrls - - match (fromGlob "index.html") $ do - route idRoute - compile $ do - let loadSec sec = field sec - (\_ -> loadBody (fromFilePath $ "content/" ++ sec ++ ".md")) - makeBibCtx (nick, _) = - field nick (\_ -> loadBody $ fromFilePath ("bibs/" ++ nick ++ ".html")) - biblioContext = mconcat $ map makeBibCtx bibHeaders - indexContext = mconcat $ fmap loadSec contentSections - footerContext = field "footer" (\_ -> loadBody $ fromFilePath "content/footer.md") - getResourceBody - >>= applyAsTemplate (indexContext <> biblioContext <> footerContext <> defaultContext) - >>= relativizeUrls - - forM_ bibHeaders $ \(nick, flags) -> - create [fromCapture (fromGlob "bibs/*.html") nick] $ do - route idRoute - compile $ - let biblioCtx = mconcat - [ field "bibitems" $ return . itemBody ] in do - bibTpl <- loadBody $ fromFilePath "templates/bibitem.html" - (bib2bib flags) - >>= bib2bibParse - >>= applyTemplateList bibTpl bibEntryContext - >>= makeItem - >>= applyAsTemplate biblioCtx - >>= relativizeUrls - - match (fromGlob "templates/*") $ compile templateCompiler