{-# LANGUAGE CPP                   #-}
{-# 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
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif

data ColAlignment = LeftAlignedCol
                  | CenterAlignedCol
                  | RightAlignedCol
                  | DefaultAlignedCol
                  deriving (Int -> ColAlignment -> ShowS
[ColAlignment] -> ShowS
ColAlignment -> String
(Int -> ColAlignment -> ShowS)
-> (ColAlignment -> String)
-> ([ColAlignment] -> ShowS)
-> Show ColAlignment
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
(ColAlignment -> ColAlignment -> Bool)
-> (ColAlignment -> ColAlignment -> Bool) -> Eq ColAlignment
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
DataType
Constr
Typeable ColAlignment
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ColAlignment -> c ColAlignment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ColAlignment)
-> (ColAlignment -> Constr)
-> (ColAlignment -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> ColAlignment -> ColAlignment)
-> (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 u. (forall d. Data d => d -> u) -> ColAlignment -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ColAlignment -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColAlignment -> m ColAlignment)
-> Data ColAlignment
ColAlignment -> DataType
ColAlignment -> Constr
(forall b. Data b => b -> b) -> ColAlignment -> ColAlignment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColAlignment -> c ColAlignment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cDefaultAlignedCol :: Constr
$cRightAlignedCol :: Constr
$cCenterAlignedCol :: Constr
$cLeftAlignedCol :: Constr
$tColAlignment :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> ColAlignment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColAlignment -> u
gmapQ :: (forall d. Data d => d -> u) -> ColAlignment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColAlignment -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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
(Int -> PipeTableData -> ShowS)
-> (PipeTableData -> String)
-> ([PipeTableData] -> ShowS)
-> Show PipeTableData
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
(PipeTableData -> PipeTableData -> Bool)
-> (PipeTableData -> PipeTableData -> Bool) -> Eq PipeTableData
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
DataType
Constr
Typeable PipeTableData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PipeTableData -> c PipeTableData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PipeTableData)
-> (PipeTableData -> Constr)
-> (PipeTableData -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> PipeTableData -> PipeTableData)
-> (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 u. (forall d. Data d => d -> u) -> PipeTableData -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PipeTableData -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PipeTableData -> m PipeTableData)
-> Data PipeTableData
PipeTableData -> DataType
PipeTableData -> Constr
(forall b. Data b => b -> b) -> PipeTableData -> PipeTableData
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PipeTableData -> c PipeTableData
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cPipeTableData :: Constr
$tPipeTableData :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> PipeTableData -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PipeTableData -> u
gmapQ :: (forall d. Data d => d -> u) -> PipeTableData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PipeTableData -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable 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 =
    Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"table" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
    (if [Html a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Html a]
headerCells
        then Html a
forall a. Monoid a => a
mempty
        else Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"thead" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
             Text -> [ColAlignment] -> [Html a] -> Html a
forall a. Text -> [ColAlignment] -> [Html a] -> Html a
toRow Text
"th" [ColAlignment]
aligns [Html a]
headerCells) Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
    (if [[Html a]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Html a]]
rows
        then Html a
forall a. Monoid a => a
mempty
        else Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"tbody" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
             [Html a] -> Html a
forall a. Monoid a => [a] -> a
mconcat (([Html a] -> Html a) -> [[Html a]] -> [Html a]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [ColAlignment] -> [Html a] -> Html a
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    =
        Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"style",Text
"text-align: left;")
      alignToAttr ColAlignment
CenterAlignedCol  =
        Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"style",Text
"text-align: center;")
      alignToAttr ColAlignment
RightAlignedCol   =
        Attribute -> Html a -> Html a
forall a. Attribute -> Html a -> Html a
addAttribute (Text
"style",Text
"text-align: right;")
      alignToAttr ColAlignment
DefaultAlignedCol = Html a -> Html a
forall a. a -> a
id
      toRow :: Text -> [ColAlignment] -> [Html a] -> Html a
toRow Text
constructor [ColAlignment]
aligns' [Html a]
cells =
        Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlBlock Text
