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