{-# LANGUAGE IncoherentInstances   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE DeriveDataTypeable    #-}

module Commonmark.Extensions.PipeTable
 ( HasPipeTable(..)
 , ColAlignment(..)
 , pipeTableSpec
 )
where

import Control.Monad (guard, void, mzero)
import Control.Monad.Trans.Class (lift)
import Commonmark.Syntax
import Commonmark.Types
import Commonmark.Tokens
import Commonmark.TokParsers
import Commonmark.Blocks
import Commonmark.SourceMap
import Commonmark.Html
import Text.Parsec
import Data.Dynamic
import Data.Tree
import Data.Data

data ColAlignment = LeftAlignedCol
                  | CenterAlignedCol
                  | RightAlignedCol
                  | DefaultAlignedCol
                  deriving (Int -> ColAlignment -> ShowS
[ColAlignment] -> ShowS
ColAlignment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColAlignment] -> ShowS
$cshowList :: [ColAlignment] -> ShowS
show :: ColAlignment -> String
$cshow :: ColAlignment -> String
showsPrec :: Int -> ColAlignment -> ShowS
$cshowsPrec :: Int -> ColAlignment -> ShowS
Show, ColAlignment -> ColAlignment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColAlignment -> ColAlignment -> Bool
$c/= :: ColAlignment -> ColAlignment -> Bool
== :: ColAlignment -> ColAlignment -> Bool
$c== :: ColAlignment -> ColAlignment -> Bool
Eq, Typeable ColAlignment
ColAlignment -> DataType
ColAlignment -> Constr
(forall b. Data b => b -> b) -> ColAlignment -> ColAlignment
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) -> ColAlignment -> u
forall u. (forall d. Data d => d -> u) -> ColAlignment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColAlignment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColAlignment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColAlignment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColAlignment -> c ColAlignment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColAlignment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColAlignment)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColAlignment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColAlignment -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColAlignment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColAlignment -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColAlignment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColAlignment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColAlignment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColAlignment -> r
gmapT :: (forall b. Data b => b -> b) -> ColAlignment -> ColAlignment
$cgmapT :: (forall b. Data b => b -> b) -> ColAlignment -> ColAlignment
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColAlignment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ColAlignment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColAlignment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColAlignment)
dataTypeOf :: ColAlignment -> DataType
$cdataTypeOf :: ColAlignment -> DataType
toConstr :: ColAlignment -> Constr
$ctoConstr :: ColAlignment -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColAlignment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColAlignment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColAlignment -> c ColAlignment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColAlignment -> c ColAlignment
Data, Typeable)

data PipeTableData = PipeTableData
     { PipeTableData -> [ColAlignment]
pipeTableAlignments :: [ColAlignment]
     , PipeTableData -> [[Tok]]
pipeTableHeaders    :: [[Tok]]
     , PipeTableData -> [[[Tok]]]
pipeTableRows       :: [[[Tok]]] -- in reverse order
     } deriving (Int -> PipeTableData -> ShowS
[PipeTableData] -> ShowS
PipeTableData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PipeTableData] -> ShowS
$cshowList :: [PipeTableData] -> ShowS
show :: PipeTableData -> String
$cshow :: PipeTableData -> String
showsPrec :: Int -> PipeTableData -> ShowS
$cshowsPrec :: Int -> PipeTableData -> ShowS
Show, PipeTableData -> PipeTableData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PipeTableData -> PipeTableData -> Bool
$c/= :: PipeTableData -> PipeTableData -> Bool
== :: PipeTableData -> PipeTableData -> Bool
$c== :: PipeTableData -> PipeTableData -> Bool
Eq, Typeable PipeTableData
PipeTableData -> DataType
PipeTableData -> Constr
(forall b. Data b => b -> b) -> PipeTableData -> PipeTableData
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) -> PipeTableData -> u
forall u. (forall d. Data d => d -> u) -> PipeTableData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PipeTableData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PipeTableData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PipeTableData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PipeTableData -> c PipeTableData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PipeTableData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PipeTableData)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PipeTableData -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PipeTableData -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PipeTableData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PipeTableData -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PipeTableData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PipeTableData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PipeTableData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PipeTableData -> r
gmapT :: (forall b. Data b => b -> b) -> PipeTableData -> PipeTableData
$cgmapT :: (forall b. Data b => b -> b) -> PipeTableData -> PipeTableData
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PipeTableData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PipeTableData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PipeTableData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PipeTableData)
dataTypeOf :: PipeTableData -> DataType
$cdataTypeOf :: PipeTableData -> DataType
toConstr :: PipeTableData -> Constr
$ctoConstr :: PipeTableData -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PipeTableData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PipeTableData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PipeTableData -> c PipeTableData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PipeTableData -> c PipeTableData
Data, Typeable)