"tr" (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just (Html a -> Maybe (Html a)) -> Html a -> Maybe (Html a)
forall a b. (a -> b) -> a -> b
$ Text -> Html a
forall a. Text -> Html a
htmlRaw Text
"\n" Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<>
          [Html a] -> Html a
forall a. Monoid a => [a] -> a
mconcat ((ColAlignment -> Html a -> Html a)
-> [ColAlignment] -> [Html a] -> [Html a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text -> ColAlignment -> Html a -> Html a
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 =
        (ColAlignment -> Html a -> Html a
forall a. ColAlignment -> Html a -> Html a
alignToAttr ColAlignment
align (Html a -> Html a) -> Html a -> Html a
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Html a) -> Html a
forall a. Text -> Maybe (Html a) -> Html a
htmlInline Text
constructor (Maybe (Html a) -> Html a) -> Maybe (Html a) -> Html a
forall a b. (a -> b) -> a -> b
$ Html a -> Maybe (Html a)
forall a. a -> Maybe a
Just Html a
cell)
          Html a -> Html a -> Html a
forall a. Semigroup a => a -> a -> a
<> Text -> Html 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
    ([ColAlignment] -> [i] -> [[i]] -> b
forall il bl.
HasPipeTable il bl =>
[ColAlignment] -> [il] -> [[il]] -> bl
pipeTable [ColAlignment]
aligns ([i] -> [[i]] -> b)
-> WithSourceMap [i] -> WithSourceMap ([[i]] -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithSourceMap i] -> WithSourceMap [i]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [WithSourceMap i]
headerCells WithSourceMap ([[i]] -> b)
-> WithSourceMap [[i]] -> WithSourceMap b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([WithSourceMap i] -> WithSourceMap [i])
-> [[WithSourceMap i]] -> WithSourceMap [[i]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [WithSourceMap i] -> WithSourceMap [i]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [[WithSourceMap i]]
rows)
     WithSourceMap b -> WithSourceMap () -> WithSourceMap b
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 :: ParsecT [Tok] s m [[Tok]]
pCells = ParsecT [Tok] s m [[Tok]] -> ParsecT [Tok] s m [[Tok]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [[Tok]] -> ParsecT [Tok] s m [[Tok]])
-> ParsecT [Tok] s m [[Tok]] -> ParsecT [Tok] s m [[Tok]]
forall a b. (a -> b) -> a -> b
$ do
  Bool
hasPipe <- Bool -> ParsecT [Tok] s m Bool -> ParsecT [Tok] s m Bool
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Bool
False (ParsecT [Tok] s m Bool -> ParsecT [Tok] s m Bool)
-> ParsecT [Tok] s m Bool -> ParsecT [Tok] s m Bool
forall a b. (a -> b) -> a -> b
$ Bool
True Bool -> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|'
  [[Tok]]
pipedCells <- ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [[Tok]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pCell ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'|')
  [[Tok]]
unpipedCell <- [[Tok]] -> ParsecT [Tok] s m [[Tok]] -> ParsecT [Tok] s m [[Tok]]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] (ParsecT [Tok] s m [[Tok]] -> ParsecT [Tok] s m [[Tok]])
-> ParsecT [Tok] s m [[Tok]] -> ParsecT [Tok] s m [[Tok]]
forall a b. (a -> b) -> a -> b
$ ([Tok] -> [[Tok]] -> [[Tok]]
forall a. a -> [a] -> [a]
:[]) ([Tok] -> [[Tok]])
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [[Tok]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
pCell
  let cells :: [[Tok]]
cells = [[Tok]]
pipedCells [[Tok]] -> [[Tok]] -> [[Tok]]
forall a. [a] -> [a] -> [a]
++ [[Tok]]
unpipedCell
  Bool -> ParsecT [Tok] s m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s m ()) -> Bool -> ParsecT [Tok] s m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([[Tok]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Tok]]
cells)
  Bool -> ParsecT [Tok] s m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] s m ()) -> Bool -> ParsecT [Tok] s m ()
forall a b. (a -> b) -> a -> b
$ Bool
hasPipe Bool -> Bool -> Bool
|| Bool -> Bool
not ([[Tok]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Tok]]
pipedCells) -- need at least one |
  ParsecT [Tok] s m () -> ParsecT [Tok] s m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] s m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
  [[Tok]] -> ParsecT [Tok] s m [[Tok]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Tok]] -> ParsecT [Tok] s m [[Tok]])
