summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Hakyll.hs185
-rw-r--r--src/Text/Hakyll/Configurations/Static.hs59
-rw-r--r--src/Text/Hakyll/Context.hs16
-rw-r--r--src/Text/Hakyll/CreateContext.hs114
-rw-r--r--src/Text/Hakyll/Feed.hs112
-rw-r--r--src/Text/Hakyll/File.hs196
-rw-r--r--src/Text/Hakyll/Internal/Cache.hs53
-rw-r--r--src/Text/Hakyll/Internal/CompressCss.hs36
-rw-r--r--src/Text/Hakyll/Internal/FileType.hs49
-rw-r--r--src/Text/Hakyll/Internal/Template.hs86
-rw-r--r--src/Text/Hakyll/Internal/Template/Hamlet.hs56
-rw-r--r--src/Text/Hakyll/Internal/Template/Template.hs34
-rw-r--r--src/Text/Hakyll/Metadata.hs108
-rw-r--r--src/Text/Hakyll/Monad.hs115
-rw-r--r--src/Text/Hakyll/Page.hs108
-rw-r--r--src/Text/Hakyll/Paginate.hs94
-rw-r--r--src/Text/Hakyll/Pandoc.hs88
-rw-r--r--src/Text/Hakyll/Regex.hs77
-rw-r--r--src/Text/Hakyll/Render.hs126
-rw-r--r--src/Text/Hakyll/Resource.hs57
-rw-r--r--src/Text/Hakyll/Tags.hs172
-rw-r--r--src/Text/Hakyll/Transformer.hs107
-rw-r--r--src/Text/Hakyll/Util.hs34
23 files changed, 0 insertions, 2082 deletions
diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
deleted file mode 100644
index b0fe479..0000000
--- a/src/Text/Hakyll.hs
+++ /dev/null
@@ -1,185 +0,0 @@
--- | This is the main Hakyll module, exporting the important @hakyll@ function.
---
--- Most configurations would use this @hakyll@ function more or less as the
--- main function:
---
--- > main = hakyll $ do
--- > directory css "css"
--- > directory static "images"
---
-module Text.Hakyll
- ( defaultHakyllConfiguration
- , hakyll
- , hakyllWithConfiguration
- , runDefaultHakyll
-
- , module Text.Hakyll.Context
- , module Text.Hakyll.ContextManipulations
- , module Text.Hakyll.CreateContext
- , module Text.Hakyll.File
- , module Text.Hakyll.HakyllMonad
- , module Text.Hakyll.Regex
- , module Text.Hakyll.Render
- , module Text.Hakyll.HakyllAction
- , module Text.Hakyll.Paginate
- , module Text.Hakyll.Page
- , module Text.Hakyll.Pandoc
- , module Text.Hakyll.Util
- , module Text.Hakyll.Tags
- , module Text.Hakyll.Feed
- , module Text.Hakyll.Configurations.Static
- ) where
-
-import Control.Concurrent (forkIO, threadDelay)
-import Control.Monad.Reader (runReaderT, liftIO, ask)
-import Control.Monad (when)
-import Data.Monoid (mempty)
-import System.Environment (getArgs, getProgName)
-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
-import System.Time (getClockTime)
-
-import Text.Pandoc
-import Text.Hamlet (defaultHamletSettings)
-
-import Network.Hakyll.SimpleServer (simpleServer)
-import Text.Hakyll.Context
-import Text.Hakyll.ContextManipulations
-import Text.Hakyll.CreateContext
-import Text.Hakyll.File
-import Text.Hakyll.HakyllMonad
-import Text.Hakyll.Regex
-import Text.Hakyll.Render
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.Paginate
-import Text.Hakyll.Page
-import Text.Hakyll.Pandoc
-import Text.Hakyll.Util
-import Text.Hakyll.Tags
-import Text.Hakyll.Feed
-import Text.Hakyll.Configurations.Static
-
--- | The default reader options for pandoc parsing.
---
-defaultPandocParserState :: ParserState
-defaultPandocParserState = defaultParserState
- { -- The following option causes pandoc to read smart typography, a nice
- -- and free bonus.
- stateSmart = True
- }
-
--- | The default writer options for pandoc rendering.
---
-defaultPandocWriterOptions :: WriterOptions
-defaultPandocWriterOptions = defaultWriterOptions
- { -- This option causes literate haskell to be written using '>' marks in
- -- html, which I think is a good default.
- writerLiterateHaskell = True
- }
-
--- | The default hakyll configuration.
---
-defaultHakyllConfiguration :: String -- ^ Absolute site URL.
- -> HakyllConfiguration -- ^ Default config.
-defaultHakyllConfiguration absoluteUrl' = HakyllConfiguration
- { absoluteUrl = absoluteUrl'
- , additionalContext = mempty
- , siteDirectory = "_site"
- , cacheDirectory = "_cache"
- , enableIndexUrl = False
- , previewMode = BuildOnRequest
- , pandocParserState = defaultPandocParserState
- , pandocWriterOptions = defaultPandocWriterOptions
- , hamletSettings = defaultHamletSettings
- }
-
--- | Main function to run Hakyll with the default configuration. The
--- absolute URL is only used in certain cases, for example RSS feeds et
--- cetera.
---
-hakyll :: String -- ^ Absolute URL of your site. Used in certain cases.
- -> Hakyll () -- ^ You code.
- -> IO ()
-hakyll absolute = hakyllWithConfiguration configuration
- where
- configuration = defaultHakyllConfiguration absolute
-
--- | Main function to run hakyll with a custom configuration.
---
-hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO ()
-hakyllWithConfiguration configuration buildFunction = do
- args <- getArgs
- let f = case args of ["build"] -> buildFunction
- ["clean"] -> clean
- ["preview", p] -> preview (read p)
- ["preview"] -> preview defaultPort
- ["rebuild"] -> clean >> buildFunction
- ["server", p] -> server (read p) (return ())
- ["server"] -> server defaultPort (return ())
- _ -> help
- runReaderT f configuration
- where
- preview port = case previewMode configuration of
- BuildOnRequest -> server port buildFunction
- BuildOnInterval -> do
- let pIO = runReaderT (previewThread buildFunction) configuration
- _ <- liftIO $ forkIO pIO
- server port (return ())
-
- defaultPort = 8000
-
--- | A preview thread that periodically recompiles the site.
---
-previewThread :: Hakyll () -- ^ Build function
- -> Hakyll () -- ^ Result
-previewThread buildFunction = run =<< liftIO getClockTime
- where
- delay = 1000000
- run time = do liftIO $ threadDelay delay
- contents <- getRecursiveContents "."
- valid <- isMoreRecent time contents
- when valid buildFunction
- run =<< liftIO getClockTime
-
--- | Clean up directories.
---
-clean :: Hakyll ()
-clean = do askHakyll siteDirectory >>= remove'
- askHakyll cacheDirectory >>= remove'
- where
- remove' dir = liftIO $ do putStrLn $ "Removing " ++ dir ++ "..."
- exists <- doesDirectoryExist dir
- when exists $ removeDirectoryRecursive dir
-
--- | Show usage information.
---
-help :: Hakyll ()
-help = liftIO $ do
- name <- getProgName
- putStrLn $ "This is a Hakyll site generator program. You should always\n"
- ++ "run it from the project root directory.\n"
- ++ "\n"
- ++ "Usage:\n"
- ++ name ++ " build Generate the site.\n"
- ++ name ++ " clean Clean up and remove cache.\n"
- ++ name ++ " help Show this message.\n"
- ++ name ++ " preview [port] Run a server and autocompile.\n"
- ++ name ++ " rebuild Clean up and build again.\n"
- ++ name ++ " server [port] Run a local test server.\n"
-
--- | Start a server at the given port number.
---
-server :: Integer -- ^ Port number to serve on.
- -> Hakyll () -- ^ Pre-respond action.
- -> Hakyll ()
-server port preRespond = do
- configuration <- ask
- root <- askHakyll siteDirectory
- let preRespondIO = runReaderT preRespond configuration
- liftIO $ simpleServer (fromIntegral port) root preRespondIO
-
--- | Run a Hakyll action with default settings. This is mostly aimed at testing
--- code.
---
-runDefaultHakyll :: Hakyll a -> IO a
-runDefaultHakyll f =
- runReaderT f $ defaultHakyllConfiguration "http://example.com"
diff --git a/src/Text/Hakyll/Configurations/Static.hs b/src/Text/Hakyll/Configurations/Static.hs
deleted file mode 100644
index 5a2c1be..0000000
--- a/src/Text/Hakyll/Configurations/Static.hs
+++ /dev/null
@@ -1,59 +0,0 @@
--- | Module for a simple static configuration of a website.
---
--- The configuration works like this:
---
--- * The @templates/@ directory should contain one template.
---
--- * Renderable files in the directory tree are rendered using this template.
---
--- * The @static/@ directory is copied entirely (if it exists).
---
--- * All files in the @css/@ directory are compressed.
---
-module Text.Hakyll.Configurations.Static
- ( staticConfiguration
- ) where
-
-import Control.Applicative ((<$>))
-import Control.Monad (filterM, forM_)
-
-import Text.Hakyll.File ( getRecursiveContents, inDirectory, inHakyllDirectory
- , directory )
-import Text.Hakyll.Internal.FileType (isRenderableFile)
-import Text.Hakyll.HakyllMonad (Hakyll, logHakyll)
-import Text.Hakyll.Render (renderChain, css, static)
-import Text.Hakyll.CreateContext (createPage)
-
--- | A simple configuration for an entirely static website.
---
-staticConfiguration :: Hakyll ()
-staticConfiguration = do
- -- Find all files not in _site or _cache.
- files <- filterM isRenderableFile' =<< getRecursiveContents "."
-
- -- Find a main template to use
- mainTemplate <- take 1 <$> getRecursiveContents templateDir
- logHakyll $ case mainTemplate of [] -> "Using no template"
- (x : _) -> "Using template " ++ x
-
- -- Render all files using this template
- forM_ files $ renderChain mainTemplate . createPage
-
- -- Render a static directory
- directory static staticDir
-
- -- Render a css directory
- directory css cssDir
- where
- -- A file should have a renderable extension and not be in a hakyll
- -- directory, and not in a special directory.
- isRenderableFile' file = do
- inHakyllDirectory' <- inHakyllDirectory file
- return $ isRenderableFile file
- && not (any (inDirectory file) [templateDir, cssDir, staticDir])
- && not inHakyllDirectory'
-
- -- Directories
- templateDir = "templates"
- cssDir = "css"
- staticDir = "static"
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs
deleted file mode 100644
index 9045a65..0000000
--- a/src/Text/Hakyll/Context.hs
+++ /dev/null
@@ -1,16 +0,0 @@
--- | This (quite small) module exports the datatype used for contexts. A
--- @Context@ is a simple key-value mapping. You can render these @Context@s
--- with templates, and manipulate them in various ways.
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Text.Hakyll.Context
- ( Context (..)
- ) where
-
-import Data.Monoid (Monoid)
-import Data.Map (Map)
-import Data.Binary (Binary)
-
--- | Datatype used for key-value mappings.
-newtype Context = Context { -- | Extract the context.
- unContext :: Map String String
- } deriving (Show, Monoid, Binary)
diff --git a/src/Text/Hakyll/CreateContext.hs b/src/Text/Hakyll/CreateContext.hs
deleted file mode 100644
index 6a0e321..0000000
--- a/src/Text/Hakyll/CreateContext.hs
+++ /dev/null
@@ -1,114 +0,0 @@
--- | A module that provides different ways to create a @Context@. These
--- functions all use the @HakyllAction@ arrow, so they produce values of the
--- type @HakyllAction () Context@.
-module Text.Hakyll.CreateContext
- ( createPage
- , createCustomPage
- , createListing
- , addField
- , combine
- , combineWithUrl
- ) where
-
-import Prelude hiding (id)
-
-import qualified Data.Map as M
-import Control.Arrow (second, arr, (&&&), (***))
-import Control.Monad (liftM2)
-import Control.Applicative ((<$>))
-import Control.Arrow ((>>>))
-import Control.Category (id)
-
-import Text.Hakyll.Context
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.Render
-import Text.Hakyll.Page
-import Text.Hakyll.Pandoc
-import Text.Hakyll.Internal.Cache
-
--- | Create a @Context@ from a page file stored on the disk. This is probably
--- the most common way to create a @Context@.
-createPage :: FilePath -> HakyllAction () Context
-createPage path = cacheAction "pages" $ readPageAction path >>> renderAction
-
--- | Create a custom page @Context@.
---
--- The association list given maps keys to values for substitution. Note
--- that as value, you can either give a @String@ or a
--- @HakyllAction () String@. The latter is preferred for more complex data,
--- since it allows dependency checking. A @String@ is obviously more simple
--- to use in some cases.
---
-createCustomPage :: FilePath
- -> [(String, Either String (HakyllAction () String))]
- -> HakyllAction () Context
-createCustomPage url association = HakyllAction
- { actionDependencies = dataDependencies
- , actionUrl = Left $ return url
- , actionFunction = \_ -> Context . M.fromList <$> assoc'
- }
- where
- mtuple (a, b) = b >>= \b' -> return (a, b')
- toHakyllString = second (either return runHakyllAction)
- assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association
- dataDependencies = map snd association >>= getDependencies
- getDependencies (Left _) = []
- getDependencies (Right x) = actionDependencies x
-
--- | A @createCustomPage@ function specialized in creating listings.
---
--- This function creates a listing of a certain list of @Context@s. Every
--- item in the list is created by applying the given template to every
--- renderable. You can also specify additional context to be included in the
--- @CustomPage@.
-createListing :: FilePath -- ^ Destination of the page.
- -> [FilePath] -- ^ Templates to render items with.
- -> [HakyllAction () Context] -- ^ Renderables in the list.
- -> [(String, Either String (HakyllAction () String))]
- -> HakyllAction () Context
-createListing url templates renderables additional =
- createCustomPage url context
- where
- context = ("body", Right concatenation) : additional
- concatenation = renderAndConcat templates renderables
-
--- | Add a field to a 'Context'.
---
-addField :: String -- ^ Key
- -> Either String (HakyllAction () String) -- ^ Value
- -> HakyllAction Context Context -- ^ Result
-addField key value = arr (const ()) &&& id
- >>> value' *** id
- >>> arr (uncurry insert)
- where
- value' = arr (const ()) >>> either (arr . const) id value
- insert v = Context . M.insert key v . unContext
-
--- | Combine two @Context@s. The url will always be taken from the first
--- @Renderable@. Also, if a `$key` is present in both renderables, the
--- value from the first @Context@ will be taken as well.
---
--- You can see this as a this as a @union@ between two mappings.
-combine :: HakyllAction () Context -> HakyllAction () Context
- -> HakyllAction () Context
-combine x y = HakyllAction
- { actionDependencies = actionDependencies x ++ actionDependencies y
- , actionUrl = actionUrl x
- , actionFunction = \_ ->
- Context <$> liftM2 (M.union) (unContext <$> runHakyllAction x)
- (unContext <$> runHakyllAction y)
- }
-
--- | Combine two @Context@s and set a custom URL. This behaves like @combine@,
--- except that for the @url@ field, the given URL is always chosen.
-combineWithUrl :: FilePath
- -> HakyllAction () Context
- -> HakyllAction () Context
- -> HakyllAction () Context
-combineWithUrl url x y = combine'
- { actionUrl = Left $ return url
- , actionFunction = \_ ->
- Context . M.insert "url" url . unContext <$> runHakyllAction combine'
- }
- where
- combine' = combine x y
diff --git a/src/Text/Hakyll/Feed.hs b/src/Text/Hakyll/Feed.hs
deleted file mode 100644
index be8d023..0000000
--- a/src/Text/Hakyll/Feed.hs
+++ /dev/null
@@ -1,112 +0,0 @@
--- | A Module that allows easy rendering of RSS feeds. If you use this module,
--- you must make sure you set the `absoluteUrl` field in the main Hakyll
--- configuration.
---
--- Apart from that, the main rendering functions (@renderRss@, @renderAtom@)
--- all assume that you pass the list of items so that the most recent entry
--- in the feed is the first item in the list.
---
--- Also note that the @Context@s should have (at least) the following
--- fields to produce a correct feed:
---
--- - @$title@: Title of the item.
---
--- - @$description@: Description to appear in the feed.
---
--- - @$url@: URL to the item - this is usually set automatically.
---
--- Furthermore, the feed will be generated, but will be incorrect (it won't
--- validate) if an empty list is passed.
---
-module Text.Hakyll.Feed
- ( FeedConfiguration (..)
- , renderRss
- , renderAtom
- ) where
-
-import Control.Arrow ((>>>), second)
-import Control.Monad.Reader (liftIO)
-import Data.Maybe (fromMaybe)
-import qualified Data.Map as M
-
-import Text.Hakyll.Context (Context (..))
-import Text.Hakyll.CreateContext (createListing)
-import Text.Hakyll.ContextManipulations (renderDate)
-import Text.Hakyll.HakyllMonad (Hakyll)
-import Text.Hakyll.Render (render, renderChain)
-import Text.Hakyll.HakyllAction
-
-import Paths_hakyll
-
--- | This is a data structure to keep the configuration of a feed.
-data FeedConfiguration = FeedConfiguration
- { -- | Url of the feed (relative to site root). For example, @rss.xml@.
- feedUrl :: String
- , -- | Title of the feed.
- feedTitle :: String
- , -- | Description of the feed.
- feedDescription :: String
- , -- | Name of the feed author.
- feedAuthorName :: String
- }
-
--- | This is an auxiliary function to create a listing that is, in fact, a feed.
--- The items should be sorted on date.
-createFeed :: FeedConfiguration -- ^ Feed configuration.
- -> [HakyllAction () Context] -- ^ Items to include.
- -> FilePath -- ^ Feed template.
- -> FilePath -- ^ Item template.
- -> HakyllAction () Context
-createFeed configuration renderables template itemTemplate =
- listing >>> render template
- where
- listing = createListing (feedUrl configuration)
- [itemTemplate] renderables additional
-
- additional = map (second $ Left . ($ configuration))
- [ ("title", feedTitle)
- , ("description", feedDescription)
- , ("authorName", feedAuthorName)
- ] ++ updated
-
- -- Take the first timestamp, which should be the most recent.
- updated = let action = createHakyllAction $ return . fromMaybe "foo"
- . M.lookup "timestamp" . unContext
- toTuple r = ("timestamp", Right $ r >>> action)
- in map toTuple $ take 1 renderables
-
-
--- | Abstract function to render any feed.
-renderFeed :: FeedConfiguration -- ^ Feed configuration.
- -> [HakyllAction () Context] -- ^ Items to include in the feed.
- -> FilePath -- ^ Feed template.
- -> FilePath -- ^ Item template.
- -> Hakyll ()
-renderFeed configuration renderables template itemTemplate = do
- template' <- liftIO $ getDataFileName template
- itemTemplate' <- liftIO $ getDataFileName itemTemplate
- let renderFeed' = createFeed configuration renderables
- template' itemTemplate'
- renderChain [] renderFeed'
-
--- | Render an RSS feed with a number of items.
-renderRss :: FeedConfiguration -- ^ Feed configuration.
- -> [HakyllAction () Context] -- ^ Items to include in the feed.
- -> Hakyll ()
-renderRss configuration renderables =
- renderFeed configuration (map (>>> renderRssDate) renderables)
- "templates/rss.xml" "templates/rss-item.xml"
- where
- renderRssDate = renderDate "timestamp" "%a, %d %b %Y %H:%M:%S UT"
- "No date found."
-
--- | Render an Atom feed with a number of items.
-renderAtom :: FeedConfiguration -- ^ Feed configuration.
- -> [HakyllAction () Context] -- ^ Items to include in the feed.
- -> Hakyll ()
-renderAtom configuration renderables =
- renderFeed configuration (map (>>> renderAtomDate) renderables)
- "templates/atom.xml" "templates/atom-item.xml"
- where
- renderAtomDate = renderDate "timestamp" "%Y-%m-%dT%H:%M:%SZ"
- "No date found."
diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
deleted file mode 100644
index 747608c..0000000
--- a/src/Text/Hakyll/File.hs
+++ /dev/null
@@ -1,196 +0,0 @@
--- | A module containing various function for manipulating and examinating
--- files and directories.
-module Text.Hakyll.File
- ( toDestination
- , toCache
- , toUrl
- , toRoot
- , inDirectory
- , inHakyllDirectory
- , removeSpaces
- , makeDirectories
- , getRecursiveContents
- , sortByBaseName
- , havingExtension
- , directory
- , isMoreRecent
- , isFileMoreRecent
- ) where
-
-import System.Directory
-import Control.Applicative ((<$>))
-import System.FilePath
-import System.Time (ClockTime)
-import Control.Monad
-import Data.List (isPrefixOf, sortBy)
-import Data.Ord (comparing)
-import Control.Monad.Reader (liftIO)
-
-import Text.Hakyll.Monad
-import Text.Hakyll.Internal.FileType (isRenderableFile)
-
--- | Auxiliary function to remove pathSeparators form the start. We don't deal
--- with absolute paths here. We also remove $root from the start.
-removeLeadingSeparator :: FilePath -> FilePath
-removeLeadingSeparator [] = []
-removeLeadingSeparator path
- | head path' `elem` pathSeparators = drop 1 path'
- | otherwise = path'
- where
- path' = if "$root" `isPrefixOf` path then drop 5 path
- else path
-
--- | Convert a relative URL to a filepath in the destination
--- (default: @_site@).
-toDestination :: FilePath -> Hakyll FilePath
-toDestination url = do dir <- askHakyll siteDirectory
- toFilePath dir url
-
--- | Convert a relative URL to a filepath in the cache
--- (default: @_cache@).
-toCache :: FilePath -> Hakyll FilePath
-toCache path = do dir <- askHakyll cacheDirectory
- toFilePath dir path
-
--- | Implementation of toDestination/toCache
---
-toFilePath :: String -- ^ Directory (site or cache)
- -> String -- ^ URL
- -> Hakyll FilePath -- ^ Resulting file path
-toFilePath dir url = do
- enableIndexUrl' <- askHakyll enableIndexUrl
- let destination = if enableIndexUrl' && separatorEnd
- then dir </> noSeparator </> "index.html"
- else dir </> noSeparator
- return destination
- where
- noSeparator = removeLeadingSeparator url
- separatorEnd = not (null url) && last url == '/'
-
--- | Get the url for a given page. For most extensions, this would be the path
--- itself. It's only for rendered extensions (@.markdown@, @.rst@, @.lhs@ this
--- function returns a path with a @.html@ extension instead.
-toUrl :: FilePath -> Hakyll FilePath
-toUrl path = do enableIndexUrl' <- askHakyll enableIndexUrl
- -- If the file does not have a renderable extension, like for
- -- example favicon.ico, we don't have to change it at all.
- return $ if not (isRenderableFile path)
- then path
- -- If index url's are enabled, we create pick it
- -- unless the page is an index already.
- else if enableIndexUrl' && not isIndex
- then indexUrl
- else withSimpleHtmlExtension
- where
- isIndex = dropExtension (takeFileName path) == "index"
- withSimpleHtmlExtension = flip addExtension ".html" $ dropExtension path
- indexUrl = dropExtension path ++ "/"
-
-
--- | Get the relative url to the site root, for a given (absolute) url
-toRoot :: FilePath -> FilePath
-toRoot = emptyException . joinPath . map parent . splitPath
- . takeDirectory . removeLeadingSeparator
- where
- parent = const ".."
- emptyException [] = "."
- emptyException x = x
-
--- | Check if a file is in a given directory.
---
-inDirectory :: FilePath -- ^ File path
- -> FilePath -- ^ Directory
- -> Bool -- ^ Result
-inDirectory path dir = case splitDirectories path of
- [] -> False
- (x : _) -> x == dir
-
--- | Check if a file is in a Hakyll directory. With a Hakyll directory, we mean
--- a directory that should be "ignored" such as the @_site@ or @_cache@
--- directory.
---
--- Example:
---
--- > inHakyllDirectory "_cache/pages/index.html"
---
--- Result:
---
--- > True
---
-inHakyllDirectory :: FilePath -> Hakyll Bool
-inHakyllDirectory path =
- or <$> mapM (liftM (inDirectory path) . askHakyll)
- [siteDirectory, cacheDirectory]
-
--- | Swaps spaces for '-'.
-removeSpaces :: FilePath -> FilePath
-removeSpaces = map swap
- where
- swap ' ' = '-'
- swap x = x
-
--- | Given a path to a file, try to make the path writable by making
--- all directories on the path.
-makeDirectories :: FilePath -> Hakyll ()
-makeDirectories path = liftIO $ createDirectoryIfMissing True dir
- where
- dir = takeDirectory path
-
--- | Get all contents of a directory. Note that files starting with a dot (.)
--- will be ignored.
---
-getRecursiveContents :: FilePath -> Hakyll [FilePath]
-getRecursiveContents topdir = do
- topdirExists <- liftIO $ doesDirectoryExist topdir
- if topdirExists
- then do names <- liftIO $ getDirectoryContents topdir
- let properNames = filter isProper names
- paths <- forM properNames $ \name -> do
- let path = topdir </> name
- isDirectory <- liftIO $ doesDirectoryExist path
- if isDirectory
- then getRecursiveContents path
- else return [normalise path]
- return (concat paths)
- else return []
- where
- isProper = not . (== '.') . head
-
--- | Sort a list of filenames on the basename.
-sortByBaseName :: [FilePath] -> [FilePath]
-sortByBaseName = sortBy compareBaseName
- where
- compareBaseName = comparing takeFileName
-
--- | A filter that takes all file names with a given extension. Prefix the
--- extension with a dot:
---
--- > havingExtension ".markdown" [ "index.markdown"
--- > , "style.css"
--- > ] == ["index.markdown"]
-havingExtension :: String -> [FilePath] -> [FilePath]
-havingExtension extension = filter ((==) extension . takeExtension)
-
--- | Perform a Hakyll action on every file in a given directory.
-directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
-directory action dir = getRecursiveContents dir >>= mapM_ action
-
--- | Check if a timestamp is newer then a number of given files.
-isMoreRecent :: ClockTime -- ^ The time to check.
- -> [FilePath] -- ^ Dependencies of the cached file.
- -> Hakyll Bool
-isMoreRecent _ [] = return True
-isMoreRecent timeStamp depends = do
- dependsModified <- liftIO $ mapM getModificationTime depends
- return (timeStamp >= maximum dependsModified)
-
--- | Check if a file is newer then a number of given files.
-isFileMoreRecent :: FilePath -- ^ The cached file.
- -> [FilePath] -- ^ Dependencies of the cached file.
- -> Hakyll Bool
-isFileMoreRecent file depends = do
- exists <- liftIO $ doesFileExist file
- if not exists
- then return False
- else do timeStamp <- liftIO $ getModificationTime file
- isMoreRecent timeStamp depends
diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs
deleted file mode 100644
index b83d9af..0000000
--- a/src/Text/Hakyll/Internal/Cache.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-module Text.Hakyll.Internal.Cache
- ( storeInCache
- , getFromCache
- , isCacheMoreRecent
- , cacheAction
- ) where
-
-import Control.Monad ((<=<))
-import Control.Monad.Reader (liftIO)
-import Data.Binary
-import System.FilePath ((</>))
-
-import Text.Hakyll.File
-import Text.Hakyll.HakyllMonad (Hakyll)
-import Text.Hakyll.HakyllAction
-
--- | We can store all datatypes instantiating @Binary@ to the cache. The cache
--- directory is specified by the @HakyllConfiguration@, usually @_cache@.
-storeInCache :: (Binary a) => a -> FilePath -> Hakyll ()
-storeInCache value path = do
- cachePath <- toCache path
- makeDirectories cachePath
- liftIO $ encodeFile cachePath value
-
--- | Get a value from the cache. The filepath given should not be located in the
--- cache. This function performs a timestamp check on the filepath and the
--- filepath in the cache, and only returns the cached value when it is still
--- up-to-date.
-getFromCache :: (Binary a) => FilePath -> Hakyll a
-getFromCache = liftIO . decodeFile <=< toCache
-
--- | Check if a file in the cache is more recent than a number of other files.
-isCacheMoreRecent :: FilePath -> [FilePath] -> Hakyll Bool
-isCacheMoreRecent file depends = toCache file >>= flip isFileMoreRecent depends
-
--- | Cache an entire arrow
---
-cacheAction :: Binary a
- => String
- -> HakyllAction () a
- -> HakyllAction () a
-cacheAction key action = action { actionFunction = const cacheFunction }
- where
- cacheFunction = do
- -- Construct a filename
- fileName <- fmap (key </>) $ either id (const $ return "unknown")
- $ actionUrl action
- -- Check the cache
- cacheOk <- isCacheMoreRecent fileName $ actionDependencies action
- if cacheOk then getFromCache fileName
- else do result <- actionFunction action ()
- storeInCache result fileName
- return result
diff --git a/src/Text/Hakyll/Internal/CompressCss.hs b/src/Text/Hakyll/Internal/CompressCss.hs
deleted file mode 100644
index 4a78791..0000000
--- a/src/Text/Hakyll/Internal/CompressCss.hs
+++ /dev/null
@@ -1,36 +0,0 @@
--- | Module used for CSS compression. The compression is currently in a simple
--- state, but would typically reduce the number of bytes by about 25%.
-module Text.Hakyll.Internal.CompressCss
- ( compressCss
- ) where
-
-import Data.List (isPrefixOf)
-
-import Text.Hakyll.Regex (substituteRegex)
-
--- | Compress CSS to speed up your site.
-compressCss :: String -> String
-compressCss = compressSeparators
- . stripComments
- . compressWhitespace
-
--- | Compresses certain forms of separators.
-compressSeparators :: String -> String
-compressSeparators = substituteRegex "; *}" "}"
- . substituteRegex " *([{};:]) *" "\\1"
- . substituteRegex ";;*" ";"
-
--- | Compresses all whitespace.
-compressWhitespace :: String -> String
-compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " "
-
--- | Function that strips CSS comments away.
-stripComments :: String -> String
-stripComments [] = []
-stripComments str
- | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str
- | otherwise = head str : stripComments (drop 1 str)
- where
- eatComments str' | null str' = []
- | isPrefixOf "*/" str' = drop 2 str'
- | otherwise = eatComments $ drop 1 str'
diff --git a/src/Text/Hakyll/Internal/FileType.hs b/src/Text/Hakyll/Internal/FileType.hs
deleted file mode 100644
index 689c77f..0000000
--- a/src/Text/Hakyll/Internal/FileType.hs
+++ /dev/null
@@ -1,49 +0,0 @@
--- | A module dealing with file extensions and associated file types.
-module Text.Hakyll.Internal.FileType
- ( FileType (..)
- , getFileType
- , isRenderable
- , isRenderableFile
- ) where
-
-import System.FilePath (takeExtension)
-
--- | Datatype to represent the different file types Hakyll can deal with.
-data FileType = Html
- | LaTeX
- | LiterateHaskellMarkdown
- | Markdown
- | ReStructuredText
- | Text
- | UnknownFileType
- deriving (Eq, Ord, Show, Read)
-
--- | Get the file type for a certain file. The type is determined by extension.
-getFileType :: FilePath -> FileType
-getFileType = getFileType' . takeExtension
- where
- getFileType' ".htm" = Html
- getFileType' ".html" = Html
- getFileType' ".lhs" = LiterateHaskellMarkdown
- getFileType' ".markdown" = Markdown
- getFileType' ".md" = Markdown
- getFileType' ".mdn" = Markdown
- getFileType' ".mdown" = Markdown
- getFileType' ".mdwn" = Markdown
- getFileType' ".mkd" = Markdown
- getFileType' ".mkdwn" = Markdown
- getFileType' ".page" = Markdown
- getFileType' ".rst" = ReStructuredText
- getFileType' ".tex" = LaTeX
- getFileType' ".text" = Text
- getFileType' ".txt" = Text
- getFileType' _ = UnknownFileType
-
--- | Check if a certain @FileType@ is renderable.
-isRenderable :: FileType -> Bool
-isRenderable UnknownFileType = False
-isRenderable _ = True
-
--- | Check if a certain file is renderable.
-isRenderableFile :: FilePath -> Bool
-isRenderableFile = isRenderable . getFileType
diff --git a/src/Text/Hakyll/Internal/Template.hs b/src/Text/Hakyll/Internal/Template.hs
deleted file mode 100644
index cd6a3bd..0000000
--- a/src/Text/Hakyll/Internal/Template.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-module Text.Hakyll.Internal.Template
- ( Template (..)
- , fromString
- , readTemplate
- , substitute
- , regularSubstitute
- , finalSubstitute
- ) where
-
-import Control.Arrow ((>>>))
-import Control.Applicative ((<$>))
-import Data.List (isPrefixOf)
-import Data.Char (isAlphaNum)
-import Data.Maybe (fromMaybe)
-import System.FilePath ((</>))
-import qualified Data.Map as M
-
-import Text.Hakyll.Context (Context (..))
-import Text.Hakyll.HakyllMonad (Hakyll)
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.Pandoc
-import Text.Hakyll.Internal.Cache
-import Text.Hakyll.Page
-import Text.Hakyll.ContextManipulations
-import Text.Hakyll.Internal.Template.Template
-import Text.Hakyll.Internal.Template.Hamlet
-
--- | Construct a @Template@ from a string.
---
-fromString :: String -> Template
-fromString = Template . fromString'
- where
- fromString' [] = []
- fromString' string
- | "$$" `isPrefixOf` string =
- EscapeCharacter : (fromString' $ drop 2 string)
- | "$" `isPrefixOf` string =
- let (key, rest) = span isAlphaNum $ drop 1 string
- in Identifier key : fromString' rest
- | otherwise =
- let (chunk, rest) = break (== '$') string
- in Chunk chunk : fromString' rest
-
--- | Read a @Template@ from a file. This function might fetch the @Template@
--- from the cache, if available.
-readTemplate :: FilePath -> Hakyll Template
-readTemplate path = do
- isCacheMoreRecent' <- isCacheMoreRecent fileName [path]
- if isCacheMoreRecent'
- then getFromCache fileName
- else do
- template <- if isHamletRTFile path
- then readHamletTemplate
- else readDefaultTemplate
- storeInCache template fileName
- return template
- where
- fileName = "templates" </> path
- readDefaultTemplate = do
- body <- runHakyllAction $ readPageAction path
- >>> renderAction
- >>> takeBody
- return $ fromString body
-
- readHamletTemplate = fromHamletRT <$> readHamletRT path
-
--- | Substitutes @$identifiers@ in the given @Template@ by values from the given
--- "Context". When a key is not found, it is left as it is. You can specify
--- the characters used to replace escaped dollars (@$$@) here.
-substitute :: String -> Template -> Context -> String
-substitute escaper template context = substitute' =<< unTemplate template
- where
- substitute' (Chunk chunk) = chunk
- substitute' (Identifier key) =
- fromMaybe ('$' : key) $ M.lookup key $ unContext context
- substitute' (EscapeCharacter) = escaper
-
--- | @substitute@ for use during a chain. This will leave escaped characters as
--- they are.
-regularSubstitute :: Template -> Context -> String
-regularSubstitute = substitute "$$"
-
--- | @substitute@ for the end of a chain (just before writing). This renders
--- escaped characters.
-finalSubstitute :: Template -> Context -> String
-finalSubstitute = substitute "$"
diff --git a/src/Text/Hakyll/Internal/Template/Hamlet.hs b/src/Text/Hakyll/Internal/Template/Hamlet.hs
deleted file mode 100644
index 458ab35..0000000
--- a/src/Text/Hakyll/Internal/Template/Hamlet.hs
+++ /dev/null
@@ -1,56 +0,0 @@
--- | Support for Hamlet templates in Hakyll.
---
-module Text.Hakyll.Internal.Template.Hamlet
- ( isHamletRTFile
- , readHamletRT
- , fromHamletRT
- ) where
-
-import Control.Exception (try)
-import Control.Monad.Trans (liftIO)
-import System.FilePath (takeExtension)
-
-import Text.Hamlet.RT
-
-import Text.Hakyll.Internal.Template.Template
-import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, hamletSettings, logHakyll)
-
--- | Determine if a file is a hamlet template by extension.
---
-isHamletRTFile :: FilePath -> Bool
-isHamletRTFile fileName = takeExtension fileName `elem` [".hamlet", ".hml"]
-
--- | Read a 'HamletRT' by file name.
---
-readHamletRT :: FilePath -- ^ Filename of the template
- -> Hakyll HamletRT -- ^ Resulting hamlet template
-readHamletRT fileName = do
- settings <- askHakyll hamletSettings
- string <- liftIO $ readFile fileName
- result <- liftIO $ try $ parseHamletRT settings string
- case result of
- Left (HamletParseException s) -> error' s
- Left (HamletUnsupportedDocException d) -> error' $ show d
- Left (HamletRenderException s) -> error' s
- Right x -> return x
- where
- error' s = do
- logHakyll $ "Parse of hamlet file " ++ fileName ++ " failed."
- logHakyll s
- error "Parse failed."
-
--- | Convert a 'HamletRT' to a 'Template'
---
-fromHamletRT :: HamletRT -- ^ Hamlet runtime template
- -> Template -- ^ Hakyll template
-fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd
- where
- fromSimpleDoc :: SimpleDoc -> TemplateElement
- fromSimpleDoc (SDRaw chunk) = Chunk chunk
- fromSimpleDoc (SDVar [var]) = Identifier var
- fromSimpleDoc (SDVar _) =
- error "Hakyll does not support '.' in identifier names when using \
- \hamlet templates."
- fromSimpleDoc _ =
- error "Only simple $key$ identifiers are allowed when using hamlet \
- \templates."
diff --git a/src/Text/Hakyll/Internal/Template/Template.hs b/src/Text/Hakyll/Internal/Template/Template.hs
deleted file mode 100644
index 49373fd..0000000
--- a/src/Text/Hakyll/Internal/Template/Template.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- | Module containing the template data structure.
---
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Text.Hakyll.Internal.Template.Template
- ( Template (..)
- , TemplateElement (..)
- ) where
-
-import Control.Applicative ((<$>))
-
-import Data.Binary (Binary, get, getWord8, put, putWord8)
-
--- | Datatype used for template substitutions.
---
-newtype Template = Template { unTemplate :: [TemplateElement] }
- deriving (Show, Eq, Binary)
-
--- | Elements of a template.
---
-data TemplateElement = Chunk String
- | Identifier String
- | EscapeCharacter
- deriving (Show, Eq)
-
-instance Binary TemplateElement where
- put (Chunk string) = putWord8 0 >> put string
- put (Identifier key) = putWord8 1 >> put key
- put (EscapeCharacter) = putWord8 2
-
- get = getWord8 >>= \tag ->
- case tag of 0 -> Chunk <$> get
- 1 -> Identifier <$> get
- 2 -> return EscapeCharacter
- _ -> error "Error reading cached template"
diff --git a/src/Text/Hakyll/Metadata.hs b/src/Text/Hakyll/Metadata.hs
deleted file mode 100644
index 7698dad..0000000
--- a/src/Text/Hakyll/Metadata.hs
+++ /dev/null
@@ -1,108 +0,0 @@
--- | This module exports a number of functions to manipulate metadata of
--- resources
---
-module Text.Hakyll.ContextManipulations
- ( renderValue
- , changeValue
- , changeUrl
- , copyValue
- , renderDate
- , renderDateWithLocale
- , changeExtension
- ) where
-
-import System.Locale (TimeLocale, defaultTimeLocale)
-import System.FilePath (takeFileName, addExtension, dropExtension)
-import Data.Time.Format (parseTime, formatTime)
-import Data.Time.Clock (UTCTime)
-import Data.Maybe (fromMaybe)
-import qualified Data.Map as M
-
-import Text.Hakyll.Regex (substituteRegex)
-import Text.Hakyll.Transformer (Transformer (..), transformMetadata)
-import Text.Hakyll.Resource
-
--- | Do something with a value in a @Context@, but keep the old value as well.
--- If the key given is not present in the @Context@, nothing will happen.
---
-renderValue :: String -- ^ Key of which the value should be copied.
- -> String -- ^ Key the value should be copied to.
- -> (String -> String) -- ^ Function to apply on the value.
- -> Transformer a a -- ^ Resulting transformer
-renderValue source destination f = transformMetadata $ \(Metadata m) ->
- Metadata $ case M.lookup source m of
- Nothing -> m
- (Just value) -> M.insert destination (f value) m
-
--- | Change a value in the metadata
---
--- > import Data.Char (toUpper)
--- > changeValue "title" (map toUpper)
---
--- Will put the title in UPPERCASE.
-changeValue :: String -- ^ Key to change.
- -> (String -> String) -- ^ Function to apply on the value.
- -> Transformer a a
-changeValue key = renderValue key key
-
--- | Change the URL of a page. You should always use this function instead of
--- 'changeValue' for this, because using 'changeValue' might break dependency
--- handling when changing the @url@ field.
---
-changeUrl :: (String -> String) -- ^ Function to change URL with.
- -> Transformer a a -- ^ Resulting action.
-changeUrl f = let t = changeValue "url" f
- in t {transformerUrl = return . f}
-
--- | Copy a metadata value from one key to another
---
-copyValue :: String -- ^ Source key.
- -> String -- ^ Destination key.
- -> Transformer a a -- ^ Resulting transformer
-copyValue source destination = renderValue source destination id
-
--- | When the context has a key called @path@ in a
--- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages),
--- this function can render the date.
---
--- > renderDate "date" "%B %e, %Y" "Date unknown"
---
--- Will render something like @January 32, 2010@.
---
-renderDate :: String -- ^ Key in which the rendered date should be placed.
- -> String -- ^ Format to use on the date.
- -> String -- ^ Default key, in case the date cannot be parsed.
- -> Transformer a a
-renderDate = renderDateWithLocale defaultTimeLocale
-
--- | This is an extended version of 'renderDate' that allows you to specify a
--- time locale that is used for outputting the date. For more details, see
--- 'renderDate'.
---
-renderDateWithLocale :: TimeLocale -- ^ Output time locale.
- -> String -- ^ Destination key.
- -> String -- ^ Format to use on the date.
- -> String -- ^ Default key.
- -> Transformer a a
-renderDateWithLocale locale key format defaultValue =
- renderValue "path" key renderDate'
- where
- renderDate' filePath = fromMaybe defaultValue $ do
- let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
- (takeFileName filePath)
- time <- parseTime defaultTimeLocale
- "%Y-%m-%d"
- dateString :: Maybe UTCTime
- return $ formatTime locale format time
-
--- | Change the extension of a file. This is only needed when you want to
--- render, for example, mardown to @.php@ files instead of @.html@ files.
---
--- > changeExtension "php"
---
--- Will render @test.markdown@ to @test.php@ instead of @test.html@.
-changeExtension :: String -- ^ Extension to change to.
- -> Transformer a a -- ^ Resulting transformer
-changeExtension extension = changeValue "url" changeExtension'
- where
- changeExtension' = flip addExtension extension . dropExtension
diff --git a/src/Text/Hakyll/Monad.hs b/src/Text/Hakyll/Monad.hs
deleted file mode 100644
index 5de5e44..0000000
--- a/src/Text/Hakyll/Monad.hs
+++ /dev/null
@@ -1,115 +0,0 @@
--- | Module describing the Hakyll monad stack.
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Text.Hakyll.Monad
- ( HakyllConfiguration (..)
- , PreviewMode (..)
- , Hakyll
- , askHakyll
- , getAdditionalContext
- , logHakyll
- , forkHakyllWait
- , concurrentHakyll
- ) where
-
-import Control.Monad.Trans (liftIO)
-import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Concurrent.MVar (MVar, putMVar, newEmptyMVar, readMVar)
-import Control.Monad.Reader (ReaderT, ask, runReaderT)
-import Control.Monad (liftM, forM, forM_)
-import qualified Data.Map as M
-import System.IO (hPutStrLn, stderr)
-
-import Text.Pandoc (ParserState, WriterOptions)
-import Text.Hamlet (HamletSettings)
-
-import Text.Hakyll.Context (Context (..))
-
--- | Our custom monad stack.
---
-newtype Hakyll a = Hakyll (ReaderT HakyllConfiguration IO a)
- deriving (Monad, Functor)
-
-instance MonadIO Hakyll where
- liftIO = Hakyll . liftIO
-
--- | Run a hakyll stack
---
-runHakyll :: Hakyll a -> HakyllConfiguration -> IO a
-runHakyll (Hakyll h) = runReaderT h
-
--- | Preview mode.
---
-data PreviewMode = BuildOnRequest
- | BuildOnInterval
- deriving (Show, Eq, Ord)
-
--- | Hakyll global configuration type.
---
-data HakyllConfiguration = HakyllConfiguration
- { -- | Absolute URL of the site.
- absoluteUrl :: String
- , -- | An additional context to use when rendering. This additional context
- -- is used globally.
- additionalContext :: Context
- , -- | Directory where the site is placed.
- siteDirectory :: FilePath
- , -- | Directory for cache files.
- cacheDirectory :: FilePath
- , -- | Enable index links.
- enableIndexUrl :: Bool
- , -- | The preview mode used
- previewMode :: PreviewMode
- , -- | Pandoc parsing options
- pandocParserState :: ParserState
- , -- | Pandoc writer options
- pandocWriterOptions :: WriterOptions
- , -- | Hamlet settings (if you use hamlet for templates)
- hamletSettings :: HamletSettings
- }
-
--- | Get the hakyll configuration
---
-getHakyllConfiguration :: Hakyll HakyllConfiguration
-getHakyllConfiguration = Hakyll ask
-
--- | Simplified @ask@ function for the Hakyll monad stack.
---
--- Usage would typically be something like:
---
--- > doSomething :: a -> b -> Hakyll c
--- > doSomething arg1 arg2 = do
--- > siteDirectory' <- askHakyll siteDirectory
--- > ...
---
-askHakyll :: (HakyllConfiguration -> a) -> Hakyll a
-askHakyll = flip liftM getHakyllConfiguration
-
--- | Obtain the globally available, additional context.
---
-getAdditionalContext :: HakyllConfiguration -> Context
-getAdditionalContext configuration =
- let (Context c) = additionalContext configuration
- in Context $ M.insert "absolute" (absoluteUrl configuration) c
-
--- | Write some log information.
---
-logHakyll :: String -> Hakyll ()
-logHakyll = Hakyll . liftIO . hPutStrLn stderr
-
--- | Perform a concurrent hakyll action. Returns an MVar you can wait on
---
-forkHakyllWait :: Hakyll () -> Hakyll (MVar ())
-forkHakyllWait action = do
- mvar <- liftIO newEmptyMVar
- config <- getHakyllConfiguration
- liftIO $ do
- runHakyll action config
- putMVar mvar ()
- return mvar
-
--- | Perform a number of concurrent hakyll actions, and waits for them to finish
---
-concurrentHakyll :: [Hakyll ()] -> Hakyll ()
-concurrentHakyll actions = do
- mvars <- forM actions forkHakyllWait
- forM_ mvars (liftIO . readMVar)
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
deleted file mode 100644
index f2b5fde..0000000
--- a/src/Text/Hakyll/Page.hs
+++ /dev/null
@@ -1,108 +0,0 @@
--- | A module for dealing with @Page@s. This module is mostly internally used.
-module Text.Hakyll.Page
- ( PageSection (..)
- , readPage
- , readPageAction
- ) where
-
-import Data.List (isPrefixOf)
-import Data.Char (isSpace)
-import Control.Monad.Reader (liftIO)
-import System.FilePath
-import Control.Monad.State (State, evalState, get, put)
-
-import Text.Hakyll.File
-import Text.Hakyll.HakyllMonad
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.Regex (substituteRegex, matchesRegex)
-import Text.Hakyll.Util (trim)
-
--- | A page is first parsed into a number of page sections. A page section
--- consists of:
---
--- * A key
---
--- * A value
---
--- * A 'Bool' flag, indicating if the value is applicable for rendering
---
-data PageSection = PageSection {unPageSection :: (String, String, Bool)}
- deriving (Show)
-
--- | Split a page into sections.
---
-splitAtDelimiters :: [String] -> State (Maybe String) [[String]]
-splitAtDelimiters [] = return []
-splitAtDelimiters ls@(x:xs) = do
- delimiter <- get
- if not (isDelimiter delimiter x)
- then return [ls]
- else do let proper = takeWhile (== '-') x
- (content, rest) = break (isDelimiter $ Just proper) xs
- put $ Just proper
- rest' <- splitAtDelimiters rest
- return $ (x : content) : rest'
- where
- isDelimiter old = case old of
- Nothing -> isPossibleDelimiter
- (Just d) -> (== d) . takeWhile (== '-')
-
--- | Check if the given string is a metadata delimiter.
-isPossibleDelimiter :: String -> Bool
-isPossibleDelimiter = isPrefixOf "---"
-
--- | Read one section of a page.
---
-readSection :: Bool -- ^ If this section is the first section in the page.
- -> [String] -- ^ Lines in the section.
- -> [PageSection] -- ^ Key-values extracted.
-readSection _ [] = []
-readSection isFirst ls
- | not isDelimiter' = [body ls]
- | isNamedDelimiter = readSectionMetaData ls
- | isFirst = readSimpleMetaData (drop 1 ls)
- | otherwise = [body (drop 1 ls)]
- where
- isDelimiter' = isPossibleDelimiter (head ls)
- isNamedDelimiter = head ls `matchesRegex` "^----* *[a-zA-Z0-9][a-zA-Z0-9]*"
- body ls' = PageSection ("body", unlines ls', True)
-
- readSimpleMetaData = map readPair . filter (not . all isSpace)
- readPair = trimPair . break (== ':')
- trimPair (key, value) = PageSection (trim key, trim (drop 1 value), False)
-
- readSectionMetaData [] = []
- readSectionMetaData (header:value) =
- let key = substituteRegex "[^a-zA-Z0-9]" "" header
- in [PageSection (key, unlines value, True)]
-
--- | Read a page from a file. Metadata is supported.
---
-readPage :: FilePath -> Hakyll [PageSection]
-readPage path = do
- let sectionFunctions = map readSection $ True : repeat False
-
- -- Read file.
- contents <- liftIO $ readFile path
- url <- toUrl path
- let sections = evalState (splitAtDelimiters $ lines contents) Nothing
- sectionsData = concat $ zipWith ($) sectionFunctions sections
-
- -- Note that url, path etc. are listed first, which means can be overwritten
- -- by section data
- return $ PageSection ("url", url, False)
- : PageSection ("path", path, False)
- : PageSection ("title", takeBaseName path, False)
- : (category ++ sectionsData)
- where
- category = let dirs = splitDirectories $ takeDirectory path
- in [PageSection ("category", last dirs, False) | not (null dirs)]
-
--- | Read a page from a file. Metadata is supported.
---
-readPageAction :: FilePath -> HakyllAction () [PageSection]
-readPageAction path = HakyllAction
- { actionDependencies = [path]
- , actionUrl = Left $ toUrl path
- , actionFunction = const $ readPage path
- }
diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs
deleted file mode 100644
index 04194ca..0000000
--- a/src/Text/Hakyll/Paginate.hs
+++ /dev/null
@@ -1,94 +0,0 @@
--- | Module aimed to paginate web pages.
---
-module Text.Hakyll.Paginate
- ( PaginateConfiguration (..)
- , defaultPaginateConfiguration
- , paginate
- ) where
-
-import Control.Applicative ((<$>))
-
-import Text.Hakyll.Context (Context)
-import Text.Hakyll.CreateContext
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.Util (link)
-
--- | A configuration for a pagination.
---
-data PaginateConfiguration = PaginateConfiguration
- { -- | Label for the link to the previous page.
- previousLabel :: String
- , -- | Label for the link to the next page.
- nextLabel :: String
- , -- | Label for the link to the first page.
- firstLabel :: String
- , -- | Label for the link to the last page.
- lastLabel :: String
- }
-
--- | A simple default configuration for pagination.
---
-defaultPaginateConfiguration :: PaginateConfiguration
-defaultPaginateConfiguration = PaginateConfiguration
- { previousLabel = "Previous"
- , nextLabel = "Next"
- , firstLabel = "First"
- , lastLabel = "Last"
- }
-
--- | The most important function for pagination. This function operates on a
--- list of @Context@s (the pages), and basically just adds fields to them
--- by combining them with a custom page.
---
--- The following metadata fields will be added:
---
--- - @$previous@: A link to the previous page.
---
--- - @$next@: A link to the next page.
---
--- - @$first@: A link to the first page.
---
--- - @$last@: A link to the last page.
---
--- - @$index@: 1-based index of the current page.
---
--- - @$length@: Total number of pages.
---
--- When @$previous@ or @$next@ are not available, they will be just a label
--- without a link. The same goes for when we are on the first or last page for
--- @$first@ and @$last@.
---
-paginate :: PaginateConfiguration
- -> [HakyllAction () Context]
- -> [HakyllAction () Context]
-paginate configuration renderables = paginate' Nothing renderables (1 :: Int)
- where
- -- Create a link with a given label, taken from the configuration.
- linkWithLabel f r = Right $ case actionUrl r of
- Left l -> createSimpleHakyllAction $
- link (f configuration) . ("$root/" ++) <$> l
- Right _ -> error "No link found for pagination."
-
- -- The main function that creates combined renderables by recursing over
- -- the list of items.
- paginate' _ [] _ = []
- paginate' maybePrev (x:xs) index =
- let (previous, first) = case maybePrev of
- (Just r) -> ( linkWithLabel previousLabel r
- , linkWithLabel firstLabel (head renderables) )
- Nothing -> ( Left $ previousLabel configuration
- , Left $ firstLabel configuration )
- (next, last') = case xs of
- (n:_) -> ( linkWithLabel nextLabel n
- , linkWithLabel lastLabel (last renderables) )
- [] -> ( Left $ nextLabel configuration
- , Left $ lastLabel configuration )
- customPage = createCustomPage ""
- [ ("previous", previous)
- , ("next", next)
- , ("first", first)
- , ("last", last')
- , ("index", Left $ show index)
- , ("length", Left $ show $ length renderables)
- ]
- in (x `combine` customPage) : paginate' (Just x) xs (index + 1)
diff --git a/src/Text/Hakyll/Pandoc.hs b/src/Text/Hakyll/Pandoc.hs
deleted file mode 100644
index af4be62..0000000
--- a/src/Text/Hakyll/Pandoc.hs
+++ /dev/null
@@ -1,88 +0,0 @@
--- | Module exporting a pandoc arrow
---
-module Text.Hakyll.Pandoc
- ( renderAction
- , renderActionWith
- ) where
-
-import Data.Maybe (fromMaybe)
-import qualified Data.Map as M
-import Control.Arrow (second, (>>>), arr, (&&&))
-
-import Text.Pandoc
-
-import Text.Hakyll.Internal.FileType
-import Text.Hakyll.Page
-import Text.Hakyll.HakyllMonad
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.Context
-
--- | Reader function for plain text
---
-readText :: ParserState -> String -> Pandoc
-readText _ = Pandoc (Meta [] [] []) . return . Plain . return . Str
-
--- | Get a read function for a given extension.
---
-readPandoc :: HakyllAction (FileType, String) Pandoc
-readPandoc = createHakyllAction $ \(fileType, inp) -> do
- parserState <- askHakyll pandocParserState
- return $ readFunction fileType (readOptions parserState fileType) inp
- where
- readFunction ReStructuredText = readRST
- readFunction LaTeX = readLaTeX
- readFunction Markdown = readMarkdown
- readFunction LiterateHaskellMarkdown = readMarkdown
- readFunction Html = readHtml
- readFunction Text = readText
- readFunction t = error $ "Cannot render " ++ show t
-
- readOptions options LiterateHaskellMarkdown = options
- { stateLiterateHaskell = True }
- readOptions options _ = options
-
--- | Get a render function for a given extension.
---
-getRenderFunction :: HakyllAction FileType (String -> String)
-getRenderFunction = createHakyllAction $ \fileType -> case fileType of
- Html -> return id
- Text -> return id
- UnknownFileType -> return id
- _ -> do parserState <- askHakyll pandocParserState
- writerOptions <- askHakyll pandocWriterOptions
- return $ writeHtmlString writerOptions
- . readFunction fileType (readOptions parserState fileType)
- where
- readFunction ReStructuredText = readRST
- readFunction LaTeX = readLaTeX
- readFunction Markdown = readMarkdown
- readFunction LiterateHaskellMarkdown = readMarkdown
- readFunction t = error $ "Cannot render " ++ show t
-
- readOptions options LiterateHaskellMarkdown = options
- { stateLiterateHaskell = True }
- readOptions options _ = options
-
--- | Get a render action
---
-renderPandoc :: HakyllAction Pandoc String
-renderPandoc = createHakyllAction $ \p -> do
- writerOptions <- askHakyll pandocWriterOptions
- return $ writeHtmlString writerOptions p
-
--- | An action that renders the list of page sections to a context using pandoc
---
-renderAction :: HakyllAction [PageSection] Context
-renderAction = (arr id &&& (getFileType' >>> getRenderFunction))
- >>> renderActionWith
- where
- getFileType' = arr $ getFileType . fromMaybe "unknown" . lookup "path"
- . map (\(x, y, _) -> (x, y)) . map unPageSection
-
--- | An action to render pages, offering just a little more flexibility
---
-renderActionWith :: HakyllAction ([PageSection], String -> String) Context
-renderActionWith = createHakyllAction $ \(sections, render') -> return $
- Context $ M.fromList $ map (renderTriple render' . unPageSection) sections
- where
- renderTriple render' (k, v, r) = second (if r then render' else id) (k, v)
diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs
deleted file mode 100644
index ba7ee46..0000000
--- a/src/Text/Hakyll/Regex.hs
+++ /dev/null
@@ -1,77 +0,0 @@
--- | A module that exports a simple regex interface. This code is mostly copied
--- from the regex-compat package at hackage. I decided to write this module
--- because I want to abstract the regex package used.
-module Text.Hakyll.Regex
- ( splitRegex
- , substituteRegex
- , matchesRegex
- ) where
-
-import Text.Regex.TDFA
-
--- | Match a regular expression against a string, returning more information
--- about the match.
-matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])
-matchRegexAll = matchM
-
--- | Replaces every occurance of the given regexp with the replacement string.
-subRegex :: Regex -- ^ Search pattern
- -> String -- ^ Input string
- -> String -- ^ Replacement text
- -> String -- ^ Output string
-subRegex _ "" _ = ""
-subRegex regexp inp replacement =
- let -- bre matches a backslash then capture either a backslash or some digits
- bre = makeRegex "\\\\(\\\\|[0-9]+)"
- lookup' _ [] _ = []
- lookup' [] _ _ = []
- lookup' match' repl groups =
- case matchRegexAll bre repl of
- Nothing -> repl
- Just (lead, _, trail, bgroups) ->
- let newval =
- if head bgroups == "\\"
- then "\\"
- else let index :: Int
- index = read (head bgroups) - 1
- in if index == -1
- then match'
- else groups !! index
- in lead ++ newval ++ lookup' match' trail groups
- in case matchRegexAll regexp inp of
- Nothing -> inp
- Just (lead, match', trail, groups) ->
- lead ++ lookup' match' replacement groups
- ++ subRegex regexp trail replacement
-
--- | Splits a string based on a regular expression. The regular expression
--- should identify one delimiter.
-splitRegex' :: Regex -> String -> [String]
-splitRegex' _ [] = []
-splitRegex' delim strIn = loop strIn where
- loop str = case matchOnceText delim str of
- Nothing -> [str]
- Just (firstline, _, remainder) ->
- if null remainder
- then [firstline,""]
- else firstline : loop remainder
-
--- | Split a list at a certain element.
-splitRegex :: String -> String -> [String]
-splitRegex pattern = filter (not . null)
- . splitRegex' (makeRegex pattern)
-
--- | Substitute a regex. Simplified interface. This function performs a global
--- substitution.
-substituteRegex :: String -- ^ Pattern to replace (regex).
- -> String -- ^ Replacement string.
- -> String -- ^ Input string.
- -> String -- ^ Result.
-substituteRegex pattern replacement string =
- subRegex (makeRegex pattern) string replacement
-
--- | Simple regex matching.
-matchesRegex :: String -- ^ Input string.
- -> String -- ^ Pattern to match.
- -> Bool
-matchesRegex = (=~)
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
deleted file mode 100644
index aa3ef8c..0000000
--- a/src/Text/Hakyll/Render.hs
+++ /dev/null
@@ -1,126 +0,0 @@
--- | Module containing rendering functions. All these functions are used to
--- render files to the @_site@ directory.
-module Text.Hakyll.Render
- ( render
- , renderAndConcat
- , renderChain
- , static
- , css
- , writePage
- ) where
-
-import Control.Arrow ((>>>))
-import Control.Applicative ((<$>))
-import Control.Monad.Reader (liftIO)
-import System.Directory (copyFile)
-import Data.Maybe (fromMaybe)
-import qualified Data.Map as M
-
-import Text.Hakyll.Context (Context (..))
-import Text.Hakyll.HakyllMonad (Hakyll, askHakyll, getAdditionalContext)
-import Text.Hakyll.File
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.ContextManipulations
-import Text.Hakyll.Internal.CompressCss
-import Text.Hakyll.Internal.Template
-
--- | A pure render function - used internally.
-pureRender :: Template -- ^ Template to use for rendering.
- -> Context -- ^ Renderable object to render with given template.
- -> Context -- ^ The body of the result will contain the render.
-pureRender template (Context c) =
- -- Ignore $root when substituting here. We will only replace that in the
- -- final render (just before writing).
- let contextIgnoringRoot = Context $ M.insert "root" "$root" c
- body = regularSubstitute template $ contextIgnoringRoot
- in Context $ M.insert "body" body c
-
--- | This is the most simple render action. You render a @Context@ with a
--- template, and get back the result.
-render :: FilePath -- ^ Template to use for rendering.
- -> HakyllAction Context Context -- ^ The render computation.
-render templatePath = HakyllAction
- { actionDependencies = [templatePath]
- , actionUrl = Right id
- , actionFunction = \context ->
- flip pureRender context <$> readTemplate templatePath
- }
-
--- | Render each @Context@ with the given templates, then concatenate the
--- result. So, basically this function:
---
--- - Takes every @Context@.
---
--- - Renders every @Context@ with all given templates. This is comparable
--- with a renderChain action.
---
--- - Concatenates the result and returns that as a @String@.
-renderAndConcat :: [FilePath]
- -> [HakyllAction () Context]
- -> HakyllAction () String
-renderAndConcat templatePaths renderables = HakyllAction
- { actionDependencies = renders >>= actionDependencies
- , actionUrl = Right id
- , actionFunction = actionFunction'
- }
- where
- render' = chain (map render templatePaths)
- renders = map (>>> render') renderables
-
- actionFunction' _ = do
- contexts <- mapM (runHakyllAction . (>>> takeBody)) renders
- return $ concat contexts
-
--- | Chain a render action for a page with a number of templates. This will
--- also write the result to the site destination. This is the preferred way
--- to do general rendering.
---
--- > renderChain [ "templates/notice.html"
--- > , "templates/default.html"
--- > ] $ createPagePath "warning.html"
---
--- This code will first render @warning.html@ using @templates/notice.html@,
--- and will then render the result with @templates/default.html@.
-renderChain :: [FilePath]
- -> HakyllAction () Context
- -> Hakyll ()
-renderChain templatePaths initial =
- runHakyllActionIfNeeded renderChainWith'
- where
- renderChainWith' = initial >>> chain' >>> writePage
- chain' = chain $ map render templatePaths
-
--- | Mark a certain file as static, so it will just be copied when the site is
--- generated.
-static :: FilePath -> Hakyll ()
-static source = runHakyllActionIfNeeded static'
- where
- static' = createFileHakyllAction source $ do
- destination <- toDestination source
- makeDirectories destination
- liftIO $ copyFile source destination
-
--- | Render a css file, compressing it.
-css :: FilePath -> Hakyll ()
-css source = runHakyllActionIfNeeded css'
- where
- css' = createFileHakyllAction source $ do
- contents <- liftIO $ readFile source
- destination <- toDestination source
- makeDirectories destination
- liftIO $ writeFile destination (compressCss contents)
-
--- | Write a page to the site destination. Final action after render
--- chains and such.
-writePage :: HakyllAction Context ()
-writePage = createHakyllAction $ \(Context initialContext) -> do
- additionalContext' <- unContext <$> askHakyll getAdditionalContext
- let url = fromMaybe (error "No url defined at write time.")
- (M.lookup "url" initialContext)
- body = fromMaybe "" (M.lookup "body" initialContext)
- let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
- destination <- toDestination url
- makeDirectories destination
- -- Substitute $root here, just before writing.
- liftIO $ writeFile destination $ finalSubstitute (fromString body)
- (Context context)
diff --git a/src/Text/Hakyll/Resource.hs b/src/Text/Hakyll/Resource.hs
deleted file mode 100644
index b0ffb8c..0000000
--- a/src/Text/Hakyll/Resource.hs
+++ /dev/null
@@ -1,57 +0,0 @@
--- | A resource represents data for a website
---
-module Text.Hakyll.Resource
- ( Metadata (..)
- , Resource (..)
- , getData
- , getMetadata
- ) where
-
-import Data.Monoid (Monoid, mempty, mappend)
-import Control.Applicative (Applicative, (<*>), pure)
-import Data.Map (Map)
-import qualified Data.Map as M
-
--- | Metadata for a resource
---
-newtype Metadata = Metadata {unMetadata :: Map String String}
- deriving (Show, Eq, Ord)
-
-instance Monoid Metadata where
- mempty = Metadata M.empty
- (Metadata m1) `mappend` (Metadata m2) = Metadata $ m1 `M.union` m2
-
--- | A resource represents a data source for the website. It contains a value
--- and a number of metadata fields
---
-data Resource a = Resource
- { resourceMetadata :: Metadata
- , resourceData :: a
- } deriving (Show, Eq, Ord)
-
-instance Functor Resource where
- fmap f (Resource m d) = Resource m $ f d
-
-instance Applicative Resource where
- pure d = Resource mempty d
- (Resource m1 f) <*> (Resource m2 d) = Resource (mappend m2 m1) (f d)
-
-instance Monad Resource where
- return d = Resource mempty d
- (Resource m1 d) >>= f = let Resource m2 d' = f d
- in Resource (mappend m2 m1) d'
-
-instance Monoid a => Monoid (Resource a) where
- mempty = Resource mempty mempty
- mappend (Resource m1 d1) (Resource m2 d2) =
- Resource (mappend m1 m2) (mappend d1 d2)
-
--- | Get the data from a resource
---
-getData :: Resource a -> a
-getData = resourceData
-
--- | Get a metadata field from a resource
---
-getMetadata :: String -> Resource a -> Maybe String
-getMetadata k (Resource m _) = M.lookup k $ unMetadata m
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
deleted file mode 100644
index a4559ca..0000000
--- a/src/Text/Hakyll/Tags.hs
+++ /dev/null
@@ -1,172 +0,0 @@
--- | Module containing some specialized functions to deal with tags.
--- This Module follows certain conventions. Stick with them.
---
--- More concrete: all functions in this module assume that the tags are
--- located in the @tags@ field, and separated by commas. An example file
--- @foo.markdown@ could look like:
---
--- > ---
--- > 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...
---
--- All the following functions would work with such a format. In addition to
--- tags, Hakyll also supports categories. The convention when using categories
--- is to place pages in subdirectories.
---
--- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@
--- Tags or categories are read using the @readTagMap@ and @readCategoryMap@
--- functions. Because categories are implemented using tags - categories can
--- be seen as tags, with the restriction that a page can only have one
--- category - all functions for tags also work with categories.
---
--- When reading a @TagMap@ (which is also used for category maps) using the
--- @readTagMap@ or @readCategoryMap@ function, you also have to give a unique
--- identifier to it. This identifier is simply for caching reasons, so Hakyll
--- can tell different maps apart; it has no other use.
---
-module Text.Hakyll.Tags
- ( TagMap
- , readTagMap
- , readCategoryMap
- , withTagMap
- , renderTagCloud
- , renderTagLinks
- ) where
-
-import qualified Data.Map as M
-import Data.List (intercalate)
-import Data.Maybe (fromMaybe, maybeToList)
-import Control.Arrow (second, (>>>))
-import Control.Applicative ((<$>))
-import System.FilePath
-
-import Text.Blaze.Renderer.String (renderHtml)
-import Text.Blaze.Html5 ((!), string, stringValue)
-import qualified Text.Blaze.Html5 as H
-import qualified Text.Blaze.Html5.Attributes as A
-
-import Text.Hakyll.Context (Context (..))
-import Text.Hakyll.ContextManipulations (changeValue)
-import Text.Hakyll.CreateContext (createPage)
-import Text.Hakyll.HakyllMonad (Hakyll)
-import Text.Hakyll.Regex
-import Text.Hakyll.HakyllAction
-import Text.Hakyll.Util
-import Text.Hakyll.Internal.Cache
-
--- | Type for a tag map.
---
--- This is a map associating tags or categories to the appropriate pages
--- using that tag or category. In the case of categories, each path will only
--- appear under one category - this is not the case with tags.
-type TagMap = M.Map String [HakyllAction () Context]
-
--- | Read a tag map. This is a internally used function that can be used for
--- tags as well as for categories.
-readMap :: (Context -> [String]) -- ^ Function to get tags from a context.
- -> String -- ^ Unique identifier for the tagmap.
- -> [FilePath]
- -> HakyllAction () TagMap
-readMap getTagsFunction identifier paths = HakyllAction
- { actionDependencies = paths
- , actionUrl = Right id
- , actionFunction = actionFunction'
- }
- where
- fileName = "tagmaps" </> identifier
-
- actionFunction' _ = do
- isCacheMoreRecent' <- isCacheMoreRecent fileName paths
- assocMap <- if isCacheMoreRecent'
- then M.fromAscList <$> getFromCache fileName
- else do assocMap' <- readTagMap'
- storeInCache (M.toAscList assocMap') fileName
- return assocMap'
- return $ M.map (map createPage) assocMap
-
- -- TODO: preserve order
- readTagMap' :: Hakyll (M.Map String [FilePath])
- readTagMap' = do
- pairs' <- concat <$> mapM pairs paths
- return $ M.fromListWith (flip (++)) pairs'
-
- -- | Read a page, and return an association list where every tag is
- -- associated with some paths. Of course, this will always be just one
- -- @FilePath@ here.
- pairs :: FilePath -> Hakyll [(String, [FilePath])]
- pairs path = do
- context <- runHakyllAction $ createPage path
- let tags = getTagsFunction context
- return $ map (\tag -> (tag, [path])) tags
-
--- | Read a @TagMap@, using the @tags@ metadata field.
-readTagMap :: String -- ^ Unique identifier for the map.
- -> [FilePath] -- ^ Paths to get tags from.
- -> HakyllAction () TagMap
-readTagMap = readMap getTagsFunction
- where
- getTagsFunction = map trim . splitRegex ","
- . fromMaybe [] . M.lookup "tags" . unContext
-
--- | Read a @TagMap@, using the subdirectories the pages are placed in.
-readCategoryMap :: String -- ^ Unique identifier for the map.
- -> [FilePath] -- ^ Paths to get tags from.
- -> HakyllAction () TagMap
-readCategoryMap = readMap $ maybeToList . M.lookup "category" . unContext
-
--- | Perform a @Hakyll@ action on every item in the tag
---
-withTagMap :: HakyllAction () TagMap
- -> (String -> [HakyllAction () Context] -> Hakyll ())
- -> Hakyll ()
-withTagMap tagMap function = runHakyllAction (tagMap >>> action)
- where
- action = createHakyllAction (mapM_ (uncurry function) . M.toList)
-
--- | Render a tag cloud.
-renderTagCloud :: (String -> String) -- ^ Function to produce an url for a tag.
- -> Float -- ^ Smallest font size, in percent.
- -> Float -- ^ Biggest font size, in percent.
- -> HakyllAction TagMap String
-renderTagCloud urlFunction minSize maxSize = createHakyllAction renderTagCloud'
- where
- renderTagCloud' tagMap =
- return $ intercalate " " $ map (renderTag tagMap) (tagCount tagMap)
-
- renderTag tagMap (tag, count) = renderHtml $
- H.a ! A.style (stringValue $ "font-size: " ++ sizeTag tagMap count)
- ! A.href (stringValue $ urlFunction tag)
- $ string tag
-
- sizeTag tagMap count = show (size' :: Int) ++ "%"
- where
- size' = floor $ minSize + relative tagMap count * (maxSize - minSize)
-
- minCount = minimum . map snd . tagCount
- maxCount = maximum . map snd . tagCount
- relative tagMap count = (count - minCount tagMap) /
- (maxCount tagMap - minCount tagMap)
-
- tagCount = map (second $ fromIntegral . length) . M.toList
-
--- | Render all tags to links.
---
--- On your site, it is nice if you can display the tags on a page, but
--- naturally, most people would expect these are clickable.
---
--- So, this function takes a function to produce an url for a given tag, and
--- applies it on all tags.
---
--- Note that it is your own responsibility to ensure a page with such an url
--- exists.
-renderTagLinks :: (String -> String) -- ^ Function to produce an url for a tag.
- -> HakyllAction Context Context
-renderTagLinks urlFunction = changeValue "tags" renderTagLinks'
- where
- renderTagLinks' = intercalate ", "
- . map ((\t -> link t $ urlFunction t) . trim)
- . splitRegex ","
diff --git a/src/Text/Hakyll/Transformer.hs b/src/Text/Hakyll/Transformer.hs
deleted file mode 100644
index 669e1d0..0000000
--- a/src/Text/Hakyll/Transformer.hs
+++ /dev/null
@@ -1,107 +0,0 @@
--- | This is the module which exports @Transformer@.
-module Text.Hakyll.Transformer
- ( Transformer (..)
- , transformResource
- , transformResourceM
- , transformData
- , transformDataM
- , transformMetadata
- , transformMetadataM
- , runTransformer
- , runTransformerForced
- ) where
-
-import Data.Monoid (Monoid, mappend, mempty)
-import Control.Arrow
-import Control.Category
-import Control.Applicative ((<$>))
-import Control.Monad ((<=<), unless, liftM2)
-import Prelude hiding ((.), id)
-
-import Text.Hakyll.Resource
-import Text.Hakyll.File (toDestination, isFileMoreRecent)
-import Text.Hakyll.Monad
-
--- | Type used for computations that transform resources, carrying along
--- dependencies.
---
-data Transformer a b = Transformer
- { -- | Dependencies of the @Transformer@.
- transformerDependencies :: [FilePath]
- , -- | URL pointing to the result of this @Transformer@.
- transformerUrl :: FilePath -> Hakyll FilePath
- , -- | The actual transforming function.
- transformerFunction :: Resource a -> Hakyll (Resource b)
- }
-
-instance Monoid b => Monoid (Transformer a b) where
- mempty = arr (const mempty)
- mappend x y = Transformer
- { transformerDependencies =
- transformerDependencies x ++ transformerDependencies y
- , transformerUrl = transformerUrl x
- , transformerFunction = \r ->
- liftM2 mappend (transformerFunction x r) (transformerFunction y r)
- }
-
-instance Category Transformer where
- id = Transformer
- { transformerDependencies = []
- , transformerUrl = return
- , transformerFunction = return
- }
-
- x . y = Transformer
- { transformerDependencies =
- transformerDependencies x ++ transformerDependencies y
- , transformerUrl = transformerUrl y <=< transformerUrl x
- , transformerFunction = transformerFunction x <=< transformerFunction y
- }
-
-instance Arrow Transformer where
- arr = transformData
-
- first t = t
- { transformerFunction = \(Resource m (x, y)) -> do
- Resource m' x' <- transformerFunction t $ Resource m x
- return $ Resource (mappend m' m) (x', y)
- }
-
-transformResource :: (Resource a -> Resource b) -> Transformer a b
-transformResource = transformResourceM . (return .)
-
-transformResourceM :: (Resource a -> Hakyll (Resource b)) -> Transformer a b
-transformResourceM f = id {transformerFunction = f}
-
-transformData :: (a -> b) -> Transformer a b
-transformData = transformResource . fmap
-
-transformDataM :: (a -> Hakyll b) -> Transformer a b
-transformDataM f = transformResourceM $ \(Resource m x) ->
- f x >>= return . Resource m
-
-transformMetadata :: (Metadata -> Metadata) -> Transformer a a
-transformMetadata = transformMetadataM . (return .)
-
-transformMetadataM :: (Metadata -> Hakyll Metadata) -> Transformer a a
-transformMetadataM f = transformResourceM $ \(Resource m x) -> do
- m' <- f m
- return $ Resource m' x
-
--- | Run a transformer. This might not run it when the result is up-to-date
---
-runTransformer :: Transformer () ()
- -> Hakyll ()
-runTransformer t = do
- url <- transformerUrl t $
- error "runTransformer: No url when checking dependencies."
- destination <- toDestination url
- valid <- isFileMoreRecent destination $ transformerDependencies t
- unless valid $ do logHakyll $ "Rendering " ++ destination
- runTransformerForced t
-
--- | Always run the transformer, even when the target is up-to-date
---
-runTransformerForced :: Transformer () ()
- -> Hakyll ()
-runTransformerForced t = getData <$> transformerFunction t mempty
diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs
deleted file mode 100644
index e032c52..0000000
--- a/src/Text/Hakyll/Util.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- | Miscellaneous text manipulation functions.
-module Text.Hakyll.Util
- ( trim
- , stripHtml
- , link
- ) where
-
-import Data.Char (isSpace)
-
-import Text.Blaze.Html5 ((!), string, stringValue, a)
-import Text.Blaze.Html5.Attributes (href)
-import Text.Blaze.Renderer.String (renderHtml)
-
--- | Trim a string (drop spaces, tabs and newlines at both sides).
-trim :: String -> String
-trim = reverse . trim' . reverse . trim'
- where
- trim' = dropWhile isSpace
-
--- | Strip html tags from the given string.
-stripHtml :: String -> String
-stripHtml [] = []
-stripHtml str = let (beforeTag, rest) = break (== '<') str
- (_, afterTag) = break (== '>') rest
- in beforeTag ++ stripHtml (drop 1 afterTag)
-
--- | Make a HTML link.
---
--- > link "foo" "bar.html" == "<a href='bar.html'>foo</a>"
-link :: String -- ^ Link text.
- -> String -- ^ Link destination.
- -> String
-link text destination = renderHtml $ a ! href (stringValue destination)
- $ string text
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-14 16:31:50 +0000