aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Conf.hs27
-rw-r--r--src/Daemon.hs18
-rw-r--r--src/Daemon/Frequency.hs8
-rw-r--r--src/Date.hs17
-rw-r--r--src/Design/Color.hs27
-rw-r--r--src/Design/Global.hs66
-rw-r--r--src/Design/Header.hs56
-rw-r--r--src/Design/Media.hs36
-rw-r--r--src/Design/Name.hs15
-rw-r--r--src/Design/NotFound.hs20
-rw-r--r--src/Design/Projects.hs51
-rw-r--r--src/Design/Resume.hs125
-rw-r--r--src/Design/Size.hs28
-rw-r--r--src/Main.hs188
-rw-r--r--src/Model.hs25
-rw-r--r--src/Model/Company.hs13
-rw-r--r--src/Model/Date.hs30
-rw-r--r--src/Model/Degree.hs18
-rw-r--r--src/Model/Header.hs25
-rw-r--r--src/Model/Identity.hs14
-rw-r--r--src/Model/Job.hs22
-rw-r--r--src/Model/Project.hs18
-rw-r--r--src/Model/School.hs13
-rw-r--r--src/Model/SkillType.hs15
-rw-r--r--src/Model/Translated.hs19
-rw-r--r--src/Model/Translation/Key.hs28
-rw-r--r--src/Model/Translation/Language.hs12
-rw-r--r--src/Model/Translation/Message.hs90
-rw-r--r--src/PDF.hs41
-rw-r--r--src/Resume.hs34
-rw-r--r--src/Utils/String.hs21
-rw-r--r--src/View/Git.hs37
-rw-r--r--src/View/Header.hs42
-rw-r--r--src/View/Icon.hs17
-rw-r--r--src/View/Interval.hs39
-rw-r--r--src/View/LaTeX/Resume.hs148
-rw-r--r--src/View/NotFound.hs26
-rw-r--r--src/View/Page.hs33
-rw-r--r--src/View/Project.hs66
-rw-r--r--src/View/Resume.hs140
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