diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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! - diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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). diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -5,4 +5,3 @@ > main :: IO () > main = defaultMain - diff --git a/gemmula.cabal b/gemmula.cabal --- a/gemmula.cabal +++ b/gemmula.cabal @@ -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 - . +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 + . license: AGPL-3 license-file: LICENSE author: Sena maintainer: Sena -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 diff --git a/src/Text/Gemini.hs b/src/Text/Gemini.hs --- a/src/Text/Gemini.hs +++ b/src/Text/Gemini.hs @@ -2,120 +2,139 @@ -- | -- Module : Text.Gemini --- Copyright : (c) Sena, 2023 +-- Copyright : (c) Sena, 2024 -- License : AGPL-3.0-or-later -- -- Maintainer : Sena -- 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 +-- . 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' \@ - | GemLink !Text !(Maybe Text) -- ^ A Gemtext link. -- @'GemLink' \ \[Optional Description]@ - | GemHeading !Int !Text -- ^ A Gemtext heading of 3 levels max. -- @'GemHeading' \ \@ - | GemList ![Text] -- ^ A Gemtext unordered list. -- @'GemList' \@ - | GemQuote !Text -- ^ A Gemtext quote. -- @'GemQuote' \@ - | GemPre ![Text] !(Maybe Text) -- ^ A Gemtext preformat. -- @'GemPre' \ [Optional Alt Text]@ - deriving (Show, Eq) +-- | A gemtext item +data GemItem + = -- | A regular gemtext line -- @'GemText' \@ + GemText !Text + | -- | A gemtext link -- @'GemLink' \ \[Optional Description]@ + GemLink !Text !(Maybe Text) + | -- | A gemtext heading of 3 levels max -- @'GemHeading' \ \@ + GemHeading !Int !Text + | -- | An unordered gemtext list -- @'GemList' \@ + GemList ![Text] + | -- | A gemtext quote -- @'GemQuote' \@ + GemQuote !Text + | -- | A preformatted gemtext block -- @'GemPre' \ [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 - diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -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 |] -