Post.hs

{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Gemoire.Gemlog.Post
-- Copyright   :  (c) 2024 Sena
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  contact@sena.pink
-- Stability   :  stable
-- Portability :  portable
--
-- Minimal gemlog post parser/formatter and default templates
--
-- For posts, the template components are also usable, following the same
-- syntax described in `Gemoire.Template'. Variables available to the post will
-- be applied while parsing like in templates.
--
-- The variables available in a post /may/ change depending on what function parses
-- them. Unless doing heavy customization, see `Gemoire.Gemlog' for the variables
-- available in the intended use. Otherwise, see each function below.
--
-- Additionally, variables can also be set (or overridden) in the post like so,
-- assuming a /single variable per line/:
--
--     > {= variable value =}
module Gemoire.Gemlog.Post
    ( -- * Parsers
      parsePost
    , readPost

      -- * Templates
    , defPost
    ) where

import Control.Arrow ((***))
import Control.Monad (join)
import Data.Bool (bool)
import qualified Data.HashMap.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time (UTCTime (..), utc, utcToZonedTime)
import Data.Time.Format.ISO8601 (iso8601Show)
import System.Directory (getModificationTime)
import System.FilePath (takeBaseName)
import Text.Gemini (GemDocument, GemItem (..))
import qualified Text.Gemini as G

import Gemoire.Template (Template, Values, format, template)

defPost :: Template
defPost = template "{$post$}\CR\LF"

-- | Parses a GemText post into a map of `Values' to use in templates.
--
-- The post content will be evaluated and formatted using `template' and
-- `format' before creating the map.
--
-- Some special variables are also generated while parsing. Those are:
--
--     * @title@ - The first heading in the document if it exists
--     * @post@ - The post content (non-overrideable by the post text)
parsePost
    :: Values
    -- ^ Extra variable overrides
    -> Text
    -> Values
parsePost extras text = parse M.empty [] doc
  where
    doc = G.decode text

    parse :: Values -> GemDocument -> [GemItem] -> Values
    parse vars post (i : is) = case i of
        GemText line -> case getVariable line of
            Just pair -> parse (uncurry M.insert pair vars) post is
            Nothing -> parse vars (post <> [GemText line]) is
        line -> parse vars (post <> [line]) is
    parse vars post [] =
        let title = maybe M.empty (M.singleton "title") $ G.documentTitle doc
            recursive = extras <> vars <> title
            content =
                M.singleton "post"
                    $ stripFinalNewline
                        . (`format` recursive)
                        . template
                        . G.encode
                    $ post
         in extras <> content <> vars <> title

-- | Reads and parses a GemText post file into a map of `Values' to use in templates.
--
-- See `parsePost' for how this function works. Everything there applies here as well.
-- This function adds some additional formatting variables, which are:
--
--     * @path@ - The given file path
--     * @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@)
--
-- These variables are /not/ overrideable by the post text.
readPost
    :: Values
    -- ^ Extra variable overrides
    -> FilePath
    -> IO Values
readPost extras path = do
    modified <- stripTime <$> getModificationTime path
    let modifiedStr = T.pack . iso8601Show . utcToZonedTime utc $ modified
        modifiedDate = T.pack . iso8601Show . utctDay $ modified
     in parsePost
            ( extras
                <> M.fromList
                    [ ("path", T.pack path)
                    , ("fname", T.pack . takeBaseName $ path)
                    , ("modified", modifiedStr)
                    , ("modified_date", modifiedDate)
                    ]
            )
            <$> TIO.readFile path

-- Get the variable value if it exists.
getVariable :: Text -> Maybe (Text, Text)
getVariable line =
    (\v -> bool (Just v) Nothing (T.null $ fst v))
        . join (***) T.strip
        . T.break (== ' ')
        . T.strip
        =<< (T.stripPrefix "{=" line >>= T.stripSuffix "=}")

-- Strip the final newline from text if it exists.
stripFinalNewline :: Text -> Text
stripFinalNewline text
    | "\CR\LF" `T.isSuffixOf` text = T.dropEnd 2 text
    | "\LF" `T.isSuffixOf` text = T.dropEnd 1 text
    | otherwise = text

-- Strip the picosecond precision from time.
stripTime :: UTCTime -> UTCTime
stripTime (UTCTime day time) = UTCTime day $ fromInteger $ floor time