diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# 0.1.0.0 + +First release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2017, Artyom + +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 Artyom 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cmark-patterns.cabal b/cmark-patterns.cabal new file mode 100644 --- /dev/null +++ b/cmark-patterns.cabal @@ -0,0 +1,31 @@ +name: cmark-patterns +version: 0.1.0.0 +synopsis: Pattern synonyms for cmark +description: + Pattern synonyms for building and deconstructing cmark AST. +homepage: http://github.com/aelve/cmark-patterns +bug-reports: http://github.com/aelve/cmark-patterns/issues +license: BSD3 +license-file: LICENSE +author: Artyom +maintainer: yom@artyom.me +-- copyright: +category: Parsing, Text +tested-with: GHC == 7.10.3, GHC == 8.0.1, GHC == 8.2.1 +build-type: Simple +extra-source-files: CHANGELOG.md +cabal-version: >=1.10 + +source-repository head + type: git + location: git://github.com/aelve/cmark-patterns.git + +library + exposed-modules: CMark.Patterns + -- other-modules: + -- other-extensions: + build-depends: base >=4.8 && <5 + , cmark == 0.5.* + ghc-options: -Wall -fno-warn-unused-do-bind + hs-source-dirs: lib + default-language: Haskell2010 diff --git a/lib/CMark/Patterns.hs b/lib/CMark/Patterns.hs new file mode 100644 --- /dev/null +++ b/lib/CMark/Patterns.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE CPP #-} + +-- We can't provide all signatures anyway because CMark doesn't export +-- OnEnter and OnExit (which are needed to provide a signature for e.g. +-- CustomBlock) +#if __GLASGOW_HASKELL__ >= 800 +{-# OPTIONS -fno-warn-missing-pattern-synonym-signatures #-} +#endif + + +-- | +-- +-- for working with the cmark AST. You can construct and deconstruct the AST +-- with them as if they were ordinary constructors. +-- +-- Each pattern comes in two versions; if you don't care about position info, +-- use the one with the underscore. (If you try to use it for construction, +-- it will use 'Nothing' as position info.) +-- +-- Since list items can only contain 'ITEM', we provide additional patterns +-- for lists – 'ListItems' and 'ListItems_' – which automatically unwrap them. +module CMark.Patterns +( + -- ** 'DOCUMENT' + pattern Document, + pattern Document_, + -- ** 'THEMATIC_BREAK' (has no children) + pattern ThematicBreak, + pattern ThematicBreak_, + -- ** 'PARAGRAPH' + pattern Paragraph, + pattern Paragraph_, + -- ** 'BLOCK_QUOTE' + pattern BlockQuote, + pattern BlockQuote_, + -- ** 'HTML_BLOCK' (has no children) + pattern HtmlBlock, + pattern HtmlBlock_, + -- ** 'CUSTOM_BLOCK' + pattern CustomBlock, + pattern CustomBlock_, + -- ** 'CODE_BLOCK' (has no children) + pattern CodeBlock, + pattern CodeBlock_, + -- ** 'HEADING' + pattern Heading, + pattern Heading_, + -- ** 'LIST' + pattern List, + pattern List_, + pattern ListItems, + pattern ListItems_, + -- ** 'ITEM' + pattern Item, + pattern Item_, + -- ** 'TEXT' (has no children) + pattern Text, + pattern Text_, + -- ** 'SOFTBREAK' (has no children) + pattern Softbreak, + pattern Softbreak_, + -- ** 'LINEBREAK' (has no children) + pattern Linebreak, + pattern Linebreak_, + -- ** 'HTML_INLINE' (has no children) + pattern HtmlInline, + pattern HtmlInline_, + -- ** 'CUSTOM_INLINE' + pattern CustomInline, + pattern CustomInline_, + -- ** 'CODE' (has no children) + pattern Code, + pattern Code_, + -- ** 'EMPH' + pattern Emph, + pattern Emph_, + -- ** 'STRONG' + pattern Strong, + pattern Strong_, + -- ** 'LINK' + pattern Link, + pattern Link_, + -- ** 'IMAGE' + pattern Image, + pattern Image_, +) +where + + +import CMark + + +---------------------------------------------------------------------------- +-- Ordinary patterns +---------------------------------------------------------------------------- + +pattern Document pos xs = Node pos DOCUMENT xs + +pattern ThematicBreak pos <- Node pos THEMATIC_BREAK _ + where ThematicBreak pos = Node pos THEMATIC_BREAK [] + +pattern Paragraph pos xs = Node pos PARAGRAPH xs + +pattern BlockQuote pos xs = Node pos BLOCK_QUOTE xs + +pattern HtmlBlock pos t <- Node pos (HTML_BLOCK t) _ + where HtmlBlock pos t = Node pos (HTML_BLOCK t) [] + +pattern CustomBlock pos en ex xs = Node pos (CUSTOM_BLOCK en ex) xs + +pattern CodeBlock pos info t <- Node pos (CODE_BLOCK info t) _ + where CodeBlock pos info t = Node pos (CODE_BLOCK info t) [] + +pattern Heading pos lvl xs = Node pos (HEADING lvl) xs + +pattern List pos attrs xs = Node pos (LIST attrs) xs + +pattern Item pos xs = Node pos ITEM xs + +pattern Text pos t <- Node pos (TEXT t) _ + where Text pos t = Node pos (TEXT t) [] + +pattern Softbreak pos <- Node pos SOFTBREAK _ + where Softbreak pos = Node pos SOFTBREAK [] + +pattern Linebreak pos <- Node pos LINEBREAK _ + where Linebreak pos = Node pos LINEBREAK [] + +pattern HtmlInline pos t <- Node pos (HTML_INLINE t) _ + where HtmlInline pos t = Node pos (HTML_INLINE t) [] + +pattern CustomInline pos en ex xs = Node pos (CUSTOM_INLINE en ex) xs + +pattern Code pos t <- Node pos (CODE t) _ + where Code pos t = Node pos (CODE t) [] + +pattern Emph pos xs = Node pos EMPH xs + +pattern Strong pos xs = Node pos STRONG xs + +pattern Link pos url title xs = Node pos (LINK url title) xs + +pattern Image pos url title xs = Node pos (IMAGE url title) xs + +---------------------------------------------------------------------------- +-- Patterns without position info +---------------------------------------------------------------------------- + +pattern Document_ xs <- Document _ xs + where Document_ xs = Document Nothing xs + +pattern ThematicBreak_ <- ThematicBreak _ + where ThematicBreak_ = ThematicBreak Nothing + +pattern Paragraph_ xs <- Paragraph _ xs + where Paragraph_ xs = Paragraph Nothing xs + +pattern BlockQuote_ xs <- BlockQuote _ xs + where BlockQuote_ xs = BlockQuote Nothing xs + +pattern HtmlBlock_ t <- HtmlBlock _ t + where HtmlBlock_ t = HtmlBlock Nothing t + +pattern CustomBlock_ en ex xs <- CustomBlock _ en ex xs + where CustomBlock_ en ex xs = CustomBlock Nothing en ex xs + +pattern CodeBlock_ info t <- CodeBlock _ info t + where CodeBlock_ info t = CodeBlock Nothing info t + +pattern Heading_ lvl xs <- Heading _ lvl xs + where Heading_ lvl xs = Heading Nothing lvl xs + +pattern List_ attrs xs <- List _ attrs xs + where List_ attrs xs = List Nothing attrs xs + +pattern Item_ xs <- Item _ xs + where Item_ xs = Item Nothing xs + +pattern Text_ t <- Text _ t + where Text_ t = Text Nothing t + +pattern Softbreak_ <- Softbreak _ + where Softbreak_ = Softbreak Nothing + +pattern Linebreak_ <- Linebreak _ + where Linebreak_ = Linebreak Nothing + +pattern HtmlInline_ t <- HtmlInline _ t + where HtmlInline_ t = HtmlInline Nothing t + +pattern CustomInline_ en ex xs <- CustomInline _ en ex xs + where CustomInline_ en ex xs = CustomInline Nothing en ex xs + +pattern Code_ t <- Code _ t + where Code_ t = Code Nothing t + +pattern Emph_ xs <- Emph _ xs + where Emph_ xs = Emph Nothing xs + +pattern Strong_ xs <- Strong _ xs + where Strong_ xs = Strong Nothing xs + +pattern Link_ url title xs <- Link _ url title xs + where Link_ url title xs = Link Nothing url title xs + +pattern Image_ url title xs <- Image _ url title xs + where Image_ url title xs = Image Nothing url title xs + +---------------------------------------------------------------------------- +-- ListItems +---------------------------------------------------------------------------- + +unwrapItems :: [Node] -> [(Maybe PosInfo, [Node])] +unwrapItems is = [(pos, xs) | Item pos xs <- is] + +unwrapItems_ :: [Node] -> [[Node]] +unwrapItems_ is = [xs | Item_ xs <- is] + +pattern ListItems pos attrs xs <- Node pos (LIST attrs) (unwrapItems -> xs) + where ListItems pos attrs xs = Node pos (LIST attrs) (map (uncurry Item) xs) + +pattern ListItems_ attrs xs <- Node _ (LIST attrs) (unwrapItems_ -> xs) + where ListItems_ attrs xs = Node Nothing (LIST attrs) (map Item_ xs)