{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE MonoLocalBinds             #-}

module Commonmark.Types
  ( Format(..)
  , ListSpacing(..)
  , ListType(..)
  , DelimiterType(..)
  , EnumeratorType(..)
  , IsInline(..)
  , IsBlock(..)
  , SourceRange(..)
  , Rangeable(..)
  , Attribute
  , Attributes
  , HasAttributes(..)
  , ToPlainText(..)

  -- * Re-exports
  , module Text.Parsec.Pos
  )
where
import           Data.Data            (Data)
import           Data.Text            (Text)
import qualified Data.Text            as T
import           Data.Typeable        (Typeable)
import           Text.Parsec.Pos      (SourcePos, sourceColumn, sourceLine,
                                       sourceName)

newtype Format = Format Text
  deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, Typeable Format
Format -> DataType
Format -> Constr
(forall b. Data b => b -> b) -> Format -> Format
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Format -> u
forall u. (forall d. Data d => d -> u) -> Format -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Format -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Format -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Format -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Format -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
gmapT :: (forall b. Data b => b -> b) -> Format -> Format
$cgmapT :: (forall b. Data b => b -> b) -> Format -> Format
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
dataTypeOf :: Format -> DataType
$cdataTypeOf :: Format -> DataType
toConstr :: Format -> Constr
$ctoConstr :: Format -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
Data, Typeable)

instance Eq Format where
  (Format Text
t1) == :: Format -> Format -> Bool
== (Format Text
t2) = Text -> Text
T.toCaseFold Text
t1 forall a. Eq a => a -> a -> Bool
== Text -> Text
T.toCaseFold Text
t2

data ListSpacing =
       TightList
     | LooseList
     deriving (Int -> ListSpacing -> ShowS
[ListSpacing] -> ShowS
ListSpacing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSpacing] -> ShowS
$cshowList :: [ListSpacing] -> ShowS
show :: ListSpacing -> String
$cshow :: ListSpacing -> String
showsPrec :: Int -> ListSpacing -> ShowS
$cshowsPrec :: Int -> ListSpacing -> ShowS
Show, Eq ListSpacing
ListSpacing -> ListSpacing -> Bool
ListSpacing -> ListSpacing -> Ordering
ListSpacing -> ListSpacing -> ListSpacing
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListSpacing -> ListSpacing -> ListSpacing
$cmin :: ListSpacing -> ListSpacing -> ListSpacing
max :: ListSpacing -> ListSpacing -> ListSpacing
$cmax :: ListSpacing -> ListSpacing -> ListSpacing
>= :: ListSpacing -> ListSpacing -> Bool
$c>= :: ListSpacing -> ListSpacing -> Bool
> :: ListSpacing -> ListSpacing -> Bool
$c> :: ListSpacing -> ListSpacing -> Bool
<= :: ListSpacing -> ListSpacing -> Bool
$c<= :: ListSpacing -> ListSpacing -> Bool
< :: ListSpacing -> ListSpacing -> Bool
$c< :: ListSpacing -> ListSpacing -> Bool
compare :: ListSpacing -> ListSpacing -> Ordering
$ccompare :: ListSpacing -> ListSpacing -> Ordering
Ord, ListSpacing -> ListSpacing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSpacing -> ListSpacing -> Bool
$c/= :: ListSpacing -> ListSpacing -> Bool
== :: ListSpacing -> ListSpacing -> Bool
$c== :: ListSpacing -> ListSpacing -> Bool
Eq, Typeable ListSpacing
ListSpacing -> DataType
ListSpacing -> Constr
(forall b. Data b => b -> b) -> ListSpacing -> ListSpacing
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ListSpacing -> u
forall u. (forall d. Data d => d -> u) -> ListSpacing -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListSpacing -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListSpacing -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListSpacing
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListSpacing -> c ListSpacing
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListSpacing)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListSpacing)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListSpacing -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListSpacing -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListSpacing -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListSpacing -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListSpacing -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListSpacing -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListSpacing -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListSpacing -> r
gmapT :: (forall b. Data b => b -> b) -> ListSpacing -> ListSpacing
$cgmapT :: (forall b. Data b => b -> b) -> ListSpacing -> ListSpacing
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListSpacing)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ListSpacing)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListSpacing)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListSpacing)
dataTypeOf :: ListSpacing -> DataType
$cdataTypeOf :: ListSpacing -> DataType
toConstr :: ListSpacing -> Constr
$ctoConstr :: ListSpacing -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListSpacing
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListSpacing
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListSpacing -> c ListSpacing
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListSpacing -> c ListSpacing
Data, Typeable)

