diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Hakyll.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Web/Redirect.hs | 82 |
2 files changed, 85 insertions, 1 deletions
diff --git a/src/Hakyll.hs b/src/Hakyll.hs index edc79a0..7b64bcb 100644 --- a/src/Hakyll.hs +++ b/src/Hakyll.hs @@ -21,10 +21,11 @@ module Hakyll , module Hakyll.Web.Html , module Hakyll.Web.Html.RelativizeUrls , module Hakyll.Web.Pandoc + , module Hakyll.Web.Paginate , module Hakyll.Web.Pandoc.Biblio , module Hakyll.Web.Pandoc.FileType + , module Hakyll.Web.Redirect , module Hakyll.Web.Tags - , module Hakyll.Web.Paginate , module Hakyll.Web.Template , module Hakyll.Web.Template.Context , module Hakyll.Web.Template.List @@ -54,6 +55,7 @@ import Hakyll.Web.Paginate import Hakyll.Web.Pandoc import Hakyll.Web.Pandoc.Biblio import Hakyll.Web.Pandoc.FileType +import Hakyll.Web.Redirect import Hakyll.Web.Tags import Hakyll.Web.Template import Hakyll.Web.Template.Context diff --git a/src/Hakyll/Web/Redirect.hs b/src/Hakyll/Web/Redirect.hs new file mode 100644 index 0000000..ead56fe --- /dev/null +++ b/src/Hakyll/Web/Redirect.hs @@ -0,0 +1,82 @@ +-- | Module used for generating HTML redirect pages. This allows renaming pages +-- to avoid breaking existing links without requiring server-side support for +-- formal 301 Redirect error codes +module Hakyll.Web.Redirect + ( Redirect (..) + , createRedirects + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (forM_) +import Data.Binary (Binary (..)) +import Hakyll.Core.Compiler +import Hakyll.Core.Identifier +import Hakyll.Core.Routes +import Hakyll.Core.Rules +import Hakyll.Core.Writable (Writable (..)) + +-- | This function exposes a higher-level interface compared to using the +-- 'Redirect' type manually. +-- +-- This creates, using a database mapping broken URLs to working ones, HTML +-- files which will do HTML META tag redirect pages (since, as a static site, we +-- can't use web-server-level 301 redirects, and using JS is gross). +-- +-- This is useful for sending people using old URLs to renamed versions, dealing +-- with common typos etc, and will increase site traffic. Such broken URLs can +-- be found by looking at server logs or by using Google Webmaster Tools. +-- Broken URLs must be valid Haskell strings, non-URL-escaped valid POSIX +-- filenames, and relative links, since they will be defined in a @hakyll.hs@ +-- and during generation, written to disk with the filename corresponding to the +-- broken URLs. (Target URLs can be absolute or relative, but should be +-- URL-escaped.) So broken incoming links like <http://www.gwern.net/foo/> which +-- should be <http://www.gwern.net/foobar> cannot be fixed (since you cannot +-- create a HTML file named @"foo/"@ on disk, as that would be a directory). +-- +-- An example of a valid association list would be: +-- +-- > brokenLinks = [("/Black-market archive", "/Black-market%20archives")] +-- +-- In which case the functionality can then be used in `main` with a line like: +-- +-- > createRedirects brokenLinks +-- +-- The on-disk files can then be uploaded with HTML mimetypes +-- (either explicitly by generating and uploading them separately, by +-- auto-detection of the filetype, or an upload tool defaulting to HTML +-- mimetype, such as calling @s3cmd@ with @--default-mime-type=text/html@) and +-- will redirect browsers and search engines going to the old/broken URLs. +-- +-- See also <https://groups.google.com/d/msg/hakyll/sWc6zxfh-uM/fUpZPsFNDgAJ>. +createRedirects :: [(Identifier, String)] -> Rules () +createRedirects redirects = + forM_ redirects $ \(ident, to) -> + create [ident] $ do + route idRoute + compile $ makeItem $! Redirect to + +-- | This datatype can be used directly if you want a lower-level interface to +-- generate redirects. For example, if you want to redirect @foo.html@ to +-- @bar.jpg@, you can use: +-- +-- > create ["foo.html"] $ do +-- > route idRoute +-- > compile $ makeItem $ Redirect "bar.jpg" +data Redirect = Redirect + { redirectTo :: String + } deriving (Eq, Ord, Show) + +instance Binary Redirect where + put (Redirect to) = put to + get = Redirect <$> get + +instance Writable Redirect where + write path = write path . fmap redirectToHtml + +redirectToHtml :: Redirect -> String +redirectToHtml (Redirect working) = + "<!DOCTYPE html><html><head><meta charset=\"utf-8\"/><meta name=\"generator\" content=\"hakyll\"/>" ++ + "<meta http-equiv=\"refresh\" content=\"0; url=" ++ working ++ + "\"><link rel=\"canonical\" href=\"" ++ working ++ + "\"><title>Permanent Redirect</title></head><body><p>The page has moved to: <a href=\"" ++ working ++ + "\">this page</a></p></body></html>" |