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

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

import Control.Monad (guard)
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]
  }

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 ()
         forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
         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 [Tok]
whitespace
         SourcePos
pos <- forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         ([[Tok]]
cells, [Tok]
toks) <- forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [[Tok]]
pCells
         Tok
nl <- 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 Tok
lineEnd
         let tabledata :: PipeTableData
tabledata = PipeTableData
              { pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = []
              , 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 = [SourcePos
pos]
                       , blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata
                       , blockLines :: [[Tok]]
blockLines = [[Tok]
toks forall a. [a] -> [a] -> [a]
++ [Tok
nl]]
                       } []
         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
         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
ndata)
           then do
             [[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)
           else
             -- last line was first; check for separators
             -- and if not found, convert to paragraph:
             forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do [ColAlignment]
aligns <- forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [ColAlignment]
pDividers
                     forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColAlignment]
aligns forall a. Eq a => a -> a -> Bool
==
                             forall (t :: * -> *) a. Foldable t => t a -> Int
length (PipeTableData -> [[Tok]]
pipeTableHeaders PipeTableData
tabledata)
                     let tabledata' :: PipeTableData
tabledata' = PipeTableData
tabledata{ pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = [ColAlignment]
aligns }
                     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{
                                              blockLines :: [[Tok]]
blockLines = []
                                            , blockData :: Dynamic
blockData = forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata'
                                            } [BlockNode m il bl]
children))
             forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (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{
                                   blockSpec :: BlockSpec m il bl
blockSpec = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec } [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
           (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
ndata)
               then forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
ndata [BlockNode m il bl]
children
               else forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
ndata{ blockSpec :: BlockSpec m il bl
blockSpec = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec } [BlockNode m il bl]
children) BlockNode m il bl
parent
     }