Move src/ to lib/, put Init.hs in src/

1 files changed, 0 insertions, 344 deletions

diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
deleted file mode 100644
index 88119c2..0000000
--- a/src/Hakyll/Web/Tags.hs
+++ /dev/null
@@ -1,344 +0,0 @@
---------------------------------------------------------------------------------
--- | This module containing some specialized functions to deal with tags. It
--- assumes you follow some conventions.
---
--- We support two types of tags: tags and categories.
---
--- To use default tags, use 'buildTags'. Tags are placed in a comma-separated
--- metadata field like this:
---
--- > ---
--- > author: Philip K. Dick
--- > title: Do androids dream of electric sheep?
--- > tags: future, science fiction, humanoid
--- > ---
--- > The novel is set in a post-apocalyptic near future, where the Earth and
--- > its populations have been damaged greatly by Nuclear...
---
--- To use categories, use the 'buildCategories' function. Categories are
--- determined by the directory a page is in, for example, the post
---
--- > posts/coding/2010-01-28-hakyll-categories.markdown
---
--- will receive the @coding@ category.
---
--- Advanced users may implement custom systems using 'buildTagsWith' if desired.
---
--- In the above example, we would want to create a page which lists all pages in
--- the @coding@ category, for example, with the 'Identifier':
---
--- > tags/coding.html
---
--- This is where the first parameter of 'buildTags' and 'buildCategories' comes
--- in. In the above case, we used the function:
---
--- > fromCapture "tags/*.html" :: String -> Identifier
---
--- The 'tagsRules' function lets you generate such a page for each tag in the
--- 'Rules' monad.
-{-# LANGUAGE Arrows                     #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings          #-}
-module Hakyll.Web.Tags
-    ( Tags (..)
-    , getTags
-    , buildTagsWith
-    , buildTags
-    , buildCategories
-    , tagsRules
-    , renderTags
-    , renderTagCloud
-    , renderTagCloudWith
-    , tagCloudField
-    , tagCloudFieldWith
-    , renderTagList
-    , tagsField
-    , tagsFieldWith
-    , categoryField
-    , 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 about tags
-data Tags = Tags
-    { tagsMap        :: [(String, [Identifier])]
-    , tagsMakeId     :: String -> Identifier
-    , tagsDependency :: Dependency
-    }
-
-
---------------------------------------------------------------------------------
--- | Obtain tags from a page in the default way: parse them from the @tags@
--- metadata field. This can either be a list or a comma-separated string.
-getTags :: MonadMetadata m => Identifier -> m [String]
-getTags identifier = do
-    metadata <- getMetadata identifier
-    return $ fromMaybe [] $
-        (lookupStringList "tags" metadata) `mplus`
-        (map trim . splitAll "," <$> lookupString "tags" metadata)
-
-
---------------------------------------------------------------------------------
--- | Obtain categories from a page.
-getCategory :: MonadMetadata m => Identifier -> m [String]
-getCategory = return . return . takeBaseName . takeDirectory . toFilePath
-
-
---------------------------------------------------------------------------------
--- | Higher-order function to read tags
-buildTagsWith :: MonadMetadata m
-              => (Identifier -> m [String])
-              -> Pattern
-              -> (String -> Identifier)
-              -> m Tags
-buildTagsWith f pattern makeId = do
-    ids    <- getMatches pattern
-    tagMap <- foldM addTags M.empty ids
-    let set' = S.fromList ids
-    return $ Tags (M.toList tagMap) makeId (PatternDependency pattern set')
-  where
-    -- Create a tag map for one page
-    addTags tagMap id' = do
-        tags <- f id'
-        let tagMap' = M.fromList $ zip tags $ repeat [id']
-        return $ M.unionWith (++) tagMap tagMap'
-
-
---------------------------------------------------------------------------------
-buildTags :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags
-buildTags = buildTagsWith getTags
-
-
---------------------------------------------------------------------------------
-buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier)
-                -> m Tags
-buildCategories = buildTagsWith getCategory
-
-
---------------------------------------------------------------------------------
-tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()
-tagsRules tags rules =
-    forM_ (tagsMap tags) $ \(tag, identifiers) ->
-        rulesExtraDependencies [tagsDependency tags] $
-            create [tagsMakeId tags tag] $
-                rules tag $ fromList identifiers
-
-
---------------------------------------------------------------------------------
--- | Render tags in HTML (the flexible higher-order function)
-renderTags :: (String -> String -> Int -> Int -> Int -> String)
-           -- ^ Produce a tag item: tag, url, count, min count, max count
-           -> ([String] -> String)
-           -- ^ Join items
-           -> Tags
-           -- ^ Tag cloud renderer
-           -> Compiler String
-renderTags makeHtml concatHtml tags = do
-    -- In tags' we create a list: [((tag, route), count)]
-    tags' <- forM (tagsMap tags) $ \(tag, ids) -> do
-        route' <- getRoute $ tagsMakeId tags tag
-        return ((tag, route'), length ids)
-
-    -- TODO: We actually need to tell a dependency here!
-
-    let -- Absolute frequencies of the pages
-        freqs = map snd tags'
-
-        -- The minimum and maximum count found
-        (min', max')
-            | null freqs = (0, 1)
-            | otherwise  = (minimum &&& maximum) freqs
-
-        -- Create a link for one item
-        makeHtml' ((tag, url), count) =
-            makeHtml tag (toUrl $ fromMaybe "/" url) count min' max'
-
-    -- Render and return the HTML
-    return $ concatHtml $ map makeHtml' tags'
-
-
---------------------------------------------------------------------------------
--- | Render a tag cloud in HTML
-renderTagCloud :: Double
-               -- ^ Smallest font size, in percent
-               -> Double
-               -- ^ Biggest font size, in percent
-               -> Tags
-               -- ^ Input tags
-               -> Compiler String
-               -- ^ Rendered cloud
-renderTagCloud = renderTagCloudWith makeLink (intercalate " ")
-  where
-    makeLink minSize maxSize tag url count min' max' =
-        -- Show the relative size of one 'count' in percent
-        let diff     = 1 + fromIntegral max' - fromIntegral min'
-            relative = (fromIntegral count - fromIntegral min') / diff
-            size     = floor $ minSize + relative * (maxSize - minSize) :: Int
-        in renderHtml $
-            H.a ! A.style (toValue $ "font-size: " ++ show size ++ "%")
-                ! A.href (toValue url)
-                $ toHtml tag
-
-
---------------------------------------------------------------------------------
--- | Render a tag cloud in HTML
-renderTagCloudWith :: (Double -> Double ->
-                       String -> String -> Int -> Int -> Int -> String)
-                   -- ^ Render a single tag link
-                   -> ([String] -> String)
-                   -- ^ Concatenate links
-                   -> Double
-                   -- ^ Smallest font size, in percent
-                   -> Double
-                   -- ^ Biggest font size, in percent
-                   -> Tags
-                   -- ^ Input tags
-                   -> Compiler String
-                   -- ^ Rendered cloud
-renderTagCloudWith makeLink cat minSize maxSize =
-  renderTags (makeLink minSize maxSize) cat
-
-
---------------------------------------------------------------------------------
--- | Render a tag cloud in HTML as a context
-tagCloudField :: String
-               -- ^ Destination key
-               -> Double
-               -- ^ Smallest font size, in percent
-               -> Double
-               -- ^ Biggest font size, in percent
-               -> Tags
-               -- ^ Input tags
-               -> Context a
-               -- ^ Context
-tagCloudField key minSize maxSize tags =
-  field key $ \_ -> renderTagCloud minSize maxSize tags
-
-
---------------------------------------------------------------------------------
--- | Render a tag cloud in HTML as a context
-tagCloudFieldWith :: String
-                  -- ^ Destination key
-                  -> (Double -> Double ->
-                      String -> String -> Int -> Int -> Int -> String)
-                  -- ^ Render a single tag link
-                  -> ([String] -> String)
-                  -- ^ Concatenate links
-                  -> Double
-                  -- ^ Smallest font size, in percent
-                  -> Double
-                  -- ^ Biggest font size, in percent
-                  -> Tags
-                  -- ^ Input tags
-                  -> Context a
-                  -- ^ Context
-tagCloudFieldWith key makeLink cat minSize maxSize tags =
-  field key $ \_ -> renderTagCloudWith makeLink cat minSize maxSize tags
-
-
---------------------------------------------------------------------------------
--- | Render a simple tag list in HTML, with the tag count next to the item
--- TODO: Maybe produce a Context here
-renderTagList :: Tags -> Compiler (String)
-renderTagList = renderTags makeLink (intercalate ", ")
-  where
-    makeLink tag url count _ _ = renderHtml $
-        H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")
-
-
---------------------------------------------------------------------------------
--- | Render tags with links with custom functions to get tags and to
--- render links
-tagsFieldWith :: (Identifier -> Compiler [String])
-              -- ^ Get the tags
-              -> (String -> (Maybe FilePath) -> Maybe H.Html)
-              -- ^ Render link for one tag
-              -> ([H.Html] -> H.Html)
-              -- ^ Concatenate tag links
-              -> String
-              -- ^ Destination field
-              -> Tags
-              -- ^ Tags structure
-              -> Context a
-              -- ^ Resulting context
-tagsFieldWith getTags' renderLink cat key tags = field key $ \item -> do
-    tags' <- getTags' $ itemIdentifier item
-    links <- forM tags' $ \tag -> do
-        route' <- getRoute $ tagsMakeId tags tag
-        return $ renderLink tag route'
-
-    return $ renderHtml $ cat $ catMaybes $ links
-
-
---------------------------------------------------------------------------------
--- | Render tags with links
-tagsField :: String     -- ^ Destination key
-          -> Tags       -- ^ Tags
-          -> Context a  -- ^ Context
-tagsField =
-  tagsFieldWith getTags simpleRenderLink (mconcat . intersperse ", ")
-
-
---------------------------------------------------------------------------------
--- | Render the category in a link
-categoryField :: String     -- ^ Destination key
-              -> Tags       -- ^ Tags
-              -> Context a  -- ^ Context
-categoryField =
-  tagsFieldWith getCategory simpleRenderLink (mconcat . intersperse ", ")
-
-
---------------------------------------------------------------------------------
--- | Render one tag link
-simpleRenderLink :: String -> (Maybe FilePath) -> Maybe H.Html
-simpleRenderLink _   Nothing         = Nothing
-simpleRenderLink tag (Just filePath) =
-  Just $ H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag
-
-
---------------------------------------------------------------------------------
--- | Sort tags using supplied function. First element of the tuple passed to
--- the comparing function is the actual tag name.
-sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)
-           -> Tags -> Tags
-sortTagsBy f t = t {tagsMap = sortBy f (tagsMap t)}
-
-
---------------------------------------------------------------------------------
--- | Sample sorting function that compares tags case insensitively.
-caseInsensitiveTags :: (String, [Identifier]) -> (String, [Identifier])
-                    -> Ordering
-caseInsensitiveTags = comparing $ map toLower . fst