-- | The Atom feeds: one per post group, described by the group's index page
module MathiasSM.Feeds (Feed (..), feedHref, feeds, absoluteUrl) where

import Data.Either (lefts, rights)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import Hakyll (MonadMetadata (getMatches, getMetadata), toFilePath)
import MathiasSM.CleanURL (outputPath)
import MathiasSM.Config (SiteConfig, pagesPattern, projectsGroup, siteName)
import MathiasSM.Metadata (Key (Description, Path, Title), lookupKey)
import MathiasSM.Writings (discoverGroups)
import System.FilePath.Posix (takeDirectory, (</>))

-- | An Atom feed, described by its group's index page
data Feed = Feed
    { Feed -> [Char]
feedGroup :: String
    , Feed -> [Char]
feedTitle :: String
    , Feed -> [Char]
feedDescription :: String
    , Feed -> [Char]
feedFile :: FilePath
    -- ^ Output file, relative to the site root (e.g. @blog/atom.xml@)
    }
    deriving (Feed -> Feed -> Bool
(Feed -> Feed -> Bool) -> (Feed -> Feed -> Bool) -> Eq Feed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Feed -> Feed -> Bool
== :: Feed -> Feed -> Bool
$c/= :: Feed -> Feed -> Bool
/= :: Feed -> Feed -> Bool
Eq, Int -> Feed -> ShowS
[Feed] -> ShowS
Feed -> [Char]
(Int -> Feed -> ShowS)
-> (Feed -> [Char]) -> ([Feed] -> ShowS) -> Show Feed
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Feed -> ShowS
showsPrec :: Int -> Feed -> ShowS
$cshow :: Feed -> [Char]
show :: Feed -> [Char]
$cshowList :: [Feed] -> ShowS
showList :: [Feed] -> ShowS
Show)

-- | Where the feed is served from
feedHref :: Feed -> String
feedHref :: Feed -> [Char]
feedHref Feed
feed = Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
: Feed -> [Char]
feedFile Feed
feed

{- | The feed of every post group, or every problem found

Each feed lives next to the group's index page (`/blog` has `/blog/atom.xml`) and
takes its title and description from that page.
-}
feeds :: (MonadMetadata m) => SiteConfig -> m (Either [String] [Feed])
feeds :: forall (m :: * -> *).
MonadMetadata m =>
SiteConfig -> m (Either [[Char]] [Feed])
feeds SiteConfig
cfg = do
    groups <- SiteConfig -> m [[Char]]
forall (m :: * -> *). MonadMetadata m => SiteConfig -> m [[Char]]
discoverGroups SiteConfig
cfg
    collect <$> mapM (feedOf cfg) (filter (/= projectsGroup) groups)
  where
    collect :: [Either a b] -> Either [a] [b]
collect [Either a b]
results = case [Either a b] -> [a]
forall a b. [Either a b] -> [a]
lefts [Either a b]
results of
        [] -> [b] -> Either [a] [b]
forall a b. b -> Either a b
Right ([Either a b] -> [b]
forall a b. [Either a b] -> [b]
rights [Either a b]
results)
        [a]
problems -> [a] -> Either [a] [b]
forall a b. a -> Either a b
Left [a]
problems

feedOf :: (MonadMetadata m) => SiteConfig -> String -> m (Either String Feed)
feedOf :: forall (m :: * -> *).
MonadMetadata m =>
SiteConfig -> [Char] -> m (Either [Char] Feed)
feedOf SiteConfig
cfg [Char]
group = do
    indexPages <- Pattern -> m [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches (SiteConfig -> [Char] -> Pattern
pagesPattern SiteConfig
cfg [Char]
group)
    case indexPages of
        [] -> Either [Char] Feed -> m (Either [Char] Feed)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [Char] Feed -> m (Either [Char] Feed))
-> Either [Char] Feed -> m (Either [Char] Feed)
forall a b. (a -> b) -> a -> b
$ [Char] -> Either [Char] Feed
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Feed) -> [Char] -> Either [Char] Feed
forall a b. (a -> b) -> a -> b
$ [Char]
"no index page for the group " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
group
        Identifier
page : [Identifier]
_ -> do
            metadata <- Identifier -> m Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
page
            pure $ case lookupKey Path metadata of
                Maybe [Char]
Nothing -> [Char] -> Either [Char] Feed
forall a b. a -> Either a b
Left ([Char] -> Either [Char] Feed) -> [Char] -> Either [Char] Feed
forall a b. (a -> b) -> a -> b
$ Identifier -> [Char]
toFilePath Identifier
page [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": needs a `path:` for the feed"
                Just [Char]
path ->
                    Feed -> Either [Char] Feed
forall a b. b -> Either a b
Right
                        Feed
                            { feedGroup :: [Char]
feedGroup = [Char]
group
                            , feedTitle :: [Char]
feedTitle = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
group (Key -> Metadata -> Maybe [Char]
lookupKey Key
Title Metadata
metadata) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" - " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SiteConfig -> [Char]
siteName SiteConfig
cfg
                            , feedDescription :: [Char]
feedDescription = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (Key -> Metadata -> Maybe [Char]
lookupKey Key
Description Metadata
metadata)
                            , feedFile :: [Char]
feedFile = ShowS
takeDirectory (ShowS
outputPath [Char]
path) [Char] -> ShowS
</> [Char]
"atom.xml"
                            }

{- | Makes a root-relative URL (`/contact`) absolute, as feed readers have no page to resolve it against.

Anything else (full URLs, `//host`, `#anchor`, `mailto:`, relative paths) is left alone.
-}
absoluteUrl :: String -> String -> String
absoluteUrl :: [Char] -> ShowS
absoluteUrl [Char]
root [Char]
url
    | [Char]
"/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
url Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char]
"//" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
url) = [Char]
root [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
url
    | Bool
otherwise = [Char]
url