-- | Typed views of the content files: posts and pages (front matter)
module MathiasSM.Content (
    Language (..),
    languageCode,
    Post (..),
    NavEntry (..),
    isDraft,
    isHidden,
    isIndex,
    isSitemapExcluded,
    isTemplated,
    groupOf,
    aliasesOf,
    parseAliasesYaml,
    parsePost,
    parsePostYaml,
    parseNavEntry,
    parseNavYaml,
    showcaseKey,
    requirePost,
    requirePostOf,
    requireLanguage,
    requireNav,
    requireProject,
    requireSocials,
) where

import Control.Monad ((>=>))
import Data.Aeson (FromJSON (parseJSON), Value (String))
import Data.List (intercalate, stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Ord (Down (Down))
import Data.Time (Day)
import Hakyll (Compiler, Identifier, Item (itemBody), Metadata, getMetadata, getUnderlying, toFilePath)
import MathiasSM.Config (Env (..))
import MathiasSM.Metadata qualified as K
import MathiasSM.Yaml (Check (runCheck), decodeYaml, enumFromJSON, optional, required)
import MathiasSM.Yaml.Project (Project (..), parseProjectYaml)
import MathiasSM.Yaml.Social (Social (..), parseSocialsYaml)
import System.FilePath.Posix (addTrailingPathSeparator, (</>))

-- | Language a page is written in
data Language = En | Es | Ja
    deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> String
show :: Language -> String
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
(Language -> Language)
-> (Language -> Language)
-> (Int -> Language)
-> (Language -> Int)
-> (Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> Language -> [Language])
-> Enum Language
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Language -> Language
succ :: Language -> Language
$cpred :: Language -> Language
pred :: Language -> Language
$ctoEnum :: Int -> Language
toEnum :: Int -> Language
$cfromEnum :: Language -> Int
fromEnum :: Language -> Int
$cenumFrom :: Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromThenTo :: Language -> Language -> Language -> [Language]
Enum, Language
Language -> Language -> Bounded Language
forall a. a -> a -> Bounded a
$cminBound :: Language
minBound :: Language
$cmaxBound :: Language
maxBound :: Language
Bounded)

-- | The code used in front matter and in @lang@ attributes
languageCode :: Language -> String
languageCode :: Language -> String
languageCode Language
En = String
"en"
languageCode Language
Es = String
"es"
languageCode Language
Ja = String
"ja"

instance FromJSON Language where
    parseJSON :: Value -> Parser Language
parseJSON = String -> (Language -> String) -> Value -> Parser Language
forall a.
(Enum a, Bounded a) =>
String -> (a -> String) -> Value -> Parser a
enumFromJSON String
"language" Language -> String
languageCode

-- | What a post (blog, creative-writing) needs to be published
data Post = Post
    { Post -> String
postTitle :: String
    , Post -> Day
postDate :: Day
    , Post -> String
postPath :: FilePath
    , Post -> Language
postLanguage :: Language
    , Post -> Maybe Day
postLastModified :: Maybe Day
    , Post -> Bool
postDraft :: Bool
    }
    deriving (Post -> Post -> Bool
(Post -> Post -> Bool) -> (Post -> Post -> Bool) -> Eq Post
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Post -> Post -> Bool
== :: Post -> Post -> Bool
$c/= :: Post -> Post -> Bool
/= :: Post -> Post -> Bool
Eq, Int -> Post -> ShowS
[Post] -> ShowS
Post -> String
(Int -> Post -> ShowS)
-> (Post -> String) -> ([Post] -> ShowS) -> Show Post
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Post -> ShowS
showsPrec :: Int -> Post -> ShowS
$cshow :: Post -> String
show :: Post -> String
$cshowList :: [Post] -> ShowS
showList :: [Post] -> ShowS
Show)

-- | Parses front matter, reporting every problem (not just the first)
parsePost :: Metadata -> Either [String] Post
parsePost :: Metadata -> Either [String] Post
parsePost Metadata
o = do
    post <-
        Check Post -> Either [String] Post
forall a. Check a -> Either [String] a
runCheck (Check Post -> Either [String] Post)
-> Check Post -> Either [String] Post
forall a b. (a -> b) -> a -> b
$
            String -> Day -> String -> Language -> Maybe Day -> Bool -> Post