class HasPipeTable il bl where
  pipeTable :: [ColAlignment] -> [il] -> [[il]] -> bl

instance HasPipeTable (Html a) (Html a) where
  pipeTable :: [ColAlignment] -> [Html a] -> [[Html a]] -> Html a
pipeTable [ColAlignment]
aligns [Html a]
headerCells [[Html a]]
rows =
    forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"table" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Html a
htmlRaw Text
"\n" forall a. Semigroup a => a -> a -> a
<>
    (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Html a]
headerCells
        then forall a. Monoid a => a
mempty
        else forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"thead" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Html a
htmlRaw Text
"\n" forall a. Semigroup a => a -> a -> a
<>
             forall {a}. Text -> [ColAlignment] -> [Html a] -> Html a
toRow Text
"th" [ColAlignment]
aligns [Html a]
headerCells) forall a. Semigroup a => a -> a -> a
<>
    (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Html a]]
rows
        then forall a. Monoid a => a
mempty
        else forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"tbody" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Html a
htmlRaw Text
"\n" forall a. Semigroup a => a -> a -> a
<>
             forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Text -> [ColAlignment] -> [Html a] -> Html a
toRow Text
"td" [ColAlignment]
aligns) [[Html a]]
rows))
    where
      alignToAttr :: ColAlignment -> Html a -> Html a
alignToAttr ColAlignment
LeftAlignedCol    =
        forall a. Attribute -> Html a -> Html a
addAttribute (Text
"style",Text
"text-align: left;")
      alignToAttr ColAlignment
CenterAlignedCol  =
        forall a. Attribute -> Html a -> Html a
addAttribute (Text
"style",Text
"text-align: center;")
      alignToAttr ColAlignment
RightAlignedCol   =
        forall a. Attribute -> Html a -> Html a
addAttribute (Text
"style",Text
"text-align: right;")
      alignToAttr ColAlignment
DefaultAlignedCol = forall a. a -> a
id
      toRow :: Text -> [ColAlignment] -> [Html a] -> Html a
toRow Text
constructor [ColAlignment]
aligns' [Html a]
cells =
        forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"tr" forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Html a
htmlRaw Text
"\n" forall a. Semigroup a => a -> a -> a
<>
          forall a. Monoid a => [a] -> a
mconcat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall {a}. Text -> ColAlignment -> Html a -> Html a
toCell Text
constructor) [ColAlignment]
aligns' [Html a]
cells)
      toCell :: Text -> ColAlignment -> Html a -> Html a
toCell Text
constructor ColAlignment
align Html a
cell =
        (forall {a}. ColAlignment -> Html a -> Html a
alignToAttr ColAlignment
align forall a b. (a -> b) -> a -> b
$ forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
constructor forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Html a
cell)
          forall a. Semigroup a => a -> a -> a
<> forall a. Text -> Html a
htmlRaw Text
"\n"

instance (HasPipeTable i b, Monoid b)
        => HasPipeTable (WithSourceMap i) (WithSourceMap b) where
  pipeTable :: [ColAlignment]
-> [WithSourceMap i] -> [[WithSourceMap i]] -> WithSourceMap b
pipeTable [ColAlignment]
aligns [WithSourceMap i]
headerCells [[WithSourceMap i]]
rows = do
    (forall il bl.
HasPipeTable il bl =>
[ColAlignment] -> [il] -> [[il]] -> bl
pipeTable [ColAlignment]
aligns forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [WithSourceMap i]
headerCells forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [[WithSourceMap i]]
rows)
     forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> WithSourceMap ()
addName Text
"pipeTable"

pCells :: Monad m => ParsecT [Tok] s m [[Tok]]
pCells :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [[Tok]]
pCells = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Bool
hasPipe <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|'
  [[Tok]]
pipedCells <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pCell forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|')
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
Spaces)
  [[Tok]]
unpipedCell <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pCell
  let cells :: [[Tok]]
cells = [[Tok]]
pipedCells forall a. [a] -> [a] -> [a]
++ [[Tok]]
unpipedCell
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Tok]]
cells)
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool
hasPipe Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Tok]]
pipedCells) -- need at least one |
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [[Tok]]
cells

