summaryrefslogtreecommitdiff
path: root/src/Hakyll/Web/Template/Util.hs
blob: 02a46b036579758994196e5aa65713b4bb30eab8 (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
module Hakyll.Web.Template.Util
    ( functionField1
    , slug
    , cat
    , identifierLink
    ) where

import Prolog
import Hakyll
import Hakyll.Web.Template.Context
import Data.String.Slugger
import System.FilePath
import Witherable

functionField1 :: String -> (String -> Compiler String) -> Context a
functionField1 n f = functionField n $ \case
    [x] -> \_ -> f x
    xs -> \_ -> fail $ "Expecting exactly one argument to " <> n <> ". Instead got " <> show (length xs)

slug :: Context a
slug = functionField "slug" $ \strs _ -> pure $ toSlug $ unwords strs

cat :: Context a
cat = functionField "cat" $ \strs _ -> pure $ concat strs


identifierLink :: Context a
identifierLink = functionField1 "identifier" $ \str -> do
    getPaths (fromString str) >>= \case
        [] -> noResult $ "No filepaths match the pattern " <> str
        x@(_:_:_) -> noResult $ "Multiple filepaths match the pattern " <> str <> ": " <> show x
        [x] -> pure x


getPaths :: Pattern -> Compiler [FilePath]
getPaths = getMatches >=> witherM getRoute