diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Change Log for gemoire +## 1.0.0 (February 1, 2025) + +- Add gemtext converter modules. + - Includes default configurations for Markdown and Web. +- Get rid of useless re-exports. +- Refine the escaping in feeds. +- Refine unit tests. + ## 0.1.0 (January 25, 2025) - Initial release! diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,11 +1,12 @@ -# gemoire - yet another static gemlog generator +# gemoire - yet another static gemlog generator + converter gemoire is just a basic flexible gemini blog generator, that can: - be configured using Haskell code, - use custom templates written in an authentic syntax, - set additional and overriding variables for formatting, -- and generate Atom and Gemini feeds. +- generate Atom and Gemini feeds. +- and convert capsules to various formats, such as HTML and Markdown by default. See the [example](https://codeberg.org/sena/gemoire/src/branch/main/example) directory in the repository to see how it looks like in "production". @@ -91,7 +92,7 @@ -} {-# LANGUAGE OverloadedStrings #-} --- gemoire uses Data.Text underhood. +-- gemoire uses Data.Text under the hood. import Data.Text (unlines) import Prelude hiding (unlines) import Gemoire @@ -126,6 +127,65 @@ ] -- ... ``` + +## Converting + +After generating a Gemini capsule, you might want to convert your art into different +formats, e.g. to publish on the web as well. To do so, you can use something like the +following: + +```hs +#!/usr/bin/env cabal +{- cabal: +build-depends: base + , gemoire +-} + +import Gemoire + +main :: IO () +main = do + let web = defWebConversion + + convertCapsule web "~/public_gemini" "~/public_html" +``` + +You can also somewhat customize this behaviour, like so: + +```hs +#!/usr/bin/env cabal +{- cabal: +build-depends: base + , gemoire +-} +{-# LANGUAGE OverloadedStrings #-} + +import Gemoire + +main :: IO () +main = do + let web = defWebConversion + { textTemplate = template "

{$text$}

