packages feed

gemoire-1.0.0: src/Gemoire/Converter.hs

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

-- |
-- Module      :  Gemoire.Converter
-- Copyright   :  (c) 2025 Sena
-- License     :  GPL-3.0-or-later
--
-- Maintainer  :  contact@sena.pink
-- Stability   :  stable
-- Portability :  portable
--
-- A tiny gemtext converter
--
-- Converting a Gemini capsule means substituting each gemtext element with a
-- template in the desired syntax. The template syntax is detailed in
-- `Gemoire.Template'. The document itself and each element in it have special
-- formatting variables attached, which are, respectively:
--
--     * Document - @body@ and /optional/ @title@
--     * Paragraphs - @text@
--     * Links - @link@ and /optional/ @description@
--     * All headings - @text@
--     * Quotes - @text@
--     * Preformatted - @text@ and /optional/ @alt@
--     * Lists /themselves/ - @items@
--     * List /items/ - @text@
--
-- Additionally, the body text may be modified using RegEx rewrite rules. See
-- `RewriteRule'.
--
-- The default configurations for HTML and Markdown can be found at `Gemoire.Converter.Web'
-- and `Gemoire.Converter.Markdown' respectively, or, see the bottom of this module.
module Gemoire.Converter
    ( -- * Configuration types
      Conversion (..)
    , RewriteRule

      -- * Converters
    , convertCapsule
    , convertDocument
    , convertElement

      -- * Re-exported default conversions
    , defWebConversion
    , defMarkdownConversion
    ) where

import Control.Arrow (second)
import Data.Bool (bool)
import Data.HashMap.Strict (fromList, singleton)
import Data.Maybe (isJust, maybeToList)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import System.Directory (copyFile, createDirectoryIfMissing)
import System.Directory.Extra (listFilesRecursive)
import System.FilePath (makeRelative, takeBaseName, takeExtension, takeFileName, (-<.>), (</>))
import Text.Gemini (GemItem (..))
import qualified Text.Gemini as G
import Text.Regex (matchRegex, mkRegex, mkRegexWithOpts, subRegex)

import Gemoire.Converter.Markdown (defMarkdownConversion)
import Gemoire.Converter.Types (Conversion (..), RewriteRule)
import Gemoire.Converter.Web (defWebConversion)
import Gemoire.Template (Values, format)

-- | Convert a Gemini capsule using the configuration.
--
-- The files are scanned recursively, retaining the directory structure.
-- Non-gemtext files will be copied without change, unless a rewrite rule
-- applies on them. Gemtext files will be converted to the desired format
-- with the target extension given in the configuration.
--
-- See the module description for more.
convertCapsule :: Conversion -> FilePath -> FilePath -> IO ()
convertCapsule config@Conversion{targetExtension, rewriteRules, conversionOverrides} input output = do
    files <-
        map
            ( second
                ( \file ->
                    bool
                        file
                        (file -<.> targetExtension)
                        (takeExtension file == ".gmi")
                )
                . (\inp -> (inp, output </> makeRelative input inp))
            )
            <$> listFilesRecursive input
    createDirectoryIfMissing True output
    mapM_
        ( \(inp, out) ->
            let rules = filterRules (takeFileName inp) rewriteRules
             in if takeExtension inp == ".gmi"
                    then
                        TIO.writeFile out
                            . convertDocument
                                (singleton "fname" (T.pack . takeBaseName $ inp) <> conversionOverrides)
                                (config{rewriteRules = rules})
                            =<< TIO.readFile inp
                    else
                        if not $ null rules
                            then TIO.writeFile out . rewriteText rules =<< TIO.readFile inp
                            else copyFile inp out
        )
        files

-- | Convert the given gemtext document using the corresponding templates
-- in the configuration.
--
-- See the module description for the special variables for each element and
-- the document itself.
--
-- The extra variables are available /only/ to the document template.
convertDocument
    :: Values
    -- ^ Extra variable overrides
    -> Conversion
    -> Text
    -> Text
convertDocument extras config@Conversion{documentTemplate, rewriteRules} text =
    let doc = G.decode text
     in format documentTemplate $
            extras
                <> fromList
                    ( [
                          ( "body"
                          , rewriteText rewriteRules
                                . T.intercalate "\LF"
                                . map (convertElement config)
                                $ doc
                          )
                      ]
                        <> maybeToList (("title",) <$> G.documentTitle doc)
                    )

-- | Convert a single `GemItem` element using the corresponding templates in the
-- configuration.
--
-- See the module description for the special variables for each element.
--
-- Rewriting rules are /not/ applied here.
convertElement :: Conversion -> GemItem -> Text
convertElement (Conversion{escaper, textTemplate}) (GemText text) =
    format textTemplate $ singleton "text" $ escaper text
convertElement (Conversion{escaper, linkTemplate}) (GemLink link desc) =
    format linkTemplate . fromList $
        [("link", escapeLink link)] <> maybeToList (("description",) . escaper <$> desc)
convertElement config (GemHeading level text) =
    let temp = case level of
            1 -> h1Template config
            2 -> h2Template config
            _ -> h3Template config
     in format temp $ singleton "text" $ escaper config text
convertElement (Conversion{escaper, quoteTemplate}) (GemQuote text) =
    format quoteTemplate $ singleton "text" $ escaper text
convertElement (Conversion{preEscaper, attrEscaper, preTemplate}) (GemPre ls alt) =
    format preTemplate . fromList $
        [("text", preEscaper $ T.intercalate "\LF" ls)] <> maybeToList (("alt",) . attrEscaper <$> alt)
convertElement (Conversion{escaper, listTemplates = (listTemplate, itemTemplate)}) (GemList items) =
    format listTemplate . fromList $
        [
            ( "items"
            , T.intercalate "\LF" $
                map (format itemTemplate . fromList . (: []) . ("text",) . escaper) items
            )
        ]

-- Percent encode given text minimally.
escapeLink :: Text -> Text
escapeLink = T.replace " " "%20" . T.replace "`" "%60" . T.replace "'" "%27" . T.replace "\"" "%22"

-- Filter the rewrite rules by the filename.
filterRules :: String -> [RewriteRule] -> [RewriteRule]
filterRules filename = filter (\(fn, _, _, _, _) -> isJust $ matchRegex (mkRegex fn) filename)

-- Apply all the given rules in order, ignoring the filename matching.
rewriteText :: [RewriteRule] -> Text -> Text
rewriteText ((_, regex, replace, multiline, caseSensitive) : rs) text =
    rewriteText rs . T.pack $
        subRegex (mkRegexWithOpts regex multiline caseSensitive) (T.unpack text) replace
rewriteText [] text = text