gemmula 1.1.0 → 1.1.1
raw patch · 6 files changed
+173/−139 lines, 6 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +3/−2
- README.md +8/−9
- Setup.lhs +0/−1
- gemmula.cabal +7/−7
- src/Text/Gemini.hs +102/−80
- test/Main.hs +53/−40
ChangeLog.md view
@@ -1,6 +1,8 @@- # `gemmula` Change Log +## 1.1.1 (July 23, 2024)+* Clean up documentations.+ ## 1.1.0 (January 13, 2024) * Normalize the links with spaces while encoding. * Ignore the empty lists while encoding.@@ -16,4 +18,3 @@ ## 0.1.0.0 (November 29, 2023) * Initial release!-
README.md view
@@ -1,13 +1,12 @@--# [gemmula](https://hackage.haskell.org/package/gemmula)--A tiny and functional Gemtext (`text/gemini`) parser from and back to Text.+# gemmula [(Hackage)](https://hackage.haskell.org/package/gemmula) -Check the Section 5 of the [Gemini Protocol specification](https://geminiprotocol.net/docs/specification.gmi)-for more about the `text/gemini` filetype. You can also check the [Gemini Protocol](https://geminiprotocol.net)-capsule for more about the Gemini itself.+gemmula (Latin for `little gem`) is a tiny and functional gemtext+(unofficially `text/gemini`) parser from and back into `Text`. -The documentation is available at [Hackage](https://hackage.haskell.org/package/gemmula/docs/Text-Gemini.html).+Check the ["gemtext" specification](https://geminiprotocol.net/docs/gemtext-specification.gmi)+for more about the `text/gemini` filetype. -You can find more information and related modules at the [Codeberg repository](https://codeberg.org/sena/gemmula).+Also check the [Gemini Protocol](https://geminiprotocol.net) capsule for more about Gemini itself. +The documentation is available at+[Hackage](https://hackage.haskell.org/package/gemmula/docs/Text-Gemini.html).
Setup.lhs view
@@ -5,4 +5,3 @@ > main :: IO () > main = defaultMain-
gemmula.cabal view
@@ -1,15 +1,15 @@ name: gemmula-version: 1.1.0-synopsis: A tiny Gemtext parser-description: gemmula is a tiny and functional Gemtext (unofficially text/gemini)- parser that aims to parse a Gemtext document from and back to Text,- according to the Section 5 of the Gemini Protocol specification at- <https://geminiprotocol.net/docs/specification.gmi>.+version: 1.1.1+synopsis: A tiny gemtext parser+description: gemmula is a tiny and functional gemtext (unofficially @text/gemini@)+ parser that aims to parse a gemtext document from and back into Text,+ according to the Gemini hypertext format specification at+ <https://geminiprotocol.net/docs/gemtext-specification.gmi>. license: AGPL-3 license-file: LICENSE author: Sena <jn-sena@proton.me> maintainer: Sena <jn-sena@proton.me>-tested-with: GHC == 9.4.8 || == 9.6.3+tested-with: GHC == 9.6.5 || == 9.8.2 category: Text, Gemini homepage: https://codeberg.org/sena/gemmula bug-reports: https://codeberg.org/sena/gemmula/issues
src/Text/Gemini.hs view
@@ -2,120 +2,139 @@ -- | -- Module : Text.Gemini--- Copyright : (c) Sena, 2023+-- Copyright : (c) Sena, 2024 -- License : AGPL-3.0-or-later -- -- Maintainer : Sena <jn-sena@proton.me> -- Stability : stable -- Portability : portable ----- A tiny Gemtext (@text/gemini@) parser.+-- A tiny gemtext (unofficially @text/gemini@) parser ----- Parses Gemtext documents from and back to 'Text'. See the Section 5 of the--- [Gemini Protocol specification](https://geminiprotocol.net/docs/specification.gmi).+-- Parses gemtext documents from and back to 'Text'.+--+-- See the Gemini hypertext format specification at+-- <https://geminiprotocol.net/docs/gemtext-specification.gmi>. module Text.Gemini- ( -- * Gemtext Types- GemDocument- , GemItem (..)- -- * Decoding from Text- , decode- , decodeLine- -- * Encoding as Text- , encode- , encodeItem- ) where+ ( -- * Gemtext types+ GemDocument+ , GemItem (..) + -- * Decoding from text+ , decode+ , decodeLine++ -- * Encoding into text+ , encode+ , encodeItem+ ) where++import Data.Bool (bool)+import Data.Char (isSpace)+import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T-import Data.Maybe (fromMaybe)-import Data.Char (isSpace)-import Data.Bool (bool) --- | A Gemtext document, in the form of an ordered list of 'GemItem's.+-- | A gemtext document, in the form of an ordered list of 'GemItem's type GemDocument = [GemItem] --- | A Gemtext item.-data GemItem = GemText !Text -- ^ A regular Gemtext line. -- @'GemText' \<Text>@- | GemLink !Text !(Maybe Text) -- ^ A Gemtext link. -- @'GemLink' \<Link> \[Optional Description]@- | GemHeading !Int !Text -- ^ A Gemtext heading of 3 levels max. -- @'GemHeading' \<Level> \<Text>@- | GemList ![Text] -- ^ A Gemtext unordered list. -- @'GemList' \<Lines>@- | GemQuote !Text -- ^ A Gemtext quote. -- @'GemQuote' \<Text>@- | GemPre ![Text] !(Maybe Text) -- ^ A Gemtext preformat. -- @'GemPre' \<Lines> [Optional Alt Text]@- deriving (Show, Eq)+-- | A gemtext item+data GemItem+ = -- | A regular gemtext line -- @'GemText' \<Text>@+ GemText !Text+ | -- | A gemtext link -- @'GemLink' \<Link> \[Optional Description]@+ GemLink !Text !(Maybe Text)+ | -- | A gemtext heading of 3 levels max -- @'GemHeading' \<Level> \<Text>@+ GemHeading !Int !Text+ | -- | An unordered gemtext list -- @'GemList' \<Lines>@+ GemList ![Text]+ | -- | A gemtext quote -- @'GemQuote' \<Text>@+ GemQuote !Text+ | -- | A preformatted gemtext block -- @'GemPre' \<Lines> [Optional Alt Text]@+ GemPre ![Text] !(Maybe Text)+ deriving (Show, Eq) --- | Parse a Gemtext file as 'GemDocument'.--- The text should be supplied as an LF-ending 'Text'.+-- | Parse a gemtext block as 'GemDocument'.+--+-- The text should be supplied as a 'Text' which uses LF line breaks. decode :: Text -> GemDocument decode = parse [] . T.lines- where -- Default line-by-line recursive parser with 'GemDocument' carried.- -- If a list or preformatting is detected, will continue with- -- @parseList@ and @parsePre@ respectively. Otherwise, will use- -- 'decodeLine' on the current line only.- parse :: GemDocument -> [Text] -> GemDocument- parse doc (l:ls)- | l `hasValueOf` "* " = parseList doc [value 1 l] ls- | "```" `T.isPrefixOf` l = parsePre doc [] (optional $ value 3 l) ls- | otherwise = parse (doc <> [decodeLine l]) ls- parse doc [] = doc+ where+ -- Default line-by-line recursive parser with 'GemDocument' carried.+ -- If a list or preformatting is detected, will continue with+ -- @parseList@ and @parsePre@ respectively. Otherwise, will use+ -- 'decodeLine' on the current line only.+ parse :: GemDocument -> [Text] -> GemDocument+ parse doc (l : ls)+ | l `hasValueOf` "* " = parseList doc [value 1 l] ls+ | "```" `T.isPrefixOf` l = parsePre doc [] (optional $ value 3 l) ls+ | otherwise = parse (doc <> [decodeLine l]) ls+ parse doc [] = doc - -- List recursive parser. Continues with @parse@ when the line- -- is no longer a list item, and adds the 'GemList' to the 'GemDocument'.- parseList :: GemDocument -> [Text] -> [Text] -> GemDocument- parseList doc glist (l:ls)- | l `hasValueOf` "* " = parseList doc (glist <> [value 1 l]) ls- | otherwise = parse (doc <> [GemList glist]) (l:ls)- parseList doc glist [] = doc <> [GemList glist]+ -- List recursive parser. Continues with @parse@ when the line+ -- is no longer a list item, and adds the 'GemList' to the 'GemDocument'.+ parseList :: GemDocument -> [Text] -> [Text] -> GemDocument+ parseList doc glist (l : ls)+ | l `hasValueOf` "* " = parseList doc (glist <> [value 1 l]) ls+ | otherwise = parse (doc <> [GemList glist]) (l : ls)+ parseList doc glist [] = doc <> [GemList glist] - -- Preformatted recursive parser. Continues with @parse@ when the- -- closing delimiter is reached, and adds the 'GemPre' to the 'GemDocument'.- parsePre :: GemDocument -> [Text] -> Maybe Text -> [Text] -> GemDocument- parsePre doc glines alt (l:ls)- | "```" `T.isPrefixOf` l = parse (doc <> [GemPre glines alt]) ls- | otherwise = parsePre doc (glines <> [l]) alt ls- parsePre doc glines alt [] = doc <> [GemPre glines alt]+ -- Preformatted recursive parser. Continues with @parse@ when the+ -- closing delimiter is reached, and adds the 'GemPre' to the 'GemDocument'.+ parsePre :: GemDocument -> [Text] -> Maybe Text -> [Text] -> GemDocument+ parsePre doc glines alt (l : ls)+ | "```" `T.isPrefixOf` l = parse (doc <> [GemPre glines alt]) ls+ | otherwise = parsePre doc (glines <> [l]) alt ls+ parsePre doc glines alt [] = doc <> [GemPre glines alt] --- | Parse a /single/ Gemtext line as 'GemItem'.+-- | Parse a /single/ gemtext line as 'GemItem'. ----- The preformatted texts are regarded as 'GemText's as they are strictly multiline.+-- Preformatted text blocks are regarded as 'GemText's as they are strictly multiline. decodeLine :: Text -> GemItem decodeLine line- | line `hasValueOf` "=>" = let (link, desc) = T.break isSpace $ value 2 line- in GemLink link $ optional $ T.strip desc+ | line `hasValueOf` "=>" =+ let (link, desc) = T.break isSpace $ value 2 line+ in GemLink link $ optional $ T.strip desc | line `hasValueOf` "#" = parseHeading line | line `hasValueOf` "* " = GemList [value 1 line] | line `hasValueOf` ">" = GemQuote $ value 1 line | otherwise = GemText $ T.stripEnd line- where -- Parse a Gemtext heading.- -- The max level of a heading is 3.- parseHeading :: Text -> GemItem- parseHeading l- | T.null $ T.strip text = GemText $ T.strip l- | otherwise = GemHeading (min (T.length pre) 3) $ T.strip text- where (pre, text) = T.span (=='#') l+ where+ -- Parse a gemtext heading.+ -- The max level of a heading is 3.+ parseHeading :: Text -> GemItem+ parseHeading l+ | T.null $ T.strip text = GemText $ T.strip l+ | otherwise = GemHeading (min (T.length pre) 3) $ T.strip text+ where+ (pre, text) = T.span (== '#') l --- | Encode parsed 'GemDocument' as a Gemtext file.--- The output 'Text' uses LF-endings. Uses the 'encodeItem' function below.+-- | Encode a parsed 'GemDocument' into a gemtext block. ----- Valid prefixes are escaped before encoding.+-- The output 'Text' uses LF line breaks. --+-- Valid prefixes are escaped before encoding. See the 'encodeItem' function below.+-- -- Empty lists are ignored if given. encode :: GemDocument -> Text encode = T.unlines . map encodeItem . filter (not . empty)- where empty :: GemItem -> Bool- empty (GemList list) = null list- empty _ = False+ where+ empty :: GemItem -> Bool+ empty (GemList list) = null list+ empty _ = False --- | Encode a /single/ parsed 'GemItem' as Gemtext text.--- The output 'Text' uses LF-endings and might be multiple lines.+-- | Encode a /single/ parsed 'GemItem' into gemtext. ----- Valid prefixes are escaped before encoding.+-- /Beware/ that the output text does /not/ end with a newline. ----- /Beware/ that the output text doesn't end with a newline.+-- The output 'Text' might be multiple lines, in which case it uses LF line breaks. --+-- Valid prefixes are escaped before encoding.+-- -- The spaces in 'GemLink's are replaced with @%20@ to normalize them. encodeItem :: GemItem -> Text encodeItem (GemText line) = escapePrefixes line@@ -129,16 +148,20 @@ -- Escape the line prefixes by adding a whitespace at the beginning for 'GemText'. escapePrefixes :: Text -> Text escapePrefixes line = bool line (T.cons ' ' line) escape- where escape = "```" `T.isPrefixOf` line ||- any (hasValueOf line) ["=>", "* ", ">"] ||- (line `hasValueOf` "#" && let (_, text) = T.span (=='#') line- in not (T.null $ T.strip text))+ where+ escape = "```" `T.isPrefixOf` line+ || any (hasValueOf line) ["=>", "* ", ">"]+ || (line `hasValueOf` "#"+ && let (_, text) = T.span (== '#') line+ in not (T.null $ T.strip text)+ ) -- @True@ if the the line has prefix /and/ a following value. hasValueOf :: Text -> Text -> Bool-hasValueOf line prefix = prefix `T.isPrefixOf` line &&- not (T.null $ value (T.length prefix) line)+hasValueOf line prefix =+ prefix `T.isPrefixOf` line+ && not (T.null $ value (T.length prefix) line) -- Get the value of a line. -- Removes the prefix of given length and strips.@@ -148,4 +171,3 @@ -- @Nothing@ if the text is empty. optional :: Text -> Maybe Text optional text = bool (Just text) Nothing $ T.null text-
test/Main.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} -import Data.Text (Text) import Control.Monad+import Data.Text (Text) import System.Exit import Test.HUnit import Text.RawString.QQ@@ -13,27 +14,38 @@ -- | Query the test functions. main :: IO () main = do- count <- runTestTT $ TestList- [ gemDecode- , gemEncode- ]+ count <-+ runTestTT $+ TestList+ [ gemDecode+ , gemEncode+ ] when (failures count > 0) exitFailure --- | Test the decoding of Gemtext documents.+-- | Test the decoding of gemtext documents. gemDecode :: Test-gemDecode = TestCase $ assertEqual "Comparing the expected result of Gemtext decoding,"- document $ G.decode raw+gemDecode =+ TestCase+ $ assertEqual+ "Comparing the expected result of gemtext decoding,"+ document+ $ G.decode raw --- | Test the encoding of Gemtext documents.+-- | Test the encoding of gemtext documents. gemEncode :: Test-gemEncode = TestCase $ assertEqual "Comparing the expected result of Gemtext encoding,"- pretty $ G.encode document+gemEncode =+ TestCase+ $ assertEqual+ "Comparing the expected result of gemtext encoding,"+ pretty+ $ G.encode document --- | The expected encoded file to compare against.+-- | The expected encoded file to compare against pretty :: Text-pretty = [r| text!!+pretty =+ [r| text!! another text => link.gmi a link => gemini://geminiprotocol.net/index.gmi@@ -63,34 +75,36 @@ ``` |] --- | The expected decoded document to compare against.+-- | The expected decoded document to compare against document :: GemDocument-document = [ GemText " text!!"- , GemText "another text"- , GemLink "link.gmi" (Just "a link")- , GemLink "gemini://geminiprotocol.net/index.gmi" Nothing- , GemText "=>"- , GemHeading 1 "heading"- , GemHeading 2 "sub-heading"- , GemText "###"- , GemHeading 3 "subsubheading but it works"- , GemHeading 3 "same as level 3"- , GemText ""- , GemText "*text"- , GemText " * also text!"- , GemList ["list item", "another item"]- , GemText "*"- , GemQuote "quote"- , GemText ">"- , GemPre ["> preformat with alt"] (Just "alt")- , GemPre ["", "* preformat without alt"] Nothing- , GemQuote "qq"- , GemPre [] (Just "empty")- ]+document =+ [ GemText " text!!"+ , GemText "another text"+ , GemLink "link.gmi" (Just "a link")+ , GemLink "gemini://geminiprotocol.net/index.gmi" Nothing+ , GemText "=>"+ , GemHeading 1 "heading"+ , GemHeading 2 "sub-heading"+ , GemText "###"+ , GemHeading 3 "subsubheading but it works"+ , GemHeading 3 "same as level 3"+ , GemText ""+ , GemText "*text"+ , GemText " * also text!"+ , GemList ["list item", "another item"]+ , GemText "*"+ , GemQuote "quote"+ , GemText ">"+ , GemPre ["> preformat with alt"] (Just "alt")+ , GemPre ["", "* preformat without alt"] Nothing+ , GemQuote "qq"+ , GemPre [] (Just "empty")+ ] --- | The raw file to try to decode.+-- | The raw file to try to decode raw :: Text-raw = [r| text!! +raw =+ [r| text!! another text =>link.gmi a link => gemini://geminiprotocol.net/index.gmi@@ -119,4 +133,3 @@ ```empty ```ignored |]-