pCell :: Monad m => ParsecT [Tok] s m [Tok]
pCell :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pCell = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1
  ( forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try
      (do Tok
tok' <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\\'
          tok :: Tok
tok@(Tok (Symbol Char
c) SourcePos
_ Text
_) <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
anySymbol
          if Char
c forall a. Eq a => a -> a -> Bool
== Char
'|'
             then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [Tok
tok]
             else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [Tok
tok',Tok
tok])
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (do Tok
tok <- (forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok forall a b. (a -> b) -> a -> b
$ \Tok
t -> Bool -> Bool
not (TokType -> Tok -> Bool
hasType (Char -> TokType
Symbol Char
'|') Tok
t Bool -> Bool -> Bool
||
                                       TokType -> Tok -> Bool
hasType TokType
LineEnd Tok
t))
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [Tok
tok])
  ) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|'))

pDividers :: Monad m => ParsecT [Tok] s m [ColAlignment]
pDividers :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [ColAlignment]
pDividers = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  Bool
hasPipe <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False forall a b. (a -> b) -> a -> b
$ Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|'
  [ColAlignment]
pipedAligns <- forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ColAlignment
pDivider forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|')
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
Spaces)
  [ColAlignment]
unpipedAlign <- forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ColAlignment
pDivider
  let aligns :: [ColAlignment]
aligns = [ColAlignment]
pipedAligns forall a. [a] -> [a] -> [a]
++ [ColAlignment]
unpipedAlign
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColAlignment]
aligns)
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool
hasPipe Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ColAlignment]
pipedAligns) -- need at least one |
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! [ColAlignment]
aligns


pDivider :: Monad m => ParsecT [Tok] s m ColAlignment
pDivider :: forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ColAlignment
pDivider = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
Spaces)
  ColAlignment
align <- forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ ColAlignment
CenterAlignedCol forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
    , ColAlignment
LeftAlignedCol forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'))
    , ColAlignment
RightAlignedCol forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
    , ColAlignment
DefaultAlignedCol forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-')
    ]
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
Spaces)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ColAlignment
align

-- | Syntax for pipe tables.  Note that this should generally be
-- placed AFTER the syntax spec for lists, headings, and other block-level
-- constructs, to avoid bad results when non-table lines contain pipe
-- characters:  use @defaultSyntaxSpec <> pipeTableSpec@ rather
-- than @pipeTableSpec <> defaultSyntaxSpec@.
pipeTableSpec :: (Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl)
              => SyntaxSpec m il bl
pipeTableSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl) =>
SyntaxSpec m il bl
pipeTableSpec = forall a. Monoid a => a
mempty
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl) =>
BlockSpec m il bl
pipeTableBlockSpec]
  }

-- This parser is structured as a system that parses the *second* line first,
-- then parses the first line. That is, if it detects a delimiter row as the
-- second line of a paragraph, it converts the paragraph into a table. This seems
-- counterintuitive, but it works better than trying to convert a table into
-- a paragraph, since it might need to be something else.
--
-- See GH-52 and GH-95
pipeTableBlockSpec :: (Monad m, IsBlock il bl, IsInline il,
                       HasPipeTable il bl)
                   => BlockSpec m il bl
pipeTableBlockSpec :: forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl) =>
BlockSpec m il bl
pipeTableBlockSpec = BlockSpec
     { blockType :: Text
blockType           = Text
"PipeTable" -- :: Text
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do -- :: BlockParser m il bl ()
             (BlockNode m il bl
cur:[BlockNode m il bl]
rest) <- forall (m :: * -> *) il bl. BPState m il bl -> [BlockNode m il bl]
nodeStack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
             forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) il bl. BlockSpec m il bl -> Bool
blockParagraph (forall (m :: * -> *) il bl. BlockNode m il bl -> BlockSpec m il bl
bspec BlockNode m il bl
cur)
             forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
             SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
             [ColAlignment]
aligns <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [ColAlignment]
pDividers
             forall (m :: * -> *) u.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] u m ()
skipWhile (TokType -> Tok -> Bool
hasType TokType
Spaces)
             forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd)

             BPState m il bl
st <- forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState

             let headerLine :: [Tok]
headerLine =
                   case forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines forall a b. (a -> b) -> a -> b
$ forall a. Tree a -> a
rootLabel BlockNode m il bl
cur of
                      [[Tok]
onlyLine] -> [Tok]
onlyLine
                      [[Tok]]
_ -> []

             Either ParseError [[Tok]]
cellsR <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [[Tok]]
pCells BPState m il bl
st String
"" [Tok]
headerLine
             case Either ParseError [[Tok]]
cellsR of
                Right [[Tok]]
