diff options
Diffstat (limited to 'src')
40 files changed, 135 insertions, 1533 deletions
diff --git a/src/Conf.hs b/src/Conf.hs deleted file mode 100644 index cd00fd9..0000000 --- a/src/Conf.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Conf - ( getConf - , Conf(..) - ) where - -import Data.Text (Text) -import qualified Data.ConfigManager as Conf - -import Daemon.Frequency (Frequency) - -data Conf = Conf - { port :: Int - , git :: String - , generateResumes :: Frequency - } deriving (Read, Eq, Show) - -getConf :: FilePath -> IO (Either Text Conf) -getConf path = - (flip fmap) (Conf.readConfig path) (\configOrError -> do - conf <- configOrError - Conf <$> - Conf.lookup "port" conf <*> - Conf.lookup "git" conf <*> - Conf.lookup "generateResumes" conf - ) diff --git a/src/Daemon.hs b/src/Daemon.hs deleted file mode 100644 index 1351ad5..0000000 --- a/src/Daemon.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Daemon - ( runDaemon - ) where - -import Control.Concurrent (threadDelay) -import Control.Monad (forever) - -import Daemon.Frequency - -runDaemon :: Frequency -> (() -> IO ()) -> IO () -runDaemon frequency process = - forever $ do - process () - threadDelay (sleepDelayMs frequency) - -sleepDelayMs :: Frequency -> Int -sleepDelayMs Hourly = 1000000 * 60 * 60 -sleepDelayMs Daily = (sleepDelayMs Hourly) * 24 diff --git a/src/Daemon/Frequency.hs b/src/Daemon/Frequency.hs deleted file mode 100644 index d989d7f..0000000 --- a/src/Daemon/Frequency.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Daemon.Frequency - ( Frequency(..) - ) where - -data Frequency = - Hourly - | Daily - deriving (Eq, Read, Show) diff --git a/src/Date.hs b/src/Date.hs deleted file mode 100644 index e3c16e5..0000000 --- a/src/Date.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Date - ( getCurrentDate - ) where - -import Data.Time.Clock -import Data.Time.Calendar -import Data.Time.LocalTime - -import Model.Date - -getCurrentDate :: IO Date -getCurrentDate = do - now <- getCurrentTime - timezone <- getCurrentTimeZone - let zoneNow = utcToLocalTime timezone now - let (y, m, _) = toGregorian $ localDay zoneNow - return (Date m (fromIntegral y)) diff --git a/src/Design/Color.hs b/src/Design/Color.hs deleted file mode 100644 index bbe20c4..0000000 --- a/src/Design/Color.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Design.Color where - -import qualified Clay.Color as C - -white :: C.Color -white = C.white - -red :: C.Color -red = C.rgb 170 57 57 - -orange :: C.Color -orange = C.rgb 182 119 25 - -green :: C.Color -green = C.rgb 0 93 0 - -blue :: C.Color -blue = C.rgb 79 182 187 - -black :: C.Color -black = C.rgb 0 0 0 - -link :: C.Color -link = blue C.-. 70 - -gray :: C.Color -gray = C.rgb 100 100 100 diff --git a/src/Design/Global.hs b/src/Design/Global.hs deleted file mode 100644 index 379d612..0000000 --- a/src/Design/Global.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.Global - ( compactDesign - ) where - -import qualified Data.Text.Lazy as T -import Data.Monoid ((<>)) - -import Clay - -import qualified Design.Color as Color -import qualified Design.Media as Media -import Design.Header (headerCss) -import Design.Resume (resumeCss) -import Design.Projects (projectsCss) -import Design.NotFound (notFoundCss) - -compactDesign :: T.Text -compactDesign = renderWith compact [] $ global - -global :: Css -global = - body ? do - color Color.black - marginBottom (px 40) - Media.mobile $ fontSize (px 16) - Media.tabletDesktop $ fontSize (px 18) - - h1 ? do - fontFamily [] [monospace] - fontWeight bold - color Color.red - - Media.mobile $ do - lineHeight (px 30) - fontSize (px 22) - marginBottom (px 20) - marginTop (px 35) - - Media.tablet $ do - lineHeight (px 40) - fontSize (px 27) - marginBottom (px 35) - marginTop (px 45) - - Media.desktop $ do - lineHeight (px 50) - fontSize (px 30) - marginBottom (px 40) - marginTop (px 55) - - a ? do - textDecoration none - color Color.link - transition "color" (sec 0.3) easeOut (sec 0) - focus & outline solid (px 0) Color.white - - (a # hover) <> (a # focus) ? do - textDecoration underline - color Color.blue - - headerCss - resumeCss - projectsCss - notFoundCss diff --git a/src/Design/Header.hs b/src/Design/Header.hs deleted file mode 100644 index d2bbace..0000000 --- a/src/Design/Header.hs +++ /dev/null @@ -1,56 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.Header - ( headerCss - ) where - -import Data.Monoid ((<>)) - -import Clay -import Clay.Display (displayTable) - -import qualified Design.Color as Color -import qualified Design.Media as Media - -headerCss :: Css -headerCss = do - ".header" ? do - backgroundColor Color.red - color Color.white - fontSize (px 28) - - ul ? do - width (pct 100) - display displayTable - "table-layout" -: "fixed" - - li ? do - display tableCell - - a ? do - display block - height (em 3) - lineHeight (em 3) - textDecoration none - padding (px 0) (px 0) (px 0) (px 0) - textAlign (alignSide sideCenter) - color Color.white - textTransform capitalize - transition "background-color" (ms 500) ease (sec 0) - - i ? marginRight (em 0.5) - - Media.mobile $ do - i ? display none - fontSize (em 0.6) - - Media.tablet $ fontSize (em 0.8) - - (a # hover <> a # focus <> a # ".currentHeader") ? do - backgroundColor Color.red - borderBottomStyle solid - borderBottomColor (Color.red +. 40) - - Media.mobile $ borderBottomWidth (px 6) - Media.tablet $ borderBottomWidth (px 8) - Media.desktop $ borderBottomWidth (px 10) diff --git a/src/Design/Media.hs b/src/Design/Media.hs deleted file mode 100644 index 77220ee..0000000 --- a/src/Design/Media.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Design.Media - ( mobile - , mobileTablet - , tablet - , tabletDesktop - , desktop - ) where - -import Clay hiding (query) -import qualified Clay -import Clay.Stylesheet (Feature) -import qualified Clay.Media as Media - -mobile :: Css -> Css -mobile = query [Media.maxWidth mobileTabletLimit] - -mobileTablet :: Css -> Css -mobileTablet = query [Media.maxWidth tabletDesktopLimit] - -tablet :: Css -> Css -tablet = query [Media.minWidth mobileTabletLimit, Media.maxWidth tabletDesktopLimit] - -tabletDesktop :: Css -> Css -tabletDesktop = query [Media.minWidth mobileTabletLimit] - -desktop :: Css -> Css -desktop = query [Media.minWidth tabletDesktopLimit] - -query :: [Feature] -> Css -> Css -query = Clay.query Media.screen - -mobileTabletLimit :: Size LengthUnit -mobileTabletLimit = (px 520) - -tabletDesktopLimit :: Size LengthUnit -tabletDesktopLimit = (px 950) diff --git a/src/Design/Name.hs b/src/Design/Name.hs deleted file mode 100644 index 84c91fb..0000000 --- a/src/Design/Name.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.Name - ( nameCss - ) where - -import Clay - -nameCss :: Css -nameCss = do - fontWeight bold - letterSpacing (px 10) - margin (px 100) (px 0) (px 80) (px 0) - lineHeight (em 1.2) - fontSize (px 48) diff --git a/src/Design/NotFound.hs b/src/Design/NotFound.hs deleted file mode 100644 index ee8a0af..0000000 --- a/src/Design/NotFound.hs +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.NotFound - ( notFoundCss - ) where - -import Clay - -notFoundCss :: Css -notFoundCss = - - ".notFoundPage" ? do - - h1 ? do - fontSize (px 40) - fontWeight bold - margin (px 20) (px 20) (px 20) (px 20) - - p ? - margin (px 20) (px 20) (px 20) (px 20) diff --git a/src/Design/Projects.hs b/src/Design/Projects.hs deleted file mode 100644 index 311b7f8..0000000 --- a/src/Design/Projects.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.Projects - ( projectsCss - ) where - -import Prelude hiding ((**)) - -import Data.Monoid ((<>)) - -import Clay -import qualified Clay.Flexbox as CF - -import qualified Design.Color as Color -import qualified Design.Media as Media -import qualified Design.Size as Size - -projectsCss :: Css -projectsCss = - ".project" ? do - margin (pct 0) (pct 10) (pct 0) (pct 10) - - h1 ? ".separator" ? color Color.black - - ".body" ? do - Size.indentation - - ".technologies" <> ".pageLink" ? do - i ? marginRight (em 0.5) - Size.lineHeight - marginBottom (px 10) - - ".technologies" ? do - Media.mobile $ fontSize (pct 90) - ul ? do - display flex - flexWrap CF.wrap - li ? do - backgroundColor Color.orange - color Color.white - borderRadius (px 2) (px 2) (px 2) (px 2) - margin (px 0) (px 10) (px 5) (px 0) - ":last-child:after" & marginRight (px 0) - - Media.desktop $ padding (px 0) (px 10) (px 0) (px 10) - Media.mobileTablet $ padding (px 0) (px 5) (px 0) (px 5) - - ".description" ? do - Size.lineHeight - marginTop (px 10) - Media.desktop $ width (pct 50) diff --git a/src/Design/Resume.hs b/src/Design/Resume.hs deleted file mode 100644 index d668987..0000000 --- a/src/Design/Resume.hs +++ /dev/null @@ -1,125 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.Resume - ( resumeCss - ) where - -import Prelude hiding ((**)) - -import Clay -import qualified Clay.Flexbox as CF - -import qualified Design.Color as Color -import qualified Design.Media as Media -import qualified Design.Size as Size - -resumeCss :: Css -resumeCss = - ".section" ? do - position relative - margin (pct 0) (pct 10) (pct 0) (pct 10) - - h1 ? textTransform capitalize - - ".identity" ? do - ".mail" <> ".git" ? do - Size.indentation - i ? marginRight (em 0.5) - - Media.mobile $ do - fontSize (px 14) - marginBottom (px 15) - - Media.tablet $ do - fontSize (px 18) - marginBottom (px 25) - - Media.desktop $ do - fontSize (px 20) - marginBottom (px 30) - - ".pdf" ? do - position absolute - right (px 0) - top (px 0) - color Color.red - transition "all" (ms 100) ease (sec 0) - i ? marginRight (px 0) - hover & transform (scale 1.2 1.2) - - Media.mobile $ do - lineHeight (px 30) - height (px 30) - fontSize (px 20) - - Media.tablet $ do - lineHeight (px 40) - height (px 40) - fontSize (px 30) - - Media.desktop $ do - lineHeight (px 50) - height (px 50) - fontSize (px 40) - - ".item" ? do - marginBottom (px 40) - Size.indentation - Media.mobile $ marginBottom (px 25) - - ".title" <> ".location" <> ".description" ? do - Size.lineHeight - - ".title" ? do - Media.desktop $ do - display flex - marginBottom (px 10) - - ".skills" & do - Size.tabletMarginBottom - - ".text" ? do - backgroundColor Color.orange - color Color.white - padding (px 0) (px 10) (px 0) (px 10) - sym borderRadius (px 2) - Media.mobileTablet $ marginBottom (px 10) - - ".date" ? do - fontStyle italic - Media.mobile $ fontSize (pct 90) - Media.desktop $ marginLeft (px 15) - - ".description" ? ".detail" ? - marginTop Size.listItemSep - - ".location" ? do - color Color.green - Media.mobile $ do - fontSize (pct 90) - marginBottom (px 10) - Size.tabletMarginBottom - - ".itemList" ? marginTop (px 5) - - ".bullets" |> ".detail" ? do - Media.mobile $ marginBottom Size.listItemSep - Size.tabletMarginBottom - - ".bullets" |> li ? do - Size.lineHeight - before & do - content (stringContent "•") - color Color.red - display inlineBlock - marginRight (px 10) - - ".technos" ? do - display flex - flexWrap CF.wrap - sym2 margin (px 5) (px 0) - - ".technos" |> ".techno" ? do - lineHeight normal - borderBottom solid (px 2) lightgray - margin (px 10) (px 15) (px 5) (px 0) diff --git a/src/Design/Size.hs b/src/Design/Size.hs deleted file mode 100644 index 8b323bf..0000000 --- a/src/Design/Size.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Design.Size - ( indentation - , lineHeight - , listItemSep - , tabletMarginBottom - ) where - -import Clay hiding (lineHeight) -import qualified Clay - -import qualified Design.Media as Media - -indentation :: Css -indentation = do - Media.tablet $ marginLeft (px 10) - Media.desktop $ marginLeft (px 20) - -lineHeight :: Css -lineHeight = do - Media.mobile $ Clay.lineHeight (px 30) - Media.tablet $ Clay.lineHeight (px 35) - Media.desktop $ Clay.lineHeight (px 40) - -listItemSep :: Size LengthUnit -listItemSep = px 8 - -tabletMarginBottom :: Css -tabletMarginBottom = Media.tablet $ marginBottom (px 15) 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 diff --git a/src/Model.hs b/src/Model.hs deleted file mode 100644 index 846d98a..0000000 --- a/src/Model.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model where - -import GHC.Generics -import Data.Yaml - -import Model.Identity (Identity) -import Model.Job (Job) -import Model.Degree (Degree) -import Model.SkillType (SkillType) -import Model.Project (Project) -import Model.Translated (Translated) - -data Model = Model - { description :: String - , identity :: Identity - , jobs :: [Job] - , degrees :: [Degree] - , skillTypes :: [SkillType] - , interests :: [Translated] - , projects :: [Project] - } deriving (Show, Read, Eq, Generic) - -instance FromJSON Model diff --git a/src/Model/Company.hs b/src/Model/Company.hs deleted file mode 100644 index 3069488..0000000 --- a/src/Model/Company.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Company where - -import GHC.Generics -import Data.Yaml - -data Company = Company - { name :: String - , location :: String - } deriving (Show, Read, Eq, Generic) - -instance FromJSON Company diff --git a/src/Model/Date.hs b/src/Model/Date.hs deleted file mode 100644 index 7edb6fb..0000000 --- a/src/Model/Date.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Date where - -import GHC.Generics -import Data.Yaml - -data Date = Date - { month :: Int - , year :: Int - } deriving (Show, Read, Eq, Generic) - -yearAndMonthDiff :: Date -> Date -> (Int, Int) -yearAndMonthDiff d1 d2 = - let totalMonths = monthDiff d1 d2 - in (totalMonths `div` 12, totalMonths `mod` 12) - -monthDiff :: Date -> Date -> Int -monthDiff (Date m1 y1) (Date m2 y2) = - if y1 == y2 then - 1 + abs (m1 - m2) - else - let (minM, minY, maxM, maxY) = - if y1 < y2 then - (m1, y1, m2, y2) - else - (m2, y2, m1, y1) - in 12 * (maxY - minY - 1) + (13 - minM) + maxM - -instance FromJSON Date diff --git a/src/Model/Degree.hs b/src/Model/Degree.hs deleted file mode 100644 index 90feacc..0000000 --- a/src/Model/Degree.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Degree where - -import GHC.Generics -import Data.Yaml - -import Model.School -import Model.Translated - -data Degree = Degree - { name :: Translated - , school :: School - , year :: Int - , topics :: [Translated] - } deriving (Show, Read, Eq, Generic) - -instance FromJSON Degree diff --git a/src/Model/Header.hs b/src/Model/Header.hs deleted file mode 100644 index 7581fc5..0000000 --- a/src/Model/Header.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Model.Header - ( Header(..) - , allHeaders - , headerLink - , headerKey - ) where - -import Model.Translation.Key (Key) -import qualified Model.Translation.Key as K - -data Header = - Resume - | Projects - deriving (Enum, Bounded, Show, Eq) - -allHeaders :: [Header] -allHeaders = [minBound..] - -headerLink :: Header -> String -headerLink Resume = "/" -headerLink Projects = "/projects" - -headerKey :: Header -> Key -headerKey Resume = K.Resume -headerKey Projects = K.Projects diff --git a/src/Model/Identity.hs b/src/Model/Identity.hs deleted file mode 100644 index fb640fa..0000000 --- a/src/Model/Identity.hs +++ /dev/null @@ -1,14 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Identity where - -import Data.Yaml -import GHC.Generics - -data Identity = Identity - { name :: String - , website :: String - , git :: String - } deriving (Show, Read, Eq, Generic) - -instance FromJSON Identity diff --git a/src/Model/Job.hs b/src/Model/Job.hs deleted file mode 100644 index f6865f4..0000000 --- a/src/Model/Job.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Job where - -import Data.Yaml -import GHC.Generics - -import Model.Company -import Model.Date -import Model.Translated - -data Job = Job - { name :: Translated - , description :: Translated - , details :: Maybe [Translated] - , technos :: Maybe [String] - , company :: Company - , beginDate :: Date - , endDate :: Maybe Date - } deriving (Show, Read, Eq, Generic) - -instance FromJSON Job diff --git a/src/Model/Project.hs b/src/Model/Project.hs deleted file mode 100644 index 7825e60..0000000 --- a/src/Model/Project.hs +++ /dev/null @@ -1,18 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Project where - -import GHC.Generics -import Data.Yaml - -import Model.Translated - -data Project = Project - { name :: String - , technologies :: [String] - , description :: Maybe Translated - , git :: String - , pageLink :: Maybe String - } deriving (Show, Read, Eq, Generic) - -instance FromJSON Project diff --git a/src/Model/School.hs b/src/Model/School.hs deleted file mode 100644 index cb10ed9..0000000 --- a/src/Model/School.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.School where - -import GHC.Generics -import Data.Yaml - -data School = School - { name :: String - , location :: Maybe String - } deriving (Show, Read, Eq, Generic) - -instance FromJSON School diff --git a/src/Model/SkillType.hs b/src/Model/SkillType.hs deleted file mode 100644 index 3e533b8..0000000 --- a/src/Model/SkillType.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.SkillType where - -import GHC.Generics -import Data.Yaml - -import Model.Translated - -data SkillType = SkillType - { name :: Translated - , skills :: [Translated] - } deriving (Show, Read, Eq, Generic) - -instance FromJSON SkillType diff --git a/src/Model/Translated.hs b/src/Model/Translated.hs deleted file mode 100644 index b92ae39..0000000 --- a/src/Model/Translated.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Translated where - -import GHC.Generics -import Data.Yaml - -import Model.Translation.Language - -data Translated = Translated - { english :: String - , french :: String - } deriving (Show, Read, Eq, Generic) - -instance FromJSON Translated - -getTranslation :: Language -> Translated -> String -getTranslation English translated = english translated -getTranslation French translated = french translated diff --git a/src/Model/Translation/Key.hs b/src/Model/Translation/Key.hs deleted file mode 100644 index 43381fb..0000000 --- a/src/Model/Translation/Key.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Model.Translation.Key - ( Key(..) - ) where - -data Key = - - Home - | Resume - | Projects - | Contact - - | Experience - | EducationalBackground - | Skills - | Interests - - | Since - | From - | To - | And - - | Month Int - | MonthText Int - | YearText Int - - | TryIt - - | PageNotFound diff --git a/src/Model/Translation/Language.hs b/src/Model/Translation/Language.hs deleted file mode 100644 index a8f5eb9..0000000 --- a/src/Model/Translation/Language.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Model.Translation.Language - ( Language(..) - , languages - ) where - -data Language = - English - | French - deriving (Show, Read, Eq, Enum, Bounded) - -languages :: [Language] -languages = [minBound..] diff --git a/src/Model/Translation/Message.hs b/src/Model/Translation/Message.hs deleted file mode 100644 index c9e0fcb..0000000 --- a/src/Model/Translation/Message.hs +++ /dev/null @@ -1,90 +0,0 @@ -module Model.Translation.Message - ( getMessage - ) where - -import Model.Translation.Language -import Model.Translation.Key - -getMessage :: Key -> Language -> String - -getMessage Home English = "home" -getMessage Home French = "accueil" - -getMessage Resume English = "resume" -getMessage Resume French = "curriculum" - -getMessage Projects English = "projects" -getMessage Projects French = "projets" - -getMessage Contact English = "contact" -getMessage Contact French = "contact" - -getMessage Experience English = "experience" -getMessage Experience French = "expérience" - -getMessage EducationalBackground English = "educational background" -getMessage EducationalBackground French = "études" - -getMessage Skills English = "skills" -getMessage Skills French = "compétences" - -getMessage Interests English = "interests" -getMessage Interests French = "intérêts" - -getMessage Since English = "since" -getMessage Since French = "depuis" - -getMessage From English = "from" -getMessage From French = "de" - -getMessage To English = "to" -getMessage To French = "à" - -getMessage And English = "and" -getMessage And French = "et" - -getMessage (Month m) English = - case m of - 1 -> "january" - 2 -> "february" - 3 -> "march" - 4 -> "april" - 5 -> "may" - 6 -> "june" - 7 -> "july" - 8 -> "august" - 9 -> "september" - 10 -> "october" - 11 -> "november" - 12 -> "december" - _ -> "" -getMessage (Month m) French = - case m of - 1 -> "janvier" - 2 -> "février" - 3 -> "mars" - 4 -> "avril" - 5 -> "mai" - 6 -> "juin" - 7 -> "juillet" - 8 -> "août" - 9 -> "septembre" - 10 -> "octoble" - 11 -> "novembre" - 12 -> "décembre" - _ -> "" - -getMessage (MonthText count) English = "month" ++ (plural count) -getMessage (MonthText _) French = "mois" - -getMessage (YearText count) English = "year" ++ (plural count) -getMessage (YearText count) French = "an" ++ (plural count) - -getMessage TryIt English = "Try it!" -getMessage TryIt French = "Voir" - -getMessage PageNotFound English = "Page not found." -getMessage PageNotFound French = "La page que vous recherchez n'est pas disponible." - -plural :: Int -> String -plural count = if count > 1 then "s" else "" diff --git a/src/PDF.hs b/src/PDF.hs deleted file mode 100644 index a002b38..0000000 --- a/src/PDF.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module PDF - ( generatePDFAt - ) where - -import Control.Exception (SomeException, try) -import System.Directory (copyFile, createDirectoryIfMissing) -import System.FilePath (takeDirectory) -import System.IO (hClose) -import System.IO.Temp (withTempFile) -import qualified System.Process as Process (callCommand) -import Text.LaTeX (LaTeX, renderFile) - -generatePDFAt :: FilePath -> LaTeX -> IO () -generatePDFAt path latex = do - (basePath, tmpPath) <- generatePDF latex - createDirectoryIfMissing True (takeDirectory path) - copyFile tmpPath path - Process.callCommand ("rm " ++ basePath ++ "*") - -generatePDF :: LaTeX -> IO (FilePath, FilePath) -generatePDF latex = - withTempFile "/tmp" "latex" $ \filePath handle -> do - hClose handle - renderFile filePath latex - renderFile "/home/joris/resume.tex" latex - pdfCommand filePath - pdfCommand filePath - return (filePath, filePath ++ ".pdf") - -pdfCommand :: String -> IO () -pdfCommand path = do - let command = "cd resume && pdflatex --output-directory /tmp " ++ path ++ " >/dev/null" - result <- try $ Process.callCommand command :: IO (Either SomeException ()) - case result of - Left err -> do - putStrLn "Error generating PDF:" - putStrLn (show err) - Right _ -> - return () diff --git a/src/Resume.hs b/src/Resume.hs deleted file mode 100644 index 9b691c6..0000000 --- a/src/Resume.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Resume - ( generateResumes - , resumePath - ) where - -import Conf (Conf) - -import Model -import Model.Date (Date) -import Model.Identity (Identity(name)) -import Model.Translation.Language -import Model.Translation.Message (getMessage) -import qualified Model.Translation.Key as K - -import View.LaTeX.Resume (resumeLaTeX) - -import Date (getCurrentDate) - -import PDF (generatePDFAt) - -generateResumes :: Model -> Conf -> IO () -generateResumes model conf = do - currentDate <- getCurrentDate - mapM_ (generateResume model currentDate conf) languages - -generateResume :: Model -> Date -> Conf -> Language -> IO () -generateResume model date conf language = - let path = "public/" ++ (resumePath model language) - resume = resumeLaTeX conf language date model - in generatePDFAt path resume - -resumePath :: Model -> Language -> FilePath -resumePath model language = - "resumes/" ++ (getMessage K.Resume language) ++ " " ++ (name . identity $ model) ++ ".pdf" diff --git a/src/Utils/String.hs b/src/Utils/String.hs deleted file mode 100644 index 44cdf03..0000000 --- a/src/Utils/String.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Utils.String - ( capitalizeWords - , capitalizeFirstWord - , capitalizeWord - ) where - -import Data.Char - -capitalizeWords :: String -> String -capitalizeWords = unwords . map capitalizeWord . words - -capitalizeFirstWord :: String -> String -capitalizeFirstWord = unwords . mapFirst capitalizeWord . words - -capitalizeWord :: String -> String -capitalizeWord [] = [] -capitalizeWord (x:xs) = toUpper x : map toLower xs - -mapFirst :: (a -> a) -> [a] -> [a] -mapFirst _ [] = [] -mapFirst f (x:xs) = f x : xs diff --git a/src/View/Git.hs b/src/View/Git.hs deleted file mode 100644 index abf5226..0000000 --- a/src/View/Git.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.Git - ( renderGit - , renderGitIcon - ) where - -import Data.String (fromString) - -import Text.Blaze.Html -import Text.Blaze.Html5.Attributes -import qualified Text.Blaze.Html5 as H - -import Conf (Conf) -import qualified Conf as Conf - -import View.Icon (renderIcon) - -renderGit :: Conf -> String -> Html -renderGit conf ref = - H.div - ! class_ "git" - $ H.a - ! href (fromString $ gitLink conf ref) - $ do - renderIcon "git-square" - fromString ref - -renderGitIcon :: Conf -> String -> Html -renderGitIcon conf ref = - H.a - ! class_ "git" - ! href (fromString $ gitLink conf ref) - $ renderIcon "git-square" - -gitLink :: Conf -> String -> String -gitLink conf ref = (Conf.git conf) ++ ref diff --git a/src/View/Header.hs b/src/View/Header.hs deleted file mode 100644 index a29b9a3..0000000 --- a/src/View/Header.hs +++ /dev/null @@ -1,42 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.Header - ( renderHeader - ) where - -import Control.Monad (forM_) - -import Data.String (fromString) - -import Text.Blaze.Html -import Text.Blaze.Html5 -import Text.Blaze.Html5.Attributes -import qualified Text.Blaze.Html5 as H - -import Model.Header -import Model.Translation.Language -import Model.Translation.Message - -renderHeader :: Language -> Maybe Header -> Html -renderHeader language mbCurrentHeader = - H.div ! class_ "header" $ - ul $ - forM_ allHeaders (headerItem language mbCurrentHeader) - -headerItem :: Language -> Maybe Header -> Header -> Html -headerItem language mbCurrentHeader pageHeader = - li $ a - ! class_ (fromString $ (headerClass pageHeader) ++ " " ++ (if mbCurrentHeader == Just pageHeader then "currentHeader" else "")) - ! href (fromString . headerLink $ pageHeader) $ do - i ! class_ (fromString $ "fa fa-lg " ++ (headerIcon pageHeader)) $ "" - H.span - ! class_ "text" - $ fromString (getMessage (headerKey pageHeader) language) - -headerClass :: Header -> String -headerClass Resume = "resume" -headerClass Projects = "projects" - -headerIcon :: Header -> String -headerIcon Resume = "fa-user" -headerIcon Projects = "fa-flask" diff --git a/src/View/Icon.hs b/src/View/Icon.hs deleted file mode 100644 index 67db0a9..0000000 --- a/src/View/Icon.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.Icon - ( renderIcon - ) where - -import Data.String (fromString) - -import Text.Blaze.Html -import Text.Blaze.Html5 -import Text.Blaze.Html5.Attributes - -renderIcon :: String -> Html -renderIcon iconName = - i - ! class_ (fromString $ "fa fa-fw fa-" ++ iconName) - $ "" diff --git a/src/View/Interval.hs b/src/View/Interval.hs deleted file mode 100644 index 05cb62c..0000000 --- a/src/View/Interval.hs +++ /dev/null @@ -1,39 +0,0 @@ -module View.Interval - ( renderDurationAndInterval - , renderYearInterval - , renderDuration - ) where - -import Data.Maybe (fromMaybe) - -import Model.Date -import Model.Translation.Language -import qualified Model.Translation.Key as K -import Model.Translation.Message - -renderDurationAndInterval :: Language -> Date -> Date -> Maybe Date -> String -renderDurationAndInterval language currentDate beginDate mbEndDate = - let duration = renderDuration language beginDate (fromMaybe currentDate mbEndDate) - interval = renderYearInterval language beginDate mbEndDate - in duration ++ ", " ++ interval - -renderDuration :: Language -> Date -> Date -> String -renderDuration language d1 d2 = - let (years, months) = yearAndMonthDiff d1 d2 - renderYears = (show years) ++ " " ++ (getMessage (K.YearText years) language) - renderMonths = (show months) ++ " " ++ (getMessage (K.MonthText months) language) - spaceAnd = " " ++ (getMessage K.And language) ++ " " - in if years > 0 then - renderYears ++ (if months > 0 then spaceAnd ++ renderMonths else "") - else - renderMonths - -renderYearInterval :: Language -> Date -> (Maybe Date) -> String -renderYearInterval language beginDate Nothing = - (getMessage K.Since language) ++ " " ++ (show . year $ beginDate) -renderYearInterval language beginDate (Just endDate) = - let beginYear = year beginDate - endYear = year endDate - in if beginYear == endYear - then show beginYear - else (show beginYear) ++ " " ++ (getMessage K.To language) ++ " " ++ (show endYear) diff --git a/src/View/LaTeX/Resume.hs b/src/View/LaTeX/Resume.hs deleted file mode 100644 index 6ec717f..0000000 --- a/src/View/LaTeX/Resume.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.LaTeX.Resume - ( resumeLaTeX - ) where - -import Text.LaTeX -import Text.LaTeX.Base.Syntax (LaTeX (TeXComm), TeXArg (FixArg)) - -import Data.Maybe (fromMaybe, listToMaybe) - -import Conf (Conf) -import qualified Conf as Conf - -import Model (Model) -import qualified Model as M -import qualified Model.Company as C -import Model.Date (Date) -import Model.Degree (Degree) -import qualified Model.Degree as D -import Model.Identity (Identity) -import qualified Model.Identity as I -import Model.Job (Job) -import qualified Model.Job as J -import qualified Model.School as S -import Model.SkillType (SkillType) -import qualified Model.SkillType as ST - -import Model.Translated -import Model.Translation.Key (Key) -import qualified Model.Translation.Key as K -import Model.Translation.Language -import Model.Translation.Message - -import View.Interval (renderDurationAndInterval) - -import Utils.String - -resumeLaTeX :: Conf -> Language -> Date -> Model -> LaTeX -resumeLaTeX conf language currentDate model = - preamble - <> document (body conf language currentDate model) - -preamble :: LaTeX -preamble = documentclass [] "resume" - -body :: Conf -> Language -> Date -> Model -> LaTeX -body conf language currentDate model = - identityLaTeX conf language (M.identity model) (M.jobs model) - <> jobsLaTeX language currentDate (M.jobs model) - <> degreesLaTeX language (M.degrees model) - <> skillTypesLaTeX language (M.skillTypes model) - <> interestsLaTeX language (M.interests model) - -identityLaTeX :: Conf -> Language -> Identity -> [Job] -> LaTeX -identityLaTeX conf language identity jobs = - TeXComm "header" - [ FixArg (fromString $ I.name identity) - , FixArg (fromString . fromMaybe "" . (fmap (getTranslation language . J.name)) . listToMaybe $ jobs) - , FixArg (fromString $ I.website identity) - , FixArg (fromString $ Conf.git conf) - , FixArg (fromString $ I.git identity) - ] - -jobsLaTeX :: Language -> Date -> [Job] -> LaTeX -jobsLaTeX language currentDate jobs = - translatedSection K.Experience language - <> mconcat (map (jobLaTeX language currentDate) jobs) - -jobLaTeX :: Language -> Date -> Job -> LaTeX -jobLaTeX language currentDate job = - customCommand "position" - [ fromString . getTranslation language $ J.name job - , fromString $ renderDurationAndInterval language currentDate (J.beginDate job) (J.endDate job) - , fromString $ ((C.name . J.company) job) ++ ", " ++ ((C.location . J.company) job) - , (fromString . getTranslation language . J.description $ job) - , case J.details job of - Just details@(_:_) -> translatedBullets language details - _ -> mempty - , case J.technos job of - Just ts -> technos ts - _ -> mempty - ] - -degreesLaTeX :: Language -> [Degree] -> LaTeX -degreesLaTeX language degrees = - translatedSection K.EducationalBackground language - <> mconcat (map (degreeLaTeX language) degrees) - -degreeLaTeX :: Language -> Degree -> LaTeX -degreeLaTeX language degree = - customCommand "position" - [ fromString . getTranslation language $ D.name degree - , fromString . show . D.year $ degree - , fromString $ S.name school ++ (fromMaybe "" (((++) ", ") <$> S.location school)) - , mempty - , translatedBullets language $ D.topics degree - , mempty - ] - where school = D.school degree - -skillTypesLaTeX :: Language -> [SkillType] -> LaTeX -skillTypesLaTeX language skillTypes = - translatedSection K.Skills language - <> (mconcat . map (skillTypeLaTeX language) $ skillTypes) - -skillTypeLaTeX :: Language -> SkillType -> LaTeX -skillTypeLaTeX language skillType = - subsection (fromString . capitalizeFirstWord . getTranslation language . ST.name $ skillType) - <> translatedBullets language (ST.skills skillType) - -interestsLaTeX :: Language -> [Translated] -> LaTeX -interestsLaTeX language interests = - translatedSection K.Interests language - <> translatedBullets language interests - -translatedBullets :: Language -> [Translated] -> LaTeX -translatedBullets language = itemsEnv "bullets" . map (getTranslation language) - -itemsEnv :: String -> [String] -> LaTeX -itemsEnv name items = - environment name . mconcat . concat . map getItem $ items - where getItem i = - [ item Nothing - , fromString . capitalizeFirstWord $ i - ] - -technos :: [String] -> LaTeX -technos names = - environment "technos" . mconcat . concat . map getItem $ names - where getItem name = - [ item Nothing - , TeXComm "techno" [ FixArg (fromString name) ] - ] - -translatedSection :: Key -> Language -> LaTeX -translatedSection key language = - section (fromString . capitalizeWords $ getMessage key language) - -customCommand :: String -> [LaTeX] -> LaTeX -customCommand commandName commandParameters = - TeXComm commandName (map FixArg commandParameters) - -environment :: String -> LaTeX -> LaTeX -environment name inside = - (TeXComm "begin" [ FixArg (fromString name) ]) - <> inside - <> (TeXComm "end" [ FixArg (fromString name) ]) diff --git a/src/View/NotFound.hs b/src/View/NotFound.hs deleted file mode 100644 index c16eb6c..0000000 --- a/src/View/NotFound.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.NotFound - ( renderNotFound - ) where - -import Data.String (fromString) - -import Text.Blaze.Html -import Text.Blaze.Html5 -import Text.Blaze.Html5.Attributes -import qualified Text.Blaze.Html5 as H - -import Model.Translation.Language -import qualified Model.Translation.Key as K -import Model.Translation.Message - -import View.Header (renderHeader) - -renderNotFound :: Language -> Html -renderNotFound language = - H.div $ do - renderHeader language Nothing - H.div ! class_ "notFoundPage" $ do - h1 "404" - p .fromString $ getMessage K.PageNotFound language diff --git a/src/View/Page.hs b/src/View/Page.hs deleted file mode 100644 index b7267e8..0000000 --- a/src/View/Page.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.Page - ( renderPage - ) where - -import Data.Text.Internal.Lazy -import Data.String (fromString) - -import Text.Blaze.Html -import Text.Blaze.Html5 -import Text.Blaze.Html5.Attributes -import qualified Text.Blaze.Html5 as H -import Text.Blaze.Html.Renderer.Text (renderHtml) - -import qualified Model as M -import qualified Model.Identity as I - -renderPage :: M.Model -> Html -> Text -renderPage model page = - renderHtml $ do - docTypeHtml $ do - H.head $ do - H.title $ fromString . I.name . M.identity $ model - meta ! charset "UTF-8" - meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0" - meta ! name "author" ! content (toValue $ I.name . M.identity $ model) - meta ! name "description" ! content (toValue $ M.description model) - link ! rel "stylesheet" ! type_ "text/css" ! href "/stylesheets/reset.css" - link ! rel "stylesheet" ! href "/stylesheets/font-awesome-4.2.0/css/font-awesome.min.css" - link ! rel "stylesheet" ! type_ "text/css" ! href "/design" - link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png" - H.body page diff --git a/src/View/Project.hs b/src/View/Project.hs deleted file mode 100644 index a5aaf2c..0000000 --- a/src/View/Project.hs +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.Project - ( renderProjects - ) where - -import Data.String (fromString) - -import Text.Blaze.Html -import Text.Blaze.Html5 -import Text.Blaze.Html5.Attributes -import qualified Text.Blaze.Html5 as H - -import Conf (Conf) - -import Model.Header (Header(Projects)) -import qualified Model.Project as P -import Model.Translated -import Model.Translation.Language - -import View.Header (renderHeader) -import View.Git (renderGitIcon) - -renderProjects :: Conf -> Language -> [P.Project] -> Html -renderProjects conf language projects = - H.div $ do - renderHeader language (Just Projects) - H.div ! class_ "projectsPage" $ - mapM_ (renderProject conf language) projects - -renderProject :: Conf -> Language -> P.Project -> Html -renderProject conf language project = - H.div ! class_ "project" $ do - renderTitle conf project - H.div ! class_ "body" $ do - renderTechnologies (P.technologies project) - case P.pageLink project of - Just pageLink -> renderPageLink pageLink - Nothing -> fromString "" - case P.description project of - Just description -> renderDescription language description - Nothing -> H.div "" - -renderTitle :: Conf -> P.Project -> Html -renderTitle conf project = - h1 $ do - toHtml (P.name project) - H.span ! class_ "separator" $ fromString " − " - renderGitIcon conf (P.git project) - -renderTechnologies :: [String] -> Html -renderTechnologies technologies = - H.div ! class_ "technologies" $ do - ul $ mapM_ (H.li . fromString) technologies - -renderPageLink :: String -> Html -renderPageLink pageLink = - H.div ! class_ "pageLink" $ do - H.a - ! href (fromString pageLink) - $ toHtml pageLink - -renderDescription :: Language -> Translated -> Html -renderDescription language description = - H.div ! class_ "description" $ do - fromString . getTranslation language $ description diff --git a/src/View/Resume.hs b/src/View/Resume.hs deleted file mode 100644 index ffd5c8c..0000000 --- a/src/View/Resume.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.Resume - ( renderResume - ) where - -import Data.Maybe -import Data.String (fromString) - -import Text.Blaze.Html -import Text.Blaze.Html5 hiding (details) -import qualified Text.Blaze.Html5 as H -import Text.Blaze.Html5.Attributes - -import Conf (Conf) - -import qualified Model as M -import qualified Model.Company as C -import Model.Date -import qualified Model.Degree as D -import Model.Header (Header (Resume)) -import qualified Model.Identity as I -import qualified Model.Job as J -import qualified Model.School as S -import qualified Model.SkillType as ST -import Model.Translated -import Model.Translation.Key (Key) -import qualified Model.Translation.Key as K -import Model.Translation.Language -import Model.Translation.Message - -import View.Git (renderGit) -import View.Header (renderHeader) -import View.Icon (renderIcon) -import View.Interval (renderDurationAndInterval) - -import Resume (resumePath) - -renderResume :: Conf -> Language -> Date -> M.Model -> Html -renderResume conf language currentDate model = - H.div $ do - renderHeader language (Just Resume) - H.div ! class_ "resumePage" $ do - renderIdentity conf language model - renderJobs language currentDate . M.jobs $ model - renderDegrees language . M.degrees $ model - renderSkillTypes language . M.skillTypes $ model - renderInterests language . M.interests $ model - -renderIdentity :: Conf -> Language -> M.Model -> Html -renderIdentity conf language model = - let identity = M.identity model - in H.div ! class_ "section" $ do - H.div ! class_ "identity" $ do - h1 (fromString (I.name identity)) - renderGit conf (I.git identity) - a ! href (fromString $ resumePath model language) ! class_ "pdf" ! target "_blank" $ - renderIcon "print" - -renderJobs :: Language -> Date -> [J.Job] -> Html -renderJobs language currentDate jobs = - H.div ! class_ "section" $ do - sectionTitle K.Experience language - mapM_ (renderJob language currentDate) jobs - -renderJob :: Language -> Date -> J.Job -> Html -renderJob language currentDate job = - H.div ! class_ "item" $ do - - H.div ! class_ "title" $ do - H.div ! class_ "text" $ - fromString . getTranslation language . J.name $ job - H.div ! class_ "date" $ - fromString $ renderDurationAndInterval language currentDate (J.beginDate job) (J.endDate job) - - H.div ! class_ "location" $ do - let company = J.company job - companyName = C.name company - companyLocation = C.location company - fromString $ companyName ++ ", " ++ companyLocation - - H.div ! class_ "description" $ do - _ <- fromString . getTranslation language . J.description $ job - case J.details job of - Just details -> - ul ! class_ "bullets detail" $ - mapM_ (\detail -> li . fromString . getTranslation language $ detail) details - Nothing -> - fromString "" - renderTechnos $ fromMaybe [] (J.technos job) - -renderTechnos :: [String] -> Html -renderTechnos = (ul ! class_ "technos") . mapM_ ((li ! class_ "techno") . fromString) - -renderDegrees :: Language -> [D.Degree] -> Html -renderDegrees language degrees = - H.div ! class_ "section" $ do - sectionTitle K.EducationalBackground language - mapM_ (renderDegree language) degrees - -renderDegree :: Language -> D.Degree -> Html -renderDegree language degree = - H.div ! class_ "item" $ do - - H.div ! class_ "title" $ do - H.div ! class_ "text " $ - fromString . getTranslation language . D.name $ degree - H.div ! class_ "date" $ - fromString . show . D.year $ degree - - H.div ! class_ "location" $ - let school = D.school degree - location = fromMaybe "" $ fmap (", " ++ ) (S.location school) - in fromString $ (S.name school) ++ location - - ul ! class_ "bullets itemList" $ - mapM_ (\topic -> li . fromString . getTranslation language $ topic) (D.topics degree) - -renderSkillTypes :: Language -> [ST.SkillType] -> Html -renderSkillTypes language skillTypes = - H.div ! class_ "section" $ do - sectionTitle K.Skills language - mapM_ (renderSkillType language) skillTypes - -renderSkillType :: Language -> ST.SkillType -> Html -renderSkillType language skillType = - H.div ! class_ "item" $ do - H.div ! class_ "title skills" $ H.div ! class_ "text" $ - fromString . getTranslation language . ST.name $ skillType - ul ! class_ "bullets itemList" $ - mapM_ (\skill -> li . fromString . getTranslation language $ skill) (ST.skills skillType) - -renderInterests :: Language -> [Translated] -> Html -renderInterests language interests = - H.div ! class_ "section" $ do - sectionTitle K.Interests language - ul ! class_ "bullets" $ mapM_ (\interest -> li . fromString . getTranslation language $ interest) interests - -sectionTitle :: Key -> Language -> Html -sectionTitle key language = h1 . fromString $ getMessage key language |