{-# LANGUAGE RankNTypes #-}
module Commonmark.Syntax
  ( SyntaxSpec(..)
  , defaultSyntaxSpec
  )
where

import Text.Parsec (ParsecT)
import Commonmark.Tokens (Tok)
import Commonmark.Types
import Commonmark.Blocks
import Commonmark.Inlines

-- | A 'SyntaxSpec' defines a basic collection of syntax
-- elements or an extension.  'SyntaxSpec's can be composed
-- using monoidal 'mappend'.
data SyntaxSpec m il bl = SyntaxSpec
     { forall (m :: * -> *) il bl.
SyntaxSpec m il bl -> [BlockSpec m il bl]
syntaxBlockSpecs      :: [BlockSpec m il bl]
        -- ^ Defines block structure
     , forall (m :: * -> *) il bl.
SyntaxSpec m il bl -> [BracketedSpec il]
syntaxBracketedSpecs  :: [BracketedSpec il]
        -- ^ Defines bracketed inline containers (inli, image)
     , forall (m :: * -> *) il bl.
SyntaxSpec m il bl -> [FormattingSpec il]
syntaxFormattingSpecs :: [FormattingSpec il]
        -- ^ Defines formatted inline containers (strong, emph)
     , forall (m :: * -> *) il bl.
SyntaxSpec m il bl -> [InlineParser m il]
syntaxInlineParsers   :: [InlineParser m il]
        -- ^ Defines inline elements that don't contain inlines
     , forall (m :: * -> *) il bl.
SyntaxSpec m il bl -> [BlockParser m il bl bl]
syntaxFinalParsers    :: [BlockParser m il bl bl]
        -- ^ Run at the end of document, e.g. to collect footnotes
     , forall (m :: * -> *) il bl.
SyntaxSpec m il bl
-> forall u (m1 :: * -> *).
   Monad m1 =>
   [ParsecT [Tok] u m1 Attributes]
syntaxAttributeParsers
             :: forall u m1 . Monad m1 => [ParsecT [Tok] u m1 Attributes]
       -- ^ Parse attributes
     }

instance Semigroup (SyntaxSpec m il bl) where
  SyntaxSpec [BlockSpec m il bl]
bl1 [BracketedSpec il]
br1 [FormattingSpec il]
fo1 [InlineParser m il]
il1 [BlockParser m il bl bl]
fp1 forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
ap1 <> :: SyntaxSpec m il bl -> SyntaxSpec m il bl -> SyntaxSpec m il bl
<> SyntaxSpec [BlockSpec m il bl]
bl2 [BracketedSpec il]
br2 [FormattingSpec il]
fo2 [InlineParser m il]
il2 [BlockParser m il bl bl]
fp2 forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
ap2
    = [BlockSpec m il bl]
-> [BracketedSpec il]
-> [FormattingSpec il]
-> [InlineParser m il]
-> [BlockParser m il bl bl]
-> (forall u (m1 :: * -> *).
    Monad m1 =>
    [ParsecT [Tok] u m1 Attributes])
-> SyntaxSpec m il bl
forall (m :: * -> *) il bl.
[BlockSpec m il bl]
-> [BracketedSpec il]
-> [FormattingSpec il]
-> [InlineParser m il]
-> [BlockParser m il bl bl]
-> (forall u (m1 :: * -> *).
    Monad m1 =>
    [ParsecT [Tok] u m1 Attributes])
-> SyntaxSpec m il bl
SyntaxSpec ([BlockSpec m il bl] -> [BlockSpec m il bl]
forall (m :: * -> *) il bl.
[BlockSpec m il bl] -> [BlockSpec m il bl]
removeDuplicateBlockSpecs ([BlockSpec m il bl] -> [BlockSpec m il bl])
-> [BlockSpec m il bl] -> [BlockSpec m il bl]
forall a b. (a -> b) -> a -> b
$ [BlockSpec m il bl]
bl1 [BlockSpec m il bl] -> [BlockSpec m il bl] -> [BlockSpec m il bl]
forall a. Semigroup a => a -> a -> a
<> [BlockSpec m il bl]
bl2)
                 ([BracketedSpec il]
br1 [BracketedSpec il] -> [BracketedSpec il] -> [BracketedSpec il]
forall a. Semigroup a => a -> a -> a
<> [BracketedSpec il]
br2) ([FormattingSpec il]
fo1 [FormattingSpec il] -> [FormattingSpec il] -> [FormattingSpec il]
forall a. Semigroup a => a -> a -> a
<> [FormattingSpec il]
fo2) ([InlineParser m il]
il1 [InlineParser m il] -> [InlineParser m il] -> [InlineParser m il]
forall a. Semigroup a => a -> a -> a
<> [InlineParser m il]
il2)
                 ([BlockParser m il bl bl]
fp1 [BlockParser m il bl bl]
-> [BlockParser m il bl bl] -> [BlockParser m il bl bl]
forall a. Semigroup a => a -> a -> a
<> [BlockParser m il bl bl]
fp2) ([ParsecT [Tok] u m1 Attributes]
forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
ap1 [ParsecT [Tok] u m1 Attributes]
-> [ParsecT [Tok] u m1 Attributes]
-> [ParsecT [Tok] u m1 Attributes]
forall a. Semigroup a => a -> a -> a
<> [ParsecT [Tok] u m1 Attributes]
forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
ap2)
instance Monoid (SyntaxSpec m il bl) where
  mempty :: SyntaxSpec m il bl
mempty = [BlockSpec m il bl]
-> [BracketedSpec il]
-> [FormattingSpec il]
-> [InlineParser m il]
-> [BlockParser m il bl bl]
-> (forall u (m1 :: * -> *).
    Monad m1 =>
    [ParsecT [Tok] u m1 Attributes])
-> SyntaxSpec m il bl
forall (m :: * -> *) il bl.
[BlockSpec m il bl]
-> [BracketedSpec il]
-> [FormattingSpec il]
-> [InlineParser m il]
-> [BlockParser m il bl bl]
-> (forall u (m1 :: * -> *).
    Monad m1 =>
    [ParsecT [Tok] u m1 Attributes])
-> SyntaxSpec m il bl
SyntaxSpec [BlockSpec m il bl]
forall a. Monoid a => a
mempty [BracketedSpec il]
forall a. Monoid a => a
mempty [FormattingSpec il]
forall a. Monoid a => a
mempty [InlineParser m il]
forall a. Monoid a => a
mempty [BlockParser m il bl bl]
forall a. Monoid a => a
mempty [ParsecT [Tok] u m1 Attributes]
forall a. Monoid a => a
forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
mempty
  mappend :: SyntaxSpec m il bl -> SyntaxSpec m il bl -> SyntaxSpec m il bl
mappend = SyntaxSpec m il bl -> SyntaxSpec m il bl -> SyntaxSpec m il bl
forall a. Semigroup a => a -> a -> a
(<>)

removeDuplicateBlockSpecs :: [BlockSpec m il bl] -> [BlockSpec m il bl]
removeDuplicateBlockSpecs :: forall (m :: * -> *) il bl.
[BlockSpec m il bl] -> [BlockSpec m il bl]
removeDuplicateBlockSpecs []     = []
removeDuplicateBlockSpecs (BlockSpec m il bl
b:[BlockSpec m il bl]
bs) =
  BlockSpec m il bl
b BlockSpec m il bl -> [BlockSpec m il bl] -> [BlockSpec m il bl]
forall a. a -> [a] -> [a]
: [BlockSpec m il bl] -> [BlockSpec m il bl]
forall (m :: * -> *) il bl.
[BlockSpec m il bl] -> [BlockSpec m il bl]
removeDuplicateBlockSpecs ((BlockSpec m il bl -> Bool)
-> [BlockSpec m il bl] -> [BlockSpec m il bl]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType BlockSpec m il bl
b) (Text -> Bool)
-> (BlockSpec m il bl -> Text) -> BlockSpec m il bl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockSpec m il bl -> Text
forall (m :: * -> *) il bl. BlockSpec m il bl -> Text
blockType) [BlockSpec m il bl]
bs)

