{-# 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]
, :: [[Tok]]
, PipeTableData -> [[[Tok]]]
pipeTableRows :: [[[Tok]]]
} 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)
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)
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
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"
, 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
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
, blockContainsLines :: Bool
blockContainsLines = Bool
False
, blockParagraph :: Bool
blockParagraph = Bool
False
, 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
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
}