{-# LANGUAGE Trustworthy #-}

-- | The command-line interface and its subcommands
module MathiasSM.Cli (cli) where

import Control.Monad (filterM, unless)
import Data.Maybe (fromMaybe)
import Hakyll (hakyllWith)
import MathiasSM.Config (Env (..), SiteConfig (..), requiredContent, siteConfiguration)
import MathiasSM.Rules (rules)
import MathiasSM.Theme (discoverContentTemplateNames)
import MathiasSM.Yaml.Website qualified as Web
import System.Directory (doesDirectoryExist, doesFileExist)
import System.Environment (getArgs, lookupEnv)
import System.Exit (die)
import System.FilePath.Posix ((</>))
import Text.Read (readMaybe)

{- | Main entrypoint for the cli subcommands (usually called like @cabal run site SUBCMD@)

[@build@]: Generate the site into @_site@
[@clean@]: Clean the generated files from @_site@
[@rebuild@]: Runs @clean@ + @build@
[@server@]: Setup a quick dev server serving the files in @_site@
[@watch@]: Build, serve and rebuild site pieces as code changes
[@check@]: Verify broken links in @_site@ files

Note: build commands check for required content before running.
-}
cli :: IO ()
cli :: IO ()
cli = do
    let contentDir :: [Char]
contentDir = [Char]
"content"
    -- 1. Parse args
    args <- IO [[Char]]
getArgs
    -- 2. Get and validate website files/config
    -- (`website.yaml` is always required, even for `clean`)
    website <- Web.loadWebsite contentDir
    unless ("clean" `elem` args) (Web.validateSecurityExpiration website)
    -- 3. Check content exists
    cfg <- loadSiteConfig contentDir website
    unless ("clean" `elem` args) (ensureContentExists cfg)
    -- 4. Run command
    hakyllWith siteConfiguration (rules cfg website)

{- | Throws if the content repo is missing, or lacks a file the site needs

(Hakyll would otherwise build whatever it finds, possibly silently leaving out missing pages)
-}
ensureContentExists :: SiteConfig -> IO ()
ensureContentExists :: SiteConfig -> IO ()
ensureContentExists SiteConfig
cfg = do
    present <- [Char] -> IO Bool
doesDirectoryExist ([Char] -> IO Bool) -> [Char] -> IO Bool
forall a b. (a -> b) -> a -> b
$ SiteConfig -> [Char]
contentDir SiteConfig
cfg
    unless present
        $ die
        $ contentDir cfg ++ "/ not found"
    missing <- filterM (fmap not . doesFileExist) (requiredContent cfg)
    unless (null missing)
        $ die
        $ "Missing required content:\n" ++ unlines (map ("  " ++) missing)

-- | Builds the site configuration from @website.yaml@, with env variables overrides.
loadSiteConfig :: FilePath -> Web.Website -> IO SiteConfig
loadSiteConfig :: [Char] -> Website -> IO SiteConfig
loadSiteConfig [Char]
contentDir Website
website = do
    let site :: Site
site = Website -> Site
Web.websiteSite Website
website
    env <- Maybe [Char] -> Env
forall {a}. (Eq a, IsString a) => Maybe a -> Env
siteEnv (Maybe [Char] -> Env) -> IO (Maybe [Char]) -> IO Env
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"SITE_ENV"
    name <- override "SITE_NAME" (Web.siteName site)
    description <- override "SITE_DESCRIPTION" (Web.siteDescription site)
    author <- override "SITE_AUTHOR" (Web.siteAuthor site)
    year <- override "SITE_COPYRIGHT_YEAR" (Web.siteCopyrightYear site)
    domain <- override "SITE_DOMAIN" (Web.siteDomain site)
    twitter <- override "TWITTER_HANDLE" (Web.siteTwitterHandle site)
    mathjax <- override "MATHJAX_VERSION" (Web.mathjaxVersion (Web.websiteMathjax website))
    highlight <- highlightStyleFromEnv (Web.websiteHighlight website)
    contentTemplates <- discoverContentTemplateNames (contentDir </> "templates")
    pure
        SiteConfig
            { siteName = name
            , siteDescription = description
            , siteAuthor = author
            , siteCopyrightYear = year
            , siteDomain = domain
            , twitterHandle = twitter
            , mathjaxVersion = mathjax
            , highlightStyle = highlight
            , contentDir = contentDir
            , assetsDir = "assets" -- TODO
            , templatesDir = "templates" -- TODO
            , contentTemplatesDir = contentDir </> "templates"
            , contentCssDir = contentDir </> "css"
            , contentTemplateNames = contentTemplates
            , siteEnv = env
            }
  where
    override :: (Read a) => String -> a -> IO a
    override :: forall a. Read a => [Char] -> a -> IO a
override [Char]
var a
fallback = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
fallback (Maybe a -> a) -> (Maybe [Char] -> Maybe a) -> Maybe [Char] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [Char] -> ([Char] -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Maybe a
forall a. Read a => [Char] -> Maybe a
readMaybe) (Maybe [Char] -> a) -> IO (Maybe [Char]) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
var

    -- Unlike 'override', unknown values fail (matching the strict @website.yaml@ parsing)
    highlightStyleFromEnv :: Web.Highlight -> IO Web.HighlightStyle
    highlightStyleFromEnv :: Highlight -> IO HighlightStyle
highlightStyleFromEnv Highlight
section = do
        value <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"HIGHLIGHT_STYLE"
        case value of
            Maybe [Char]
Nothing -> HighlightStyle -> IO HighlightStyle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Highlight -> HighlightStyle
Web.highlightStyle Highlight
section)
            Just [Char]
name -> IO HighlightStyle
-> (HighlightStyle -> IO HighlightStyle)
-> Maybe HighlightStyle
-> IO HighlightStyle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> IO HighlightStyle
forall a. [Char] -> IO a
die ([Char] -> IO HighlightStyle) -> [Char] -> IO HighlightStyle
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown HIGHLIGHT_STYLE \"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\"") HighlightStyle -> IO HighlightStyle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Maybe HighlightStyle
Web.parseHighlightStyle [Char]
name)

    -- Defaults to Prod; unknown values currently also fall through to Prod.
    -- TODO: Let's have a stricter parse; unknown values should fail
    siteEnv :: Maybe a -> Env
siteEnv (Just a
"prod") = Env
Prod
    siteEnv (Just a
"dev") = Env
Dev
    siteEnv Maybe a
_ = Env
Prod