    -- | 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.Monad          (forM_, when)
    import           Data.Binary            (Binary (..))
    import           Data.List              (sort, group)
    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 =
    -- >     [ ("projects.html", "http://github.com/gwern")
    -- >     , ("/Black-market archive", "Black-market%20archives")
    -- >     ]
    --
    -- In which case the functionality can then be used in `main` with a line like:
    --
    -- > version "redirects" $ createRedirects brokenLinks
    --
    -- The 'version' is recommended to separate these items from your other pages.
    --
    -- 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 :: [(Identifier, FilePath)] -> Rules ()
    createRedirects [(Identifier, FilePath)]
    redirects =
     do -- redirects are many-to-fewer; keys must be unique, and must point somewhere else:
        let gkeys :: [[Identifier]]
    gkeys = [Identifier] -> [[Identifier]]
    forall a. Eq a => [a] -> [[a]]
    group ([Identifier] -> [[Identifier]]) -> [Identifier] -> [[Identifier]]
    forall a b. (a -> b) -> a -> b
    $ [Identifier] -> [Identifier]
    forall a. Ord a => [a] -> [a]
    sort ([Identifier] -> [Identifier]) -> [Identifier] -> [Identifier]
    forall a b. (a -> b) -> a -> b
    $ ((Identifier, FilePath) -> Identifier)
    -> [(Identifier, FilePath)] -> [Identifier]
    forall a b. (a -> b) -> [a] -> [b]
    map (Identifier, FilePath) -> Identifier
    forall a b. (a, b) -> a
    fst [(Identifier, FilePath)]
    redirects
        [[Identifier]] -> ([Identifier] -> Rules ()) -> Rules ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [[Identifier]]
    gkeys (([Identifier] -> Rules ()) -> Rules ())
    -> ([Identifier] -> Rules ()) -> Rules ()
    forall a b. (a -> b) -> a -> b
    $ \[Identifier]
    gkey -> case [Identifier]
    gkey of
            (Identifier
    k : Identifier
    _ : [Identifier]
    _) -> FilePath -> Rules ()
    forall a. FilePath -> Rules a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> Rules ()) -> FilePath -> Rules ()
    forall a b. (a -> b) -> a -> b
    $
                FilePath
    "Duplicate 301 redirects; " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Identifier -> FilePath
    forall a. Show a => a -> FilePath
    show Identifier
    k FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " is ambiguous."
            [Identifier]
    _           -> () -> Rules ()
    forall a. a -> Rules a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        [(Identifier, FilePath)]
    -> ((Identifier, FilePath) -> Rules ()) -> Rules ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Identifier, FilePath)]
    redirects (((Identifier, FilePath) -> Rules ()) -> Rules ())
    -> ((Identifier, FilePath) -> Rules ()) -> Rules ()
    forall a b. (a -> b) -> a -> b
    $ \(Identifier
    r, FilePath
    t) ->
            Bool -> Rules () -> Rules ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Identifier -> FilePath
    toFilePath Identifier
    r FilePath -> FilePath -> Bool
    forall a. Eq a => a -> a -> Bool
    == FilePath
    t) (Rules () -> Rules ()) -> Rules () -> Rules ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Rules ()
    forall a. FilePath -> Rules a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> Rules ()) -> FilePath -> Rules ()
    forall a b. (a -> b) -> a -> b
    $
                FilePath
    "Self-redirect detected: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Identifier -> FilePath
    forall a. Show a => a -> FilePath
    show Identifier
    r FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    " points to itself."

        [(Identifier, FilePath)]
    -> ((Identifier, FilePath) -> Rules ()) -> Rules ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Identifier, FilePath)]
    redirects (((Identifier, FilePath) -> Rules ()) -> Rules ())
    -> ((Identifier, FilePath) -> Rules ()) -> Rules ()
    forall a b. (a -> b) -> a -> b
    $ \(Identifier
    ident, FilePath
    to) ->
            [Identifier] -> Rules () -> Rules ()
    create [Identifier
    ident] (Rules () -> Rules ()) -> Rules () -> Rules ()
    forall a b. (a -> b) -> a -> b
    $ do
                Routes -> Rules ()
    route Routes
    idRoute
                Compiler (Item Redirect) -> Rules ()
    forall a.
    (Binary a, Typeable a, Writable a) =>
    Compiler (Item a) -> Rules ()
    compile (Compiler (Item Redirect) -> Rules ())
    -> Compiler (Item Redirect) -> Rules ()
    forall a b. (a -> b) -> a -> b
    $ Redirect -> Compiler (Item Redirect)
    forall a. a -> Compiler (Item a)
    makeItem (Redirect -> Compiler (Item Redirect))
    -> Redirect -> Compiler (Item Redirect)
    forall a b. (a -> b) -> a -> b
    $! FilePath -> Redirect
    Redirect FilePath
    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
        { Redirect -> FilePath
    redirectTo :: String
        } deriving (Redirect -> Redirect -> Bool
    (Redirect -> Redirect -> Bool)
    -> (Redirect -> Redirect -> Bool) -> Eq Redirect
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Redirect -> Redirect -> Bool
    == :: Redirect -> Redirect -> Bool
    $c/= :: Redirect -> Redirect -> Bool
    /= :: Redirect -> Redirect -> Bool
    Eq, Eq Redirect
    Eq Redirect =>
    (Redirect -> Redirect -> Ordering)
    -> (Redirect -> Redirect -> Bool)
    -> (Redirect -> Redirect -> Bool)
    -> (Redirect -> Redirect -> Bool)
    -> (Redirect -> Redirect -> Bool)
    -> (Redirect -> Redirect -> Redirect)
    -> (Redirect -> Redirect -> Redirect)
    -> Ord Redirect
    Redirect -> Redirect -> Bool
    Redirect -> Redirect -> Ordering
    Redirect -> Redirect -> Redirect
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Redirect -> Redirect -> Ordering
    compare :: Redirect -> Redirect -> Ordering
    $c< :: Redirect -> Redirect -> Bool
    < :: Redirect -> Redirect -> Bool
    $c<= :: Redirect -> Redirect -> Bool
    <= :: Redirect -> Redirect -> Bool
    $c> :: Redirect -> Redirect -> Bool
    > :: Redirect -> Redirect -> Bool
    $c>= :: Redirect -> Redirect -> Bool
    >= :: Redirect -> Redirect -> Bool
    $cmax :: Redirect -> Redirect -> Redirect
    max :: Redirect -> Redirect -> Redirect
    $cmin :: Redirect -> Redirect -> Redirect
    min :: Redirect -> Redirect -> Redirect
    Ord, Int -> Redirect -> FilePath -> FilePath
    [Redirect] -> FilePath -> FilePath
    Redirect -> FilePath
    (Int -> Redirect -> FilePath -> FilePath)
    -> (Redirect -> FilePath)
    -> ([Redirect] -> FilePath -> FilePath)
    -> Show Redirect
    forall a.
    (Int -> a -> FilePath -> FilePath)
    -> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
    $cshowsPrec :: Int -> Redirect -> FilePath -> FilePath
    showsPrec :: Int -> Redirect -> FilePath -> FilePath
    $cshow :: Redirect -> FilePath
    show :: Redirect -> FilePath
    $cshowList :: [Redirect] -> FilePath -> FilePath
    showList :: [Redirect] -> FilePath -> FilePath
    Show)

    instance Binary Redirect where
        put :: Redirect -> Put
    put (Redirect FilePath
    to) = FilePath -> Put
    forall t. Binary t => t -> Put
    put FilePath
    to
        get :: Get Redirect
    get = FilePath -> Redirect
    Redirect (FilePath -> Redirect) -> Get FilePath -> Get Redirect
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get FilePath
    forall t. Binary t => Get t
    get

    instance Writable Redirect where
        write :: FilePath -> Item Redirect -> IO ()
    write FilePath
    path = FilePath -> Item FilePath -> IO ()
    forall a. Writable a => FilePath -> Item a -> IO ()
    write FilePath
    path (Item FilePath -> IO ())
    -> (Item Redirect -> Item FilePath) -> Item Redirect -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Redirect -> FilePath) -> Item Redirect -> Item FilePath
    forall a b. (a -> b) -> Item a -> Item b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Redirect -> FilePath
    redirectToHtml

    redirectToHtml :: Redirect -> String
    redirectToHtml :: Redirect -> FilePath
    redirectToHtml (Redirect FilePath
    working) =
        FilePath
    "<!DOCTYPE html><html><head><meta charset=\"utf-8\"/><meta name=\"generator\" content=\"hakyll\"/>" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
        FilePath
    "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
        FilePath
    "<meta http-equiv=\"refresh\" content=\"0; url=" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    working FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
        FilePath
    "\"><link rel=\"canonical\" href=\"" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    working FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
        FilePath
    "\"><title>Permanent Redirect</title></head><body><p>The page has moved to: <a href=\"" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    working FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++
        FilePath
    "\">this page</a></p></body></html>"