on master help sign in
Add toUrl, move & optimize replaceAll a bit
2d12251Jasper Van der Jeugt
src/Hakyll/Web/CompressCss.hs+1−15
@@ -6,23 +6,9 @@ module Text.Hakyll.Internal.CompressCss
6 ) where
6 ) where
7
7
8import Data.Char (isSpace)
8import Data.Char (isSpace)
9−import Data.Maybe (listToMaybe)
10import Data.List (isPrefixOf)
9import Data.List (isPrefixOf)
11−import Text.Regex.Posix ((=~~))
12
10
13−-- | A simple (but inefficient) regex replace funcion
11+import Hakyll.Web.Util.String
14−--
15−replaceAll :: String -- ^ Pattern
16− -> (String -> String) -- ^ Replacement (called on capture)
17− -> String -- ^ Source string
18− -> String -- ^ Result
19−replaceAll pattern f source =
20− case listToMaybe (source =~~ pattern) of
21− Nothing -> source
22− Just (o, l) ->
23− let (before, tmp) = splitAt o source
24− (capture, after) = splitAt l tmp
25− in before ++ f capture ++ replaceAll pattern f after
26
12
27-- | Compress CSS to speed up your site.
13-- | Compress CSS to speed up your site.
28--
14--
src/Hakyll/Web/Page.hs+2−2
@@ -56,8 +56,8 @@ addDefaultFields = (getRoute &&& id >>^ uncurry addRoute)
56 where
56 where
57 -- Add root and url, based on route
57 -- Add root and url, based on route
58 addRoute Nothing = id
58 addRoute Nothing = id
59− addRoute (Just r) = addField "url" r
59+ addRoute (Just r) = addField "url" (toUrl r)
60− . addField "root" (toSiteRoot r)
60+ . addField "root" (toSiteRoot $ toUrl r)
61
61
62 -- Add title and category, based on identifier
62 -- Add title and category, based on identifier
63 addIdentifier i = addField "title" (takeBaseName p)
63 addIdentifier i = addField "title" (takeBaseName p)
src/Hakyll/Web/Util/String.hs+33−1
@@ -2,12 +2,16 @@
2--
2--
3module Hakyll.Web.Util.String
3module Hakyll.Web.Util.String
4 ( trim
4 ( trim
5+ , replaceAll
6+ , toUrl
5 , toSiteRoot
7 , toSiteRoot
6 ) where
8 ) where
7
9
8import Data.Char (isSpace)
10import Data.Char (isSpace)
11+import Data.Maybe (listToMaybe)
9
12
10import System.FilePath (splitPath, takeDirectory, joinPath)
13import System.FilePath (splitPath, takeDirectory, joinPath)
14+import Text.Regex.PCRE ((=~~))
11
15
12-- | Trim a string (drop spaces, tabs and newlines at both sides).
16-- | Trim a string (drop spaces, tabs and newlines at both sides).
13--
17--
@@ -16,9 +20,37 @@ trim = reverse . trim' . reverse . trim'
16 where
20 where
17 trim' = dropWhile isSpace
21 trim' = dropWhile isSpace
18
22
23+-- | A simple (but inefficient) regex replace funcion
24+--
25+replaceAll :: String -- ^ Pattern
26+ -> (String -> String) -- ^ Replacement (called on capture)
27+ -> String -- ^ Source string
28+ -> String -- ^ Result
29+replaceAll pattern f source = replaceAll' source
30+ where
31+ replaceAll' src = case listToMaybe (src =~~ pattern) of
32+ Nothing -> src
33+ Just (o, l) ->
34+ let (before, tmp) = splitAt o src
35+ (capture, after) = splitAt l tmp
36+ in before ++ f capture ++ replaceAll' after
37+
38+-- | Convert a filepath to an URL starting from the site root
39+--
40+-- Example:
41+--
42+-- > toUrl "foo/bar.html"
43+--
44+-- Result:
45+--
46+-- > "/foo/bar.html"
47+--
48+toUrl :: FilePath -> String
49+toUrl = ('/' :)
50+
19-- | Get the relative url to the site root, for a given (absolute) url
51-- | Get the relative url to the site root, for a given (absolute) url
20--
52--
21−toSiteRoot :: FilePath -> FilePath
53+toSiteRoot :: String -> String
22toSiteRoot = emptyException . joinPath . map parent . splitPath . takeDirectory
54toSiteRoot = emptyException . joinPath . map parent . splitPath . takeDirectory
23 where
55 where
24 parent = const ".."
56 parent = const ".."