packages feed

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 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 ">" "&gt;" . T.replace "<" "&lt;" . T.replace "&" "&amp;"++escapeAttr :: Text -> Text+escapeAttr = T.replace "'" "&#39;" . T.replace "\"" "&quot;" . T.replace "&" "&amp;"++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 ">" "&gt;"-        . T.replace "<" "&lt;"-        . T.replace "'" "&#39;"-        . T.replace "\"" "&quot;"-        . T.replace "&" "&amp;"+escapeContent = T.replace ">" "&gt;" . T.replace "<" "&lt;" . T.replace "&" "&amp;"  -- 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 &lt;escaped&gt; [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=\"&#39;alt&#39;\">"+                , "  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", "&lt;escaped&gt;")+            ]+            ~=? 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-    ]