data EnumeratorType =
       Decimal
     | UpperAlpha
     | LowerAlpha
     | UpperRoman
     | LowerRoman
     deriving (Int -> EnumeratorType -> ShowS
[EnumeratorType] -> ShowS
EnumeratorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumeratorType] -> ShowS
$cshowList :: [EnumeratorType] -> ShowS
show :: EnumeratorType -> String
$cshow :: EnumeratorType -> String
showsPrec :: Int -> EnumeratorType -> ShowS
$cshowsPrec :: Int -> EnumeratorType -> ShowS
Show, Eq EnumeratorType
EnumeratorType -> EnumeratorType -> Bool
EnumeratorType -> EnumeratorType -> Ordering
EnumeratorType -> EnumeratorType -> EnumeratorType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EnumeratorType -> EnumeratorType -> EnumeratorType
$cmin :: EnumeratorType -> EnumeratorType -> EnumeratorType
max :: EnumeratorType -> EnumeratorType -> EnumeratorType
$cmax :: EnumeratorType -> EnumeratorType -> EnumeratorType
>= :: EnumeratorType -> EnumeratorType -> Bool
$c>= :: EnumeratorType -> EnumeratorType -> Bool
> :: EnumeratorType -> EnumeratorType -> Bool
$c> :: EnumeratorType -> EnumeratorType -> Bool
<= :: EnumeratorType -> EnumeratorType -> Bool
$c<= :: EnumeratorType -> EnumeratorType -> Bool
< :: EnumeratorType -> EnumeratorType -> Bool
$c< :: EnumeratorType -> EnumeratorType -> Bool
compare :: EnumeratorType -> EnumeratorType -> Ordering
$ccompare :: EnumeratorType -> EnumeratorType -> Ordering
Ord, EnumeratorType -> EnumeratorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumeratorType -> EnumeratorType -> Bool
$c/= :: EnumeratorType -> EnumeratorType -> Bool
== :: EnumeratorType -> EnumeratorType -> Bool
$c== :: EnumeratorType -> EnumeratorType -> Bool
Eq, Typeable EnumeratorType
EnumeratorType -> DataType
EnumeratorType -> Constr
(forall b. Data b => b -> b) -> EnumeratorType -> EnumeratorType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> EnumeratorType -> u
forall u. (forall d. Data d => d -> u) -> EnumeratorType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EnumeratorType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EnumeratorType -> c EnumeratorType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EnumeratorType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EnumeratorType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> EnumeratorType -> m EnumeratorType
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EnumeratorType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> EnumeratorType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EnumeratorType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EnumeratorType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r
gmapT :: (forall b. Data b => b -> b) -> EnumeratorType -> EnumeratorType
$cgmapT :: (forall b. Data b => b -> b) -> EnumeratorType -> EnumeratorType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EnumeratorType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EnumeratorType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EnumeratorType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EnumeratorType)
dataTypeOf :: EnumeratorType -> DataType
$cdataTypeOf :: EnumeratorType -> DataType
toConstr :: EnumeratorType -> Constr
$ctoConstr :: EnumeratorType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EnumeratorType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EnumeratorType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EnumeratorType -> c EnumeratorType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EnumeratorType -> c EnumeratorType
Data, Typeable)

