Gemlog.hs

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Gemoire.Gemlog
-- Copyright   :  (c) 2024 Sena
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  contact@sena.pink
-- Stability   :  stable
-- Portability :  portable
--
-- A tiny static gemlog generator
--
-- To make a gemlog, you need two essential types of materials: posts and
-- templates.
--
-- The template syntax detailed in `Gemoire.Template' is also usable in posts.
-- The posts processed using this module have some special variables available
-- to them while generating. Those are, including others:
--
--     * @title@ - The first heading in the document if it exists
--     * @path@ - The given file path /(non-overrideable)/
--     * @fname@ - The file name without the extension and the directories
--     * @modified@ - File modification date and time (@yyyy-mm-ddThh:mm:ss[.ss]±hh:mm@)
--     * @modified_date@ - File modification date (@yyyy-mm-dd@)
--     * @url@ - The permanent link to post /(non-overrideable)/
--     * @gemlog@ - The title of the gemlog /(non-overrideable)/
--     * @author@ - The author of the gemlog /(non-overrideable)/
--
-- Additionally, variables can also be set (or overridden) in the post like so,
-- assuming a /single variable per line/:
--
--     > {= variable value =}
--
-- For the templates, see `Gemoire.Template'. However, as with posts, feeds also
-- have special variables available. Those are, for the /feed itself/:
--
--     * @title@ - The title of the gemlog
--     * @author@ - The author of the gemlog
--     * @base@ - The base URL of the gemlog
--     * @url@ - The permanent link to the feed
--     * @entries@ - The formatted entries
--
-- For each entry in the feed, every variable the post associated with the entry has
-- is available.
--
-- See the README.md for a roughly step-by-step guide.
module Gemoire.Gemlog
    ( -- * Gemlog generation
      Gemlog (..)
    , generatePosts
    , generateGemfeed
    , generateAtom

      -- * Re-exports
    , defPost
    , defGemfeed
    , defGemfeedEntry
    , defAtom
    , defAtomEntry
    , vempty
    , vlist
    ) where

import Data.Bool (bool)
import Data.HashMap.Strict (findWithDefault, fromList, singleton)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
import System.Directory.Extra (listFilesRecursive)
import System.FilePath (takeExtension, takeFileName, (</>))

import Gemoire.Gemlog.Feed
    ( defAtom
    , defAtomEntry
    , defGemfeed
    , defGemfeedEntry
    , escapeFeed
    , lastModified
    , sortPosts
    )
import Gemoire.Gemlog.Post (defPost, readPost)
import Gemoire.Template (Template, Values, format, vempty, vlist)

-- | A gemlog recipe to generate files for
data Gemlog = Gemlog
    { title :: !Text
    -- ^ The title of the gemlog
    , author :: !Text
    -- ^ The author of the gemlog
    , sourceDir :: !FilePath
    -- ^ The source directory for posts, scanned recursively,
    -- /not/ retaining the directory structure
    , baseURL :: !Text
    -- ^ The base URL of the gemlog
    , postTemplate :: Template
    -- ^ The post template
    , gemfeedTemplates :: (Template, Template)
    -- ^ The gemfeed templates, where the first is the feed itself
    -- and the second is a single entry
    , atomTemplates :: (Template, Template)
    -- ^ The Atom feed templates, where the first is the feed itself
    -- and the second is a single entry
    , overrides :: !Values
    }
    deriving (Show, Eq)

-- | Generates and writes all the posts in the given `Gemlog' to the given directory.
--
-- The output directory is /flat/ and the structure of the source is /never/ retained.
--
-- See the module description for the variables available in the post.
generatePosts :: Gemlog -> FilePath -> IO ()
generatePosts glog@(Gemlog{postTemplate}) outputDir = do
    posts <- parsePosts glog
    createDirectoryIfMissing True outputDir
    mapM_ (\p -> writeFile (outputDir </> fileName p) $ T.unpack . crlf $ format postTemplate p) posts

-- | Generates a gemfeed in the given path.
--
-- See the module description for the variables available in the feed.
--
-- If the given path is a directory, the feed file will be named
-- @index.gmi@ by default.
--
-- The entries are sorted by last modified in the feed. Every variable in the
-- post is available in its respective entry. See `generatePosts' above.
generateGemfeed :: Gemlog -> FilePath -> IO ()
generateGemfeed = generateFeed True

-- | Generates an feed Atom in the given path.
--
-- See the module description for the variables available in the feed.
--
-- If the given path is a directory, the feed file will be named
-- @atom.xml@ by default.
--
-- The entries are sorted by last modified in the feed. Every variable in the post
-- is available in its respective entry. See `generatePosts' above.
--
-- Additionally, every variable is escaped to make the XML valid. Variables ending with
-- @url@ are escaped using percent encodings for URLs instead of ampersand. See `escapeAtom'.
generateAtom :: Gemlog -> FilePath -> IO ()
generateAtom = generateFeed False

-- The first parameter is @True@ for gemfeeds and @False@ for Atom.
-- Adds some additional variables described above.
generateFeed :: Bool -> Gemlog -> FilePath -> IO ()
generateFeed gemfeed glog@(Gemlog{title, author, baseURL, overrides}) path = do
    let (feed, entry) = bool atomTemplates gemfeedTemplates gemfeed glog
        ending = bool "" "\CR" gemfeed <> "\LF"
        fname = bool "atom.xml" "index.gmi" gemfeed
    output <- bool path (path </> fname) <$> doesDirectoryExist path
    posts <- sortPosts <$> parsePosts glog
    TIO.writeFile output
        . bool id crlf gemfeed
        . format feed
        . escapeFeed gemfeed
        . (overrides <>)
        . (lastModified posts <>)
        . fromList
        $ [ ("title", title)
          , ("author", author)
          , ("base", baseURL)
          , ("url", T.dropWhileEnd (== '/') baseURL <> "/" <> T.pack (takeFileName output))
          ,
              ( "entries"
              , T.intercalate ending $
                    map (T.stripEnd . bool id crlf gemfeed . format entry . escapeFeed gemfeed) posts
              )
          ]

-- Parse all the posts /recursively/ in a `Gemlog's source directory.
-- Adds the @url@, @gemlog@, and @author@ fields.
parsePosts :: Gemlog -> IO [Values]
parsePosts (Gemlog{title, author, sourceDir, baseURL, overrides}) =
    map (\p -> singleton "url" (T.dropWhileEnd (== '/') baseURL <> "/" <> T.pack (fileName p)) <> p)
        <$> ( mapM (readPost (fromList [("gemlog", title), ("author", author)] <> overrides))
                . filter ((== ".gmi") . takeExtension)
                =<< listFilesRecursive sourceDir
            )

-- Take the file name from the path in a parsed post.
fileName :: Values -> FilePath
fileName p = takeFileName . T.unpack $ findWithDefault "post.gmi" "path" p

-- Make the newlines CRLF in the given text if the boolean is @True@.
crlf :: Text -> Text
crlf = T.unlines . map ((<> "\CR") . T.dropWhileEnd (== '\CR')) . T.lines