-> [[Tok]] -> ParsecT [Tok] s m [[Tok]]
forall a b. (a -> b) -> a -> b
$! [[Tok]]
cells

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

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


pDivider :: Monad m => ParsecT [Tok] s m ColAlignment
pDivider :: ParsecT [Tok] s m ColAlignment
pDivider = ParsecT [Tok] s m ColAlignment -> ParsecT [Tok] s m ColAlignment
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m ColAlignment -> ParsecT [Tok] s m ColAlignment)
-> ParsecT [Tok] s m ColAlignment -> ParsecT [Tok] s m ColAlignment
forall a b. (a -> b) -> a -> b
$ do
  ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ())
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ()
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
Spaces)
  ColAlignment
align <- [ParsecT [Tok] s m ColAlignment] -> ParsecT [Tok] s m ColAlignment
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
    [ ColAlignment
CenterAlignedCol ColAlignment
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ColAlignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':' ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-') ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
    , ColAlignment
LeftAlignedCol ColAlignment
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ColAlignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':' ParsecT [Tok] s m Tok
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m [Tok]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-'))
    , ColAlignment
RightAlignedCol ColAlignment
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ColAlignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-') ParsecT [Tok] s m [Tok]
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m Tok
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
':')
    , ColAlignment
DefaultAlignedCol ColAlignment
-> ParsecT [Tok] s m [Tok] -> ParsecT [Tok] s m ColAlignment
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
       ParsecT [Tok] s m Tok -> ParsecT [Tok] s m [Tok]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s. Monad m => Char -> ParsecT [Tok] s m Tok
symbol Char
'-')
    ]
  ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany (ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ())
-> ParsecT [Tok] s m Tok -> ParsecT [Tok] s m ()
forall a b. (a -> b) -> a -> b
$ (Tok -> Bool) -> ParsecT [Tok] s m Tok
forall (m :: * -> *) s.
Monad m =>
(Tok -> Bool) -> ParsecT [Tok] s m Tok
satisfyTok (TokType -> Tok -> Bool
hasType TokType
Spaces)
  ColAlignment -> ParsecT [Tok] s m ColAlignment
