diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 3.0.2.0 +Version: 3.0.2.1 Synopsis: A simple static site generator library. Description: A simple static site generator library, mainly aimed at @@ -75,7 +75,7 @@ Hakyll.Web.Feed Hakyll.Web.Tags Hakyll.Web.Pandoc - Hakyll.Web.FileType + Hakyll.Web.Pandoc.FileType Hakyll.Web.Page Hakyll.Web.Template.Read Hakyll.Web.RelativizeUrls diff --git a/src/Hakyll.hs b/src/Hakyll.hs --- a/src/Hakyll.hs +++ b/src/Hakyll.hs @@ -19,11 +19,11 @@ , module Hakyll.Web.Blaze , module Hakyll.Web.CompressCss , module Hakyll.Web.Feed - , module Hakyll.Web.FileType , module Hakyll.Web.Page , module Hakyll.Web.Page.Metadata , module Hakyll.Web.Page.Read , module Hakyll.Web.Pandoc + , module Hakyll.Web.Pandoc.FileType , module Hakyll.Web.RelativizeUrls , module Hakyll.Web.Tags , module Hakyll.Web.Template @@ -48,11 +48,11 @@ import Hakyll.Web.Blaze import Hakyll.Web.CompressCss import Hakyll.Web.Feed -import Hakyll.Web.FileType import Hakyll.Web.Page import Hakyll.Web.Page.Metadata import Hakyll.Web.Page.Read import Hakyll.Web.Pandoc +import Hakyll.Web.Pandoc.FileType import Hakyll.Web.RelativizeUrls import Hakyll.Web.Tags import Hakyll.Web.Template diff --git a/src/Hakyll/Web/FileType.hs b/src/Hakyll/Web/FileType.hs deleted file mode 100644 --- a/src/Hakyll/Web/FileType.hs +++ /dev/null @@ -1,55 +0,0 @@ --- | A module dealing with common file extensions and associated file types. --- -module Hakyll.Web.FileType - ( FileType (..) - , fileType - , getFileType - ) where - -import System.FilePath (takeExtension) -import Control.Arrow ((>>^)) - -import Hakyll.Core.Identifier -import Hakyll.Core.Compiler - --- | Datatype to represent the different file types Hakyll can deal with by --- default --- -data FileType - = Html - | LaTeX - | LiterateHaskell FileType - | Markdown - | Rst - | PlainText - | Css - | Binary - deriving (Eq, Ord, Show, Read) - --- | Get the file type for a certain file. The type is determined by extension. --- -fileType :: FilePath -> FileType -fileType = fileType' . takeExtension - where - fileType' ".htm" = Html - fileType' ".html" = Html - fileType' ".lhs" = LiterateHaskell Markdown - fileType' ".markdown" = Markdown - fileType' ".md" = Markdown - fileType' ".mdn" = Markdown - fileType' ".mdown" = Markdown - fileType' ".mdwn" = Markdown - fileType' ".mkd" = Markdown - fileType' ".mkdwn" = Markdown - fileType' ".page" = Markdown - fileType' ".rst" = Rst - fileType' ".tex" = LaTeX - fileType' ".text" = PlainText - fileType' ".txt" = PlainText - fileType' ".css" = Css - fileType' _ = Binary -- Treat unknown files as binary - --- | Get the file type for the current file --- -getFileType :: Compiler a FileType -getFileType = getIdentifier >>^ fileType . toFilePath diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs --- a/src/Hakyll/Web/Pandoc.hs +++ b/src/Hakyll/Web/Pandoc.hs @@ -26,7 +26,7 @@ import Text.Pandoc import Hakyll.Core.Compiler -import Hakyll.Web.FileType +import Hakyll.Web.Pandoc.FileType import Hakyll.Web.Page.Internal -- | Read a string using pandoc, with the default options diff --git a/src/Hakyll/Web/Pandoc/FileType.hs b/src/Hakyll/Web/Pandoc/FileType.hs new file mode 100644 --- /dev/null +++ b/src/Hakyll/Web/Pandoc/FileType.hs @@ -0,0 +1,55 @@ +-- | A module dealing with pandoc file extensions and associated file types +-- +module Hakyll.Web.Pandoc.FileType + ( FileType (..) + , fileType + , getFileType + ) where + +import System.FilePath (takeExtension) +import Control.Arrow ((>>^)) + +import Hakyll.Core.Identifier +import Hakyll.Core.Compiler + +-- | Datatype to represent the different file types Hakyll can deal with by +-- default +-- +data FileType + = Html + | LaTeX + | LiterateHaskell FileType + | Markdown + | Rst + | PlainText + | Css + | Binary + deriving (Eq, Ord, Show, Read) + +-- | Get the file type for a certain file. The type is determined by extension. +-- +fileType :: FilePath -> FileType +fileType = fileType' . takeExtension + where + fileType' ".htm" = Html + fileType' ".html" = Html + fileType' ".lhs" = LiterateHaskell Markdown + fileType' ".markdown" = Markdown + fileType' ".md" = Markdown + fileType' ".mdn" = Markdown + fileType' ".mdown" = Markdown + fileType' ".mdwn" = Markdown + fileType' ".mkd" = Markdown + fileType' ".mkdwn" = Markdown + fileType' ".page" = Markdown + fileType' ".rst" = Rst + fileType' ".tex" = LaTeX + fileType' ".text" = PlainText + fileType' ".txt" = PlainText + fileType' ".css" = Css + fileType' _ = Binary -- Treat unknown files as binary + +-- | Get the file type for the current file +-- +getFileType :: Compiler a FileType +getFileType = getIdentifier >>^ fileType . toFilePath diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs --- a/src/Hakyll/Web/Tags.hs +++ b/src/Hakyll/Web/Tags.hs @@ -32,6 +32,7 @@ , readTags , readCategory , renderTagCloud + , renderTagList , renderTagsField , renderCategoryField ) where @@ -41,7 +42,7 @@ import Control.Applicative ((<$>)) import Data.Map (Map) import qualified Data.Map as M -import Data.List (intersperse) +import Data.List (intersperse, intercalate) import Control.Arrow (arr, (&&&), (>>>), (***), (<<^), returnA) import Data.Maybe (catMaybes, fromMaybe) import Data.Monoid (mconcat) @@ -108,13 +109,17 @@ readCategory :: [Page a] -> Tags a readCategory = readTagsWith getCategory --- | Render a tag cloud in HTML +-- | Render tags in HTML -- -renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag - -> Double -- ^ Smallest font size, in percent - -> Double -- ^ Biggest font size, in percent - -> Compiler (Tags a) String -- ^ Tag cloud renderer -renderTagCloud makeUrl minSize maxSize = proc (Tags tags) -> do +renderTags :: (String -> Identifier) + -- ^ Produce a link + -> (String -> String -> Int -> Int -> Int -> String) + -- ^ Produce a tag item: tag, url, count, min count, max count + -> ([String] -> String) + -- ^ Join items + -> Compiler (Tags a) String + -- ^ Tag cloud renderer +renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do -- In tags' we create a list: [((tag, route), count)] tags' <- mapCompiler ((id &&& (getRouteFor <<^ makeUrl)) *** arr length) -< M.toList tags @@ -122,28 +127,47 @@ let -- Absolute frequencies of the pages freqs = map snd tags' - -- Find out the relative count of a tag: on a scale from 0 to 1 - relative count = (fromIntegral count - min') / (1 + max' - min') - - -- Show the relative size of one 'count' in percent - size count = - let size' = floor $ minSize + relative count * (maxSize - minSize) - in show (size' :: Int) ++ "%" - - -- The minimum and maximum count found, as doubles + -- The minimum and maximum count found (min', max') | null freqs = (0, 1) - | otherwise = (minimum &&& maximum) $ map fromIntegral freqs + | otherwise = (minimum &&& maximum) freqs -- Create a link for one item - makeLink ((tag, url), count) = - H.a ! A.style (toValue $ "font-size: " ++ size count) - ! A.href (toValue $ toUrl $ fromMaybe "/" url) - $ toHtml tag + makeItem' ((tag, url), count) = + makeItem tag (toUrl $ fromMaybe "/" url) count min' max' -- Render and return the HTML - returnA -< renderHtml $ mconcat $ intersperse " " $ map makeLink tags' + returnA -< concatItems $ map makeItem' tags' +-- | Render a tag cloud in HTML +-- +renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag + -> Double -- ^ Smallest font size, in percent + -> Double -- ^ Biggest font size, in percent + -> Compiler (Tags a) String -- ^ Tag cloud renderer +renderTagCloud makeUrl minSize maxSize = + renderTags makeUrl makeLink (intercalate " ") + where + makeLink tag url count min' max' = renderHtml $ + H.a ! A.style (toValue $ "font-size: " ++ size count min' max') + ! A.href (toValue url) + $ toHtml tag + + -- Show the relative size of one 'count' in percent + size count min' max' = + let diff = 1 + fromIntegral max' - fromIntegral min' + relative = (fromIntegral count - fromIntegral min') / diff + size' = floor $ minSize + relative * (maxSize - minSize) + in show (size' :: Int) ++ "%" + +-- | Render a simple tag list in HTML, with the tag count next to the item +-- +renderTagList :: (String -> Identifier) -> Compiler (Tags a) (String) +renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ") + where + makeLink tag url count _ _ = renderHtml $ + H.a ! A.href (toValue url) $ toHtml (tag ++ "(" ++ show count ++ ")") + -- | Render tags with links -- renderTagsFieldWith :: (Page a -> [String]) -- ^ Function to get the tags @@ -151,14 +175,14 @@ -> (String -> Identifier) -- ^ Create a link for a tag -> Compiler (Page a) (Page a) -- ^ Resulting compiler renderTagsFieldWith tags destination makeUrl = - id &&& arr tags >>> setFieldA destination renderTags + id &&& arr tags >>> setFieldA destination renderTags' where -- Compiler creating a comma-separated HTML string for a list of tags - renderTags :: Compiler [String] String - renderTags = arr (map $ id &&& makeUrl) - >>> mapCompiler (id *** getRouteFor) - >>> arr (map $ uncurry renderLink) - >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes) + renderTags' :: Compiler [String] String + renderTags' = arr (map $ id &&& makeUrl) + >>> mapCompiler (id *** getRouteFor) + >>> arr (map $ uncurry renderLink) + >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes) -- Render one tag link renderLink _ Nothing = Nothing