{-# 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]
, :: [[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 forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'\\'
Tok
tok <- forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|'
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
<|> (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
(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
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
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
[[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
}