{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Data.Char (toLower)

import Data.List (isSuffixOf)

import Data.Maybe (fromMaybe)

import Data.Monoid ((<>))

import Hakyll

import System.Environment

import System.FilePath

import Text.Jasmine

import Text.Pandoc

import qualified Data.ByteString.Lazy.Char8 as C

main :: IO ()

main = getEnvironment >>= (hakyllWith configuration . rules)

sitePort :: Int

sitePort = 4000

supportedLanguages :: [String]

supportedLanguages = [ -- Name here the directories of the programming languages to be supported

"elixir"

, "haskell"

, "functional-full-stack" -- Haskell backend + PureScript frontend

, "java"

, "python"

, "reason"

]

markdownPattern :: Pattern

markdownPattern = filePattern "md"

imagePattern :: Pattern

imagePattern = filePattern "png"

filePattern :: String -> Pattern

filePattern extension = foldl (.||.) (head patterns) (tail patterns)

where

patterns = fmap (\dir -> fromGlob $ "tutorials/" ++ dir ++ "/*/*." ++ extension) supportedLanguages

configuration :: Configuration

configuration =

defaultConfiguration

{ ignoreFile = ignoreFile'

, previewPort = sitePort

}

where

ignoreFile' path =

ignoreFile defaultConfiguration path

|| takeFileName path `elem` ["makefile", "stack.yaml"]

cleanIndexUrls :: Item String -> Compiler (Item String)

cleanIndexUrls = return . fmap (withUrls cleanIndex)

cleanIndexHtmls :: Item String -> Compiler (Item String)

cleanIndexHtmls = return . fmap (replaceAll pattern' replacement)

where

pattern' = "/index.html"

replacement = const "/"

cleanIndex :: String -> String

cleanIndex url

| idx `isSuffixOf` url = take (length url - length idx) url

| otherwise = url

where idx = "index.html"

rules :: [(String, String)] -> Rules ()

rules env = do

let commonCtx = commonContext Blog env

datedCtx = datedContext env

tutorialCtx = tutorialContext env

create ["archive.html"] $ do

route idRoute

compile $ do

tutorials <- recentFirst =<< loadAll markdownPattern

let

title = "Archives"

archiveContext =

listField "tutorials" tutorialCtx (return tutorials)

<> constField "title" title

<> constField "title-list" title

<> commonCtx

makeItem ""

>>= loadAndApplyTemplate "templates/archive.html" archiveContext

>>= loadAndApplyTemplate "templates/default.html" archiveContext

>>= relativizeUrls

>>= cleanIndexUrls

match "tutorials/index.html" $ do

route idRoute

compile $ do

tutorials <- recentFirst =<< loadAll markdownPattern

let

indexContext =

listField "tutorials" tutorialCtx (return tutorials)

<> constField "title" "Home"

<> constField "title-list" ""

<> commonCtx

getResourceBody

>>= applyAsTemplate indexContext

>>= loadAndApplyTemplate "templates/default.html" indexContext

>>= relativizeUrls

>>= cleanIndexUrls

match "tutorials/stylesheets/*" $ do

route idRoute

compile compressCssCompiler

match "tutorials/javascripts/*" $ do

route idRoute

compile compressJsCompiler

match "templates/*" (compile templateCompiler)

match "tutorials/*.png" $ do

route idRoute

compile copyFileCompiler

tags <- buildTags markdownPattern (fromCapture "tutorials/tags/*.html")

tagsRules tags $ \tag pattern -> do

let title = "Posts tagged \"" ++ tag ++ "\""

route idRoute

compile $ do

tutorials <- recentFirst =<< loadAll pattern

let ctx = constField "title" title

`mappend` constField "title-list" title

`mappend` listField "tutorials" tutorialCtx (return tutorials)

`mappend` defaultContext

`mappend` commonCtx

makeItem ""

>>= loadAndApplyTemplate "templates/tag.html" ctx

>>= loadAndApplyTemplate "templates/default.html" ctx

>>= relativizeUrls

match markdownPattern $ do

let

tutorialRoute i = takeDirectory p </> "index.html"

where p = toFilePath i

route (customRoute tutorialRoute)

compile $

tutorialsCompiler

>>= loadAndApplyTemplate "templates/tutorial.html" (tutorialCtxWithTags env tags)

>>= loadAndApplyTemplate "templates/default.html" (tutorialCtxWithTags env tags)

>>= relativizeUrls

>>= cleanIndexUrls

match imagePattern $ do

route idRoute

compile copyFileCompiler

create ["tutorials/sitemap.xml"] $ do

route idRoute

compile $ do

posts <- recentFirst =<< loadAll markdownPattern

let allPosts = return posts

let sitemapCtx = listField "entries" tutorialCtx allPosts

makeItem ("" :: String)

>>= loadAndApplyTemplate "templates/sitemap.xml" sitemapCtx

>>= cleanIndexHtmls

let pumpFeedPosts =

fmap (take 10) . recentFirst =<< loadAll markdownPattern

create ["tutorials/atom.xml"] $ do

route idRoute

compile (pumpFeedPosts >>= renderAtom feedConfiguration datedCtx)

create ["tutorials/rss.xml"] $ do

route idRoute

compile (pumpFeedPosts >>= renderRss feedConfiguration datedCtx)

tutorialCtxWithTags :: [(String, String)] -> Tags -> Context String

tutorialCtxWithTags env tags = do

let tutorialCtx = tutorialContext env

tagsField "tags" tags `mappend` tutorialCtx

feedConfiguration :: FeedConfiguration

feedConfiguration =

FeedConfiguration

{ feedTitle = "Stack Builders' Tutorials"

, feedDescription = "Tutorials about tech Stack Builders consider important to promote"

, feedAuthorName = "Stack Builders"

, feedAuthorEmail = "info@stackbuilders.com"

, feedRoot = "https://stackbuilders.com"

}

data Hero

= Blog

| Post

deriving Show

commonContext :: Hero -> [(String, String)] -> Context String

commonContext hero env =

let

readEnv d key = fromMaybe d $ lookup key env

host = readEnv ("//localhost:" ++ show sitePort) "SITE_ROOT_URL"

protocol = readEnv "http:" "SITE_PROTOCOL"

in

constField "host" host

<> constField "protocol" protocol

<> constField "hero" (map toLower (show hero))

<> defaultContext

datedContext :: [(String, String)] -> Context String

datedContext env = dateField "published" "%B %e, %Y" <> commonContext Post env

tutorialContext :: [(String, String)] -> Context String

tutorialContext env = libs <> datedContext env

where

libs = listFieldWith "libs" libraryContext $ \item -> do

libraries <- getMetadataField' (itemIdentifier item) "libraries"

mapM makeItem (words libraries)

libraryContext = field "lib" (return . itemBody)

tutorialsCompiler :: Compiler (Item String)

tutorialsCompiler = pandocCompilerWith defaultTutorialsReaderOptions defaultHakyllWriterOptions

defaultTutorialsReaderOptions :: ReaderOptions

defaultTutorialsReaderOptions = defaultHakyllReaderOptions

{ readerSmart = False

}

compressJsCompiler :: Compiler (Item String)

compressJsCompiler = do

let minifyJS = C.unpack . minify . C.pack . itemBody

source <- getResourceString

return $ itemSetBody (minifyJS source) source