-- | The site menu, built from the pages that declare a nav entry
module MathiasSM.Context.Nav (navContext) where

import Control.Monad (filterM)
import Data.List (sortOn)
import Data.Maybe (catMaybes)
import Hakyll (
    Compiler,
    Context,
    Item (Item, itemBody, itemIdentifier),
    boolField,
    field,
    getMatches,
    getMetadata,
    listField,
    noResult,
    toFilePath,
 )
import MathiasSM.Config (SiteConfig, pagesPattern, siteEnv)
import MathiasSM.Content (Language (En), NavEntry (..), isHidden, languageCode, requireNav)
import System.FilePath.Posix (takeBaseName)

{- | The site menu as a @nav@ list (@label@, @href@, @active@, @lang@), built from the
pages that declare `nav:` and ordered by `navOrder`

@current@ is the name of the page being rendered (its file name without extension, or
its post group); that menu entry is @active@.
-}
navContext :: SiteConfig -> String -> Context a
navContext :: forall a. SiteConfig -> String -> Context a
navContext SiteConfig
cfg String
current = String -> Context NavEntry -> Compiler [Item NavEntry] -> Context a
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"nav" Context NavEntry
entryContext (SiteConfig -> Compiler [Item NavEntry]
navItems SiteConfig
cfg)
  where
    entryContext :: Context NavEntry
entryContext =
        String -> (Item NavEntry -> Compiler String) -> Context NavEntry
forall a. String -> (Item a -> Compiler String) -> Context a
field String
"label" (String -> Compiler String
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Compiler String)
-> (Item NavEntry -> String) -> Item NavEntry -> Compiler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavEntry -> String
navLabel (NavEntry -> String)
-> (Item NavEntry -> NavEntry) -> Item NavEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item NavEntry -> NavEntry
forall a. Item a -> a
itemBody)
            Context NavEntry -> Context NavEntry -> Context NavEntry
forall a. Semigroup a => a -> a -> a
<> String -> (Item NavEntry -> Compiler String) -> Context NavEntry
forall a. String -> (Item a -> Compiler String) -> Context a
field String
"href" (String -> Compiler String
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Compiler String)
-> (Item NavEntry -> String) -> Item NavEntry -> Compiler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavEntry -> String
navHref (NavEntry -> String)
-> (Item NavEntry -> NavEntry) -> Item NavEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item NavEntry -> NavEntry
forall a. Item a -> a
itemBody)
            Context NavEntry -> Context NavEntry -> Context NavEntry
forall a. Semigroup a => a -> a -> a
<> String -> (Item NavEntry -> Bool) -> Context NavEntry
forall a. String -> (Item a -> Bool) -> Context a
boolField String
"active" ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
current) (String -> Bool)
-> (Item NavEntry -> String) -> Item NavEntry -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeBaseName (String -> String)
-> (Item NavEntry -> String) -> Item NavEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> String
toFilePath (Identifier -> String)
-> (Item NavEntry -> Identifier) -> Item NavEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item NavEntry -> Identifier
forall a. Item a -> Identifier
itemIdentifier)
            Context NavEntry -> Context NavEntry -> Context NavEntry
forall a. Semigroup a => a -> a -> a
<> String -> (Item NavEntry -> Compiler String) -> Context NavEntry
forall a. String -> (Item a -> Compiler String) -> Context a
field String
"lang" (Language -> Compiler String
inOtherLanguage (Language -> Compiler String)
-> (Item NavEntry -> Language) -> Item NavEntry -> Compiler String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavEntry -> Language
navLanguage (NavEntry -> Language)
-> (Item NavEntry -> NavEntry) -> Item NavEntry -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item NavEntry -> NavEntry
forall a. Item a -> a
itemBody)

    -- The menu sits in an English header, so only other languages need marking
    inOtherLanguage :: Language -> Compiler String
inOtherLanguage Language
language
        | Language
language Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== Language
En = String -> Compiler String
forall a. String -> Compiler a
noResult String
"English"
        | Bool
otherwise = String -> Compiler String
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Compiler String) -> String -> Compiler String
forall a b. (a -> b) -> a -> b
$ Language -> String
languageCode Language
language

navItems :: SiteConfig -> Compiler [Item NavEntry]
navItems :: SiteConfig -> Compiler [Item NavEntry]
navItems SiteConfig
cfg = do
    pages <- Pattern -> Compiler [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches (Pattern -> Compiler [Identifier])
-> Pattern -> Compiler [Identifier]
forall a b. (a -> b) -> a -> b
$ SiteConfig -> String -> Pattern
pagesPattern SiteConfig
cfg String
"*"
    visible <- filterM (fmap (not . isHidden (siteEnv cfg)) . getMetadata) pages
    entries <- mapM (\Identifier
page -> (NavEntry -> Item NavEntry)
-> Maybe NavEntry -> Maybe (Item NavEntry)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identifier -> NavEntry -> Item NavEntry
forall a. Identifier -> a -> Item a
Item Identifier
page) (Maybe NavEntry -> Maybe (Item NavEntry))
-> Compiler (Maybe NavEntry) -> Compiler (Maybe (Item NavEntry))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Compiler (Maybe NavEntry)
requireNav Identifier
page) visible
    return $ sortOn (navOrder . itemBody) $ catMaybes entries