-- | Rules that build redirect pages from aliases
module MathiasSM.Rules.Redirects (processRedirects, Entry (..), planRedirects) where

import Data.Either (fromLeft)
import Data.List (tails)
import Hakyll (
    Rules,
    createRedirects,
    fromFilePath,
    getAllMetadata,
    preprocess,
    toFilePath,
    version,
 )
import MathiasSM.CleanURL (outputPath)
import MathiasSM.Config (SiteConfig, pagesPattern, postsPattern)
import MathiasSM.Content (aliasesOf, isDraft)
import MathiasSM.Metadata (Key (Path), lookupKey)
import MathiasSM.Writings (discoverGroups)

-- | A published page or post, with the old paths that should lead to it
data Entry = Entry
    { Entry -> [Char]
entryFile :: FilePath
    , Entry -> Maybe [Char]
entryPath :: Maybe FilePath
    , Entry -> [[Char]]
entryAliases :: [FilePath]
    }
    deriving (Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: Entry -> Entry -> Bool
Eq, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> [Char]
(Int -> Entry -> ShowS)
-> (Entry -> [Char]) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Entry -> ShowS
showsPrec :: Int -> Entry -> ShowS
$cshow :: Entry -> [Char]
show :: Entry -> [Char]
$cshowList :: [Entry] -> ShowS
showList :: [Entry] -> ShowS
Show)

{- | Builds a redirect page for every `aliases:` of every published page and post

Invalid aliases fail the build.
-}
processRedirects :: SiteConfig -> Rules ()
processRedirects :: SiteConfig -> Rules ()
processRedirects SiteConfig
cfg = do
    groups <- SiteConfig -> Rules [[Char]]
forall (m :: * -> *). MonadMetadata m => SiteConfig -> m [[Char]]
discoverGroups SiteConfig
cfg
    items <- concat <$> mapM getAllMetadata (pagesPattern cfg "*" : map (postsPattern cfg) groups)
    let parsed = [(Identifier -> [Char]
toFilePath Identifier
ident, Metadata
metadata, Metadata -> Either [[Char]] [[Char]]
aliasesOf Metadata
metadata) | (Identifier
ident, Metadata
metadata) <- [(Identifier, Metadata)]
items, Bool -> Bool
not (Metadata -> Bool
isDraft Metadata
metadata)]
        entries = [[Char] -> Maybe [Char] -> [[Char]] -> Entry
Entry [Char]
file (Key -> Metadata -> Maybe [Char]
lookupKey Key
Path Metadata
metadata) [[Char]]
aliases | ([Char]
file, Metadata
metadata, Right [[Char]]
aliases) <- [([Char], Metadata, Either [[Char]] [[Char]])]
parsed]
        planned = [Entry] -> Either [[Char]] [([Char], [Char])]
planRedirects [Entry]
entries
        problems =
            [[Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
problem | ([Char]
file, Metadata
_, Left [[Char]]
found) <- [([Char], Metadata, Either [[Char]] [[Char]])]
parsed, [Char]
problem <- [[Char]]
found]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> Either [[Char]] [([Char], [Char])] -> [[Char]]
forall a b. a -> Either a b -> a
fromLeft [] Either [[Char]] [([Char], [Char])]
planned
    case planned of
        Right [([Char], [Char])]
redirects | [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
problems -> [Char] -> Rules () -> Rules ()
version [Char]
"redirects" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ [(Identifier, [Char])] -> Rules ()
createRedirects [([Char] -> Identifier
fromFilePath [Char]
out, [Char]
target) | ([Char]
out, [Char]
target) <- [([Char], [Char])]
redirects]
        Either [[Char]] [([Char], [Char])]
_ -> IO () -> Rules ()
forall a. IO a -> Rules a
preprocess (IO () -> Rules ()) -> IO () -> Rules ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError ([Char] -> IOError) -> [Char] -> IOError
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid aliases:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines (ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) [[Char]]
problems)

{- | The redirects to build, as (output file, target path), or every problem found:
an alias that is its own path, the path of another page, or claimed twice
-}
planRedirects :: [Entry] -> Either [String] [(FilePath, FilePath)]
planRedirects :: [Entry] -> Either [[Char]] [([Char], [Char])]
planRedirects [Entry]
entries
    | [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
problems = [([Char], [Char])] -> Either [[Char]] [([Char], [Char])]
forall a b. b -> Either a b
Right [(ShowS
outputPath [Char]
alias, [Char]
target) | ([Char]
_, [Char]
alias, Just [Char]
target) <- [([Char], [Char], Maybe [Char])]
claims]
    | Bool
otherwise = [[Char]] -> Either [[Char]] [([Char], [Char])]
forall a b. a -> Either a b
Left [[Char]]
problems
  where
    claims :: [([Char], [Char], Maybe [Char])]
claims = [([Char]
file, [Char]
alias, Maybe [Char]
path) | Entry [Char]
file Maybe [Char]
path [[Char]]
aliases <- [Entry]
entries, [Char]
alias <- [[Char]]
aliases]
    published :: [([Char], [Char])]
published = [([Char]
file, [Char]
path) | Entry [Char]
file (Just [Char]
path) [[Char]]
_ <- [Entry]
entries]
    same :: [Char] -> [Char] -> Bool
same [Char]
a [Char]
b = ShowS
outputPath [Char]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== ShowS
outputPath [Char]
b
    problems :: [[Char]]
problems =
        [[Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": aliases need a `path:` to point to" | ([Char]
file, [Char]
_, Maybe [Char]
Nothing) <- [([Char], [Char], Maybe [Char])]
claims]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": alias " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
alias [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is its own path" | ([Char]
file, [Char]
alias, Just [Char]
path) <- [([Char], [Char], Maybe [Char])]
claims, [Char] -> [Char] -> Bool
same [Char]
alias [Char]
path]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": alias " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
alias [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is the path of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
other | ([Char]
file, [Char]
alias, Maybe [Char]
_) <- [([Char], [Char], Maybe [Char])]
claims, ([Char]
other, [Char]
path) <- [([Char], [Char])]
published, [Char]
other [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
file, [Char] -> [Char] -> Bool
same [Char]
alias [Char]
path]
            [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [ [Char]
file [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": alias " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
alias [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" is also claimed by " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
other
               | ([Char]
file, [Char]
alias, Maybe [Char]
_) : [([Char], [Char], Maybe [Char])]
later <- [([Char], [Char], Maybe [Char])]
-> [[([Char], [Char], Maybe [Char])]]
forall a. [a] -> [[a]]
tails [([Char], [Char], Maybe [Char])]
claims
               , ([Char]
other, [Char]
alias', Maybe [Char]
_) <- [([Char], [Char], Maybe [Char])]
later
               , [Char] -> [Char] -> Bool
same [Char]
alias [Char]
alias'
               ]