diff options
Diffstat (limited to 'src')
40 files changed, 1547 insertions, 0 deletions
diff --git a/src/Conf.hs b/src/Conf.hs new file mode 100644 index 0000000..cd00fd9 --- /dev/null +++ b/src/Conf.hs @@ -0,0 +1,27 @@ +{-# 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 new file mode 100644 index 0000000..1351ad5 --- /dev/null +++ b/src/Daemon.hs @@ -0,0 +1,18 @@ +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 new file mode 100644 index 0000000..d989d7f --- /dev/null +++ b/src/Daemon/Frequency.hs @@ -0,0 +1,8 @@ +module Daemon.Frequency + ( Frequency(..) + ) where + +data Frequency = + Hourly + | Daily + deriving (Eq, Read, Show) diff --git a/src/Date.hs b/src/Date.hs new file mode 100644 index 0000000..e3c16e5 --- /dev/null +++ b/src/Date.hs @@ -0,0 +1,17 @@ +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 new file mode 100644 index 0000000..bbe20c4 --- /dev/null +++ b/src/Design/Color.hs @@ -0,0 +1,27 @@ +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 new file mode 100644 index 0000000..379d612 --- /dev/null +++ b/src/Design/Global.hs @@ -0,0 +1,66 @@ +{-# 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 new file mode 100644 index 0000000..d2bbace --- /dev/null +++ b/src/Design/Header.hs @@ -0,0 +1,56 @@ +{-# 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 new file mode 100644 index 0000000..77220ee --- /dev/null +++ b/src/Design/Media.hs @@ -0,0 +1,36 @@ +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 new file mode 100644 index 0000000..84c91fb --- /dev/null +++ b/src/Design/Name.hs @@ -0,0 +1,15 @@ +{-# 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 new file mode 100644 index 0000000..ee8a0af --- /dev/null +++ b/src/Design/NotFound.hs @@ -0,0 +1,20 @@ +{-# 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 new file mode 100644 index 0000000..311b7f8 --- /dev/null +++ b/src/Design/Projects.hs @@ -0,0 +1,51 @@ +{-# 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 new file mode 100644 index 0000000..d668987 --- /dev/null +++ b/src/Design/Resume.hs @@ -0,0 +1,125 @@ +{-# 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 new file mode 100644 index 0000000..8b323bf --- /dev/null +++ b/src/Design/Size.hs @@ -0,0 +1,28 @@ +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 new file mode 100644 index 0000000..fd1e076 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main + ( main + ) where + +import Control.Concurrent (forkIO) +import Control.Monad.IO.Class (liftIO) + +import Network.Wai.Middleware.Static + +import Web.Scotty + +import Data.Text.Lazy (isPrefixOf) +import Data.Yaml (decodeFileEither) + +import Model +import Model.Translation.Language + +import View.NotFound (renderNotFound) +import View.Page (renderPage) +import View.Project (renderProjects) +import View.Resume (renderResume) + +import Design.Global (compactDesign) + +import qualified Conf as Conf + +import Date (getCurrentDate) + +import Daemon (runDaemon) + +import Resume (generateResumes) + +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 diff --git a/src/Model.hs b/src/Model.hs new file mode 100644 index 0000000..846d98a --- /dev/null +++ b/src/Model.hs @@ -0,0 +1,25 @@ +{-# 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 new file mode 100644 index 0000000..3069488 --- /dev/null +++ b/src/Model/Company.hs @@ -0,0 +1,13 @@ +{-# 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 new file mode 100644 index 0000000..7edb6fb --- /dev/null +++ b/src/Model/Date.hs @@ -0,0 +1,30 @@ +{-# 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 new file mode 100644 index 0000000..90feacc --- /dev/null +++ b/src/Model/Degree.hs @@ -0,0 +1,18 @@ +{-# 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 new file mode 100644 index 0000000..7581fc5 --- /dev/null +++ b/src/Model/Header.hs @@ -0,0 +1,25 @@ +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 new file mode 100644 index 0000000..fb640fa --- /dev/null +++ b/src/Model/Identity.hs @@ -0,0 +1,14 @@ +{-# 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 new file mode 100644 index 0000000..f6865f4 --- /dev/null +++ b/src/Model/Job.hs @@ -0,0 +1,22 @@ +{-# 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 new file mode 100644 index 0000000..7825e60 --- /dev/null +++ b/src/Model/Project.hs @@ -0,0 +1,18 @@ +{-# 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 new file mode 100644 index 0000000..cb10ed9 --- /dev/null +++ b/src/Model/School.hs @@ -0,0 +1,13 @@ +{-# 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 new file mode 100644 index 0000000..3e533b8 --- /dev/null +++ b/src/Model/SkillType.hs @@ -0,0 +1,15 @@ +{-# 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 new file mode 100644 index 0000000..b92ae39 --- /dev/null +++ b/src/Model/Translated.hs @@ -0,0 +1,19 @@ +{-# 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 new file mode 100644 index 0000000..43381fb --- /dev/null +++ b/src/Model/Translation/Key.hs @@ -0,0 +1,28 @@ +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 new file mode 100644 index 0000000..a8f5eb9 --- /dev/null +++ b/src/Model/Translation/Language.hs @@ -0,0 +1,12 @@ +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 new file mode 100644 index 0000000..c9e0fcb --- /dev/null +++ b/src/Model/Translation/Message.hs @@ -0,0 +1,90 @@ +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 new file mode 100644 index 0000000..a002b38 --- /dev/null +++ b/src/PDF.hs @@ -0,0 +1,41 @@ +{-# 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 new file mode 100644 index 0000000..9b691c6 --- /dev/null +++ b/src/Resume.hs @@ -0,0 +1,34 @@ +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 new file mode 100644 index 0000000..44cdf03 --- /dev/null +++ b/src/Utils/String.hs @@ -0,0 +1,21 @@ +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 new file mode 100644 index 0000000..abf5226 --- /dev/null +++ b/src/View/Git.hs @@ -0,0 +1,37 @@ +{-# 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 new file mode 100644 index 0000000..a29b9a3 --- /dev/null +++ b/src/View/Header.hs @@ -0,0 +1,42 @@ +{-# 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 new file mode 100644 index 0000000..67db0a9 --- /dev/null +++ b/src/View/Icon.hs @@ -0,0 +1,17 @@ +{-# 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 new file mode 100644 index 0000000..05cb62c --- /dev/null +++ b/src/View/Interval.hs @@ -0,0 +1,39 @@ +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 new file mode 100644 index 0000000..6ec717f --- /dev/null +++ b/src/View/LaTeX/Resume.hs @@ -0,0 +1,148 @@ +{-# 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 new file mode 100644 index 0000000..c16eb6c --- /dev/null +++ b/src/View/NotFound.hs @@ -0,0 +1,26 @@ +{-# 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 new file mode 100644 index 0000000..b7267e8 --- /dev/null +++ b/src/View/Page.hs @@ -0,0 +1,33 @@ +{-# 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 new file mode 100644 index 0000000..a5aaf2c --- /dev/null +++ b/src/View/Project.hs @@ -0,0 +1,66 @@ +{-# 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 new file mode 100644 index 0000000..ffd5c8c --- /dev/null +++ b/src/View/Resume.hs @@ -0,0 +1,140 @@ +{-# 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 |