Add skeleton for citation support.

New module Commonmark.Extensions.Citations.
[API change]

Inlines:  change type of bracketedSuffix so the constructor operators on
[Chunk il] rather than il.  Export unChunks, which will now be needed to
form the constructor.  This is intended to give the constructor access
to information only available in the Chunks, e.g. whether a semicolon
was escaped.  [API change]

Also we now export Chunk from Comonmark.Inlines [API change].

commonmark-cli/src/convert.hs

@@ -134,6 +134,7 @@ extensions :: (Monad m, Typeable m,
                HasStrikethrough il,
                HasSuperscript il,
                HasSubscript il,
+               HasCitations il,
                HasDefinitionList il bl,
                HasDiv bl,
                HasTaskList il bl,
@@ -146,6 +147,7 @@ extensions =
   ,("strikethrough", strikethroughSpec)
   ,("superscript", superscriptSpec)
   ,("subscript", subscriptSpec)
+  ,("citations", citationsSpec)
   ,("smart", smartPunctuationSpec)
   ,("math", mathSpec)
   ,("emoji", emojiSpec)
@@ -184,6 +186,7 @@ specFromExtensionNames ::
   HasStrikethrough il,
   HasSuperscript il,
   HasSubscript il,
+  HasCitations il,
   HasDefinitionList il bl,
   HasDiv bl,
   HasTaskList il bl,

commonmark-extensions/commonmark-extensions.cabal

@@ -82,6 +82,7 @@ library
       Commonmark.Extensions.ImplicitHeadingReferences
       Commonmark.Extensions.RebaseRelativePaths
       Commonmark.Extensions.Wikilinks
+      Commonmark.Extensions.Citations
   ghc-options: -Wall -fno-warn-unused-do-bind -funbox-small-strict-fields
   if impl(ghc >= 8.10)
     ghc-options:      -Wunused-packages

commonmark-extensions/src/Commonmark/Extensions.hs

@@ -40,6 +40,7 @@ module Commonmark.Extensions
     , module Commonmark.Extensions.ImplicitHeadingReferences
     , module Commonmark.Extensions.Wikilinks
     , module Commonmark.Extensions.RebaseRelativePaths
+    , module Commonmark.Extensions.Citations
     , gfmExtensions
     ) where
 
@@ -61,6 +62,7 @@ import           Commonmark.Extensions.TaskList
 import           Commonmark.Extensions.ImplicitHeadingReferences
 import           Commonmark.Extensions.Wikilinks
 import           Commonmark.Extensions.RebaseRelativePaths
+import           Commonmark.Extensions.Citations
 import           Commonmark
 import           Data.Typeable
 
