gemoire 0.1.0 → 1.0.0
raw patch · 16 files changed
+780/−91 lines, 16 filesdep +regex-compatPVP ok
version bump matches the API change (PVP)
Dependencies added: regex-compat
API changes (from Hackage documentation)
- Gemoire.Gemlog: vempty :: Values
- Gemoire.Gemlog: vlist :: [(Text, Text)] -> Values
- Gemoire.Gemlog.Feed: vempty :: Values
- Gemoire.Gemlog.Feed: vlist :: [(Text, Text)] -> Values
- Gemoire.Gemlog.Post: vempty :: Values
- Gemoire.Gemlog.Post: vlist :: [(Text, Text)] -> Values
+ Gemoire.Converter: Conversion :: !String -> (Text -> Text) -> (Text -> Text) -> (Text -> Text) -> Template -> Template -> Template -> Template -> Template -> Template -> (Template, Template) -> Template -> Template -> ![RewriteRule] -> !Values -> Conversion
+ Gemoire.Converter: [attrEscaper] :: Conversion -> Text -> Text
+ Gemoire.Converter: [conversionOverrides] :: Conversion -> !Values
+ Gemoire.Converter: [documentTemplate] :: Conversion -> Template
+ Gemoire.Converter: [escaper] :: Conversion -> Text -> Text
+ Gemoire.Converter: [h1Template] :: Conversion -> Template
+ Gemoire.Converter: [h2Template] :: Conversion -> Template
+ Gemoire.Converter: [h3Template] :: Conversion -> Template
+ Gemoire.Converter: [linkTemplate] :: Conversion -> Template
+ Gemoire.Converter: [listTemplates] :: Conversion -> (Template, Template)
+ Gemoire.Converter: [preEscaper] :: Conversion -> Text -> Text
+ Gemoire.Converter: [preTemplate] :: Conversion -> Template
+ Gemoire.Converter: [quoteTemplate] :: Conversion -> Template
+ Gemoire.Converter: [rewriteRules] :: Conversion -> ![RewriteRule]
+ Gemoire.Converter: [targetExtension] :: Conversion -> !String
+ Gemoire.Converter: [textTemplate] :: Conversion -> Template
+ Gemoire.Converter: convertCapsule :: Conversion -> FilePath -> FilePath -> IO ()
+ Gemoire.Converter: convertDocument :: Values -> Conversion -> Text -> Text
+ Gemoire.Converter: convertElement :: Conversion -> GemItem -> Text
+ Gemoire.Converter: data Conversion
+ Gemoire.Converter: defMarkdownConversion :: Conversion
+ Gemoire.Converter: defWebConversion :: Conversion
+ Gemoire.Converter: type RewriteRule = (String, String, String, Bool, Bool)
+ Gemoire.Converter.Markdown: defDocument :: Template
+ Gemoire.Converter.Markdown: defH1 :: Template
+ Gemoire.Converter.Markdown: defH2 :: Template
+ Gemoire.Converter.Markdown: defH3 :: Template
+ Gemoire.Converter.Markdown: defLink :: Template
+ Gemoire.Converter.Markdown: defList :: Template
+ Gemoire.Converter.Markdown: defListItem :: Template
+ Gemoire.Converter.Markdown: defMarkdownConversion :: Conversion
+ Gemoire.Converter.Markdown: defPre :: Template
+ Gemoire.Converter.Markdown: defQuote :: Template
+ Gemoire.Converter.Markdown: defText :: Template
+ Gemoire.Converter.Markdown: escapeContent :: Text -> Text
+ Gemoire.Converter.Web: defDocument :: Template
+ Gemoire.Converter.Web: defH1 :: Template
+ Gemoire.Converter.Web: defH2 :: Template
+ Gemoire.Converter.Web: defH3 :: Template
+ Gemoire.Converter.Web: defLink :: Template
+ Gemoire.Converter.Web: defList :: Template
+ Gemoire.Converter.Web: defListItem :: Template
+ Gemoire.Converter.Web: defPre :: Template
+ Gemoire.Converter.Web: defQuote :: Template
+ Gemoire.Converter.Web: defText :: Template
+ Gemoire.Converter.Web: defWebConversion :: Conversion
+ Gemoire.Converter.Web: escapeAttr :: Text -> Text
+ Gemoire.Converter.Web: escapeContent :: Text -> Text
Files
- ChangeLog.md +8/−0
- README.md +63/−3
- gemoire.cabal +13/−4
- src/Gemoire.hs +3/−1
- src/Gemoire/Converter.hs +183/−0
- src/Gemoire/Converter/Markdown.hs +111/−0
- src/Gemoire/Converter/Types.hs +68/−0
- src/Gemoire/Converter/Web.hs +119/−0
- src/Gemoire/Gemlog.hs +1/−3
- src/Gemoire/Gemlog/Feed.hs +4/−13
- src/Gemoire/Gemlog/Post.hs +1/−5
- src/Gemoire/Template.hs +1/−1
- test/Case/Converter.hs +107/−0
- test/Case/Gemlog.hs +54/−0
- test/Case/Template.hs +37/−0
- test/Main.hs +7/−61
ChangeLog.md view
@@ -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!
README.md view
@@ -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 "<p class=\"something\">{$text$}</p>"+ , 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
gemoire.cabal view
@@ -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
src/Gemoire.hs view
@@ -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
+ src/Gemoire/Converter.hs view
@@ -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
+ src/Gemoire/Converter/Markdown.hs view
@@ -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$}"+ , "```"+ ]
+ src/Gemoire/Converter/Types.hs view
@@ -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+ }
+ src/Gemoire/Converter/Web.hs view
@@ -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 $+ [ "<!DOCTYPE html>"+ , "<html>"+ , " <head>"+ , " <title>{&title:fname&}</title>"+ , " </head>"+ , " <body>"+ , ""+ , "{$body$}"+ , ""+ , " </body>"+ , "</html>"+ ]++defText :: Template+defText = template "<p>{$text$}</p>"++defLink :: Template+defLink = template "<a href=\"{$link$}\">{&description:link&}</a>"++defH1 :: Template+defH1 = template "<h1>{$text$}</h1>"++defH2 :: Template+defH2 = template "<h2>{$text$}</h2>"++defH3 :: Template+defH3 = template "<h3>{$text$}</h3>"++defList :: Template+defList =+ template . T.intercalate "\LF" $+ [ "<ul>"+ , "{$items$}"+ , "</ul>"+ ]++defListItem :: Template+defListItem = template " <li>{$text$}</li>"++defQuote :: Template+defQuote =+ template . T.intercalate "\LF" $+ [ "<blockquote>"+ , " {$text$}"+ , "</blockquote>"+ ]++defPre :: Template+defPre =+ template . T.intercalate "\LF" $+ [ "<pre title=\"{$alt$}\">"+ , "{$text$}"+ , "</pre>"+ ]
src/Gemoire/Gemlog.hs view
@@ -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
src/Gemoire/Gemlog/Feed.hs view
@@ -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
src/Gemoire/Gemlog/Post.hs view
@@ -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"
src/Gemoire/Template.hs view
@@ -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
+ test/Case/Converter.hs view
@@ -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 <escaped> [this too]"+ , "## h2"+ , "### h3"+ , "* item1"+ , "* item2"+ , "- this is also text"+ , "``` 'alt'"+ , " preformatted"+ , "```"+ ]+ web =+ T.unlines+ [ "<!DOCTYPE html>"+ , "<html>"+ , " <head>"+ , " <title>overridden</title>"+ , " </head>"+ , " <body>"+ , ""+ , "<h1>title</h1>"+ , "<p></p>"+ , "<a href=\"link.gmi\">link.gmi</a>"+ , "<a href=\"link.gmi\">with description</a>"+ , "<blockquote>"+ , " quote"+ , "</blockquote>"+ , "<p>text <escaped> [this too]</p>"+ , "<h2>h2</h2>"+ , "<h3>h3</h3>"+ , "<ul>"+ , " <li>item1</li>"+ , " <li>item2</li>"+ , "</ul>"+ , "<p>- this is also text</p>"+ , "<pre title=\"'alt'\">"+ , " preformatted"+ , "</pre>"+ , ""+ , " </body>"+ , "</html>"+ ]+ markdown =+ T.unlines+ [ "# title"+ , " "+ , "[link.gmi](link.gmi) "+ , "[with description](link.gmi) "+ , "> quote"+ , "text <escaped> \\[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+ ]
+ test/Case/Gemlog.hs view
@@ -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", "<escaped>")+ ]+ 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$}"+ ]
+ test/Case/Template.hs view
@@ -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+ ]
test/Main.hs view
@@ -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- ]