{-# LANGUAGE OverloadedStrings, LambdaCase, NamedFieldPuns, TupleSections #-}
-- |
-- Module : Main
-- Copyright : (c) Sena, 2024
-- License : AGPL-3.0-or-later
--
-- Maintainer : Sena <jn-sena@proton.me>
-- Stability : unstable
-- Portability : portable
--
-- A tiny command line helper for converting Gemini capsules.
--
-- Converts Gemtext to Markdown and HTML.
module Main (main) where
import Options.Applicative
import Control.Monad (when)
import Control.Arrow (first, second)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Maybe (fromMaybe)
import Data.List (isPrefixOf)
import Data.Bool (bool)
import Data.Function ((&))
import System.IO (hReady, stdin)
import System.Directory
import System.FilePath
import Paths_gemmula_altera (version)
import Data.Version (showVersion)
import Data.Text.IO (readFile, writeFile, putStr)
import Prelude hiding (readFile, writeFile, putStr)
import Text.Gemini (GemDocument)
import qualified Text.Gemini as G
import qualified Text.Gemini.Markdown as M
import qualified Text.Gemini.Web as W
-- | Process the input files (or piped input) according to the command and write them.
run :: Opts -> IO ()
run opt@Opts { mode }
| null $ inputs mode = hReady stdin >>= bool (errorWithoutStackTrace "No inputs found.")
(putStr =<< processStdin opt convert)
| otherwise = writeFiles =<< processFiles opt convert ext
where (convert, ext) = case mode of
Markdown {} -> (markdown opt, "md")
Web {} -> (web opt, "html")
-- | Convert Gemtext to Markdown.
--
-- Rewrites all local @.gmi@ links as @.md@ and encodes the file using 'M.encode'.
-- Non-local links are webified using 'W.webifyLink' if the @webify@ flag is used.
markdown :: Opts -> FilePath -> GemDocument -> IO Text
markdown (Opts { webify }) _ = fmap (M.encode . map M.rewriteLink) . bool return (mapM W.webifyLink) webify
-- | Convert Gemtext to HTML.
--
-- Rewrites all local @.gmi@ links as @.html@ and encodes the file using 'W.encode'.
-- Non-local links are webified using 'W.webifyLink' if the @webify@ flag is used.
--
-- If the body flag is not used, the template is used with the following special variables:
--
-- * @body@: Encoded HTML body, converted from GemText.
-- * @title@: The text of the first <h1> heading in the document.
--
-- The file path variables are inserted while processing the inputs.
web :: Opts -> FilePath -> GemDocument -> IO Text
web (Opts { mode, webify }) path doc
| body mode = fmap (W.encode . map W.rewriteLink) . bool return (mapM W.webifyLink) webify $ doc
| otherwise = let title = fromMaybe (T.pack $ takeBaseName path) $ W.getTitle doc
defaultTemplate = T.unlines
[ "<!DOCTYPE html>"
, "<html lang=\"en\">"
, " <head>"
, " <meta charset=\"utf-8\" />"
, " <meta name=\"viewport\" content=\"width=device-width, \
\ initial-scale=1.0, maximum-scale=1.0\" />"
, " <link href=\"<!--#VAR style#-->\" rel=\"stylesheet\" />"
, " <title><!--#VAR title#--></title>"
, " </head>"
, " <body>"
, ""
, "<!--#VAR body#-->"
, " </body>"
, "</html>"
]
in do templ <- maybe (return defaultTemplate) readFile $ template mode
body <- fmap (W.encode . map W.rewriteLink) . bool return (mapM W.webifyLink) webify $ doc
return $ insertVars templ [("body", body), ("title", title)]
-- | Write the processed files to their output paths.
writeFiles :: [(FilePath, Either FilePath Text)] -> IO ()
writeFiles files = do when (null files) $ errorWithoutStackTrace "No files to copy or write found."
mapM_ (\(out, content) -> case content of
Left src -> copyFile src out
Right text -> writeFile out text) files
-- | Process the input files with the given converter function and extension.
-- The output is a tuple with the output path of the file; and the content of the
-- file, where Left is the path to copy from if the input file isn't @.gmi@, or
-- Right is the converted text content if it is @.gmi@.
--
-- Directories are processed recursively. If the input is a single directory, the
-- files are directly put in the output dir, with the input dir name stripped.
-- Otherwise, they are put in a subdirectory in the output dir.
--
-- The file path variables are inserted here, after the subdir is stripped if needed.
processFiles :: Opts -> (FilePath -> GemDocument -> IO Text) -> String -> IO [(FilePath, Either FilePath Text)]
processFiles (Opts { mode, output, copy }) convert ext = let
stripSubdir fs = if all (isPrefixOf (head $ splitDirectories (fst $ head fs)) . fst) fs
then return $ map (first ((\p -> joinPath $ bool p (tail p) (length p > 1)) . splitPath)) fs
else return fs
insertPathVars = case mode of
Web {} -> mapM (\(path, content) -> case content of
Left _ -> return (path, content)
Right t -> (path,) . Right . insertVars t <$> mapM (pathVar path) (filevars mode))
_ -> return
outputPath fs
| length fs <= 1 = maybe (return fs)
(\o -> (fs &) . map . bool (first (const o)) (first (o </>)) <$> doesDirectoryExist o) output
| otherwise = let out = fromMaybe "result" output
in do createDirectoryIfMissing True out
mapM_ (\f -> createDirectoryIfMissing True (out </> takeDirectory (fst f))) fs
return $ map (first (out </>)) fs
in outputPath =<< insertPathVars =<< stripSubdir . concat =<< mapM (process "") (inputs mode)
where process :: FilePath -> FilePath -> IO [(FilePath, Either FilePath Text)]
process root path = ((path &) . bool (single root) (recurse root)) =<< doesDirectoryExist path
single :: FilePath -> FilePath -> IO [(FilePath, Either FilePath Text)]
single root path
| takeExtension path /= ".gmi" = return $ bool [] [(root </> takeFileName path, Left path)] copy
| otherwise = let out = root </> replaceExtension (takeFileName path) ext
in (:[]) . (out,) . Right <$> (convert out . G.decode =<< readFile path)
recurse :: FilePath -> FilePath -> IO [(FilePath, Either FilePath Text)]
recurse root path = let proc p = process (root </> last (splitDirectories path)) (path </> p)
in fmap concat . mapM proc =<< listDirectory path
processStdin :: Opts -> (FilePath -> GemDocument -> IO Text) -> IO Text
processStdin (Opts { mode }) convert = let
insertPathVars t = case mode of
Web {} -> insertVars t <$> mapM getVar (filevars mode)
_ -> return t
in insertPathVars =<< convert "gemalter" . G.decode . T.pack =<< getContents
-- | Parse the variable option and make it relative to the 'FilePath'.
pathVar :: FilePath -> Text -> IO (Text, Text)
pathVar path text = (\(name, val) ->
let relative = joinPath (replicate (length . init . splitDirectories $ path) "..") </> val
in return (name, T.pack relative)) . second T.unpack =<< getVar text
-- | Parse a variable option of @"key=val"@ as a pair of key and value.
getVar :: Text -> IO (Text, Text)
getVar var
| T.null val = errorWithoutStackTrace "Incorrect variable option. See \"web --help\"."
| otherwise = return (name, val)
where (name, val) = second (T.drop 1) . T.break (== '=') $ var
-- | Replace the variable keywords in the text with the parsed variables in the list.
insertVars :: Text -> [(Text, Text)] -> Text
insertVars text vars = foldr (\(n, v) t -> T.replace ("<!--#VAR " <> n <> "#-->") v t) text (reverse vars)
-- | Options to use normally.
data Opts = Opts { output :: !(Maybe FilePath)
, copy :: !Bool
, webify :: !Bool
, mode :: !Command
} deriving (Show, Eq)
data Command = Markdown { inputs :: ![FilePath] }
| Web { body :: !Bool
, template :: !(Maybe FilePath)
, filevars :: ![Text]
, inputs :: ![FilePath]
} deriving (Show, Eq)
opts :: Parser Opts
opts = Opts
<$> optional (option str
( long "output"
<> short 'o'
<> help "The output path"
<> metavar "PATH" ))
<*> flag True False
( long "no-copy"
<> short 'n'
<> help "Do not copy non-convertable files to the output dir" )
<*> switch
( long "webify"
<> short 'w'
<> help "Rewrite gemini links as http if they can be reached" )
<*> hsubparser
( command "md" (info (Markdown
<$> many (argument str (metavar "FILES"))
) (progDesc "Convert Gemtext files to Markdown."))
<> command "web" (info (Web
<$> switch
( long "body"
<> short 'b'
<> help "Output the HTML body only" )
<*> optional (option str
( long "template"
<> short 't'
<> help "Template file to use while producing HTML outputs, \
\ where <!--#VAR name#--> are replaced with the \
\ variable values. Special variables are: body, title"
<> metavar "PATH" ))
<*> many (option str
( long "file"
<> short 'f'
<> help "Set a dynamic file path variable always pointing to \
\ the given path, in the form of \"name=value\", where \
\ value must be a path relative to the output root"
<> metavar "VAR" ))
<*> many (argument str (metavar "FILES"))
) (progDesc "Convert Gemtext files to HTML.")) )
main :: IO ()
main = run =<< execParser (info (opts <**> helper <**> simpleVersioner ("v" <> showVersion version))
( fullDesc
<> progDesc "Convert Gemtext to Markdown and HTML using gemmula library."
<> header "gemalter - a tiny command line helper for converting Gemini capsules"))