data DelimiterType =
       Period
     | OneParen
     | TwoParens
     deriving (Int -> DelimiterType -> ShowS
[DelimiterType] -> ShowS
DelimiterType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelimiterType] -> ShowS
$cshowList :: [DelimiterType] -> ShowS
show :: DelimiterType -> String
$cshow :: DelimiterType -> String
showsPrec :: Int -> DelimiterType -> ShowS
$cshowsPrec :: Int -> DelimiterType -> ShowS
Show, Eq DelimiterType
DelimiterType -> DelimiterType -> Bool
DelimiterType -> DelimiterType -> Ordering
DelimiterType -> DelimiterType -> DelimiterType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DelimiterType -> DelimiterType -> DelimiterType
$cmin :: DelimiterType -> DelimiterType -> DelimiterType
max :: DelimiterType -> DelimiterType -> DelimiterType
$cmax :: DelimiterType -> DelimiterType -> DelimiterType
>= :: DelimiterType -> DelimiterType -> Bool
$c>= :: DelimiterType -> DelimiterType -> Bool
> :: DelimiterType -> DelimiterType -> Bool
$c> :: DelimiterType -> DelimiterType -> Bool
<= :: DelimiterType -> DelimiterType -> Bool
$c<= :: DelimiterType -> DelimiterType -> Bool
< :: DelimiterType -> DelimiterType -> Bool
$c< :: DelimiterType -> DelimiterType -> Bool
compare :: DelimiterType -> DelimiterType -> Ordering
$ccompare :: DelimiterType -> DelimiterType -> Ordering
Ord, DelimiterType -> DelimiterType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelimiterType -> DelimiterType -> Bool
$c/= :: DelimiterType -> DelimiterType -> Bool
== :: DelimiterType -> DelimiterType -> Bool
$c== :: DelimiterType -> DelimiterType -> Bool
Eq, Typeable DelimiterType
DelimiterType -> DataType
DelimiterType -> Constr
(forall b. Data b => b -> b) -> DelimiterType -> DelimiterType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DelimiterType -> u
forall u. (forall d. Data d => d -> u) -> DelimiterType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelimiterType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelimiterType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelimiterType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelimiterType -> c DelimiterType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelimiterType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DelimiterType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DelimiterType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DelimiterType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DelimiterType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DelimiterType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelimiterType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DelimiterType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelimiterType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DelimiterType -> r
gmapT :: (forall b. Data b => b -> b) -> DelimiterType -> DelimiterType
$cgmapT :: (forall b. Data b => b -> b) -> DelimiterType -> DelimiterType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DelimiterType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DelimiterType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelimiterType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DelimiterType)
dataTypeOf :: DelimiterType -> DataType
$cdataTypeOf :: DelimiterType -> DataType
toConstr :: DelimiterType -> Constr
$ctoConstr :: DelimiterType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelimiterType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DelimiterType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelimiterType -> c DelimiterType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DelimiterType -> c DelimiterType
Data, Typeable)

data ListType =
       BulletList !Char
     | OrderedList !Int !EnumeratorType !DelimiterType
     -- first Text is before, second Text is after enumerator
     deriving (Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, Eq ListType
ListType -> ListType -> Bool
ListType -> ListType -> Ordering
ListType -> ListType -> ListType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListType -> ListType -> ListType
$cmin :: ListType -> ListType -> ListType
max :: ListType -> ListType -> ListType
$cmax :: ListType -> ListType -> ListType
>= :: ListType -> ListType -> Bool
$c>= :: ListType -> ListType -> Bool
> :: ListType -> ListType -> Bool
$c> :: ListType -> ListType -> Bool
<= :: ListType -> ListType -> Bool
$c<= :: ListType -> ListType -> Bool
< :: ListType -> ListType -> Bool
$c< :: ListType -> ListType -> Bool
compare :: ListType -> ListType -> Ordering
$ccompare :: ListType -> ListType -> Ordering
Ord, ListType -> ListType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq, Typeable ListType
ListType -> DataType
ListType -> Constr
(forall b. Data b => b -> b) -> ListType -> ListType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
forall u. (forall d. Data d => d -> u) -> ListType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ListType -> m ListType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ListType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ListType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ListType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ListType -> r
gmapT :: (forall b. Data b => b -> b) -> ListType -> ListType
$cgmapT :: (forall b. Data b => b -> b) -> ListType -> ListType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ListType)
dataTypeOf :: ListType -> DataType
$cdataTypeOf :: ListType -> DataType
toConstr :: ListType -> Constr
$ctoConstr :: ListType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ListType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ListType -> c ListType
Data, Typeable)

