{-# 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
    , takeDirectory
    , 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 :: Conversion -> String -> String -> IO ()
convertCapsule config :: Conversion
config@Conversion{String
targetExtension :: String
targetExtension :: Conversion -> String
targetExtension, [RewriteRule]
rewriteRules :: [RewriteRule]
rewriteRules :: Conversion -> [RewriteRule]
rewriteRules, Values
conversionOverrides :: Values
conversionOverrides :: Conversion -> Values
conversionOverrides} String
input String
output = do
    [(String, String)]
files <-
        (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map
            ( (String -> String) -> (String, String) -> (String, String)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
                ( \String
file ->
                    String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool
                        String
file
                        (String
file String -> String -> String
-<.> String
targetExtension)
                        (String -> String
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".gmi")
                )
                ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
inp -> (String
inp, String
output String -> String -> String
</> String -> String -> String
makeRelative String
input String
inp))
            )
            ([String] -> [(String, String)])
-> IO [String] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listFilesRecursive String
input
    ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
        ( \(String
inp, String
out) ->
            let rules :: [RewriteRule]
rules = String -> [RewriteRule] -> [RewriteRule]
filterRules (String -> String
takeFileName String
inp) [RewriteRule]
rewriteRules
             in Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
out)
                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> if String -> String
takeExtension String
inp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".gmi"
                        then
                            String -> Text -> IO ()
TIO.writeFile String
out
                                (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> Conversion -> Text -> Text
convertDocument
                                    (Text -> Text -> Values
forall k v. Hashable k => k -> v -> HashMap k v
singleton Text
"fname" (String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeBaseName (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
inp) Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Values
conversionOverrides)
                                    (Conversion
config{rewriteRules = rules})
                                (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Text
TIO.readFile String
inp
                        else
                            if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RewriteRule]
rules
                                then String -> Text -> IO ()
TIO.writeFile String
out (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RewriteRule] -> Text -> Text
rewriteText [RewriteRule]
rules (Text -> IO ()) -> IO Text -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO Text
TIO.readFile String
inp
                                else String -> String -> IO ()
copyFile String
inp String
out
        )
        [(String, String)]
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 :: Values -> Conversion -> Text -> Text
convertDocument Values
extras config :: Conversion
config@Conversion{Template
documentTemplate :: Template
documentTemplate :: Conversion -> Template
documentTemplate, [RewriteRule]
rewriteRules :: Conversion -> [RewriteRule]
rewriteRules :: [RewriteRule]
rewriteRules} Text
text =
    let doc :: GemDocument
doc = Text -> GemDocument
G.decode Text
text
     in Template -> Values -> Text
format Template
documentTemplate (Values -> Text) -> Values -> Text
forall a b. (a -> b) -> a -> b
$
            Values
extras
                Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList
                    ( [
                          ( Text
"body"
                          , [RewriteRule] -> Text -> Text
rewriteText [RewriteRule]
rewriteRules
                                (Text -> Text) -> (GemDocument -> Text) -> GemDocument -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\LF"
                                ([Text] -> Text) -> (GemDocument -> [Text]) -> GemDocument -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GemItem -> Text) -> GemDocument -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Conversion -> GemItem -> Text
convertElement Conversion
config)
                                (GemDocument -> Text) -> GemDocument -> Text
forall a b. (a -> b) -> a -> b
$ GemDocument
doc
                          )
                      ]
                        [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList ((Text
"title",) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GemDocument -> Maybe Text
G.documentTitle GemDocument
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 -> GemItem -> Text
convertElement (Conversion{Text -> Text
escaper :: Text -> Text
escaper :: Conversion -> Text -> Text
escaper, Template
textTemplate :: Template
textTemplate :: Conversion -> Template
textTemplate}) (GemText Text
text) =
    Template -> Values -> Text
format Template
textTemplate (Values -> Text) -> Values -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Values
forall k v. Hashable k => k -> v -> HashMap k v
singleton Text
"text" (Text -> Values) -> Text -> Values
forall a b. (a -> b) -> a -> b
$ Text -> Text
escaper Text
text
convertElement (Conversion{Text -> Text
escaper :: Conversion -> Text -> Text
escaper :: Text -> Text
escaper, Template
linkTemplate :: Template
linkTemplate :: Conversion -> Template
linkTemplate}) (GemLink Text
link Maybe Text
desc) =
    Template -> Values -> Text
format Template
linkTemplate (Values -> Text)
-> ([(Text, Text)] -> Values) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Text, Text)] -> Text) -> [(Text, Text)] -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text
"link", Text -> Text
escapeLink Text
link)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList ((Text
"description",) (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escaper (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
desc)
convertElement Conversion
config (GemHeading Int
level Text
text) =
    let temp :: Template
temp = case Int
level of
            Int
1 -> Conversion -> Template
h1Template Conversion
config
            Int
2 -> Conversion -> Template
h2Template Conversion
config
            Int
_ -> Conversion -> Template
h3Template Conversion
config
     in Template -> Values -> Text
format Template
temp (Values -> Text) -> Values -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Values
forall k v. Hashable k => k -> v -> HashMap k v
singleton Text
"text" (Text -> Values) -> Text -> Values
forall a b. (a -> b) -> a -> b
$ Conversion -> Text -> Text
escaper Conversion
config Text
text
convertElement (Conversion{Text -> Text
escaper :: Conversion -> Text -> Text
escaper :: Text -> Text
escaper, Template
quoteTemplate :: Template
quoteTemplate :: Conversion -> Template
quoteTemplate}) (GemQuote Text
text) =
    Template -> Values -> Text
format Template
quoteTemplate (Values -> Text) -> Values -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Values
forall k v. Hashable k => k -> v -> HashMap k v
singleton Text
"text" (Text -> Values) -> Text -> Values
forall a b. (a -> b) -> a -> b
$ Text -> Text
escaper Text
text
convertElement (Conversion{Text -> Text
preEscaper :: Text -> Text
preEscaper :: Conversion -> Text -> Text
preEscaper, Text -> Text
attrEscaper :: Text -> Text
attrEscaper :: Conversion -> Text -> Text
attrEscaper, Template
preTemplate :: Template
preTemplate :: Conversion -> Template
preTemplate}) (GemPre [Text]
ls Maybe Text
alt) =
    Template -> Values -> Text
format Template
preTemplate (Values -> Text)
-> ([(Text, Text)] -> Values) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Text, Text)] -> Text) -> [(Text, Text)] -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text
"text", Text -> Text
preEscaper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\LF" [Text]
ls)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList ((Text
"alt",) (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
attrEscaper (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
alt)
convertElement (Conversion{Text -> Text
escaper :: Conversion -> Text -> Text
escaper :: Text -> Text
escaper, listTemplates :: Conversion -> (Template, Template)
listTemplates = (Template
listTemplate, Template
itemTemplate)}) (GemList [Text]
items) =
    Template -> Values -> Text
format Template
listTemplate (Values -> Text)
-> ([(Text, Text)] -> Values) -> [(Text, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Text, Text)] -> Text) -> [(Text, Text)] -> Text
forall a b. (a -> b) -> a -> b
$
        [
            ( Text
"items"
            , Text -> [Text] -> Text
T.intercalate Text
"\LF" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Template -> Values -> Text
format Template
itemTemplate (Values -> Text) -> (Text -> Values) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> Values
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList ([(Text, Text)] -> Values)
-> (Text -> [(Text, Text)]) -> Text -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: []) ((Text, Text) -> [(Text, Text)])
-> (Text -> (Text, Text)) -> Text -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"text",) (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escaper) [Text]
items
            )
        ]

-- Percent encode given text minimally.
escapeLink :: Text -> Text
escapeLink :: Text -> Text
escapeLink = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"%20" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"`" Text
"%60" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"'" Text
"%27" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"%22"

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

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