commonmark-initial (empty) → 0.1.0.0
raw patch · 6 files changed
+792/−0 lines, 6 filesdep +basedep +commonmarkdep +commonmark-extensions
Dependencies added: base, commonmark, commonmark-extensions, commonmark-initial, deriving-compat, dwergaz, free, parsec, text
Files
- CHANGELOG.md +5/−0
- LICENSE +13/−0
- commonmark-initial.cabal +53/−0
- src/Commonmark/Initial.hs +149/−0
- test/Commonmark/InitialTest.hs +559/−0
- test/Main.hs +13/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for commonmark-initial++## 0.1.0.0 -- 2025-07-28++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (c) 2025 Henry Till++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.
+ commonmark-initial.cabal view
@@ -0,0 +1,53 @@+cabal-version: 3.0+name: commonmark-initial+version: 0.1.0.0+synopsis: An initial encoding of the CommonMark language+description:+ This library provides an initial encoding of the CommonMark language+ for use with the [commonmark](https://hackage.haskell.org/package/commonmark)+ library.+license: ISC+license-file: LICENSE+author: Henry Till+maintainer: henrytill@gmail.com+homepage: https://github.com/henrytill/commonmark-initial+copyright: Copyright (c) 2025, Henry Till+category: Text+build-type: Simple+extra-doc-files: CHANGELOG.md+tested-with: GHC ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.2 || ==9.12.2++source-repository head+ type: git+ location: https://github.com/henrytill/commonmark-initial.git++common warnings+ ghc-options: -Wall++library+ import: warnings+ default-language: GHC2021+ hs-source-dirs: src+ exposed-modules: Commonmark.Initial+ build-depends:+ base >=4.17.2.1 && <4.22,+ commonmark ^>=0.2.6.1,+ deriving-compat ^>=0.6.7,+ free ^>=5.2,+ text >=2.0.2 && <2.2++test-suite commonmark-initial-test+ import: warnings+ default-language: GHC2021+ hs-source-dirs: test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules: Commonmark.InitialTest+ build-depends:+ base >=4.17.2.1 && <4.22,+ commonmark ^>=0.2.6.1,+ commonmark-extensions ^>=0.2.6,+ dwergaz ^>=0.3.1.0,+ parsec ^>=3.1.16.1,+ text >=2.0.2 && <2.2,+ commonmark-initial
+ src/Commonmark/Initial.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoFieldSelectors #-}++module Commonmark.Initial+ ( Ann (..)+ , Block+ , Blocks+ , BlockF (..)+ , Inline+ , Inlines+ , InlineF (..)+ , pattern MkBlock+ , pattern MkInline+ )+where++import Commonmark.Types+ ( Attributes+ , Format+ , HasAttributes (..)+ , IsBlock (..)+ , IsInline (..)+ , ListSpacing+ , ListType+ , Rangeable (..)+ , SourceRange+ )+import Control.Comonad.Cofree+import Data.Eq.Deriving+import Data.Text (Text)+import Text.Show.Deriving++data Ann = MkAnn+ { range :: SourceRange+ , attributes :: Attributes+ }+ deriving (Show, Eq)++instance Semigroup Ann where+ a <> b = MkAnn (a.range <> b.range) (a.attributes <> b.attributes)++instance Monoid Ann where+ mempty = MkAnn mempty mempty++data InlineF r+ = LineBreak+ | SoftBreak+ | Str Text+ | Entity Text+ | EscapedChar Char+ | Emph [r]+ | Strong [r]+ | Link Text Text [r]+ | Image Text Text [r]+ | Code Text+ | RawInline Format Text+ deriving (Show, Eq, Functor, Foldable, Traversable)++$(deriveShow1 ''InlineF)+$(deriveEq1 ''InlineF)++type Inline a = Cofree InlineF a++pattern MkInline :: a -> InlineF (Inline a) -> Inline a+pattern MkInline a body = a :< body++{-# COMPLETE MkInline #-}++type Inlines = [Inline Ann]++rangedInline :: SourceRange -> Inline Ann -> Inline Ann+rangedInline sr (MkInline ann body) = MkInline (ann <> MkAnn sr mempty) body++addAttributesInline :: Attributes -> Inline Ann -> Inline Ann+addAttributesInline attrs (MkInline ann body) = MkInline (ann <> MkAnn mempty attrs) body++instance Rangeable Inlines where+ ranged sr = map $ rangedInline sr++instance HasAttributes Inlines where+ addAttributes attrs = map $ addAttributesInline attrs++mkInline :: (Monoid a) => InlineF (Inline a) -> Inline a+mkInline = MkInline mempty++instance IsInline Inlines where+ lineBreak = [mkInline LineBreak]+ softBreak = [mkInline SoftBreak]+ str t = [mkInline $ Str t]+ entity t = [mkInline $ Entity t]+ escapedChar c = [mkInline $ EscapedChar c]+ emph ils = [mkInline $ Emph ils]+ strong ils = [mkInline $ Strong ils]+ link d t desc = [mkInline $ Link d t desc]+ image s t desc = [mkInline $ Image s t desc]+ code t = [mkInline $ Code t]+ rawInline f t = [mkInline $ RawInline f t]++data BlockF a r+ = Paragraph [Inline a]+ | Plain [Inline a]+ | ThematicBreak+ | BlockQuote [r]+ | CodeBlock Text Text+ | Heading Int [Inline a]+ | RawBlock Format Text+ | ReferenceLinkDefinition Text (Text, Text)+ | List ListType ListSpacing [[r]]+ deriving (Show, Eq, Functor, Foldable, Traversable)++$(deriveShow1 ''BlockF)+$(deriveEq1 ''BlockF)++type Block a = Cofree (BlockF a) a++pattern MkBlock :: a -> BlockF a (Block a) -> Block a+pattern MkBlock a body = a :< body++{-# COMPLETE MkBlock #-}++type Blocks = [Block Ann]++rangedBlock :: SourceRange -> Block Ann -> Block Ann+rangedBlock sr (MkBlock ann body) = MkBlock (ann <> MkAnn sr mempty) body++addAttributesBlock :: Attributes -> Block Ann -> Block Ann+addAttributesBlock attrs (MkBlock ann body) = MkBlock (ann <> MkAnn mempty attrs) body++instance Rangeable Blocks where+ ranged sr = map $ rangedBlock sr++instance HasAttributes Blocks where+ addAttributes attrs = map $ addAttributesBlock attrs++mkBlock :: (Monoid a) => BlockF a (Block a) -> Block a+mkBlock = MkBlock mempty++instance IsBlock Inlines Blocks where+ paragraph ils = [mkBlock $ Paragraph ils]+ plain ils = [mkBlock $ Plain ils]+ thematicBreak = [mkBlock ThematicBreak]+ blockQuote bs = [mkBlock $ BlockQuote bs]+ codeBlock info c = [mkBlock $ CodeBlock info c]+ heading level ils = [mkBlock $ Heading level ils]+ rawBlock f t = [mkBlock $ RawBlock f t]+ referenceLinkDefinition l dt = [mkBlock $ ReferenceLinkDefinition l dt]+ list lt ls bss = [mkBlock $ List lt ls bss]
+ test/Commonmark/InitialTest.hs view
@@ -0,0 +1,559 @@+{-# LANGUAGE OverloadedStrings #-}++module Commonmark.InitialTest where++import Commonmark+import Commonmark.Extensions.Attributes (attributesSpec)+import Commonmark.Initial+import Data.Functor.Identity (runIdentity)+import Data.Text (Text)+import Data.Text qualified as Text+import Test.Dwergaz+import Text.Parsec.Pos (newPos)++myCommonmark :: (IsBlock il bl) => String -> Text -> Either ParseError bl+myCommonmark name = runIdentity . commonmarkWith (defaultSyntaxSpec <> attributesSpec) name++parseName :: String+parseName = "test"++parse :: Text -> Either ParseError Blocks+parse = myCommonmark parseName++testHeading :: Test+testHeading = assertEqual "Test Heading" expected actual+ where+ actual = parse $ Text.unlines ["# Hello, world!"]+ expected =+ Right+ [ MkBlock+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 1, newPos parseName 2 1)]+ , attributes = []+ }+ )+ ( Heading+ 1+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 3, newPos parseName 1 8)]+ , attributes = []+ }+ )+ (Str "Hello")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 8, newPos parseName 1 9)]+ , attributes = []+ }+ )+ (Str ",")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 9, newPos parseName 1 10)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 10, newPos parseName 1 15)]+ , attributes = []+ }+ )+ (Str "world")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 15, newPos parseName 1 16)]+ , attributes = []+ }+ )+ (Str "!")+ ]+ )+ ]++testHeadingAttributes :: Test+testHeadingAttributes = assertEqual "Test Heading w/attributes" expected actual+ where+ actual = parse $ Text.unlines ["# Hello, world! {#foo}"]+ expected =+ Right+ [ MkBlock+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 1, newPos parseName 2 1)]+ , attributes = [("id", "foo")]+ }+ )+ ( Heading+ 1+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 3, newPos parseName 1 8)]+ , attributes = []+ }+ )+ (Str "Hello")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 8, newPos parseName 1 9)]+ , attributes = []+ }+ )+ (Str ",")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 9, newPos parseName 1 10)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 10, newPos parseName 1 15)]+ , attributes = []+ }+ )+ (Str "world")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 15, newPos parseName 1 16)]+ , attributes = []+ }+ )+ (Str "!")+ ]+ )+ ]++testParagraph :: Test+testParagraph = assertEqual "Test Paragraph" expected actual+ where+ actual = parse $ Text.unlines ["Hello, world!"]+ expected =+ Right+ [ MkBlock+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 1, newPos parseName 2 1)]+ , attributes = []+ }+ )+ ( Paragraph+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 1, newPos parseName 1 6)]+ , attributes = []+ }+ )+ (Str "Hello")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 6, newPos parseName 1 7)]+ , attributes = []+ }+ )+ (Str ",")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 7, newPos parseName 1 8)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 8, newPos parseName 1 13)]+ , attributes = []+ }+ )+ (Str "world")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 13, newPos parseName 1 14)]+ , attributes = []+ }+ )+ (Str "!")+ ]+ )+ ]++testDocument :: Test+testDocument = assertEqual "Test Document" expected actual+ where+ actual =+ parse $+ Text.unlines+ [ "# Hello, world! {#foo}"+ , ""+ , "Hello, world!"+ ]+ expected =+ Right+ [ MkBlock+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 1, newPos parseName 2 1)]+ , attributes = [("id", "foo")]+ }+ )+ ( Heading+ 1+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 3, newPos parseName 1 8)]+ , attributes = []+ }+ )+ (Str "Hello")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 8, newPos parseName 1 9)]+ , attributes = []+ }+ )+ (Str ",")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 9, newPos parseName 1 10)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 10, newPos parseName 1 15)]+ , attributes = []+ }+ )+ (Str "world")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 15, newPos parseName 1 16)]+ , attributes = []+ }+ )+ (Str "!")+ ]+ )+ , MkBlock+ ( MkAnn+ { range = SourceRange [(newPos parseName 3 1, newPos parseName 4 1)]+ , attributes = []+ }+ )+ ( Paragraph+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 3 1, newPos parseName 3 6)]+ , attributes = []+ }+ )+ (Str "Hello")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 3 6, newPos parseName 3 7)]+ , attributes = []+ }+ )+ (Str ",")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 3 7, newPos parseName 3 8)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 3 8, newPos parseName 3 13)]+ , attributes = []+ }+ )+ (Str "world")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 3 13, newPos parseName 3 14)]+ , attributes = []+ }+ )+ (Str "!")+ ]+ )+ ]++testList :: Test+testList = assertEqual "Test List" expected actual+ where+ actual =+ parse $+ Text.unlines+ [ "- Hello, world!"+ , "- Goobye"+ , ""+ , " Again"+ ]+ expected =+ Right+ [ MkBlock+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 1, newPos parseName 5 1)]+ , attributes = []+ }+ )+ ( List+ (BulletList '-')+ LooseList+ [+ [ MkBlock+ ( MkAnn+ { range =+ SourceRange+ [ (newPos parseName 1 3, newPos parseName 2 1)+ , (newPos parseName 1 1, newPos parseName 2 1)+ ]+ , attributes = []+ }+ )+ ( Paragraph+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 3, newPos parseName 1 8)]+ , attributes = []+ }+ )+ (Str "Hello")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 8, newPos parseName 1 9)]+ , attributes = []+ }+ )+ (Str ",")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 9, newPos parseName 1 10)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 10, newPos parseName 1 15)]+ , attributes = []+ }+ )+ (Str "world")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 15, newPos parseName 1 16)]+ , attributes = []+ }+ )+ (Str "!")+ ]+ )+ ]+ ,+ [ MkBlock+ ( MkAnn+ { range =+ SourceRange+ [ (newPos parseName 2 3, newPos parseName 3 1)+ , (newPos parseName 2 1, newPos parseName 5 1)+ ]+ , attributes = []+ }+ )+ ( Paragraph+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 2 3, newPos parseName 2 9)]+ , attributes = []+ }+ )+ (Str "Goobye")+ ]+ )+ , MkBlock+ ( MkAnn+ { range =+ SourceRange+ [ (newPos parseName 4 3, newPos parseName 5 1)+ , (newPos parseName 2 1, newPos parseName 5 1)+ ]+ , attributes = []+ }+ )+ ( Paragraph+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 4 3, newPos parseName 4 8)]+ , attributes = []+ }+ )+ (Str "Again")+ ]+ )+ ]+ ]+ )+ ]++testTightList :: Test+testTightList = assertEqual "Test Tight List" expected actual+ where+ actual =+ parse $+ Text.unlines+ [ "- Hello, world!"+ , "- [Foo{#bar .klass baz=\"quux\"} is foo](https://www.foo.com/)"+ ]+ expected =+ Right+ [ MkBlock+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 1, newPos parseName 3 1)]+ , attributes = []+ }+ )+ ( List+ (BulletList '-')+ TightList+ [+ [ MkBlock+ ( MkAnn+ { range =+ SourceRange+ [ (newPos parseName 1 3, newPos parseName 2 1)+ , (newPos parseName 1 1, newPos parseName 2 1)+ ]+ , attributes = []+ }+ )+ ( Plain+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 3, newPos parseName 1 8)]+ , attributes = []+ }+ )+ (Str "Hello")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 8, newPos parseName 1 9)]+ , attributes = []+ }+ )+ (Str ",")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 9, newPos parseName 1 10)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 10, newPos parseName 1 15)]+ , attributes = []+ }+ )+ (Str "world")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 1 15, newPos parseName 1 16)]+ , attributes = []+ }+ )+ (Str "!")+ ]+ )+ ]+ ,+ [ MkBlock+ ( MkAnn+ { range =+ SourceRange+ [ (newPos parseName 2 3, newPos parseName 3 1)+ , (newPos parseName 2 1, newPos parseName 3 1)+ ]+ , attributes = []+ }+ )+ ( Plain+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 2 3, newPos parseName 2 61)]+ , attributes = []+ }+ )+ ( Link+ "https://www.foo.com/"+ mempty+ [ MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 2 4, newPos parseName 2 7)]+ , attributes =+ [ ("id", "bar")+ , ("class", "klass")+ , ("baz", "quux")+ ]+ }+ )+ (Str "Foo")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 2 31, newPos parseName 2 32)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 2 32, newPos parseName 2 34)]+ , attributes = []+ }+ )+ (Str "is")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 2 34, newPos parseName 2 35)]+ , attributes = []+ }+ )+ (Str " ")+ , MkInline+ ( MkAnn+ { range = SourceRange [(newPos parseName 2 35, newPos parseName 2 38)]+ , attributes = []+ }+ )+ (Str "foo")+ ]+ )+ ]+ )+ ]+ ]+ )+ ]++allTests :: Test+allTests =+ group+ "Commonmark.Initial tests"+ [ testHeading+ , testHeadingAttributes+ , testParagraph+ , testDocument+ , testList+ , testTightList+ ]++results :: (String, Bool)+results = (buildString mempty, allPassed)+ where+ result = runTest allTests+ allPassed = resultIsPassed result+ showResults = showString $ resultToString result+ buildString = showResults . showChar '\n'
+ test/Main.hs view
@@ -0,0 +1,13 @@+module Main (main) where++import Commonmark.InitialTest qualified as InitialTest+import Control.Monad (unless)+import System.Exit (exitFailure)+import Text.Printf (printf)++main :: IO ()+main = do+ let (initialOutput, initialPassed) = InitialTest.results+ putStr initialOutput+ printf "Summary: %s\n" (if initialPassed then "All tests passed!" else "Some tests failed.")+ unless initialPassed exitFailure