summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll/Metadata.hs
blob: 7698dad1ece127ffcb61ec011d9d3d648e95f52e (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
-- | This module exports a number of functions to manipulate metadata of
-- resources
--
module Text.Hakyll.ContextManipulations
    ( renderValue
    , changeValue
    , changeUrl
    , copyValue
    , renderDate
    , renderDateWithLocale
    , changeExtension
    ) where

import System.Locale (TimeLocale, defaultTimeLocale)
import System.FilePath (takeFileName, addExtension, dropExtension)
import Data.Time.Format (parseTime, formatTime)
import Data.Time.Clock (UTCTime)
import Data.Maybe (fromMaybe)
import qualified Data.Map as M

import Text.Hakyll.Regex (substituteRegex)
import Text.Hakyll.Transformer (Transformer (..), transformMetadata)
import Text.Hakyll.Resource

-- | Do something with a value in a @Context@, but keep the old value as well.
--   If the key given is not present in the @Context@, nothing will happen.
--
renderValue :: String              -- ^ Key of which the value should be copied.
            -> String              -- ^ Key the value should be copied to.
            -> (String -> String)  -- ^ Function to apply on the value.
            -> Transformer a a     -- ^ Resulting transformer
renderValue source destination f = transformMetadata $ \(Metadata m) ->
    Metadata $ case M.lookup source m of
        Nothing      -> m
        (Just value) -> M.insert destination (f value) m

-- | Change a value in the metadata
--
--   > import Data.Char (toUpper)
--   > changeValue "title" (map toUpper)
--
--   Will put the title in UPPERCASE.
changeValue :: String              -- ^ Key to change.
            -> (String -> String)  -- ^ Function to apply on the value.
            -> Transformer a a
changeValue key = renderValue key key

-- | Change the URL of a page. You should always use this function instead of
-- 'changeValue' for this, because using 'changeValue' might break dependency
-- handling when changing the @url@ field.
-- 
changeUrl :: (String -> String)  -- ^ Function to change URL with.
          -> Transformer a a     -- ^ Resulting action.
changeUrl f = let t = changeValue "url" f
              in t {transformerUrl = return . f}

-- | Copy a metadata value from one key to another
--
copyValue :: String           -- ^ Source key.
          -> String           -- ^ Destination key.
          -> Transformer a a  -- ^ Resulting transformer
copyValue source destination = renderValue source destination id

-- | When the context has a key called @path@ in a
--   @folder/yyyy-mm-dd-title.extension@ format (the convention for pages),
--   this function can render the date.
--
--   > renderDate "date" "%B %e, %Y" "Date unknown"
--
--   Will render something like @January 32, 2010@.
--
renderDate :: String -- ^ Key in which the rendered date should be placed.
           -> String -- ^ Format to use on the date.
           -> String -- ^ Default key, in case the date cannot be parsed.
           -> Transformer a a
renderDate = renderDateWithLocale defaultTimeLocale

-- | This is an extended version of 'renderDate' that allows you to specify a
-- time locale that is used for outputting the date. For more details, see
-- 'renderDate'.
--
renderDateWithLocale :: TimeLocale  -- ^ Output time locale.
                     -> String      -- ^ Destination key.
                     -> String      -- ^ Format to use on the date.
                     -> String      -- ^ Default key.
                     -> Transformer a a
renderDateWithLocale locale key format defaultValue =
    renderValue "path" key renderDate'
  where
    renderDate' filePath = fromMaybe defaultValue $ do
        let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
                                         (takeFileName filePath)
        time <- parseTime defaultTimeLocale
                          "%Y-%m-%d"
                          dateString :: Maybe UTCTime
        return $ formatTime locale format time

-- | Change the extension of a file. This is only needed when you want to
--   render, for example, mardown to @.php@ files instead of @.html@ files.
--
--   > changeExtension "php"
--
--   Will render @test.markdown@ to @test.php@ instead of @test.html@.
changeExtension :: String           -- ^ Extension to change to.
                -> Transformer a a  -- ^ Resulting transformer
changeExtension extension = changeValue "url" changeExtension'
  where
    changeExtension' = flip addExtension extension . dropExtension