0954e89 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Merge pull request #134 from ian-ross/master

0954e89Jasper Van der Jeugt14 years ago

src/Hakyll/Web/Html.hs+1−1

compare with master

unifiedsplit

@@ -54,7 +54,7 @@ demoteHeaders = withTags $ \tag -> case tag of

55--------------------------------------------------------------------------------

56isUrlAttribute :: String -> Bool

57−isUrlAttribute = (`elem` ["src", "href"])

57+isUrlAttribute = (`elem` ["src", "href", "data"])

60--------------------------------------------------------------------------------

src/Hakyll/Web/Tags.hs+96−23

@@ -49,8 +49,12 @@ module Hakyll.Web.Tags

49 , tagsRules

50 , renderTags

51 , renderTagCloud

52+ , renderTagCloudWith

53+ , tagCloudField

54+ , tagCloudFieldWith

52 , renderTagList

55 , renderTagList

53 , tagsField

56 , tagsField

57+ , tagsFieldWith

54 , categoryField

58 , categoryField

55 , sortTagsBy

59 , sortTagsBy

56 , caseInsensitiveTags

60 , caseInsensitiveTags

@@ -184,7 +188,6 @@ renderTags makeHtml concatHtml tags = do

184

188

185--------------------------------------------------------------------------------

189--------------------------------------------------------------------------------

186-- | Render a tag cloud in HTML

190-- | Render a tag cloud in HTML

187−-- TODO: Maybe produce a Context here

188renderTagCloud :: Double

191renderTagCloud :: Double

189 -- ^ Smallest font size, in percent

192 -- ^ Smallest font size, in percent

190 -> Double

193 -> Double

@@ -193,19 +196,75 @@ renderTagCloud :: Double

193 -- ^ Input tags

196 -- ^ Input tags

194 -> Compiler String

197 -> Compiler String

195 -- ^ Rendered cloud

198 -- ^ Rendered cloud

196−renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ")

199+renderTagCloud = renderTagCloudWith makeLink (intercalate " ")

197 where

200 where

198− makeLink tag url count min' max' = renderHtml $

201+ makeLink minSize maxSize tag url count min' max' = renderHtml $

199 H.a ! A.style (toValue $ "font-size: " ++ size count min' max')

202 H.a ! A.style (toValue $ "font-size: " ++ size count min' max')

200 ! A.href (toValue url)

203 ! A.href (toValue url)

201 $ toHtml tag

204 $ toHtml tag

205+ where

206+ -- Show the relative size of one 'count' in percent

207+ size count min' max' =

208+ let diff = 1 + fromIntegral max' - fromIntegral min'

