diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 188 |
1 files changed, 135 insertions, 53 deletions
diff --git a/src/Main.hs b/src/Main.hs index fd1e076..d66e67b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,67 +1,149 @@ {-# LANGUAGE OverloadedStrings #-} -module Main - ( main - ) where +import Control.Applicative (empty) +import qualified Data.Text as T +import Hakyll ((.&&.)) +import Hakyll (Compiler, Configuration (..), + Context (Context), + ContextField (ListField), Identifier, + Item, MonadMetadata, TmpFile (TmpFile)) +import qualified Hakyll as H +import qualified System.FilePath as FilePath (replaceExtension, + takeDirectory) +import qualified System.Process as Process (readCreateProcess, shell, + system) +import qualified Text.Pandoc as Pandoc -import Control.Concurrent (forkIO) -import Control.Monad.IO.Class (liftIO) +main :: IO () +main = H.hakyllWith configuration $ do -import Network.Wai.Middleware.Static + -- Static files + H.match "assets/**" $ do + H.route H.idRoute + H.compile H.copyFileCompiler -import Web.Scotty + H.match "css/**.hs" $ do + H.route . H.customRoute $ const "style.css" + H.compile $ do + H.unsafeCompiler (Process.readCreateProcess (Process.shell "cd css && runghc Style.hs") "") + >>= H.makeItem -import Data.Text.Lazy (isPrefixOf) -import Data.Yaml (decodeFileEither) + H.match "cv/**" $ H.version "html" $ do + H.route $ H.setExtension "html" + let context = + metadataListField `mappend` + H.defaultContext + H.compile $ H.pandocCompiler + >>= H.loadAndApplyTemplate "templates/resume.html" context + >>= H.relativizeUrls -import Model -import Model.Translation.Language + H.match "cv/**" $ H.version "tex" $ do + H.route $ H.setExtension "tex" + let context = + metadataListField `mappend` + H.defaultContext + H.compile $ H.getResourceBody + >>= H.readPandoc + >>= writeLaTeX + >>= H.loadAndApplyTemplate "templates/resume.tex" context -import View.NotFound (renderNotFound) -import View.Page (renderPage) -import View.Project (renderProjects) -import View.Resume (renderResume) + H.match "project/**" $ do + H.route $ H.setExtension "html" + let context = + metadataListField `mappend` + H.defaultContext + H.compile $ H.pandocCompiler + >>= H.loadAndApplyTemplate "templates/project.html" context + >>= H.relativizeUrls -import Design.Global (compactDesign) + H.match "index.html" $ do + H.route H.idRoute + let layoutContext = + H.constField "isResume" "true" `mappend` + H.defaultContext + let context = + H.listField "experience" H.defaultContext (H.loadAll ("cv/experience/*" .&&. H.hasVersion "html")) `mappend` + H.listField "education" H.defaultContext (H.loadAll ("cv/education/*" .&&. H.hasVersion "html")) `mappend` + H.listField "skills" H.defaultContext (H.loadAll ("cv/skill/*" .&&. H.hasVersion "html")) `mappend` + H.listField "hobbies" H.defaultContext (H.loadAll ("cv/hobby/*" .&&. H.hasVersion "html")) `mappend` + H.defaultContext + H.compile $ + H.getResourceBody + >>= H.applyAsTemplate context + >>= H.loadAndApplyTemplate "templates/layout.html" layoutContext + >>= H.relativizeUrls -import qualified Conf as Conf + H.match "projects.html" $ do + H.route H.idRoute + let layoutContext = + H.constField "isProjects" "true" `mappend` + H.defaultContext + let context = + H.listField "projects" H.defaultContext (H.loadAll "project/*") `mappend` + H.defaultContext + H.compile $ + H.getResourceBody + >>= H.applyAsTemplate context + >>= H.loadAndApplyTemplate "templates/layout.html" layoutContext + >>= H.relativizeUrls -import Date (getCurrentDate) + H.match "cv.tex" $ do + H.route $ H.setExtension ".pdf" + let context = + H.listField "experience" H.defaultContext (H.loadAll ("cv/experience/*" .&&. H.hasVersion "tex")) `mappend` + H.listField "education" H.defaultContext (H.loadAll ("cv/education/*" .&&. H.hasVersion "tex")) `mappend` + H.listField "skills" H.defaultContext (H.loadAll ("cv/skill/*" .&&. H.hasVersion "tex")) `mappend` + H.listField "hobbies" H.defaultContext (H.loadAll ("cv/hobby/*" .&&. H.hasVersion "tex")) `mappend` + H.defaultContext + H.compile $ + H.getResourceBody + >>= H.applyAsTemplate context + >>= H.readPandoc + >>= writeLaTeX + >>= H.loadAndApplyTemplate "templates/layout.tex" context + >>= generatePdf -import Daemon (runDaemon) + H.match "templates/**" $ + H.compile H.templateBodyCompiler -import Resume (generateResumes) +writeLaTeX :: Item Pandoc.Pandoc -> Compiler (Item String) +writeLaTeX = traverse $ \pandoc -> + case Pandoc.runPure (Pandoc.writeLaTeX Pandoc.def pandoc) of + Left err -> fail $ show err + Right x -> return (T.unpack x) -main :: IO () -main = do - modelOrError <- decodeFileEither "data.yaml" - confOrError <- Conf.getConf "application.conf" - case (modelOrError, confOrError) of - (Left modelError, _) -> - putStrLn $ "Model error: " ++ (show modelError) - (_, Left confError) -> - putStrLn $ "Configuration error: " ++ (show confError) - (Right model, Right conf) -> do - _ <- forkIO . runDaemon (Conf.generateResumes conf) $ \() -> generateResumes model conf - scotty (Conf.port conf) $ do - middleware $ staticPolicy (noDots >-> addBase "public") - get "/design" $ do - addHeader "Content-Type" "text/css" - text compactDesign - get "/" $ do - language <- getLanguage - currentDate <- liftIO getCurrentDate - html $ renderPage model (renderResume conf language currentDate model) - get "/projects" $ do - language <- getLanguage - html $ renderPage model (renderProjects conf language (projects model)) - notFound $ do - language <- getLanguage - html $ renderPage model (renderNotFound language) - -getLanguage :: ActionM Language -getLanguage = do - mbLang <- header "Accept-Language" - case mbLang of - Just lang | "fr" `isPrefixOf` lang -> return French - _ -> return English +configuration :: Configuration +configuration = H.defaultConfiguration + { destinationDirectory = "public" + } + +metadataListField :: Context a +metadataListField = Context $ \k _ i -> do + values <- getMetadataListField (H.itemIdentifier i) k + case values of + Just vs -> do + listItems <- mapM H.makeItem vs + return $ ListField (H.field "item" (return . H.itemBody)) listItems + Nothing -> + empty + +getMetadataListField :: MonadMetadata m => Identifier -> String -> m (Maybe [String]) +getMetadataListField identifier key = do + metadata <- H.getMetadata identifier + return $ H.lookupStringList key metadata + +generatePdf :: Item String -> Compiler (Item TmpFile) +generatePdf item = do + TmpFile texPath <- H.newTmpFile "file.tex" + let tmpDir = FilePath.takeDirectory texPath + pdfPath = FilePath.replaceExtension texPath "pdf" + + H.unsafeCompiler $ do + writeFile texPath $ H.itemBody item + _ <- Process.system $ unwords ["cd resume", "&&", "pdflatex", "-halt-on-error", + "-output-directory", "../" ++ tmpDir, "../" ++ texPath, ">/dev/null", "2>&1"] + _ <- Process.system $ unwords ["cd resume", "&&", "pdflatex", "-halt-on-error", + "-output-directory", "../" ++ tmpDir, "../" ++ texPath, ">/dev/null", "2>&1"] + return () + + H.makeItem $ TmpFile pdfPath |