" + , rewriteRules = + [ -- Rewrite .gmi links in the domain example.com as .html. + ( ".*\\.gmi" -- input files in which the rewriting will occur + , "((https*)|(gemini))://example.com/(.*)\\.gmi" -- the RegEx to match + , "https://example.com/\\4.html" -- the replacement text + , True -- multiline + , True -- case senstive + ) + ] + , conversionOverrides = vlist [("title", "every title is this now")] + } + + convertCapsule web "~/public_gemini" "~/public_html" +``` + +You can also define your own conversion rules using the +[`Conversion`](https://hackage.haskell.org/package/gemoire/docs/Gemoire-Converter.html#t:Conversion) +struct. See the documentation of +[`Gemoire.Converter`](https://hackage.haskell.org/package/gemoire/docs/Gemoire-Converter.html) +for more on what else you can do and the template variables. ## See also diff --git a/gemoire.cabal b/gemoire.cabal --- a/gemoire.cabal +++ b/gemoire.cabal @@ -1,14 +1,15 @@ cabal-version: 2.2 name: gemoire -version: 0.1.0 +version: 1.0.0 category: Gemini homepage: https://codeberg.org/sena/gemoire bug-reports: https://codeberg.org/sena/gemoire/issues -synopsis: yet another static gemlog generator +synopsis: yet another static gemlog generator + converter description: gemoire is just another take on a static gemlog generator with feeds trying - to be flexible just enough, configured and served using Haskell. See the - README.md for usage examples and Hackage for a detailed documentation. + to be flexible just enough, plus a small HTML and Markdown converter, configured + and served using Haskell. See the README.md for usage examples and Hackage for a + detailed documentation. license: GPL-3.0-or-later license-file: LICENSE copyright: (c) Sena 2024 @@ -29,12 +30,17 @@ , Gemoire.Gemlog , Gemoire.Gemlog.Post , Gemoire.Gemlog.Feed + , Gemoire.Converter + , Gemoire.Converter.Web + , Gemoire.Converter.Markdown , Gemoire.Template + other-modules: Gemoire.Converter.Types build-depends: base >= 4.16 && < 5 , directory >= 1.3.7 && < 1.4 , extra >= 1.7.12 && < 1.9 , filepath >= 1.4.100.4 && < 1.6 , gemmula >= 1.2 && < 1.3 + , regex-compat >= 0.95.2.1 && < 0.96 , text >= 2.0 && < 2.2 , time >= 1.12 && < 1.15 , unordered-containers >= 0.2.18 && < 0.2.21 @@ -45,6 +51,9 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs + other-modules: Case.Template + , Case.Gemlog + , Case.Converter build-depends: base , HUnit >= 1.6 && < 2 , text diff --git a/src/Gemoire.hs b/src/Gemoire.hs --- a/src/Gemoire.hs +++ b/src/Gemoire.hs @@ -7,15 +7,17 @@ -- Stability : stable -- Portability : portable -- --- yet another static gemlog generator +-- yet another static gemlog generator + converter -- -- See each module below for a detailed explanation. -- See the README.md for a roughly step-by-step guide. module Gemoire ( -- * Module re-exports module Gemoire.Gemlog + , module Gemoire.Converter , module Gemoire.Template ) where +import Gemoire.Converter import Gemoire.Gemlog import Gemoire.Template diff --git a/src/Gemoire/Converter.hs b/src/Gemoire/Converter.hs new file mode 100644 --- /dev/null +++ b/src/Gemoire/Converter.hs @@ -0,0 +1,183 @@ +{-# 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 diff --git a/src/Gemoire/Converter/Markdown.hs b/src/Gemoire/Converter/Markdown.hs new file mode 100644 --- /dev/null +++ b/src/Gemoire/Converter/Markdown.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Gemoire.Converter.Markdown +-- Copyright : (c) 2025 Sena +-- License : GPL-3.0-or-later +-- +-- Maintainer : contact@sena.pink +-- Stability : stable +-- Portability : portable +-- +-- Default configuration and templates for Gemini to Markdown conversion +module Gemoire.Converter.Markdown + ( -- * Defaults + defMarkdownConversion + , escapeContent + , defDocument + , defText + , defLink + , defH1 + , defH2 + , defH3 + , defList + , defListItem + , defQuote + , defPre + ) where + +import Control.Arrow (second) +import Data.Char (isSpace) +import Data.HashMap.Strict (empty) +import Data.Text (Text) +import qualified Data.Text as T + +import Gemoire.Converter.Types (Conversion (..)) +import Gemoire.Template (Template, template) + +defMarkdownConversion :: Conversion +defMarkdownConversion = + Conversion + { targetExtension = ".md" + , escaper = escapeContent + , preEscaper = id + , attrEscaper = escapeContent + , documentTemplate = defDocument + , textTemplate = defText + , linkTemplate = defLink + , h1Template = defH1 + , h2Template = defH2 + , h3Template = defH3 + , listTemplates = (defList, defListItem) + , quoteTemplate = defQuote + , preTemplate = defPre + , rewriteRules = [] + , conversionOverrides = empty + } + +escapeContent :: Text -> Text +escapeContent = + replaceOnStart ">" "\\>" + . replaceOnStart "-" "\\-" + . replaceOnStart "+" "\\+" + . replaceOnStart "*" "\\*" + . replaceOnStart "#" "\\#" + . T.replace "(" "\\(" + . T.replace ")" "\\)" + . T.replace "[" "\\[" + . T.replace "]" "\\]" + . T.replace "\\" "\\\\" + +replaceOnStart :: Text -> Text -> Text -> Text +replaceOnStart a b text = + uncurry (<>) + . second (maybe text (b <>) . T.stripPrefix a) + . T.span isSpace + $ text + +defDocument :: Template +defDocument = template "{$body$}\LF" + +defText :: Template +defText = template "{$text$} " + +defLink :: Template +defLink = template "[{&description:link&}]({$link$}) " + +defH1 :: Template +defH1 = template "# {$text$}" + +defH2 :: Template +defH2 = template "## {$text$}" + +defH3 :: Template +defH3 = template "### {$text$}" + +defList :: Template +defList = template "{$items$}" + +defListItem :: Template +defListItem = template "- {$text$}" + +defQuote :: Template +defQuote = template "> {$text$}" + +defPre :: Template +defPre = + template . T.intercalate "\LF" $ + [ "```{$alt$}" + , "{$text$}" + , "```" + ] diff --git a/src/Gemoire/Converter/Types.hs b/src/Gemoire/Converter/Types.hs new file mode 100644 --- /dev/null +++ b/src/Gemoire/Converter/Types.hs @@ -0,0 +1,68 @@ +-- | +-- Module : Gemoire.Converter.Types +-- Copyright : (c) 2025 Sena +-- License : GPL-3.0-or-later +-- +-- Maintainer : contact@sena.pink +-- Stability : stable +-- Portability : portable +-- +-- Types for the conversion +module Gemoire.Converter.Types + ( RewriteRule + , Conversion (..) + ) where + +import Data.Text (Text) +import Text.Regex () + +import Gemoire.Template (Template, Values) + +-- | A RegEx rewriting rule +-- +-- The regular expressions must be POSIX extended variants, without the surrounding +-- forward slashes. You can use @\\1@ to get the substrings of matches for the +-- replacement string. See `Text.Regex' for more. +-- +-- * The first field is a RegEx matching the input filename in which the rewriting will occur. +-- * The second field is the RegEx matching the string that will be replaced. +-- * The third field is the replacement string. +-- * The fourth field is whether the matching is multiline. +-- * The fifth field is whether the matching is case sensitive. +type RewriteRule = (String, String, String, Bool, Bool) + +-- | A gemtext conversion recipe +-- +-- See the module description for the variables available in each template. +data Conversion = Conversion + { targetExtension :: !String + -- ^ The extension of the target files + , escaper :: Text -> Text + -- ^ The function that escapes content text + , preEscaper :: Text -> Text + -- ^ The function that escapes preformatted text + , attrEscaper :: Text -> Text + -- ^ The function that escapes attributes + , documentTemplate :: Template + -- ^ The template for the final document + , textTemplate :: Template + -- ^ Paragraph element template + , linkTemplate :: Template + -- ^ Link element template + , h1Template :: Template + -- ^ Main heading element template + , h2Template :: Template + -- ^ Second level heading element template + , h3Template :: Template + -- ^ Third level heading element template + , listTemplates :: (Template, Template) + -- ^ List element templates, the first being the list itself + , quoteTemplate :: Template + -- ^ Quote element template + , preTemplate :: Template + -- ^ Preformatted element template + , rewriteRules :: ![RewriteRule] + -- ^ List of RegEx rewrite rules + , conversionOverrides :: !Values + -- ^ Variable overrides for template formatting + } diff --git a/src/Gemoire/Converter/Web.hs b/src/Gemoire/Converter/Web.hs new file mode 100644 --- /dev/null +++ b/src/Gemoire/Converter/Web.hs @@ -0,0 +1,119 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : Gemoire.Converter.Web +-- Copyright : (c) 2025 Sena +-- License : GPL-3.0-or-later +-- +-- Maintainer : contact@sena.pink +-- Stability : stable +-- Portability : portable +-- +-- Default configuration and templates for Gemini to HTML conversion +module Gemoire.Converter.Web + ( -- * Defaults + defWebConversion + , escapeContent + , escapeAttr + , defDocument + , defText + , defLink + , defH1 + , defH2 + , defH3 + , defList + , defListItem + , defQuote + , defPre + ) where + +import Data.HashMap.Strict (empty) +import Data.Text (Text) +import qualified Data.Text as T + +import Gemoire.Converter.Types (Conversion (..)) +import Gemoire.Template (Template, template) + +defWebConversion :: Conversion +defWebConversion = + Conversion + { targetExtension = ".html" + , escaper = escapeContent + , preEscaper = escapeContent + , attrEscaper = escapeAttr + , documentTemplate = defDocument + , textTemplate = defText + , linkTemplate = defLink + , h1Template = defH1 + , h2Template = defH2 + , h3Template = defH3 + , listTemplates = (defList, defListItem) + , quoteTemplate = defQuote + , preTemplate = defPre + , rewriteRules = [] + , conversionOverrides = empty + } + +escapeContent :: Text -> Text +escapeContent = T.replace ">" ">" . T.replace "<" "<" . T.replace "&" "&" + +escapeAttr :: Text -> Text +escapeAttr = T.replace "'" "'" . T.replace "\"" """ . T.replace "&" "&" + +defDocument :: Template +defDocument = + template . T.unlines $ + [ "" + , "" + , " " + , " {&title:fname&}" + , " " + , " " + , "" + , "{$body$}" + , "" + , " " + , "" + ] + +defText :: Template +defText = template "

