{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE 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 Control.Arrow (first, second)
import Control.Monad (when)
import Data.Bool (bool)
import Data.Function ((&))
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Options.Applicative
import System.Directory
import System.FilePath
import System.IO (hReady, stdin)
import Data.Text.IO (putStr, readFile, writeFile)
import Data.Version (showVersion)
import Paths_gemmula_altera (version)
import Prelude hiding (putStr, readFile, writeFile)
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>"
, ""
, "<div id=\"gemalter-body\">"
, "<!--#VAR body#-->"
, "</div>"
, ""
, " </body>"
, "</html>"
]
stripLastNewline t = bool t (T.dropEnd 1 t) ("\n" `T.isSuffixOf` t)
in do
templ <- maybe (return defaultTemplate) readFile $ template mode
body <-
fmap (stripLastNewline . 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 the gemmula library."
<> header "gemalter - a tiny command line helper for converting Gemini capsules"
)
)