Post
                (String -> Day -> String -> Language -> Maybe Day -> Bool -> Post)
-> Check String
-> Check (Day -> String -> Language -> Maybe Day -> Bool -> Post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metadata -> Key -> Check String
forall a. FromJSON a => Metadata -> Key -> Check a
required Metadata
o Key
K.Title
                Check (Day -> String -> Language -> Maybe Day -> Bool -> Post)
-> Check Day
-> Check (String -> Language -> Maybe Day -> Bool -> Post)
forall a b. Check (a -> b) -> Check a -> Check b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metadata -> Key -> Check Day
forall a. FromJSON a => Metadata -> Key -> Check a
required Metadata
o Key
K.Date
                Check (String -> Language -> Maybe Day -> Bool -> Post)
-> Check String -> Check (Language -> Maybe Day -> Bool -> Post)
forall a b. Check (a -> b) -> Check a -> Check b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metadata -> Key -> Check String
forall a. FromJSON a => Metadata -> Key -> Check a
required Metadata
o Key
K.Path
                Check (Language -> Maybe Day -> Bool -> Post)
-> Check Language -> Check (Maybe Day -> Bool -> Post)
forall a b. Check (a -> b) -> Check a -> Check b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metadata -> Check Language
languageOf Metadata
o
                Check (Maybe Day -> Bool -> Post)
-> Check (Maybe Day) -> Check (Bool -> Post)
forall a b. Check (a -> b) -> Check a -> Check b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metadata -> Key -> Check (Maybe Day)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.LastModifiedAt
                Check (Bool -> Post) -> Check Bool -> Check Post
forall a b. Check (a -> b) -> Check a -> Check b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Check (Maybe Bool) -> Check Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metadata -> Key -> Check (Maybe Bool)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.Draft)
    case postLastModified post of
        Just Day
modified
            | Day
modified Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Post -> Day
postDate Post
post -> [String] -> Either [String] Post
forall a b. a -> Either a b
Left [String
"lastModifiedAt: is before date"]
        Maybe Day
_ -> Post -> Either [String] Post
forall a b. b -> Either a b
Right Post
post

-- | The language of an item (English unless stated)
languageOf :: Metadata -> Check Language
languageOf :: Metadata -> Check Language
languageOf Metadata
o = Language -> Maybe Language -> Language
forall a. a -> Maybe a -> a
fromMaybe Language
En (Maybe Language -> Language)
-> Check (Maybe Language) -> Check Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metadata -> Key -> Check (Maybe Language)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.Language