-- | Standard commonmark syntax.
defaultSyntaxSpec :: (Monad m, IsBlock il bl, IsInline il)
                  => SyntaxSpec m il bl
defaultSyntaxSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl
defaultSyntaxSpec = SyntaxSpec
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs          = [BlockSpec m il bl]
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
[BlockSpec m il bl]
defaultBlockSpecs
  , syntaxBracketedSpecs :: [BracketedSpec il]
syntaxBracketedSpecs      = [BracketedSpec il]
forall il. IsInline il => [BracketedSpec il]
defaultBracketedSpecs
  , syntaxFormattingSpecs :: [FormattingSpec il]
syntaxFormattingSpecs     = [FormattingSpec il]
forall il. IsInline il => [FormattingSpec il]
defaultFormattingSpecs
  , syntaxInlineParsers :: [InlineParser m il]
syntaxInlineParsers       = [InlineParser m il
forall (m :: * -> *) a. (Monad m, IsInline a) => InlineParser m a
defaultInlineParser]
  , syntaxFinalParsers :: [BlockParser m il bl bl]
syntaxFinalParsers        = []
  , syntaxAttributeParsers :: forall u (m1 :: * -> *).
Monad m1 =>
[ParsecT [Tok] u m1 Attributes]
syntaxAttributeParsers    = []
  }