summaryrefslogtreecommitdiff
path: root/web/site.hs
blob: cb3ade460df82b01ac9bba4746bae86d24128785 (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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import           Control.Arrow    (second)
import           Control.Monad    (filterM, forM_)
import           Data.List        (isPrefixOf, sortBy)
import           Data.Monoid      ((<>))
import           Data.Ord         (comparing)
import           Hakyll
import           System.Directory (copyFile)
import           System.FilePath  (dropTrailingPathSeparator, splitPath)
import           Text.Pandoc


--------------------------------------------------------------------------------
main :: IO ()
main = hakyllWith config $ do
    -- Copy CHANGELOG.md here.
    preprocess $ copyFile "../CHANGELOG.md" "releases.markdown"

    -- CSS
    match "css/*" $ do
        route   idRoute
        compile compressCssCompiler

    -- Static directories
    forM_ ["images/*", "examples/*"] $ \f -> match f $ do
        route   idRoute
        compile copyFileCompiler

    -- Haddock stuff
    match "reference/**.html" $ do
        route   idRoute
        compile $ fmap (withUrls hackage) <$> getResourceString

    -- Haddock stuff
    match ("reference/**" `mappend` complement "**.html") $ do
        route   idRoute
        compile copyFileCompiler

    -- Pages
    match "*.markdown" $ do
        route   $ setExtension "html"
        compile $ pandocCompiler
            >>= loadAndApplyTemplate "templates/default.html" defaultContext
            >>= relativizeUrls

    -- Tutorials
    match "tutorials/*" $ do
        route   $ setExtension "html"
        compile $ pandocCompilerWith defaultHakyllReaderOptions withToc
            >>= loadAndApplyTemplate "templates/tutorial.html" defaultContext
            >>= loadAndApplyTemplate "templates/default.html" defaultContext
            >>= relativizeUrls

    -- Tutorial list
    create ["tutorials.html"] $ do
        route idRoute
        compile $ do
            ctx <- tutorialsCtx <$>
                sortBy (comparing itemIdentifier) <$> loadAll "tutorials/*"
            makeItem ""
                >>= loadAndApplyTemplate "templates/tutorials.html" ctx
                >>= loadAndApplyTemplate "templates/default.html"   ctx
                >>= relativizeUrls

    -- Templates
    match "templates/*" $ compile templateCompiler
  where
    withToc = defaultHakyllWriterOptions
        { writerTableOfContents = True
        , writerTemplate        = Just "$toc$\n$body$"
        }


--------------------------------------------------------------------------------
config :: Configuration
config = defaultConfiguration
    { deployCommand = "rsync --checksum -ave 'ssh -p 2222' \
                      \_site/* \
                      \jaspervdj@jaspervdj.be:jaspervdj.be/hakyll/"
    }


--------------------------------------------------------------------------------
-- | Turns
--
-- > /usr/share/doc/ghc/html/libraries/base-4.6.0.0/Data-String.html
--
-- into
--
-- > http://hackage.haskell.org/packages/archive/base/4.6.0.0/doc/html/Data-String.html
hackage :: String -> String
hackage url
    | "/usr" `isPrefixOf` url =
        "http://hackage.haskell.org/packages/archive/" ++
        packageName ++ "/" ++ version' ++ "/doc/html/" ++ baseName
    | otherwise               = url
  where
    (packageName, version')  = second (drop 1) $ break (== '-') package
    (baseName : package : _) = map dropTrailingPathSeparator $
        reverse $ splitPath url


--------------------------------------------------------------------------------
-- | Partition tutorials into tutorial series, other articles, external articles
tutorialsCtx :: [Item String] -> Context String
tutorialsCtx tuts =
    constField "title" "Tutorials"                                    <>
    listField "main"          defaultContext (ofType "main")          <>
    listField "articles"      defaultContext (ofType "article")       <>
    listField "externals"     defaultContext (ofType "external")      <>
    listField "robertwpearce" defaultContext (ofType "robertwpearce") <>
    defaultContext
  where
    ofType ty = filterM (\item -> do
        mbType <- getMetadataField (itemIdentifier item) "type"
        return $ Just ty == mbType) tuts