class (Monoid a, Show a, Rangeable a, HasAttributes a) => IsInline a where
  lineBreak :: a
  softBreak :: a
  str :: Text -> a
  entity :: Text -> a
  escapedChar :: Char -> a
  emph :: a -> a
  strong :: a -> a
  link :: Text -- ^ Destination
       -> Text -- ^ Title
       -> a    -- ^ Link description
       -> a
  image :: Text -- ^ Source
        -> Text -- ^ Title
        -> a    -- ^ Description
        -> a
  code :: Text -> a
  rawInline :: Format -> Text -> a

class (Monoid b, Show b, Rangeable b, IsInline il, HasAttributes b)
      => IsBlock il b | b -> il where
  paragraph :: il -> b
  plain :: il -> b
  thematicBreak :: b
  blockQuote :: b -> b
  codeBlock :: Text -> Text -> b
  heading :: Int -- ^ Level
          -> il  -- ^ text
          -> b
  rawBlock :: Format -> Text -> b
  referenceLinkDefinition :: Text -- ^ Label
                          -> (Text, Text) -- ^ Destination, title
                          -> b
  list :: ListType -> ListSpacing -> [b] -> b

newtype SourceRange = SourceRange
        { SourceRange -> [(SourcePos, SourcePos)]
unSourceRange :: [(SourcePos, SourcePos)] }
  deriving (SourceRange -> SourceRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceRange -> SourceRange -> Bool
$c/= :: SourceRange -> SourceRange -> Bool
== :: SourceRange -> SourceRange -> Bool
$c== :: SourceRange -> SourceRange -> Bool
Eq, Eq SourceRange
SourceRange -> SourceRange -> Bool
SourceRange -> SourceRange -> Ordering
SourceRange -> SourceRange -> SourceRange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceRange -> SourceRange -> SourceRange
$cmin :: SourceRange -> SourceRange -> SourceRange
max :: SourceRange -> SourceRange -> SourceRange
$cmax :: SourceRange -> SourceRange -> SourceRange
>= :: SourceRange -> SourceRange -> Bool
$c>= :: SourceRange -> SourceRange -> Bool
> :: SourceRange -> SourceRange -> Bool
$c> :: SourceRange -> SourceRange -> Bool
<= :: SourceRange -> SourceRange -> Bool
$c<= :: SourceRange -> SourceRange -> Bool
< :: SourceRange -> SourceRange -> Bool
$c< :: SourceRange -> SourceRange -> Bool
compare :: SourceRange -> SourceRange -> Ordering
$ccompare :: SourceRange -> SourceRange -> Ordering
Ord, Typeable SourceRange
SourceRange -> DataType
SourceRange -> Constr
(forall b. Data b => b -> b) -> SourceRange -> SourceRange
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceRange -> u
forall u. (forall d. Data d => d -> u) -> SourceRange -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRange
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRange -> c SourceRange
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRange)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceRange)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceRange -> m SourceRange
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceRange -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceRange -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> SourceRange -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceRange -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceRange -> r
gmapT :: (forall b. Data b => b -> b) -> SourceRange -> SourceRange
$cgmapT :: (forall b. Data b => b -> b) -> SourceRange -> SourceRange
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceRange)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceRange)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRange)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceRange)
dataTypeOf :: SourceRange -> DataType
$cdataTypeOf :: SourceRange -> DataType
toConstr :: SourceRange -> Constr
$ctoConstr :: SourceRange -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRange
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceRange
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRange -> c SourceRange
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceRange -> c SourceRange
Data, Typeable)

instance Semigroup SourceRange where
  (SourceRange [(SourcePos, SourcePos)]
xs) <> :: SourceRange -> SourceRange -> SourceRange
<> (SourceRange [(SourcePos, SourcePos)]
ys) =
    [(SourcePos, SourcePos)] -> SourceRange