forall (m :: * -> *) a. Monad m => a -> m a
return (ColAlignment -> ParsecT [Tok] s m ColAlignment)
-> ColAlignment -> ParsecT [Tok] s m ColAlignment
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 :: SyntaxSpec m il bl
pipeTableSpec = SyntaxSpec m il bl
forall a. Monoid a => a
mempty
  { syntaxBlockSpecs :: [BlockSpec m il bl]
syntaxBlockSpecs = [BlockSpec m il bl
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 :: BlockSpec m il bl
pipeTableBlockSpec = BlockSpec :: forall (m :: * -> *) il bl.
Text
-> BlockParser m il bl BlockStartResult
-> (BlockSpec m il bl -> Bool)
-> Bool
-> Bool
-> (BlockNode m il bl
    -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (BlockNode m il bl -> BlockParser m il bl bl)
-> (BlockNode m il bl
    -> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl))
-> BlockSpec m il bl
BlockSpec
     { blockType :: Text
blockType           = Text
"PipeTable" -- :: Text
     , blockStart :: BlockParser m il bl BlockStartResult
blockStart          = BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl BlockStartResult
 -> BlockParser m il bl BlockStartResult)
-> BlockParser m il bl BlockStartResult
-> BlockParser m il bl BlockStartResult
forall a b. (a -> b) -> a -> b
$ do -- :: BlockParser m il bl ()
         BlockParser m il bl Bool
forall (m :: * -> *) bl il. Monad m => BlockParser m bl il Bool
interruptsParagraph BlockParser m il bl Bool
-> (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> (Bool -> Bool) -> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not
         ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
         ParsecT [Tok] (BPState m il bl) m [Tok]
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] (BPState m il bl) m [Tok]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [Tok]
whitespace
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         ([[Tok]]
cells, [Tok]
toks) <- ParsecT [Tok] (BPState m il bl) m [[Tok]]
-> ParsecT [Tok] (BPState m il bl) m ([[Tok]], [Tok])
forall (m :: * -> *) s a.
Monad m =>
ParsecT [Tok] s m a -> ParsecT [Tok] s m (a, [Tok])
withRaw ParsecT [Tok] (BPState m il bl) m [[Tok]]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [[Tok]]
pCells
         Tok
nl <- ParsecT [Tok] (BPState m il bl) m Tok
-> ParsecT [Tok] (BPState m il bl) m Tok
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT [Tok] (BPState m il bl) m Tok
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m Tok
lineEnd
         let tabledata :: PipeTableData
tabledata = PipeTableData :: [ColAlignment] -> [[Tok]] -> [[[Tok]]] -> PipeTableData
PipeTableData
              { pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = []
              , pipeTableHeaders :: [[Tok]]
pipeTableHeaders    = [[Tok]]
cells
              , pipeTableRows :: [[[Tok]]]
pipeTableRows       = []
              }
         BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) bl il.
Monad m =>
BlockNode m bl il -> BlockParser m bl il ()
addNodeToStack (BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ())
-> BlockNode m il bl -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$
               BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node (BlockSpec m il bl -> BlockData m il bl
forall (m :: * -> *) il bl. BlockSpec m il bl -> BlockData m il bl
defBlockData BlockSpec m il bl
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 = PipeTableData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata
                       , blockLines :: [[Tok]]
blockLines = [[Tok]
toks [Tok] -> [Tok] -> [Tok]
forall a. [a] -> [a] -> [a]
++ [Tok
nl]]
                       } []
         BlockStartResult -> BlockParser m il bl BlockStartResult
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 Forest (BlockData m il bl)
children) -> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (BlockParser m il bl (SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$ do
         ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
nonindentSpaces
         ParsecT [Tok] (BPState m il bl) m ()
-> ParsecT [Tok] (BPState m il bl) m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m ()
blankLine
         let tabledata :: PipeTableData
tabledata = Dynamic -> PipeTableData -> PipeTableData
forall a. Typeable a => Dynamic -> a -> a
fromDyn
                (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata)
                PipeTableData :: [ColAlignment] -> [[Tok]] -> [[[Tok]]] -> PipeTableData
PipeTableData{ pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = []
                             , pipeTableHeaders :: [[Tok]]
pipeTableHeaders = []
                             , pipeTableRows :: [[[Tok]]]
pipeTableRows = [] }
         SourcePos
pos <- ParsecT [Tok] (BPState m il bl) m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
         if [[Tok]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
ndata)
           then do
             [[Tok]]
cells <- ParsecT [Tok] (BPState m il bl) m [[Tok]]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [[Tok]]
pCells
             let tabledata' :: PipeTableData
tabledata' = PipeTableData
tabledata{ pipeTableRows :: [[[Tok]]]
pipeTableRows =
                                 [[Tok]]
cells [[Tok]] -> [[[Tok]]] -> [[[Tok]]]
forall a. a -> [a] -> [a]
: PipeTableData -> [[[Tok]]]
pipeTableRows PipeTableData
tabledata }
             (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
ndata{ blockData :: Dynamic
blockData =
                                   PipeTableData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata' } Forest (BlockData m il bl)
children)
           else
             -- last line was first; check for separators
             -- and if not found, convert to paragraph:
             BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do [ColAlignment]
aligns <- ParsecT [Tok] (BPState m il bl) m [ColAlignment]
forall (m :: * -> *) s. Monad m => ParsecT [Tok] s m [ColAlignment]
pDividers
                     Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT [Tok] (BPState m il bl) m ())
-> Bool -> ParsecT [Tok] (BPState m il bl) m ()
forall a b. (a -> b) -> a -> b
$ [ColAlignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColAlignment]
aligns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==
                             [[Tok]] -> Int
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 }
                     (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
ndata{
                                              blockLines :: [[Tok]]
blockLines = []
                                            , blockData :: Dynamic
blockData = PipeTableData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata'
                                            } Forest (BlockData m il bl)
children))
             BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ((SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall (m :: * -> *) a. Monad m => a -> m a
return ((SourcePos, BlockNode m il bl)
 -> BlockParser m il bl (SourcePos, BlockNode m il bl))
-> (SourcePos, BlockNode m il bl)
-> BlockParser m il bl (SourcePos, BlockNode m il bl)
forall a b. (a -> b) -> a -> b
$! (SourcePos
pos, BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
ndata{
                                   blockSpec :: BlockSpec m il bl
blockSpec = BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec } Forest (BlockData m il bl)
children))
     , blockConstructor :: BlockNode m il bl -> BlockParser m il bl bl
blockConstructor    = \(Node BlockData m il bl
ndata Forest (BlockData m il bl)
_) -> do
         let tabledata :: PipeTableData
tabledata = Dynamic -> PipeTableData -> PipeTableData
forall a. Typeable a => Dynamic -> a -> a
fromDyn
                (BlockData m il bl -> Dynamic
forall (m :: * -> *) il bl. BlockData m il bl -> Dynamic
blockData BlockData m il bl
ndata)
                PipeTableData :: [ColAlignment] -> [[Tok]] -> [[[Tok]]] -> PipeTableData
PipeTableData{ pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = []
                             , pipeTableHeaders :: [[Tok]]
pipeTableHeaders = []
                             , pipeTableRows :: [[[Tok]]]
pipeTableRows = [] }
         let aligns :: [ColAlignment]
aligns = PipeTableData -> [ColAlignment]
pipeTableAlignments PipeTableData
tabledata
         [il]
headers <- ([Tok] -> ParsecT [Tok] (BPState m il bl) m il)
-> [[Tok]] -> ParsecT [Tok] (BPState m il bl) m [il]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Tok] -> ParsecT [Tok] (BPState m il bl) m il
forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser (PipeTableData -> [[Tok]]
pipeTableHeaders PipeTableData
tabledata)
         let numcols :: Int