{$text$}

" + +defLink :: Template +defLink = template "{&description:link&}" + +defH1 :: Template +defH1 = template "

{$text$}

" + +defH2 :: Template +defH2 = template "

{$text$}

" + +defH3 :: Template +defH3 = template "

{$text$}

" + +defList :: Template +defList = + template . T.intercalate "\LF" $ + [ "" + ] + +defListItem :: Template +defListItem = template "
  • {$text$}
    • " + +defQuote :: Template +defQuote = + template . T.intercalate "\LF" $ + [ "
    " + , " {$text$}" + , "
    " + ] + +defPre :: Template +defPre = + template . T.intercalate "\LF" $ + [ "
    "
+        , "{$text$}"
+        , "
    " + ] diff --git a/src/Gemoire/Gemlog.hs b/src/Gemoire/Gemlog.hs --- a/src/Gemoire/Gemlog.hs +++ b/src/Gemoire/Gemlog.hs @@ -59,8 +59,6 @@ , defGemfeedEntry , defAtom , defAtomEntry - , vempty - , vlist ) where import Data.Bool (bool) @@ -82,7 +80,7 @@ , sortPosts ) import Gemoire.Gemlog.Post (defPost, readPost) -import Gemoire.Template (Template, Values, format, vempty, vlist) +import Gemoire.Template (Template, Values, format) -- | A gemlog recipe to generate files for data Gemlog = Gemlog diff --git a/src/Gemoire/Gemlog/Feed.hs b/src/Gemoire/Gemlog/Feed.hs --- a/src/Gemoire/Gemlog/Feed.hs +++ b/src/Gemoire/Gemlog/Feed.hs @@ -25,10 +25,6 @@ , defGemfeedEntry , defAtom , defAtomEntry - - -- * Re-exports - , vempty - , vlist ) where import Control.Monad ((<=<)) @@ -41,7 +37,7 @@ import Data.Time (UTCTime (utctDay), utc, utcToZonedTime, zonedTimeToUTC) import Data.Time.Format.ISO8601 (iso8601ParseM, iso8601Show) -import Gemoire.Template (Template, Values, template, vempty, vlist) +import Gemoire.Template (Template, Values, template) defGemfeed :: Template defGemfeed = @@ -92,7 +88,7 @@ -- @modified_date@, like in `Gemoire.Gemlog.Post.readPost'. lastModified :: [Values] -> Values lastModified posts = case parseModified <=< listToMaybe . sortPosts $ posts of - Nothing -> vempty + Nothing -> M.empty Just modified -> let modifiedStr = T.pack . iso8601Show . utcToZonedTime utc $ modified modifiedDate = T.pack . iso8601Show . utctDay $ modified @@ -123,16 +119,11 @@ -- Ampersand encode given text minimally. escapeContent :: Text -> Text -escapeContent = - T.replace ">" ">" - . T.replace "<" "<" - . T.replace "'" "'" - . T.replace "\"" """ - . T.replace "&" "&" +escapeContent = T.replace ">" ">" . T.replace "<" "<" . T.replace "&" "&" -- Percent encode given text minimally. escapeLink :: Text -> Text -escapeLink = T.replace "'" "%27" . T.replace "\"" "%22" +escapeLink = T.replace " " "%20" . T.replace "`" "%60" . T.replace "'" "%27" . T.replace "\"" "%22" -- Get the time modified of the given post. parseModified :: Values -> Maybe UTCTime diff --git a/src/Gemoire/Gemlog/Post.hs b/src/Gemoire/Gemlog/Post.hs --- a/src/Gemoire/Gemlog/Post.hs +++ b/src/Gemoire/Gemlog/Post.hs @@ -30,10 +30,6 @@ -- * Templates , defPost - - -- * Re-exports - , vempty - , vlist ) where import Control.Arrow ((***)) @@ -50,7 +46,7 @@ import Text.Gemini (GemDocument, GemItem (..)) import qualified Text.Gemini as G -import Gemoire.Template (Template, Values, format, template, vempty, vlist) +import Gemoire.Template (Template, Values, format, template) defPost :: Template defPost = template "{$post$}\CR\LF" diff --git a/src/Gemoire/Template.hs b/src/Gemoire/Template.hs --- a/src/Gemoire/Template.hs +++ b/src/Gemoire/Template.hs @@ -19,7 +19,7 @@ -- * @{&pholder:fallback&}@ - With a fallback /key/ to use in case @pholder@ has no value -- * @{&pholder:fallback:default value&}@ - With a fallback /key/ and a default /value/ -- * @{# comment! #}@ - An unrendered comment --- * @{\ constant \}@ - An unevaluated block, akin to escaping things inside it +-- * @{\\ constant \\}@ - An unevaluated block, akin to escaping things inside it -- -- All inline components can be multiline in any way, including placeholder keys. -- The arguments can also be surrounded by any amount of whitespace, which will diff --git a/test/Case/Converter.hs b/test/Case/Converter.hs new file mode 100644 --- /dev/null +++ b/test/Case/Converter.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Case.Converter + ( converter + ) where + +import qualified Data.Text as T +import Test.HUnit (Test, (~=?)) + +import Gemoire.Converter (Conversion (..), convertDocument, defMarkdownConversion, defWebConversion) +import Gemoire.Template (vempty, vlist) + +converter :: [Test] +converter = conversion <> rewriting + +conversion :: [Test] +conversion = + let document = + T.unlines . map (<> "\CR") $ + [ "# title" + , "" + , "=> link.gmi" + , "=> link.gmi with description" + , "> quote" + , "text [this too]" + , "## h2" + , "### h3" + , "* item1" + , "* item2" + , "- this is also text" + , "``` 'alt'" + , " preformatted" + , "```" + ] + web = + T.unlines + [ "" + , "" + , " " + , " overridden" + , " " + , " " + , "" + , "

    title

    " + , "

    " + , "link.gmi" + , "with description" + , "
    " + , " quote" + , "
    " + , "

    text <escaped> [this too]

    " + , "

    h2

    " + , "

    h3

    " + , "" + , "

    - this is also text

    " + , "
    "
+                , "  preformatted"
+                , "
    " + , "" + , " " + , "" + ] + markdown = + T.unlines + [ "# title" + , " " + , "[link.gmi](link.gmi) " + , "[with description](link.gmi) " + , "> quote" + , "text \\[this too\\] " + , "## h2" + , "### h3" + , "- item1" + , "- item2" + , "\\- this is also text " + , "```'alt'" + , " preformatted" + , "```" + ] + in [ web ~=? convertDocument (vlist [("title", "overridden")]) defWebConversion document + , markdown ~=? convertDocument vempty defMarkdownConversion document + ] + +rewriting :: [Test] +rewriting = + let document = "=> gemini://example.com/gemlog/post.gmi post\CR\LF" + markdown = "[post](https://example.com/gemlog/post.html) \LF" + in [ markdown + ~=? convertDocument + vempty + ( defMarkdownConversion + { rewriteRules = + [ + ( ".*\\.gmi" + , "((https*)|(gemini))://example.com/(.*)\\.gmi" + , "https://example.com/\\4.html" + , True + , True + ) + ] + } + ) + document + ] diff --git a/test/Case/Gemlog.hs b/test/Case/Gemlog.hs new file mode 100644 --- /dev/null +++ b/test/Case/Gemlog.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Case.Gemlog + ( gemlog + ) where + +import Data.HashMap.Strict (empty, fromList, singleton) +import Test.HUnit (Test, (~=?)) + +import Gemoire.Gemlog.Feed (escapeFeed, lastModified, sortPosts) +import Gemoire.Gemlog.Post (parsePost) + +gemlog :: [Test] +gemlog = feeds <> posts + +feeds :: [Test] +feeds = + let post = + [ fromList [("post", "1"), ("modified", "2024-08-17T05:00:00+00:00")] + , fromList [("post", "2"), ("modified", "2024-08-17T09:00:00+00:00")] + , fromList [("post", "3"), ("modified", "2024-11-14T13:47:01+00:00")] + ] + feed = + fromList + [ ("test_url", "url test") + , ("base", "also'url") + , ("entries", "as&is") + , ("other", "") + ] + in [ [ fromList [("post", "3"), ("modified", "2024-11-14T13:47:01+00:00")] + , fromList [("post", "2"), ("modified", "2024-08-17T09:00:00+00:00")] + , fromList [("post", "1"), ("modified", "2024-08-17T05:00:00+00:00")] + ] + ~=? sortPosts post + , fromList [("modified", "2024-11-14T13:47:01+00:00"), ("modified_date", "2024-11-14")] + ~=? lastModified post + , fromList + [ ("test_url", "url%20test") + , ("base", "also%27url") + , ("entries", "as&is") + , ("other", "<escaped>") + ] + ~=? escapeFeed False feed + ] + +posts :: [Test] +posts = + [ fromList [("post", "post")] ~=? parsePost empty "post" + , fromList [("title", "heading"), ("post", "# heading")] ~=? parsePost empty "# heading" + , fromList [("data", "extras"), ("post", "with extras")] + ~=? parsePost (singleton "data" "extras") "with {$data$}" + , fromList [("data", "variables"), ("post", "with variables")] + ~=? parsePost empty "{= data variables =}\CR\LFwith {$data$}" + ] diff --git a/test/Case/Template.hs b/test/Case/Template.hs new file mode 100644 --- /dev/null +++ b/test/Case/Template.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Case.Template + ( templates + ) where + +import Data.HashMap.Strict (empty, singleton) +import Test.HUnit (Test, (~=?)) + +import Gemoire.Template (Component (..), format, template) + +templates :: [Test] +templates = + [ [Left "text"] ~=? template "text" + , [Left "also {$", Left "text"] ~=? template "also {$text" + , [Right $ Placeholder "placeholder" Nothing] ~=? template "{$ placeholder $}" + , [Right $ Placeholder "with" $ Just "default value"] ~=? template "{$with:default value$}" + , [Right $ Placeholder "{$weird" Nothing, Left "$}"] ~=? template "{${$weird$}$}" + , [Right $ Placeholder "pholder" $ Just "multiline \CR\LF value"] + ~=? template "{$pholder:multiline \CR\LF value$}" + , [Right $ Placeholder "multiline\CR\LFunfortunately" Nothing] + ~=? template "{$multiline\CR\LFunfortunately$}" + , [Left "mixed ", Right $ Placeholder "pholder" Nothing, Left " text"] + ~=? template "mixed {$pholder$} text" + , [Right $ Fallback "variable" "fallback" Nothing] ~=? template "{&variable:fallback&}" + , [Right $ Fallback "same as a variable" "" Nothing] ~=? template "{& same as a variable&}" + , [Right $ Fallback "var" "fback" (Just "default")] ~=? template "{&var:fback:default&}" + , [Left "commented ", Left " text"] ~=? template "commented {# meow #} text" + , [] ~=? template "{# comment with {$flare$} #}" + , [] ~=? template "{#multiline \CR\LF comment#}" + , [Left "{# not a comment #}"] ~=? template "{\\{# not a comment #}\\}" + , [Left "constant"] ~=? template "{\\constant\\}" + , "formatted text!" ~=? format (template "formatted {$ key $}") (singleton "key" "text!") + , "default value" ~=? format (template "{$key:default$} value") empty + , "falled back!" ~=? format (template "falled {&unexist:fallback&}!") (singleton "fallback" "back") + , "couldn't fall back." ~=? format (template "couldn't {&a:b:fall&} back.") empty + ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,73 +1,19 @@ -{-# LANGUAGE OverloadedStrings #-} - module Main (main) where import Control.Monad (when) -import qualified Data.HashMap.Strict as M import System.Exit (exitFailure) -import Test.HUnit (Test (..), failures, runTestTT, (~=?)) +import Test.HUnit (Test (..), failures, runTestTT) -import Gemoire.Gemlog.Feed (lastModified, sortPosts) -import Gemoire.Gemlog.Post (parsePost) -import Gemoire.Template (Component (..), format, template) +import Case.Converter (converter) +import Case.Gemlog (gemlog) +import Case.Template (templates) -- | Query the test cases. main :: IO () main = do count <- runTestTT . TestList $ - feeds <> posts <> templates + templates + <> gemlog + <> converter when (failures count > 0) exitFailure - -feeds :: [Test] -feeds = - let post = - [ M.fromList [("post", "1"), ("modified", "2024-08-17T05:00:00+00:00")] - , M.fromList [("post", "2"), ("modified", "2024-08-17T09:00:00+00:00")] - , M.fromList [("post", "3"), ("modified", "2024-11-14T13:47:01+00:00")] - ] - in [ [ M.fromList [("post", "3"), ("modified", "2024-11-14T13:47:01+00:00")] - , M.fromList [("post", "2"), ("modified", "2024-08-17T09:00:00+00:00")] - , M.fromList [("post", "1"), ("modified", "2024-08-17T05:00:00+00:00")] - ] - ~=? sortPosts post - , M.fromList [("modified", "2024-11-14T13:47:01+00:00"), ("modified_date", "2024-11-14")] - ~=? lastModified post - ] - -posts :: [Test] -posts = - [ M.fromList [("post", "post")] ~=? parsePost M.empty "post" - , M.fromList [("title", "heading"), ("post", "# heading")] ~=? parsePost M.empty "# heading" - , M.fromList [("data", "extras"), ("post", "with extras")] - ~=? parsePost (M.singleton "data" "extras") "with {$data$}" - , M.fromList [("data", "variables"), ("post", "with variables")] - ~=? parsePost M.empty "{= data variables =}\CR\LFwith {$data$}" - ] - -templates :: [Test] -templates = - [ [Left "text"] ~=? template "text" - , [Left "also {$", Left "text"] ~=? template "also {$text" - , [Right $ Placeholder "placeholder" Nothing] ~=? template "{$ placeholder $}" - , [Right $ Placeholder "with" $ Just "default value"] ~=? template "{$with:default value$}" - , [Right $ Placeholder "{$weird" Nothing, Left "$}"] ~=? template "{${$weird$}$}" - , [Right $ Placeholder "pholder" $ Just "multiline \CR\LF value"] - ~=? template "{$pholder:multiline \CR\LF value$}" - , [Right $ Placeholder "multiline\CR\LFunfortunately" Nothing] - ~=? template "{$multiline\CR\LFunfortunately$}" - , [Left "mixed ", Right $ Placeholder "pholder" Nothing, Left " text"] - ~=? template "mixed {$pholder$} text" - , [Right $ Fallback "variable" "fallback" Nothing] ~=? template "{&variable:fallback&}" - , [Right $ Fallback "same as a variable" "" Nothing] ~=? template "{& same as a variable&}" - , [Right $ Fallback "var" "fback" (Just "default")] ~=? template "{&var:fback:default&}" - , [Left "commented ", Left " text"] ~=? template "commented {# meow #} text" - , [] ~=? template "{# comment with {$flare$} #}" - , [] ~=? template "{#multiline \CR\LF comment#}" - , [Left "{# not a comment #}"] ~=? template "{\\{# not a comment #}\\}" - , [Left "constant"] ~=? template "{\\constant\\}" - , "formatted text!" ~=? format (template "formatted {$ key $}") (M.singleton "key" "text!") - , "default value" ~=? format (template "{$key:default$} value") M.empty - , "falled back!" ~=? format (template "falled {&unexist:fallback&}!") (M.singleton "fallback" "back") - , "couldn't fall back." ~=? format (template "couldn't {&a:b:fall&} back.") M.empty - ]