SourceRange (forall a. Eq a => [(a, a)] -> [(a, a)] -> [(a, a)]
consolidateRanges [(SourcePos, SourcePos)]
xs [(SourcePos, SourcePos)]
ys)

instance Monoid SourceRange where
  mempty :: SourceRange
mempty = [(SourcePos, SourcePos)] -> SourceRange
SourceRange forall a. Monoid a => a
mempty
  mappend :: SourceRange -> SourceRange -> SourceRange
mappend = forall a. Semigroup a => a -> a -> a
(<>)

consolidateRanges :: Eq a => [(a,a)] -> [(a,a)] -> [(a,a)]
consolidateRanges :: forall a. Eq a => [(a, a)] -> [(a, a)] -> [(a, a)]
consolidateRanges [] [(a, a)]
xs = [(a, a)]
xs
consolidateRanges [(a, a)]
xs [] = [(a, a)]
xs
consolidateRanges xs :: [(a, a)]
xs@((a, a)
_:[(a, a)]
_) ((a
s2,a
e2):[(a, a)]
ys) =
  if a
e1 forall a. Eq a => a -> a -> Bool
== a
s2
     then forall a. [a] -> [a]
init [(a, a)]
xs forall a. [a] -> [a] -> [a]
++ (a
s1,a
e2)forall a. a -> [a] -> [a]
:[(a, a)]
ys
     else [(a, a)]
xs forall a. [a] -> [a] -> [a]
++ (a
s2,a
e2)forall a. a -> [a] -> [a]
:[(a, a)]
ys
  where (a
s1,a
e1) = forall a. [a] -> a
last [(a, a)]
xs

instance Show SourceRange where
  show :: SourceRange -> String
show = SourceRange -> String
prettyRange

class Rangeable a where
  ranged :: SourceRange -> a -> a

prettyRange :: SourceRange -> String
prettyRange :: SourceRange -> String
prettyRange (SourceRange [(SourcePos, SourcePos)]
xs) = String -> [(SourcePos, SourcePos)] -> String
go String
"" [(SourcePos, SourcePos)]
xs
  where
    go :: String -> [(SourcePos, SourcePos)] -> String
go String
_ [] = String
""
    go String
curname ((SourcePos
p1,SourcePos
p2):[(SourcePos, SourcePos)]
rest)
      = (if SourcePos -> String
sourceName SourcePos
p1 forall a. Eq a => a -> a -> Bool
/= String
curname
            then SourcePos -> String
sourceName SourcePos
p1 forall a. [a] -> [a] -> [a]
++ String
"@"
            else String
"") forall a. [a] -> [a] -> [a]
++
         forall a. Show a => a -> String
show (SourcePos -> Int
sourceLine SourcePos
p1) forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++
         forall a. Show a => a -> String
show (SourcePos -> Int
sourceColumn SourcePos
p1) forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++
         (if SourcePos -> String
sourceName SourcePos
p2 forall a. Eq a => a -> a -> Bool
/= SourcePos -> String
sourceName SourcePos
p1
             then SourcePos -> String
sourceName SourcePos
p2 forall a. [a] -> [a] -> [a]
++ String
"@"
             else String
"") forall a. [a] -> [a] -> [a]
++
         forall a. Show a => a -> String
show (SourcePos -> Int
sourceLine SourcePos
p2) forall a. [a] -> [a] -> [a]
++
         String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (SourcePos -> Int
sourceColumn SourcePos
p2) forall a. [a] -> [a] -> [a]
++
         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(SourcePos, SourcePos)]
rest
            then String
""
            else String
";" forall a. [a] -> [a] -> [a]
++ String -> [(SourcePos, SourcePos)] -> String
go (SourcePos -> String
sourceName SourcePos
p2) [(SourcePos, SourcePos)]
rest

type Attribute = (Text, Text)

type Attributes = [Attribute]

class HasAttributes a where
  addAttributes :: Attributes -> a -> a

class ToPlainText a where
  toPlainText :: a -> Text