{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Hakyll.Web.Tags
( Tags (..)
, getTags
, getTagsByField
, getCategory
, buildTagsWith
, buildTags
, buildCategories
, tagsRules
, renderTags
, renderTagCloud
, renderTagCloudWith
, tagCloudField
, tagCloudFieldWith
, renderTagList
, tagsField
, tagsFieldWith
, categoryField
, simpleRenderLink
, sortTagsBy
, caseInsensitiveTags
) where
import Control.Arrow ((&&&))
import Control.Monad (foldM, forM, forM_, mplus)
import Data.Char (toLower)
import Data.List (intercalate, intersperse,
sortBy)
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe)
import Data.Ord (comparing)
import qualified Data.Set as S
import System.FilePath (takeBaseName, takeDirectory)
import Text.Blaze.Html (toHtml, toValue, (!))
import Text.Blaze.Html.Renderer.String (renderHtml)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Hakyll.Core.Compiler
import Hakyll.Core.Dependencies
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Item
import Hakyll.Core.Metadata
import Hakyll.Core.Rules
import Hakyll.Core.Util.String
import Hakyll.Web.Html
import Hakyll.Web.Template.Context
data Tags = Tags
{ Tags -> [([Char], [Identifier])]
tagsMap :: [(String, [Identifier])]
, Tags -> [Char] -> Identifier
tagsMakeId :: String -> Identifier
, Tags -> Dependency
tagsDependency :: Dependency
}
getTags :: MonadMetadata m => Identifier -> m [String]
getTags :: forall (m :: * -> *). MonadMetadata m => Identifier -> m [[Char]]
getTags = [Char] -> Identifier -> m [[Char]]
forall (m :: * -> *).
MonadMetadata m =>
[Char] -> Identifier -> m [[Char]]
getTagsByField [Char]
"tags"
getTagsByField :: MonadMetadata m => String -> Identifier -> m [String]
getTagsByField :: forall (m :: * -> *).
MonadMetadata m =>
[Char] -> Identifier -> m [[Char]]
getTagsByField [Char]
fieldName Identifier
identifier = do
Metadata
metadata <- Identifier -> m Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
identifier
[[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> m [[Char]]) -> [[Char]] -> m [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Maybe [[Char]] -> [[Char]]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [[Char]] -> [[Char]]) -> Maybe [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
([Char] -> Metadata -> Maybe [[Char]]
lookupStringList [Char]
fieldName Metadata
metadata) Maybe [[Char]] -> Maybe [[Char]] -> Maybe [[Char]]
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
trim ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [[Char]]
splitAll [Char]
"," ([Char] -> [[Char]]) -> Maybe [Char] -> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Metadata -> Maybe [Char]
lookupString [Char]
fieldName Metadata
metadata)
getCategory :: MonadMetadata m => Identifier -> m [String]
getCategory :: forall (m :: * -> *). MonadMetadata m => Identifier -> m [[Char]]
getCategory = [[Char]] -> m [[Char]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> m [[Char]])
-> (Identifier -> [[Char]]) -> Identifier -> m [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> [[Char]])
-> (Identifier -> [Char]) -> Identifier -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeBaseName ([Char] -> [Char])
-> (Identifier -> [Char]) -> Identifier -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeDirectory ([Char] -> [Char])
-> (Identifier -> [Char]) -> Identifier -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> [Char]
toFilePath
buildTagsWith :: MonadMetadata m
=> (Identifier -> m [String])
-> Pattern
-> (String -> Identifier)
-> m Tags
buildTagsWith :: forall (m :: * -> *).
MonadMetadata m =>
(Identifier -> m [[Char]])
-> Pattern -> ([Char] -> Identifier) -> m Tags
buildTagsWith Identifier -> m [[Char]]
f Pattern
pattern [Char] -> Identifier
makeId = do
[Identifier]
ids <- Pattern -> m [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches Pattern
pattern
Map [Char] [Identifier]
tagMap <- (Map [Char] [Identifier]
-> Identifier -> m (Map [Char] [Identifier]))
-> Map [Char] [Identifier]
-> [Identifier]
-> m (Map [Char] [Identifier])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map [Char] [Identifier]
-> Identifier -> m (Map [Char] [Identifier])
addTags Map [Char] [Identifier]
forall k a. Map k a
M.empty [Identifier]
ids
let set' :: Set Identifier
set' = [Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
ids
Tags -> m Tags
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tags -> m Tags) -> Tags -> m Tags
forall a b. (a -> b) -> a -> b
$ [([Char], [Identifier])]
-> ([Char] -> Identifier) -> Dependency -> Tags
Tags (Map [Char] [Identifier] -> [([Char], [Identifier])]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] [Identifier]
tagMap) [Char] -> Identifier
makeId (Pattern -> Set Identifier -> Dependency
PatternDependency Pattern
pattern Set Identifier
set')
where
addTags :: Map [Char] [Identifier]
-> Identifier -> m (Map [Char] [Identifier])
addTags Map [Char] [Identifier]
tagMap Identifier
id' = do
[[Char]]
tags <- Identifier -> m [[Char]]
f Identifier
id'
let tagMap' :: Map [Char] [Identifier]
tagMap' = [([Char], [Identifier])] -> Map [Char] [Identifier]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], [Identifier])] -> Map [Char] [Identifier])
-> [([Char], [Identifier])] -> Map [Char] [Identifier]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Identifier]] -> [([Char], [Identifier])]
forall a b. [a] -> [b] -> [(a, b)]
zip [[Char]]
tags ([[Identifier]] -> [([Char], [Identifier])])
-> [[Identifier]] -> [([Char], [Identifier])]
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [[Identifier]]
forall a. a -> [a]
repeat [Identifier
id']
Map [Char] [Identifier] -> m (Map [Char] [Identifier])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map [Char] [Identifier] -> m (Map [Char] [Identifier]))
-> Map [Char] [Identifier] -> m (Map [Char] [Identifier])
forall a b. (a -> b) -> a -> b
$ ([Identifier] -> [Identifier] -> [Identifier])
-> Map [Char] [Identifier]
-> Map [Char] [Identifier]
-> Map [Char] [Identifier]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
(++) Map [Char] [Identifier]
tagMap Map [Char] [Identifier]
tagMap'
buildTags :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags
buildTags :: forall (m :: * -> *).
MonadMetadata m =>
Pattern -> ([Char] -> Identifier) -> m Tags
buildTags = (Identifier -> m [[Char]])
-> Pattern -> ([Char] -> Identifier) -> m Tags
forall (m :: * -> *).
MonadMetadata m =>
(Identifier -> m [[Char]])
-> Pattern -> ([Char] -> Identifier) -> m Tags
buildTagsWith Identifier -> m [[Char]]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [[Char]]
getTags
buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier)
-> m Tags
buildCategories :: forall (m :: * -> *).
MonadMetadata m =>
Pattern -> ([Char] -> Identifier) -> m Tags
buildCategories = (Identifier -> m [[Char]])
-> Pattern -> ([Char] -> Identifier) -> m Tags
forall (m :: * -> *).
MonadMetadata m =>
(Identifier -> m [[Char]])
-> Pattern -> ([Char] -> Identifier) -> m Tags
buildTagsWith Identifier -> m [[Char]]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [[Char]]
getCategory
tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()
tagsRules :: Tags -> ([Char] -> Pattern -> Rules ()) -> Rules ()
tagsRules Tags
tags [Char] -> Pattern -> Rules ()
rules =
[([Char], [Identifier])]
-> (([Char], [Identifier]) -> Rules ()) -> Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Tags -> [([Char], [Identifier])]
tagsMap Tags
tags) ((([Char], [Identifier]) -> Rules ()) -> Rules ())
-> (([Char], [Identifier]) -> Rules ()) -> Rules ()
forall a b. (a -> b) -> a -> b
$ \([Char]
tag, [Identifier]
identifiers) ->
[Dependency] -> Rules () -> Rules ()
forall a. [Dependency] -> Rules a -> Rules a
rulesExtraDependencies [Tags -> Dependency
tagsDependency Tags
tags] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
[Identifier] -> Rules () -> Rules ()
create [Tags -> [Char] -> Identifier
tagsMakeId Tags
tags [Char]
tag] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Pattern -> Rules ()
rules [Char]
tag (Pattern -> Rules ()) -> Pattern -> Rules ()
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Pattern
fromList [Identifier]
identifiers
renderTags :: (String -> String -> Int -> Int -> Int -> String)
-> ([String] -> String)
-> Tags
-> Compiler String
renderTags :: ([Char] -> [Char] -> Int -> Int -> Int -> [Char])
-> ([[Char]] -> [Char]) -> Tags -> Compiler [Char]
renderTags [Char] -> [Char] -> Int -> Int -> Int -> [Char]
makeHtml [[Char]] -> [Char]
concatHtml Tags
tags = do
[(([Char], Maybe [Char]), Int)]
tags' <- [([Char], [Identifier])]
-> (([Char], [Identifier])
-> Compiler (([Char], Maybe [Char]), Int))
-> Compiler [(([Char], Maybe [Char]), Int)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Tags -> [([Char], [Identifier])]
tagsMap Tags
tags) ((([Char], [Identifier]) -> Compiler (([Char], Maybe [Char]), Int))
-> Compiler [(([Char], Maybe [Char]), Int)])
-> (([Char], [Identifier])
-> Compiler (([Char], Maybe [Char]), Int))
-> Compiler [(([Char], Maybe [Char]), Int)]
forall a b. (a -> b) -> a -> b
$ \([Char]
tag, [Identifier]
ids) -> do
Maybe [Char]
route' <- Identifier -> Compiler (Maybe [Char])
getRoute (Identifier -> Compiler (Maybe [Char]))
-> Identifier -> Compiler (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ Tags -> [Char] -> Identifier
tagsMakeId Tags
tags [Char]
tag
(([Char], Maybe [Char]), Int)
-> Compiler (([Char], Maybe [Char]), Int)
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (([Char]
tag, Maybe [Char]
route'), [Identifier] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Identifier]
ids)
let
freqs :: [Int]
freqs = ((([Char], Maybe [Char]), Int) -> Int)
-> [(([Char], Maybe [Char]), Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (([Char], Maybe [Char]), Int) -> Int
forall a b. (a, b) -> b
snd [(([Char], Maybe [Char]), Int)]
tags'
(Int
min', Int
max')
| [Int] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
freqs = (Int
0, Int
1)
| Bool
otherwise = ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> ([Int] -> Int) -> [Int] -> (Int, Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum) [Int]
freqs
makeHtml' :: (([Char], Maybe [Char]), Int) -> [Char]
makeHtml' (([Char]
tag, Maybe [Char]
url), Int
count) =
[Char] -> [Char] -> Int -> Int -> Int -> [Char]
makeHtml [Char]
tag ([Char] -> [Char]
toUrl ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"/" Maybe [Char]
url) Int
count Int
min' Int
max'
[Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char]) -> [Char] -> Compiler [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
concatHtml ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((([Char], Maybe [Char]), Int) -> [Char])
-> [(([Char], Maybe [Char]), Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char], Maybe [Char]), Int) -> [Char]
makeHtml' [(([Char], Maybe [Char]), Int)]
tags'
renderTagCloud :: Double
-> Double
-> Tags
-> Compiler String
renderTagCloud :: Double -> Double -> Tags -> Compiler [Char]
renderTagCloud = (Double
-> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char])
-> ([[Char]] -> [Char])
-> Double
-> Double
-> Tags
-> Compiler [Char]
renderTagCloudWith Double -> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char]
forall {a} {a} {p} {p} {p} {a}.
(ToMarkup a, ToValue a, Integral p, Integral p, Integral p,
RealFrac a) =>
a -> a -> a -> a -> p -> p -> p -> [Char]
makeLink ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" ")
where
makeLink :: a -> a -> a -> a -> p -> p -> p -> [Char]
makeLink a
minSize a
maxSize a
tag a
url p
count p
min' p
max' =
let diff :: a
diff = a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
max' a -> a -> a
forall a. Num a => a -> a -> a
- p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
min'
relative :: a
relative = (p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
count a -> a -> a
forall a. Num a => a -> a -> a
- p -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
min') a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
diff
size :: Int
size = a -> Int
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ a
minSize a -> a -> a
forall a. Num a => a -> a -> a
+ a
relative a -> a -> a
forall a. Num a => a -> a -> a
* (a
maxSize a -> a -> a
forall a. Num a => a -> a -> a
- a
minSize) :: Int
in Html -> [Char]
renderHtml (Html -> [Char]) -> Html -> [Char]
forall a b. (a -> b) -> a -> b
$
Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.style ([Char] -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue ([Char] -> AttributeValue) -> [Char] -> AttributeValue
forall a b. (a -> b) -> a -> b
$ [Char]
"font-size: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"%")
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
url)
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
toHtml a
tag
renderTagCloudWith :: (Double -> Double ->
String -> String -> Int -> Int -> Int -> String)
-> ([String] -> String)
-> Double
-> Double
-> Tags
-> Compiler String
renderTagCloudWith :: (Double
-> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char])
-> ([[Char]] -> [Char])
-> Double
-> Double
-> Tags
-> Compiler [Char]
renderTagCloudWith Double -> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char]
makeLink [[Char]] -> [Char]
cat Double
minSize Double
maxSize =
([Char] -> [Char] -> Int -> Int -> Int -> [Char])
-> ([[Char]] -> [Char]) -> Tags -> Compiler [Char]
renderTags (Double -> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char]
makeLink Double
minSize Double
maxSize) [[Char]] -> [Char]
cat
tagCloudField :: String
-> Double
-> Double
-> Tags
-> Context a
tagCloudField :: forall a. [Char] -> Double -> Double -> Tags -> Context a
tagCloudField [Char]
key Double
minSize Double
maxSize Tags
tags =
[Char] -> (Item a -> Compiler [Char]) -> Context a
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
key ((Item a -> Compiler [Char]) -> Context a)
-> (Item a -> Compiler [Char]) -> Context a
forall a b. (a -> b) -> a -> b
$ \Item a
_ -> Double -> Double -> Tags -> Compiler [Char]
renderTagCloud Double
minSize Double
maxSize Tags
tags
tagCloudFieldWith :: String
-> (Double -> Double ->
String -> String -> Int -> Int -> Int -> String)
-> ([String] -> String)
-> Double
-> Double
-> Tags
-> Context a
tagCloudFieldWith :: forall a.
[Char]
-> (Double
-> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char])
-> ([[Char]] -> [Char])
-> Double
-> Double
-> Tags
-> Context a
tagCloudFieldWith [Char]
key Double -> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char]
makeLink [[Char]] -> [Char]
cat Double
minSize Double
maxSize Tags
tags =
[Char] -> (Item a -> Compiler [Char]) -> Context a
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
key ((Item a -> Compiler [Char]) -> Context a)
-> (Item a -> Compiler [Char]) -> Context a
forall a b. (a -> b) -> a -> b
$ \Item a
_ -> (Double
-> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char])
-> ([[Char]] -> [Char])
-> Double
-> Double
-> Tags
-> Compiler [Char]
renderTagCloudWith Double -> Double -> [Char] -> [Char] -> Int -> Int -> Int -> [Char]
makeLink [[Char]] -> [Char]
cat Double
minSize Double
maxSize Tags
tags
renderTagList :: Tags -> Compiler (String)
renderTagList :: Tags -> Compiler [Char]
renderTagList = ([Char] -> [Char] -> Int -> Int -> Int -> [Char])
-> ([[Char]] -> [Char]) -> Tags -> Compiler [Char]
renderTags [Char] -> [Char] -> Int -> Int -> Int -> [Char]
forall {a} {a} {p} {p}.
(ToValue a, Show a) =>
[Char] -> a -> a -> p -> p -> [Char]
makeLink ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", ")
where
makeLink :: [Char] -> a -> a -> p -> p -> [Char]
makeLink [Char]
tag a
url a
count p
_ p
_ = Html -> [Char]
renderHtml (Html -> [Char]) -> Html -> [Char]
forall a b. (a -> b) -> a -> b
$
Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
url) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rel AttributeValue
"tag" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
toHtml ([Char]
tag [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
count [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")")
tagsFieldWith :: (Identifier -> Compiler [String])
-> (String -> (Maybe FilePath) -> Maybe H.Html)
-> ([H.Html] -> H.Html)
-> String
-> Tags
-> Context a
tagsFieldWith :: forall a.
(Identifier -> Compiler [[Char]])
-> ([Char] -> Maybe [Char] -> Maybe Html)
-> ([Html] -> Html)
-> [Char]
-> Tags
-> Context a
tagsFieldWith Identifier -> Compiler [[Char]]
getTags' [Char] -> Maybe [Char] -> Maybe Html
renderLink [Html] -> Html
cat [Char]
key Tags
tags = [Char] -> (Item a -> Compiler [Char]) -> Context a
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
key ((Item a -> Compiler [Char]) -> Context a)
-> (Item a -> Compiler [Char]) -> Context a
forall a b. (a -> b) -> a -> b
$ \Item a
item -> do
[[Char]]
tags' <- Identifier -> Compiler [[Char]]
getTags' (Identifier -> Compiler [[Char]])
-> Identifier -> Compiler [[Char]]
forall a b. (a -> b) -> a -> b
$ Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item
[Maybe Html]
links <- [[Char]]
-> ([Char] -> Compiler (Maybe Html)) -> Compiler [Maybe Html]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Char]]
tags' (([Char] -> Compiler (Maybe Html)) -> Compiler [Maybe Html])
-> ([Char] -> Compiler (Maybe Html)) -> Compiler [Maybe Html]
forall a b. (a -> b) -> a -> b
$ \[Char]
tag -> do
Maybe [Char]
route' <- Identifier -> Compiler (Maybe [Char])
getRoute (Identifier -> Compiler (Maybe [Char]))
-> Identifier -> Compiler (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ Tags -> [Char] -> Identifier
tagsMakeId Tags
tags [Char]
tag
Maybe Html -> Compiler (Maybe Html)
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Html -> Compiler (Maybe Html))
-> Maybe Html -> Compiler (Maybe Html)
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe [Char] -> Maybe Html
renderLink [Char]
tag Maybe [Char]
route'
[Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char]) -> [Char] -> Compiler [Char]
forall a b. (a -> b) -> a -> b
$ Html -> [Char]
renderHtml (Html -> [Char]) -> Html -> [Char]
forall a b. (a -> b) -> a -> b
$ [Html] -> Html
cat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ [Maybe Html] -> [Html]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Html] -> [Html]) -> [Maybe Html] -> [Html]
forall a b. (a -> b) -> a -> b
$ [Maybe Html]
links
tagsField :: String
-> Tags
-> Context a
tagsField :: forall a. [Char] -> Tags -> Context a
tagsField =
(Identifier -> Compiler [[Char]])
-> ([Char] -> Maybe [Char] -> Maybe Html)
-> ([Html] -> Html)
-> [Char]
-> Tags
-> Context a
forall a.
(Identifier -> Compiler [[Char]])
-> ([Char] -> Maybe [Char] -> Maybe Html)
-> ([Html] -> Html)
-> [Char]
-> Tags
-> Context a
tagsFieldWith Identifier -> Compiler [[Char]]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [[Char]]
getTags [Char] -> Maybe [Char] -> Maybe Html
simpleRenderLink ([Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse Html
", ")
categoryField :: String
-> Tags
-> Context a
categoryField :: forall a. [Char] -> Tags -> Context a
categoryField =
(Identifier -> Compiler [[Char]])
-> ([Char] -> Maybe [Char] -> Maybe Html)
-> ([Html] -> Html)
-> [Char]
-> Tags
-> Context a
forall a.
(Identifier -> Compiler [[Char]])
-> ([Char] -> Maybe [Char] -> Maybe Html)
-> ([Html] -> Html)
-> [Char]
-> Tags
-> Context a
tagsFieldWith Identifier -> Compiler [[Char]]
forall (m :: * -> *). MonadMetadata m => Identifier -> m [[Char]]
getCategory [Char] -> Maybe [Char] -> Maybe Html
simpleRenderLink ([Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> ([Html] -> [Html]) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> [Html] -> [Html]
forall a. a -> [a] -> [a]
intersperse Html
", ")
simpleRenderLink :: String -> (Maybe FilePath) -> Maybe H.Html
simpleRenderLink :: [Char] -> Maybe [Char] -> Maybe Html
simpleRenderLink [Char]
_ Maybe [Char]
Nothing = Maybe Html
forall a. Maybe a
Nothing
simpleRenderLink [Char]
tag (Just [Char]
filePath) = Html -> Maybe Html
forall a. a -> Maybe a
Just (Html -> Maybe Html) -> Html -> Maybe Html
forall a b. (a -> b) -> a -> b
$
Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.title ([Char] -> AttributeValue
H.stringValue ([Char]
"All pages tagged '"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
tag[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"'."))
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href ([Char] -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue ([Char] -> AttributeValue) -> [Char] -> AttributeValue
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
toUrl [Char]
filePath)
(Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! (AttributeValue -> Attribute
A.rel AttributeValue
"tag")
(Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
toHtml [Char]
tag
sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)
-> Tags -> Tags
sortTagsBy :: (([Char], [Identifier]) -> ([Char], [Identifier]) -> Ordering)
-> Tags -> Tags
sortTagsBy ([Char], [Identifier]) -> ([Char], [Identifier]) -> Ordering
f Tags
t = Tags
t {tagsMap = sortBy f (tagsMap t)}
caseInsensitiveTags :: (String, [Identifier]) -> (String, [Identifier])
-> Ordering
caseInsensitiveTags :: ([Char], [Identifier]) -> ([Char], [Identifier]) -> Ordering
caseInsensitiveTags = (([Char], [Identifier]) -> [Char])
-> ([Char], [Identifier]) -> ([Char], [Identifier]) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((([Char], [Identifier]) -> [Char])
-> ([Char], [Identifier]) -> ([Char], [Identifier]) -> Ordering)
-> (([Char], [Identifier]) -> [Char])
-> ([Char], [Identifier])
-> ([Char], [Identifier])
-> Ordering
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower ([Char] -> [Char])
-> (([Char], [Identifier]) -> [Char])
-> ([Char], [Identifier])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], [Identifier]) -> [Char]
forall a b. (a, b) -> a
fst