aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
blob: fd1e076fcd08ee956cac75a8e74ad7737199c80d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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