{-# LANGUAGE OverloadedStrings, LambdaCase, NamedFieldPuns, TupleSections #-} -- | -- Module : Main -- Copyright : (c) Sena, 2024 -- License : AGPL-3.0-or-later -- -- Maintainer : Sena -- 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

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 [ "" , "" , " " , " " , " " , " \" rel=\"stylesheet\" />" , " " , " " , " " , "" , "" , " " , "" ] 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 ("") 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 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"))