cells ->
                   if forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Tok]]
cells forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColAlignment]
aligns
                      then forall (m :: * -> *) a. MonadPlus m => m a
mzero -- parse fail: not a table
                      else do
                         forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState forall a b. (a -> b) -> a -> b
$ \BPState m il bl
st' -> BPState m il bl
st'{ nodeStack :: [BlockNode m il bl]
nodeStack = [BlockNode m il bl]
rest }
                         let tabledata :: PipeTableData
tabledata = PipeTableData
                               { pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = [ColAlignment]
aligns
                               , pipeTableHeaders :: [[Tok]]
pipeTableHeaders    = [[Tok]]
cells
                               , pipeTableRows :: [[[Tok]]]
pipeTableRows       = []
                               }
                         forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack forall a b. (a -> b) -> a -> b
$
                            forall a. a -> [Tree a] -> Tree a
Node (forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il, HasPipeTable il bl) =>
BlockSpec m il bl
pipeTableBlockSpec){
                                    blockStartPos :: [SourcePos]
blockStartPos = forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (forall a. Tree a -> a
rootLabel BlockNode m il bl
cur) forall a. [a] -> [a] -> [a]
++ [SourcePos
pos]
                                  , blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata
                                  , blockAttributes :: Attributes
blockAttributes = forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes (forall a. Tree a -> a
rootLabel BlockNode m il bl
cur)
                                  } []
                Either ParseError [[Tok]]
_ ->
                   forall (m :: * -> *) a. MonadPlus m => m a
mzero -- parse fail: not a table
             forall (m :: * -> *) a. Monad m => a -> m a
return BlockStartResult
BlockStartMatch
     , blockCanContain :: BlockSpec m il bl -> Bool
blockCanContain     = \BlockSpec m il bl
_ -> Bool
False -- :: BlockSpec m il bl -> Bool
     , blockContainsLines :: Bool
blockContainsLines  = Bool
False -- :: Bool
     , blockParagraph :: Bool
blockParagraph      = Bool
False -- :: Bool
     , blockContinue :: BlockNode m il bl
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
blockContinue       = \(Node BlockData m il bl
ndata [BlockNode m il bl]
children) -> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ do
         forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
         forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
         let tabledata :: PipeTableData
tabledata = forall a. Typeable a => Dynamic -> a -> a
fromDyn
                (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata)
                PipeTableData{ pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = []
                             , pipeTableHeaders :: [[Tok]]
pipeTableHeaders = []
                             , pipeTableRows :: [[[Tok]]]
pipeTableRows = [] }
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         [[Tok]]
cells <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [[Tok]]
pCells
         let tabledata' :: PipeTableData
tabledata' = PipeTableData
tabledata{ pipeTableRows :: [[[Tok]]]
pipeTableRows =
                             [[Tok]]
cells forall a. a -> [a] -> [a]
: PipeTableData -> [[[Tok]]]
pipeTableRows PipeTableData
tabledata }
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
ndata{ blockData :: Dynamic
blockData =
                               forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata' } [BlockNode m il bl]
children)
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \(Node BlockData m il bl
ndata [BlockNode m il bl]
_) -> do
         let tabledata :: PipeTableData
tabledata = forall a. Typeable a => Dynamic -> a -> a
fromDyn
                (forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata)
                PipeTableData{ pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = []
                             , pipeTableHeaders :: [[Tok]]
pipeTableHeaders = []
                             , pipeTableRows :: [[[Tok]]]
pipeTableRows = [] }
         let aligns :: [ColAlignment]
aligns = PipeTableData -> [ColAlignment]
pipeTableAlignments PipeTableData
tabledata
         [il]
headers <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (PipeTableData -> [[Tok]]
pipeTableHeaders PipeTableData
tabledata)
         let numcols :: Int
numcols = forall (t :: * -> *) a. Foldable t => t a -> Int
length [il]
headers
         [[il]]
rows <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
numcols forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ (forall a. a -> [a]
repeat [])))
                    (forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ PipeTableData -> [[[Tok]]]
pipeTableRows PipeTableData
tabledata)
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall il bl.
HasPipeTable il bl =>
[ColAlignment] -> [il] -> [[il]] -> bl
pipeTable [ColAlignment]
aligns [il]
headers [[il]]
rows)
     , blockFinalize :: BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
blockFinalize       = \(Node BlockData m il bl
ndata [BlockNode m il bl]
children) BlockNode m il bl
parent ->
         forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer (forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
ndata [BlockNode m il bl]
children) BlockNode m il bl
parent
     }