-- | Whether an item is marked `draft: true`, and so left out of the site
isDraft :: Metadata -> Bool
isDraft :: Metadata -> Bool
isDraft Metadata
o = Check (Maybe Bool) -> Either [String] (Maybe Bool)
forall a. Check a -> Either [String] a
runCheck (Metadata -> Key -> Check (Maybe Bool)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.Draft) Either [String] (Maybe Bool)
-> Either [String] (Maybe Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool -> Either [String] (Maybe Bool)
forall a b. b -> Either a b
Right (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)

-- | Whether a draft item is hidden from this build (dev shows drafts, prod hides them)
isHidden :: Env -> Metadata -> Bool
isHidden :: Env -> Metadata -> Bool
isHidden Env
Prod = Metadata -> Bool
isDraft
isHidden Env
Dev = Bool -> Metadata -> Bool
forall a b. a -> b -> a
const Bool
False

-- | Whether an item is a group index page (`index: true` in its front matter)
isIndex :: Metadata -> Bool
isIndex :: Metadata -> Bool
isIndex Metadata
o = Check (Maybe Bool) -> Either [String] (Maybe Bool)
forall a. Check a -> Either [String] a
runCheck (Metadata -> Key -> Check (Maybe Bool)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.Index) Either [String] (Maybe Bool)
-> Either [String] (Maybe Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool -> Either [String] (Maybe Bool)
forall a b. b -> Either a b
Right (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)

-- | Whether an item is marked `sitemap: false`, and so left out of the sitemap
isSitemapExcluded :: Metadata -> Bool
isSitemapExcluded :: Metadata -> Bool
isSitemapExcluded Metadata
o = Check (Maybe Bool) -> Either [String] (Maybe Bool)
forall a. Check a -> Either [String] a
runCheck (Metadata -> Key -> Check (Maybe Bool)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.Sitemap) Either [String] (Maybe Bool)
-> Either [String] (Maybe Bool) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool -> Either [String] (Maybe Bool)
forall a b. b -> Either a b
Right (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)

-- | Whether the current item is marked `templated: true`, and so may use template syntax in its body
isTemplated :: Compiler Bool
isTemplated :: Compiler Bool
isTemplated = do
    metadata <- Compiler Identifier
getUnderlying Compiler Identifier
-> (Identifier -> Compiler Metadata) -> Compiler Metadata
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier -> Compiler Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata
    return $ K.lookupKey K.Templated metadata == Just "true"

-- | The group an item belongs to: its `group:` front matter, or the folder it sits in under `writings/`
groupOf :: FilePath -> Identifier -> Metadata -> Maybe String
groupOf :: String -> Identifier -> Metadata -> Maybe String
groupOf String
contentDir Identifier
ident Metadata
metadata =
    case Key -> Metadata -> Maybe String
K.lookupKey Key
K.Group Metadata
metadata of
        Just String
group -> String -> Maybe String
forall a. a -> Maybe a
Just String
group
        Maybe String
Nothing -> do
            rest <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (ShowS
addTrailingPathSeparator (String
contentDir String -> ShowS
</> String
"writings")) (Identifier -> String
toFilePath Identifier
ident)
            case break (== '/') rest of
                (String
group, Char
'/' : String
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
group
                (String, String)
_ -> Maybe String
forall a. Maybe a
Nothing

{- | Old paths an item should redirect from (`aliases: [/old]`, or a single `aliases: /old`)

Each must be an absolute path other than the home page.
-}
aliasesOf :: Metadata -> Either [String] [FilePath]
aliasesOf :: Metadata -> Either [String] [String]
aliasesOf Metadata
o = do
    aliases <- [String] -> (AliasList -> [String]) -> Maybe AliasList -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] AliasList -> [String]
unAliasList (Maybe AliasList -> [String])
-> Either [String] (Maybe AliasList) -> Either [String] [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Check (Maybe AliasList) -> Either [String] (Maybe AliasList)
forall a. Check a -> Either [String] a
runCheck (Metadata -> Key -> Check (Maybe AliasList)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.Aliases)
    case concatMap problem aliases of
        [] -> [String] -> Either [String] [String]
forall a b. b -> Either a b
Right [String]
aliases
        [String]
problems -> [String] -> Either [String] [String]
forall a b. a -> Either a b
Left [String]
problems
  where
    problem :: String -> [String]
problem String
alias
        | String
alias String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"/" = [String
"aliases: / is the home page, it can't be an alias"]
        | Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
alias String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"/" = [String
"aliases: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
alias String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" must start with / (like /old-name)"]
        | Bool
otherwise = []

-- | A string or a list of strings
newtype AliasList = AliasList {AliasList -> [String]
unAliasList :: [String]}

instance FromJSON AliasList where
    parseJSON :: Value -> Parser AliasList
parseJSON v :: Value
v@(String Text
_) = [String] -> AliasList
AliasList ([String] -> AliasList)
-> (String -> [String]) -> String -> AliasList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> AliasList) -> Parser String -> Parser AliasList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    parseJSON Value
v = [String] -> AliasList
AliasList ([String] -> AliasList) -> Parser [String] -> Parser AliasList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [String]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | 'aliasesOf' on YAML text (the same shape as front matter)
parseAliasesYaml :: String -> Either [String] [FilePath]
parseAliasesYaml :: String -> Either [String] [String]
parseAliasesYaml = String -> Either [String] Metadata
forall a. FromJSON a => String -> Either [String] a
decodeYaml (String -> Either [String] Metadata)
-> (Metadata -> Either [String] [String])
-> String
-> Either [String] [String]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> Either [String] [String]
aliasesOf

-- | A page that appears in the site menu (`nav: <label>`, `navOrder: <n>` in its front matter)
data NavEntry = NavEntry
    { NavEntry -> String
navLabel :: String
    -- ^ What the menu link says; may contain HTML
    , NavEntry -> Int
navOrder :: Int
    , NavEntry -> String
navHref :: FilePath
    -- ^ The page's @path@
    , NavEntry -> Language
navLanguage :: Language
    }
    deriving (NavEntry -> NavEntry -> Bool
(NavEntry -> NavEntry -> Bool)
-> (NavEntry -> NavEntry -> Bool) -> Eq NavEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NavEntry -> NavEntry -> Bool
== :: NavEntry -> NavEntry -> Bool
$c/= :: NavEntry -> NavEntry -> Bool
/= :: NavEntry -> NavEntry -> Bool
Eq, Int -> NavEntry -> ShowS
[NavEntry] -> ShowS
NavEntry -> String
(Int -> NavEntry -> ShowS)
-> (NavEntry -> String) -> ([NavEntry] -> ShowS) -> Show NavEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NavEntry -> ShowS
showsPrec :: Int -> NavEntry -> ShowS
$cshow :: NavEntry -> String
show :: NavEntry -> String
$cshowList :: [NavEntry] -> ShowS
showList :: [NavEntry] -> ShowS
Show)

{- | The menu entry a page asks for, if it has a `nav:` label (it then also needs `navOrder`
and @path@)
-}
parseNavEntry :: Metadata -> Either [String] (Maybe NavEntry)
parseNavEntry :: Metadata -> Either [String] (Maybe NavEntry)
parseNavEntry Metadata
o = do
    label <- Check (Maybe String) -> Either [String] (Maybe String)
forall a. Check a -> Either [String] a
runCheck (Metadata -> Key -> Check (Maybe String)
forall a. FromJSON a => Metadata -> Key -> Check (Maybe a)
optional Metadata
o Key
K.Nav)
    case label of
        Maybe String
Nothing -> Maybe NavEntry -> Either [String] (Maybe NavEntry)
forall a b. b -> Either a b
Right Maybe NavEntry
forall a. Maybe a
Nothing
        Just String
text ->
            Check (Maybe NavEntry) -> Either [String] (Maybe NavEntry)
forall a. Check a -> Either [String] a
runCheck (Check (Maybe NavEntry) -> Either [String] (Maybe NavEntry))
-> Check (Maybe NavEntry) -> Either [String] (Maybe NavEntry)
forall a b. (a -> b) -> a -> b
$
                (\Int
order String
path Language
language -> NavEntry -> Maybe NavEntry
forall a. a -> Maybe a
Just (String -> Int -> String -> Language -> NavEntry
NavEntry String
text Int
order String
path Language
language))
                    (Int -> String -> Language -> Maybe NavEntry)
-> Check Int -> Check (String -> Language -> Maybe NavEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metadata -> Key -> Check Int
forall a. FromJSON a => Metadata -> Key -> Check a
required Metadata
o Key
K.NavOrder
                    Check (String -> Language -> Maybe NavEntry)
-> Check String -> Check (Language -> Maybe NavEntry)
forall a b. Check (a -> b) -> Check a -> Check b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metadata -> Key -> Check String
forall a. FromJSON a => Metadata -> Key -> Check a
required Metadata
o Key
K.Path
                    Check (Language -> Maybe NavEntry)
-> Check Language -> Check (Maybe NavEntry)
forall a b. Check (a -> b) -> Check a -> Check b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metadata -> Check Language
languageOf Metadata
o

{- | Sort key for the showcase: projects with a @priority@ first (lowest number
first), then the rest, newest start first
-}
showcaseKey :: Project -> (Int, Down Day)
showcaseKey :: Project -> (Int, Down Day)
showcaseKey Project
p = (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
forall a. Bounded a => a
maxBound (Project -> Maybe Int
projectPriority Project
p), Day -> Down Day
forall a. a -> Down a
Down (Project -> Day
projectStart Project
p))

-- | 'parseNavEntry' on YAML text (the same shape as front matter)
parseNavYaml :: String -> Either [String] (Maybe NavEntry)
parseNavYaml :: String -> Either [String] (Maybe NavEntry)
parseNavYaml = String -> Either [String] Metadata
forall a. FromJSON a => String -> Either [String] a
decodeYaml (String -> Either [String] Metadata)
-> (Metadata -> Either [String] (Maybe NavEntry))
-> String
-> Either [String] (Maybe NavEntry)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> Either [String] (Maybe NavEntry)
parseNavEntry

-- | 'parsePost' on YAML text (the same shape as front matter)
parsePostYaml :: String -> Either [String] Post
parsePostYaml :: String -> Either [String] Post
parsePostYaml = String -> Either [String] Metadata
forall a. FromJSON a => String -> Either [String] a
decodeYaml (String -> Either [String] Metadata)
-> (Metadata -> Either [String] Post)
-> String
-> Either [String] Post
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Metadata -> Either [String] Post
parsePost

-- | Parses the current item's front matter, failing the build with the problems found
requirePost :: Compiler Post
requirePost :: Compiler Post
requirePost = do
    metadata <- Compiler Identifier
getUnderlying Compiler Identifier
-> (Identifier -> Compiler Metadata) -> Compiler Metadata
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier -> Compiler Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata
    either (failWith "invalid front matter") pure (parsePost metadata)

-- | Parses the front matter of any item, failing the build (naming it) with the problems found
requirePostOf :: Identifier -> Compiler Post
requirePostOf :: Identifier -> Compiler Post
requirePostOf Identifier
ident = do
    metadata <- Identifier -> Compiler Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
ident
    either (failWith $ toFilePath ident ++ ": invalid front matter") pure (parsePost metadata)

-- | The language of an item, failing the build if it's not a known one
requireLanguage :: Identifier -> Compiler Language
requireLanguage :: Identifier -> Compiler Language
requireLanguage Identifier
ident = do
    metadata <- Identifier -> Compiler Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
ident
    either (failWith $ toFilePath ident ++ ": invalid language") pure (runCheck $ languageOf metadata)

-- | The menu entry of any page, failing the build (naming the page) if it's invalid
requireNav :: Identifier -> Compiler (Maybe NavEntry)
requireNav :: Identifier -> Compiler (Maybe NavEntry)
requireNav Identifier
ident = do
    metadata <- Identifier -> Compiler Metadata
forall (m :: * -> *). MonadMetadata m => Identifier -> m Metadata
getMetadata Identifier
ident
    either (failWith $ toFilePath ident ++ ": invalid menu entry") pure (parseNavEntry metadata)

-- | Parses a project item (its body is the YAML), failing the build with the problems found
requireProject :: Item String -> Compiler Project
requireProject :: Item String -> Compiler Project
requireProject = ([String] -> Compiler Project)
-> (Project -> Compiler Project)
-> Either [String] Project
-> Compiler Project
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> [String] -> Compiler Project
forall a. String -> [String] -> Compiler a
failWith String
"invalid project") Project -> Compiler Project
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [String] Project -> Compiler Project)
-> (Item String -> Either [String] Project)
-> Item String
-> Compiler Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either [String] Project
parseProjectYaml (String -> Either [String] Project)
-> (Item String -> String)
-> Item String
-> Either [String] Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item String -> String
forall a. Item a -> a
itemBody

-- | Parses the socials item (its body is the YAML list), failing the build with the problems found
requireSocials :: Item String -> Compiler [Social]
requireSocials :: Item String -> Compiler [Social]
requireSocials = ([String] -> Compiler [Social])
-> ([Social] -> Compiler [Social])
-> Either [String] [Social]
-> Compiler [Social]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> [String] -> Compiler [Social]
forall a. String -> [String] -> Compiler a
failWith String
"invalid socials") [Social] -> Compiler [Social]
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [String] [Social] -> Compiler [Social])
-> (Item String -> Either [String] [Social])
-> Item String
-> Compiler [Social]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either [String] [Social]
parseSocialsYaml (String -> Either [String] [Social])
-> (Item String -> String)
-> Item String
-> Either [String] [Social]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item String -> String
forall a. Item a -> a
itemBody

{- | Fails the build listing the problems.

Hakyll already prefixes the error with the item being compiled, so the message
only says what is wrong (and names the other item when it isn't the one compiling).
-}
failWith :: String -> [String] -> Compiler a
failWith :: forall a. String -> [String] -> Compiler a
failWith String
what [String]
problems = String -> Compiler a
forall a. String -> Compiler a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler a) -> String -> Compiler a
forall a b. (a -> b) -> a -> b
$ String
what String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
problems)