numcols = [il] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [il]
headers
         [[il]]
rows <- ([[Tok]] -> ParsecT [Tok] (BPState m il bl) m [il])
-> [[[Tok]]] -> ParsecT [Tok] (BPState m il bl) m [[il]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Tok] -> ParsecT [Tok] (BPState m il bl) m il)
-> [[Tok]] -> ParsecT [Tok] (BPState m il bl) m [il]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Tok] -> ParsecT [Tok] (BPState m il bl) m il
forall (m :: * -> *) il bl.
Monad m =>
[Tok] -> BlockParser m il bl il
runInlineParser ([[Tok]] -> ParsecT [Tok] (BPState m il bl) m [il])
-> ([[Tok]] -> [[Tok]])
-> [[Tok]]
-> ParsecT [Tok] (BPState m il bl) m [il]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Tok]] -> [[Tok]]
forall a. Int -> [a] -> [a]
take Int
numcols ([[Tok]] -> [[Tok]]) -> ([[Tok]] -> [[Tok]]) -> [[Tok]] -> [[Tok]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[Tok]] -> [[Tok]] -> [[Tok]]
forall a. [a] -> [a] -> [a]
++ ([Tok] -> [[Tok]]
forall a. a -> [a]
repeat [])))
                    ([[[Tok]]] -> [[[Tok]]]
forall a. [a] -> [a]
reverse ([[[Tok]]] -> [[[Tok]]]) -> [[[Tok]]] -> [[[Tok]]]
forall a b. (a -> b) -> a -> b
$ PipeTableData -> [[[Tok]]]
pipeTableRows PipeTableData
tabledata)
         bl -> BlockParser m il bl bl
forall (m :: * -> *) a. Monad m => a -> m a
return (bl -> BlockParser m il bl bl) -> bl -> BlockParser m il bl bl
forall a b. (a -> b) -> a -> b
$! ([ColAlignment] -> [il] -> [[il]] -> bl
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 Forest (BlockData m il bl)
children) BlockNode m il bl
parent ->
         BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
forall (m :: * -> *) il bl.
Monad m =>
BlockNode m il bl
-> BlockNode m il bl -> BlockParser m il bl (BlockNode m il bl)
defaultFinalizer
           (if [[Tok]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BlockData m il bl -> [[Tok]]
forall (m :: * -> *) il bl. BlockData m il bl -> [[Tok]]
blockLines BlockData m il bl
ndata)
               then BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
ndata Forest (BlockData m il bl)
children
               else BlockData m il bl
-> Forest (BlockData m il bl) -> BlockNode m il bl
forall a. a -> Forest a -> Tree a
Node BlockData m il bl
ndata{ blockSpec :: BlockSpec m il bl
blockSpec = BlockSpec m il bl
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
BlockSpec m il bl
paraSpec } Forest (BlockData m il bl)
children) BlockNode m il bl
parent
     }