209+ relative = (fromIntegral count - fromIntegral min') / diff

210+ size' = floor $ minSize + relative * (maxSize - minSize)

211+ in show (size' :: Int) ++ "%"

212+

213+

214+--------------------------------------------------------------------------------

215+-- | Render a tag cloud in HTML

216+renderTagCloudWith :: (Double -> Double ->

217+ String -> String -> Int -> Int -> Int -> String)

218+ -- ^ Render a single tag link

219+ -> ([String] -> String)

220+ -- ^ Concatenate links

221+ -> Double

222+ -- ^ Smallest font size, in percent

223+ -> Double

224+ -- ^ Biggest font size, in percent

225+ -> Tags

226+ -- ^ Input tags

227+ -> Compiler String

228+ -- ^ Rendered cloud

229+renderTagCloudWith makeLink cat minSize maxSize =

230+ renderTags (makeLink minSize maxSize) cat

231+

232+

233+--------------------------------------------------------------------------------

234+-- | Render a tag cloud in HTML as a context

235+tagCloudField :: String

236+ -- ^ Destination key

237+ -> Double

238+ -- ^ Smallest font size, in percent

239+ -> Double

240+ -- ^ Biggest font size, in percent

241+ -> Tags

242+ -- ^ Input tags

243+ -> Context a

244+ -- ^ Context

245+tagCloudField key minSize maxSize tags =

246+ field key $ \_ -> renderTagCloud minSize maxSize tags

247+

202

248

203− -- Show the relative size of one 'count' in percent

249+--------------------------------------------------------------------------------

204− size count min' max' =

250+-- | Render a tag cloud in HTML as a context

205− let diff = 1 + fromIntegral max' - fromIntegral min'

251+tagCloudFieldWith :: String

206− relative = (fromIntegral count - fromIntegral min') / diff

252+ -- ^ Destination key

207− size' = floor $ minSize + relative * (maxSize - minSize)

253+ -> (Double -> Double ->

208− in show (size' :: Int) ++ "%"

254+ String -> String -> Int -> Int -> Int -> String)

255+ -- ^ Render a single tag link

256+ -> ([String] -> String)

257+ -- ^ Concatenate links

258+ -> Double

259+ -- ^ Smallest font size, in percent

260+ -> Double

261+ -- ^ Biggest font size, in percent

262+ -> Tags

263+ -- ^ Input tags

264+ -> Context a

265+ -- ^ Context

266+tagCloudFieldWith key makeLink cat minSize maxSize tags =

267+ field key $ \_ -> renderTagCloudWith makeLink cat minSize maxSize tags

209

268

210

269

211--------------------------------------------------------------------------------

270--------------------------------------------------------------------------------

@@ -219,23 +278,27 @@ renderTagList = renderTags makeLink (intercalate ", ")

219

278

220

279

221--------------------------------------------------------------------------------

280--------------------------------------------------------------------------------

222−-- | Render tags with links with custom function to get tags

281+-- | Render tags with links with custom functions to get tags and to

282+-- render links

223−tagsFieldWith :: (Identifier -> Compiler [String]) -- ^ Get the tags

283+tagsFieldWith :: (Identifier -> Compiler [String])

284+ -- ^ Get the tags

285+ -> (String -> (Maybe FilePath) -> Maybe H.Html)

286+ -- ^ Render link for one tag

287+ -> ([H.Html] -> H.Html)

288+ -- ^ Concatenate tag links

289+ -> String

224− -> String -- ^ Destination field

290+ -- ^ Destination field

291+ -> Tags

225− -> Tags -- ^ Tags structure

292+ -- ^ Tags structure

293+ -> Context a

226− -> Context a -- ^ Resulting context

294+ -- ^ Resulting context

227−tagsFieldWith getTags' key tags = field key $ \item -> do

295+tagsFieldWith getTags' renderLink cat key tags = field key $ \item -> do

228 tags' <- getTags' $ itemIdentifier item

296 tags' <- getTags' $ itemIdentifier item

229 links <- forM tags' $ \tag -> do

297 links <- forM tags' $ \tag -> do

230 route' <- getRoute $ tagsMakeId tags tag

298 route' <- getRoute $ tagsMakeId tags tag

231 return $ renderLink tag route'

299 return $ renderLink tag route'

232

300

233− return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links

301+ return $ renderHtml $ cat $ catMaybes $ links

234− where

235− -- Render one tag link

236− renderLink _ Nothing = Nothing

237− renderLink tag (Just filePath) = Just $

238− H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag

239

302

240

303

241--------------------------------------------------------------------------------

304--------------------------------------------------------------------------------

@@ -243,7 +306,8 @@ tagsFieldWith getTags' key tags = field key $ \item -> do

243tagsField :: String -- ^ Destination key

306tagsField :: String -- ^ Destination key

244 -> Tags -- ^ Tags

307 -> Tags -- ^ Tags

245 -> Context a -- ^ Context

308 -> Context a -- ^ Context

309+tagsField =

246−tagsField = tagsFieldWith getTags

310+ tagsFieldWith getTags simpleRenderLink (mconcat . intersperse ", ")

247

311

248

312

249--------------------------------------------------------------------------------

313--------------------------------------------------------------------------------

@@ -251,7 +315,16 @@ tagsField = tagsFieldWith getTags

251categoryField :: String -- ^ Destination key

315categoryField :: String -- ^ Destination key

252 -> Tags -- ^ Tags

316 -> Tags -- ^ Tags

253 -> Context a -- ^ Context

317 -> Context a -- ^ Context

254−categoryField = tagsFieldWith getCategory

318+categoryField =

319+ tagsFieldWith getCategory simpleRenderLink (mconcat . intersperse ", ")

320+

321+

322+--------------------------------------------------------------------------------

323+-- | Render one tag link

324+simpleRenderLink :: String -> (Maybe FilePath) -> Maybe H.Html

325+simpleRenderLink _ Nothing = Nothing

326+simpleRenderLink tag (Just filePath) =

327+ Just $ H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag

255

328

256

329

257--------------------------------------------------------------------------------

330--------------------------------------------------------------------------------