language-gemini (empty) → 0.1.0.0

raw patch · 6 files changed

+202/−0 lines, 6 filesdep +basedep +textsetup-changed

Dependencies added: base, text

Files

CHANGELOG.md +6/−0
LICENSE +30/−0
Language/Gemini.hs +122/−0
README.md +9/−0
Setup.hs +2/−0
language-gemini.cabal +33/−0

+ CHANGELOG.md view

@@ -0,0 +1,6 @@+# Revision history for language-gemini++## 0.1.0.0 -- 2020-07-24++* First version. Released on an unsuspecting world.+

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2020, Francesco Gazzetta++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Francesco Gazzetta nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Language/Gemini.hs view

@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.Gemini (+-- * Gemini documents+  GeminiDocument+, GeminiLine(..)+-- * Decoding+, decodeGemini+-- * Encoding+, encodeGemini+) where++import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T++import Data.Char (isSpace)+import Data.Int (Int64)++-- Gemini documents+----------------------------++type GeminiDocument = [GeminiLine]++data GeminiLine = LText Text -- ^ Normal text+                | LLink Text (Maybe Text) -- ^ A link with an optional description+                | LPre [Text] -- ^ A preformatted block containing multiple lines+                | LH1 Text -- ^ A first level heading+                | LH2 Text -- ^ A second level heading+                | LH3 Text -- ^ A third level heading+                | LItem Text -- ^ A list item+                | LQuote Text -- ^ A quotation+  deriving (Show, Read, Eq)++-- Decoding+----------------------------++decodeGemini :: Bool -- ^ Whether to allow unix-style line endings (\n)+             -> Text -- ^ Text to parse+             -> GeminiDocument+-- gemini is really simple, so we do not even use a parsing library+decodeGemini allowUnixStyle = go . (if allowUnixStyle then concatMap T.lines else id)+                                 . T.splitOn "\CR\LF"+  where+    go [] = []+    go (l:ls) | isPreToggle l = let (pres, rest) = break isPreToggle ls+                                 in LPre pres : go (drop 1 rest)+              | "=>" `T.isPrefixOf` l = parseLink l : go ls+              | "###" `T.isPrefixOf` l = LH3 (dropPrefix 3 l) : go ls+              | "##" `T.isPrefixOf` l = LH2 (dropPrefix 2 l) : go ls+              | "#" `T.isPrefixOf` l = LH1 (dropPrefix 1 l) : go ls+              | "* " `T.isPrefixOf` l = LItem (dropPrefix 2 l) : go ls+              | ">" `T.isPrefixOf` l = LQuote (dropPrefix 1 l) : go ls+              | otherwise = LText l : go ls++isPreToggle :: Text -> Bool+isPreToggle = T.isPrefixOf "```"++dropPrefix :: Int64 -> Text -> Text+dropPrefix n = T.stripStart . T.drop n++parseLink :: Text -> GeminiLine+parseLink txt = LLink link $ if T.null desc' then Nothing else Just desc'+  where+    (link, desc) = T.break isSpace $ T.stripStart txt+    desc' = T.stripStart desc++-- Encoding+----------------------------++encodeGemini :: GeminiDocument -> Text+encodeGemini = T.intercalate "\CR\LF" . fmap encodeLine++encodeLine :: GeminiLine -> Text+encodeLine (LText t) = escapeLText t+encodeLine (LLink l desc) = "=> " <> escapeLink l <> " " <> desc'+  where desc' = maybe T.empty escapeNewlines desc+encodeLine (LPre ls) = T.intercalate "\CR\LF" $+  "```" : fmap escapeLPre ls <> ["```"]+encodeLine (LH1 t) = "# " <> escapeNewlines t+encodeLine (LH2 t) = "## " <> escapeNewlines t+encodeLine (LH3 t) = "### " <> escapeNewlines t+encodeLine (LItem t) = "* " <> escapeNewlines t+encodeLine (LQuote t) = "> " <> escapeNewlines t++--- TODO ask about actual escaping rules instead of just using "\\" and stripping newlines+escapeCharacter :: Char+escapeCharacter = ' '++escapeLPre :: Text -> Text+escapeLPre = escapePrePrefix . escapeNewlines++escapeLText :: Text -> Text+escapeLText = escapeAnyPrefix . escapeNewlines++escapeLink :: Text -> Text+-- Ideally spaces should be urlencoded but nonmalicious agents wouldn't put+-- whitespace in a link anyway.+escapeLink = T.map $ \c -> if isSpace c then '+' else c++escapeNewlines :: Text -> Text+escapeNewlines = T.map crlfToSpace+  where+    crlfToSpace '\CR' = ' '+    crlfToSpace '\LF' = ' '+    crlfToSpace c     = c++escapePrePrefix :: Text -> Text+escapePrePrefix t | "```" `T.isPrefixOf` t = T.cons escapeCharacter t+                  | otherwise                     = t++escapeAnyPrefix :: Text -> Text+escapeAnyPrefix t | reservedPrefix t = T.cons escapeCharacter t+                  | otherwise        = t++reservedPrefix :: Text -> Bool+reservedPrefix t = any (`T.isPrefixOf` t)+  [ "=>"+  , "```"+  , "#"+  , "* "+  , ">"+  ]+

+ README.md view

@@ -0,0 +1,9 @@+# language-gemini++[![Hackage](https://img.shields.io/hackage/v/language-gemini.svg)](https://hackage.haskell.org/package/language-gemini)+[![builds.sr.ht status](https://builds.sr.ht/~fgaz/language-gemini.svg)](https://builds.sr.ht/~fgaz/language-gemini?)++**Datatypes and parsing/printing functions to represent the Gemini markup language in Haskell**++More info at https://sr.ht/~fgaz/haskell-gemini/+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ language-gemini.cabal view

@@ -0,0 +1,33 @@+cabal-version:       2.2++name:                language-gemini+version:             0.1.0.0+synopsis:            Datatypes and parsing/printing functions to represent the Gemini markup language+description:+  This package contains the 'GeminiDocument' datatype, representing a Gemini+  (<https://gemini.circumlunar.space>) document, together with functions for+  parsing and printing Gemini documents to/from 'Text' data.+homepage:            https://sr.ht/~fgaz/haskell-gemini/+bug-reports:         https://todo.sr.ht/~fgaz/haskell-gemini+license:             BSD-3-Clause+license-file:        LICENSE+author:              Francesco Gazzetta+maintainer:          Francesco Gazzetta <fgaz@fgaz.me>+copyright:           © 2020 Francesco Gazzetta and contributors+category:            Text, Gemini+extra-source-files:  CHANGELOG.md, README.md++source-repository head+  type:                git+  location:            https://git.sr.ht/~fgaz/language-gemini++library+  exposed-modules:     Language.Gemini+  -- other-modules:+  other-extensions:    OverloadedStrings+  build-depends:       base ^>=4.13.0.0 || ^>=4.14.0.0+                     , text ^>=1.2.3.2+  -- hs-source-dirs:+  ghc-options:         -Wall+  default-language:    Haskell2010+