@@ -73,4 +75,3 @@ gfmExtensions :: (Monad m, Typeable m, Typeable il, Typeable bl,
 gfmExtensions =
   emojiSpec <> strikethroughSpec <> pipeTableSpec <> autolinkSpec <>
     autoIdentifiersSpec <> taskListSpec <> footnoteSpec
-

commonmark-extensions/src/Commonmark/Extensions/Citations.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
+module Commonmark.Extensions.Citations
+  ( HasCitations(..),
+    citationsSpec
+  )
+where
+import Commonmark.Types
+import Commonmark.Tokens
+import Commonmark.Syntax
+import Commonmark.Inlines
+import Commonmark.SourceMap ( addName, WithSourceMap, runWithSourceMap )
+import Commonmark.Html ( htmlInline, addAttribute, Html(..), ElementType(..) )
+import Commonmark.TokParsers
+import Control.Monad (guard)
+import Data.Text (Text)
+import Text.Parsec
+
+class HasCitations il where
+  citationGroup :: il -> il -- we'll parse further in pandoc
+  citation :: Text -> Bool -> il
+  hasCitations :: il -> Bool
+
+instance HasCitations (Html il) where
+  citationGroup =
+    addAttribute ("class", "citation-group") .
+    htmlInline "span" .
+    Just
+  citation ident suppressAuthor =
+    addAttribute ("class", "citation") .
+    addAttribute ("identifier", ident) .
+    (if suppressAuthor
+        then addAttribute ("suppress-author", "true")
+      else id) $
+    htmlInline "span" Nothing
+  hasCitations x = case x of
+    HtmlElement InlineElement "span" attr _ ->
+      lookup "class" attr == Just "citation"
+    HtmlConcat w v -> hasCitations w || hasCitations v
+    _ -> False
+
+instance (HasCitations il, Monoid il, Show il) => HasCitations (WithSourceMap il) where
+  citationGroup x = (citationGroup <$> x) <* addName "citation"
+  citation ident suppressAuthor =
+    pure (citation ident suppressAuthor) <* addName "citation"
+  hasCitations x =
+    let (x', _) = runWithSourceMap x
+     in hasCitations x'
+
+citationsSpec
+  :: forall m bl il . (Monad m , IsInline il , IsBlock il bl, HasCitations il)
+  => SyntaxSpec m il bl
+citationsSpec =
+  defaultSyntaxSpec {
+    syntaxBracketedSpecs = [citationBracketedSpec]
+  , syntaxInlineParsers = [withAttributes parseBareCitation] }
+
+ where
+
+  citationBracketedSpec :: BracketedSpec il
+  citationBracketedSpec = BracketedSpec
+            { bracketedName = "Citation"
+            , bracketedNests = True
+            , bracketedPrefix = Nothing
+            , bracketedSuffixEnd = Just ';'
+            -- causes ; to be parsed in own chunk
+            , bracketedSuffix = checkCitation
+            }
+
+  checkCitation _rm chunksInside = do
+    -- if there are bare citations inside, return citation
+    let chunkHasCitations c =
+          case chunkType c of
+            Parsed x -> hasCitations x
+            _ -> False
+    guard $ any chunkHasCitations chunksInside
+    return $! citationGroup
+
+parseBareCitation :: (Monad m, HasCitations il, IsInline il)
+                  => InlineParser m il
+parseBareCitation = do
+  suppressAuthor <- (True <$ symbol '-') <|> pure False
+  ident <- parseCitationId
+  return $! citation ident suppressAuthor
+
+parseCitationId :: Monad m => InlineParser m Text
+parseCitationId = try $ do
+  symbol '@'
+  untokenize <$>
+    (many1 (satisfyTok (\t -> case tokType t of
+                 Symbol c -> c `elem` ['_']
+                 WordChars -> True
+                 _ -> False)))

commonmark-extensions/src/Commonmark/Extensions/RebaseRelativePaths.hs

@@ -7,6 +7,7 @@ where
 import Commonmark.Types
 import Commonmark.Syntax
 import Commonmark.Inlines
+import Commonmark.Tokens
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Maybe (fromMaybe)
@@ -45,14 +46,16 @@ rebaseRelativePathsSpec =
            , bracketedSuffix = newLinkSuffix
            }
 
-  newImageSuffix rm key = do
+  newImageSuffix rm chunksInside = do
     pos <- getPosition
+    let key = untokenize $ concatMap chunkToks chunksInside
     LinkInfo target title attrs mbpos <- pLink rm key
     let pos' = fromMaybe pos mbpos
     return $! addAttributes attrs . image (rebasePath pos' target) title
 
-  newLinkSuffix rm key = do
+  newLinkSuffix rm chunksInside = do
     pos <- getPosition
+    let key = untokenize $ concatMap chunkToks chunksInside
     LinkInfo target title attrs mbpos <- pLink rm key
     let pos' = fromMaybe pos mbpos
     return $! addAttributes attrs . link (rebasePath pos' target) title

commonmark-pandoc/src/Commonmark/Pandoc.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE ExtendedDefaultRules       #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE FlexibleInstances          #-}
@@ -32,6 +33,7 @@ import Commonmark.Extensions.Attributes
 import Commonmark.Extensions.Footnote
 import Commonmark.Extensions.TaskList
 import Commonmark.Extensions.Smart
+import Commonmark.Extensions.Citations
 import Data.Char (isSpace)
 import Data.Coerce (coerce)
 
@@ -178,6 +180,17 @@ instance HasSuperscript (Cm a B.Inlines) where
 instance HasSubscript (Cm a B.Inlines) where
   subscript ils = B.subscript <$> ils
 
+instance HasCitations (Cm a B.Inlines) where
+  citationGroup ils = B.spanWith ("",["citation-group"],[]) <$> ils
+  citation ident suppressAuthor =
+    Cm $ B.spanWith ("", ["citation"],
+                       ([("citation-identifier", ident)] ++
+                        [("suppress-author","true") | suppressAuthor])) mempty
+  hasCitations (Cm ils) =
+    let isCitation (Span (_,["citation"],_) _) = True
+        isCitation _ = False
+    in  any isCitation ils
+
 instance Rangeable (Cm a B.Inlines) => HasSpan (Cm a B.Inlines) where
   spanWith attrs ils =
     B.spanWith (addToPandocAttr attrs nullAttr) <$> ils

commonmark/src/Commonmark/Html.hs

@@ -4,7 +4,8 @@
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE UndecidableInstances       #-}
 module Commonmark.Html
-  ( Html
+  ( Html(..)
+  , ElementType(..)
   , htmlInline
   , htmlBlock
   , htmlText

commonmark/src/Commonmark/Inlines.hs

@@ -17,6 +17,8 @@ module Commonmark.Inlines
   , BracketedSpec(..)
   , defaultBracketedSpecs
   , LinkInfo(..)
+  , Chunk(..)
+  , ChunkType(..)
   , imageSpec
   , linkSpec
   , pLink
@@ -249,7 +251,7 @@ data BracketedSpec il = BracketedSpec
      , bracketedPrefix    :: Maybe Char -- ^ Prefix character.
      , bracketedSuffixEnd :: Maybe Char -- ^ Suffix character.
      , bracketedSuffix    :: ReferenceMap
-                          -> Text
+                          -> [Chunk il]
                           -> Parsec [Tok] () (il -> il)
                           -- ^ Parser for suffix after
                           -- brackets.  Returns a constructor.
@@ -286,15 +288,17 @@ imageSpec = BracketedSpec
             }
 
 pLinkSuffix :: IsInline il
-            => ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
-pLinkSuffix rm key = do
-  LinkInfo target title attrs _mbpos <- pLink rm key
+            => ReferenceMap -> [Chunk il] -> Parsec [Tok] s (il -> il)
+pLinkSuffix rm chunksInside = do
+  LinkInfo target title attrs _mbpos <-
+    pLink rm (untokenize $ concatMap chunkToks chunksInside)
   return $! addAttributes attrs . link target title
 
 pImageSuffix :: IsInline il
-             => ReferenceMap -> Text -> Parsec [Tok] s (il -> il)
-pImageSuffix rm key = do
-  LinkInfo target title attrs _mbpos <- pLink rm key
+             => ReferenceMap -> [Chunk il] -> Parsec [Tok] s (il -> il)
+pImageSuffix rm chunksInside = do
+  LinkInfo target title attrs _mbpos <-
+    pLink rm (untokenize $ concatMap chunkToks chunksInside)
   return $! addAttributes attrs . image target title
 
 ---
@@ -734,15 +738,6 @@ processBs bracketedSpecs st =
         Just closer@(Chunk Delim{ delimType = ']'} closePos _)) ->
           let chunksinside = takeWhile (\ch -> chunkPos ch /= closePos)
                                (afters left)
-              isBracket (Chunk Delim{ delimType = c' } _ _) =
-                 c' == '[' || c' == ']'
-              isBracket _ = False
-              key = if any isBracket chunksinside
-                       then ""
-                       else
-                         case untokenize (concatMap chunkToks chunksinside) of
-                              ks | T.length ks <= 999 -> ks
-                              _  -> ""
               prefixChar = case befores left of
                                  Chunk Delim{delimType = c} _ [_] : _
                                     -> Just c
@@ -764,7 +759,7 @@ processBs bracketedSpecs st =
                  (withRaw
                    (do setPosition suffixPos
                        (spec, constructor) <- choice $
-                           map (\s -> (s,) <$> bracketedSuffix s rm key)
+                           map (\s -> (s,) <$> bracketedSuffix s rm chunksinside)
                            specs
                        pos <- getPosition
                        return (spec, constructor, pos)))