summaryrefslogtreecommitdiff
path: root/src/Text/Hakyll
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Hakyll')
-rw-r--r--src/Text/Hakyll/CompressCSS.hs10
-rw-r--r--src/Text/Hakyll/Context.hs26
-rw-r--r--src/Text/Hakyll/Page.hs39
-rw-r--r--src/Text/Hakyll/Regex.hs34
-rw-r--r--src/Text/Hakyll/Render.hs44
-rw-r--r--src/Text/Hakyll/Renderable.hs2
-rw-r--r--src/Text/Hakyll/Renderables.hs12
-rw-r--r--src/Text/Hakyll/Tags.hs7
8 files changed, 91 insertions, 83 deletions
diff --git a/src/Text/Hakyll/CompressCSS.hs b/src/Text/Hakyll/CompressCSS.hs
index 85c061d..4b35558 100644
--- a/src/Text/Hakyll/CompressCSS.hs
+++ b/src/Text/Hakyll/CompressCSS.hs
@@ -3,7 +3,7 @@ module Text.Hakyll.CompressCSS
) where
import Data.List (isPrefixOf)
-import Text.Hakyll.Regex (substitute)
+import Text.Hakyll.Regex (substituteRegex)
-- | Compress CSS to speed up your site.
compressCSS :: String -> String
@@ -13,13 +13,13 @@ compressCSS = compressSeparators
-- | Compresses certain forms of separators.
compressSeparators :: String -> String
-compressSeparators = substitute "; *}" "}"
- . substitute " *([{};:]) *" "\\1"
- . substitute ";;*" ";"
+compressSeparators = substituteRegex "; *}" "}"
+ . substituteRegex " *([{};:]) *" "\\1"
+ . substituteRegex ";;*" ";"
-- | Compresses all whitespace.
compressWhitespace :: String -> String
-compressWhitespace = substitute "[ \t\n][ \t\n]*" " "
+compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " "
-- | Function that strips CSS comments away.
stripComments :: String -> String
diff --git a/src/Text/Hakyll/Context.hs b/src/Text/Hakyll/Context.hs
index 22409bf..074c88f 100644
--- a/src/Text/Hakyll/Context.hs
+++ b/src/Text/Hakyll/Context.hs
@@ -1,20 +1,23 @@
-- | Module containing various functions to manipulate contexts.
module Text.Hakyll.Context
- ( ContextManipulation
+ ( Context
+ , ContextManipulation
, renderValue
, renderDate
) where
import qualified Data.Map as M
-import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Map (Map)
import System.Locale (defaultTimeLocale)
import System.FilePath (takeFileName)
-import Text.Template (Context)
import Data.Time.Format (parseTime, formatTime)
import Data.Time.Clock (UTCTime)
import Data.Maybe (fromMaybe)
-import Text.Hakyll.Regex (substitute)
+import Text.Hakyll.Regex (substituteRegex)
+
+-- | Type for a context.
+type Context = Map String String
-- | Type for context manipulating functions.
type ContextManipulation = Context -> Context
@@ -22,11 +25,11 @@ type ContextManipulation = Context -> Context
-- | Do something with a value of a context.
renderValue :: String -- ^ Key of which the value should be copied.
-> String -- ^ Key the value should be copied to.
- -> (B.ByteString -> B.ByteString) -- ^ Function to apply on the value.
+ -> (String -> String) -- ^ Function to apply on the value.
-> ContextManipulation
-renderValue src dst f context = case M.lookup (B.pack src) context of
+renderValue src dst f context = case M.lookup src context of
Nothing -> context
- (Just value) -> M.insert (B.pack dst) (f value) context
+ (Just value) -> M.insert dst (f value) context
-- | When the context has a key called `path` in a `yyyy-mm-dd-title.extension`
-- format (default for pages), this function can render the date.
@@ -34,12 +37,11 @@ renderDate :: String -- ^ Key in which the rendered date should be placed.
-> String -- ^ Format to use on the date.
-> String -- ^ Default value when the date cannot be parsed.
-> ContextManipulation
-renderDate key format defaultValue context =
- M.insert (B.pack key) (B.pack value) context
+renderDate key format defaultValue context = M.insert key value context
where value = fromMaybe defaultValue pretty
- pretty = do filePath <- M.lookup (B.pack "path") context
- let dateString = substitute "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
- (takeFileName $ B.unpack filePath)
+ pretty = do filePath <- M.lookup "path" context
+ let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"
+ (takeFileName filePath)
time <- parseTime defaultTimeLocale
"%Y-%m-%d"
dateString :: Maybe UTCTime
diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs
index 83ca654..f70d898 100644
--- a/src/Text/Hakyll/Page.hs
+++ b/src/Text/Hakyll/Page.hs
@@ -8,7 +8,6 @@ module Text.Hakyll.Page
import qualified Data.Map as M
import qualified Data.List as L
-import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromMaybe)
import System.FilePath (FilePath, takeExtension)
@@ -16,10 +15,10 @@ import System.IO
import Text.Hakyll.File
import Text.Hakyll.Util (trim)
+import Text.Hakyll.Context (Context)
import Text.Hakyll.Renderable
import Text.Pandoc
-import Text.Template (Context)
-- | A Page is basically key-value mapping. Certain keys have special
-- meanings, like for example url, body and title.
@@ -31,26 +30,22 @@ fromContext = Page
-- | Obtain a value from a page. Will resturn an empty string when nothing is
-- found.
-getValue :: String -> Page -> B.ByteString
-getValue str (Page page) = fromMaybe B.empty $ M.lookup (B.pack str) page
-
--- | Auxiliary function to pack a pair.
-packPair :: (String, String) -> (B.ByteString, B.ByteString)
-packPair (a, b) = (B.pack a, B.pack b)
+getValue :: String -> Page -> String
+getValue str (Page page) = fromMaybe [] $ M.lookup str page
-- | Get the URL for a certain page. This should always be defined. If
-- not, it will error.
getPageURL :: Page -> String
-getPageURL (Page page) = B.unpack $ fromMaybe (error "No page url") $ M.lookup (B.pack "url") page
+getPageURL (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page
-- | Get the original page path.
getPagePath :: Page -> String
-getPagePath (Page page) = B.unpack $ fromMaybe (error "No page path") $ M.lookup (B.pack "path") page
+getPagePath (Page page) = fromMaybe (error "No page path") $ M.lookup "path" page
-- | Get the body for a certain page. When not defined, the body will be
-- empty.
-getBody :: Page -> B.ByteString
-getBody (Page page) = fromMaybe B.empty $ M.lookup (B.pack "body") page
+getBody :: Page -> String
+getBody (Page page) = fromMaybe [] $ M.lookup "body" page
-- | The default writer options for pandoc rendering.
writerOptions :: WriterOptions
@@ -86,13 +81,13 @@ cachePage page@(Page mapping) = do
makeDirectories destination
handle <- openFile destination WriteMode
hPutStrLn handle "---"
- mapM_ (writePair handle) $ M.toList $ M.delete (B.pack "body") mapping
+ mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping
hPutStrLn handle "---"
- B.hPut handle $ getBody page
+ hPutStr handle $ getBody page
hClose handle
- where writePair h (k, v) = B.hPut h k >>
- B.hPut h (B.pack ": ") >>
- B.hPut h v >>
+ where writePair h (k, v) = hPutStr h k >>
+ hPutStr h ": " >>
+ hPutStr h v >>
hPutStrLn h ""
-- | Read a page from a file. Metadata is supported, and if the filename
@@ -114,13 +109,13 @@ readPage pagePath = do
else hGetContents handle >>= \b -> return ([], line ++ b)
-- Render file
- let rendered = B.pack $ (renderFunction $ takeExtension path) body
+ let rendered = (renderFunction $ takeExtension path) body
seq rendered $ hClose handle
let page = fromContext $ M.fromList $
- [ (B.pack "body", rendered)
- , packPair ("url", url)
- , packPair ("path", pagePath)
- ] ++ map packPair context
+ [ ("body", rendered)
+ , ("url", url)
+ , ("path", pagePath)
+ ] ++ context
-- Cache if needed
if getFromCache then return () else cachePage page
diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs
index e2e21bc..37bbc7e 100644
--- a/src/Text/Hakyll/Regex.hs
+++ b/src/Text/Hakyll/Regex.hs
@@ -1,8 +1,8 @@
-- | A module that exports a simple regex interface. This code is mostly copied
-- from the regex-compat package at hackage.
module Text.Hakyll.Regex
- ( split
- , substitute
+ ( splitRegex
+ , substituteRegex
) where
import Text.Regex.TDFA
@@ -13,10 +13,10 @@ matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])
matchRegexAll p str = matchM p str
-- | 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 :: 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
@@ -43,9 +43,9 @@ subRegex regexp inp 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
+splitRegex' :: Regex -> String -> [String]
+splitRegex' _ [] = []
+splitRegex' delim strIn = loop strIn where
loop str = case matchOnceText delim str of
Nothing -> [str]
Just (firstline, _, remainder) ->
@@ -54,13 +54,13 @@ splitRegex delim strIn = loop strIn where
else firstline : loop remainder
-- | Split a list at a certain element.
-split :: String -> String -> [String]
-split pattern = filter (not . null)
- . splitRegex (makeRegex pattern)
+splitRegex :: String -> String -> [String]
+splitRegex pattern = filter (not . null)
+ . splitRegex' (makeRegex pattern)
-- | Substitute a regex. Simplified interface.
-substitute :: String -- ^ Pattern to replace (regex).
- -> String -- ^ Replacement string.
- -> String -- ^ Input string.
- -> String -- ^ Result.
-substitute pattern replacement str = subRegex (makeRegex pattern) str replacement
+substituteRegex :: String -- ^ Pattern to replace (regex).
+ -> String -- ^ Replacement string.
+ -> String -- ^ Input string.
+ -> String -- ^ Result.
+substituteRegex pattern replacement str = subRegex (makeRegex pattern) str replacement
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index d3e4a34..1719e83 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -10,15 +10,16 @@ module Text.Hakyll.Render
, css
) where
-import Text.Template hiding (render)
-import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Map as M
+import Data.List (isPrefixOf)
import Control.Monad (unless, liftM, foldM)
+import Data.Char (isAlpha)
+import Data.Maybe (fromMaybe)
import System.Directory (copyFile)
import System.IO
-import Text.Hakyll.Context (ContextManipulation)
+import Text.Hakyll.Context (Context, ContextManipulation)
import Text.Hakyll.Page
import Text.Hakyll.Renderable
import Text.Hakyll.File
@@ -33,6 +34,19 @@ depends file dependencies action = do
valid <- isCacheValid (toDestination file) dependencies
unless valid action
+-- | Substitutes `$identifiers` in the given string by values from the given
+-- "Context". When a key is not found, it is left as it is.
+substitute :: String -> Context -> String
+substitute [] _ = []
+substitute string context
+ | "$$" `isPrefixOf` string = "$$" ++ (substitute (tail tail') context)
+ | "$" `isPrefixOf` string = substitute'
+ | otherwise = (head string) : (substitute tail' context)
+ where tail' = tail string
+ (key, rest) = break (not . isAlpha) tail'
+ replacement = fromMaybe ('$' : key) $ M.lookup key context
+ substitute' = replacement ++ substitute rest context
+
-- | Render to a Page.
render :: Renderable a
=> FilePath -- ^ Template to use for rendering.
@@ -49,18 +63,18 @@ renderWith :: Renderable a
-> IO Page -- ^ The body of the result will contain the render.
renderWith manipulation templatePath renderable = do
handle <- openFile templatePath ReadMode
- templateString <- liftM B.pack $ hGetContents handle
+ templateString <- hGetContents handle
seq templateString $ hClose handle
context <- liftM manipulation $ toContext renderable
-- Ignore $root when substituting here. We will only replace that in the
-- final render (just before writing).
- let contextIgnoringRoot = M.insert (B.pack "root") (B.pack "$root") context
+ let contextIgnoringRoot = M.insert "root" "$root" context
body = substitute templateString contextIgnoringRoot
- return $ fromContext (M.insert (B.pack "body") body context)
+ return $ fromContext (M.insert "body" body context)
-- | Render each renderable with the given template, then concatenate the
-- result.
-renderAndConcat :: Renderable a => FilePath -> [a] -> IO B.ByteString
+renderAndConcat :: Renderable a => FilePath -> [a] -> IO String
renderAndConcat = renderAndConcatWith id
-- | Render each renderable with the given template, then concatenate the
@@ -70,14 +84,14 @@ renderAndConcatWith :: Renderable a
=> ContextManipulation
-> FilePath
-> [a]
- -> IO B.ByteString
+ -> IO String
renderAndConcatWith manipulation templatePath renderables =
- foldM concatRender' B.empty renderables
- where concatRender' :: Renderable a => B.ByteString -> a -> IO B.ByteString
+ foldM concatRender' [] renderables
+ where concatRender' :: Renderable a => String -> a -> IO String
concatRender' chunk renderable = do
rendered <- renderWith manipulation templatePath renderable
let body = getBody rendered
- return $ B.append chunk $ body
+ return $ chunk ++ body
-- | 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
@@ -100,11 +114,11 @@ writePage :: Page -> IO ()
writePage page = do
let destination = toDestination url
makeDirectories destination
- B.writeFile destination body
+ writeFile destination body
where url = getURL page
- -- Substitute $root here, just before writing.
- body = substitute (getBody page)
- (M.singleton (B.pack "root") (B.pack $ toRoot url))
+          -- Substitute $root here, just before writing.
+          body = substitute (getBody page)
+                            (M.singleton "root" $ toRoot url)
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs
index 4ca6f46..c8e780e 100644
--- a/src/Text/Hakyll/Renderable.hs
+++ b/src/Text/Hakyll/Renderable.hs
@@ -3,7 +3,7 @@ module Text.Hakyll.Renderable
) where
import System.FilePath (FilePath)
-import Text.Template (Context)
+import Text.Hakyll.Context (Context)
-- | A class for datatypes that can be rendered to pages.
class Renderable a where
diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs
index bd474e2..26d1e86 100644
--- a/src/Text/Hakyll/Renderables.hs
+++ b/src/Text/Hakyll/Renderables.hs
@@ -6,7 +6,6 @@ module Text.Hakyll.Renderables
) where
import System.FilePath (FilePath)
-import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Map as M
import Text.Hakyll.Page
import Text.Hakyll.Renderable
@@ -16,13 +15,13 @@ import Text.Hakyll.File
data CustomPage = CustomPage
{ url :: String,
dependencies :: [FilePath],
- mapping :: [(String, Either String (IO B.ByteString))]
+ mapping :: [(String, Either String (IO String))]
}
-- | Create a custom page.
createCustomPage :: String -- ^ Destination of the page, relative to _site.
-> [FilePath] -- ^ Dependencies of the page.
- -> [(String, Either String (IO B.ByteString))] -- ^ Key - value mapping for rendering.
+ -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering.
-> CustomPage
createCustomPage = CustomPage
@@ -30,10 +29,9 @@ instance Renderable CustomPage where
getDependencies = dependencies
getURL = url
toContext page = do
- values <- mapM (either (return . B.pack) (>>= return) . snd) (mapping page)
- let keys = map (B.pack . fst) (mapping page)
- return $ M.fromList $ [ (B.pack "url", B.pack $ url page)
- ] ++ zip keys values
+ values <- mapM (either (return) (>>= return) . snd) (mapping page)
+ return $ M.fromList $ [ ("url", url page)
+ ] ++ zip (map fst $ mapping page) values
-- | PagePath is a class that wraps a FilePath. This is used to render Pages
-- without reading them first through use of caching.
diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs
index 69386be..801b9b1 100644
--- a/src/Text/Hakyll/Tags.hs
+++ b/src/Text/Hakyll/Tags.hs
@@ -7,7 +7,6 @@ module Text.Hakyll.Tags
) where
import qualified Data.Map as M
-import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (intercalate)
import Control.Monad (foldM)
@@ -24,7 +23,7 @@ readTagMap :: [FilePath] -> IO (M.Map String [FilePath])
readTagMap paths = foldM addPaths M.empty paths
where addPaths current path = do
page <- readPage path
- let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page
+ let tags = map trim $ splitRegex "," $ getValue ("tags") page
return $ foldr (\t -> M.insertWith (++) t [path]) current tags
-- | Render a tag cloud.
@@ -57,6 +56,6 @@ renderTagCloud tagMap urlFunction minSize maxSize =
renderTagLinks :: (String -> String) -- ^ Function that produces an url for a tag.
-> ContextManipulation
renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'
- where renderTagLinks' = B.pack . intercalate ", "
+ where renderTagLinks' = intercalate ", "
. map (\t -> link t $ urlFunction t)
- . map trim . split "," . B.unpack
+ . map trim . splitRegex ","
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-28 07:21:47 +0000