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

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

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

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

             Either ParseError [[Tok]]
cellsR <- m (Either ParseError [[Tok]])
-> ParsecT [Tok] (BPState m il bl) m (Either ParseError [[Tok]])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either ParseError [[Tok]])
 -> ParsecT [Tok] (BPState m il bl) m (Either ParseError [[Tok]]))
-> m (Either ParseError [[Tok]])
-> ParsecT [Tok] (BPState m il bl) m (Either ParseError [[Tok]])
forall a b. (a -> b) -> a -> b
$ ParsecT [Tok] (BPState m il bl) m [[Tok]]
-> BPState m il bl
-> String
-> [Tok]
-> m (Either ParseError [[Tok]])
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT ParsecT [Tok] (BPState m il bl) m [[Tok]]
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 [[Tok]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Tok]]
cells Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [ColAlignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ColAlignment]
aligns
                      then ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- parse fail: not a table
                      else do
                         (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
updateState ((BPState m il bl -> BPState m il bl)
 -> ParsecT [Tok] (BPState m il bl) m ())
-> (BPState m il bl -> BPState m il bl)
-> ParsecT [Tok] (BPState m il bl) m ()
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 :: [ColAlignment] -> [[Tok]] -> [[[Tok]]] -> PipeTableData
PipeTableData
                               { pipeTableAlignments :: [ColAlignment]
pipeTableAlignments = [ColAlignment]
aligns
                               , 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 -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree 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 = BlockData m il bl -> [SourcePos]
forall (m :: * -> *) il bl. BlockData m il bl -> [SourcePos]
blockStartPos (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
cur) [SourcePos] -> [SourcePos] -> [SourcePos]
forall a. [a] -> [a] -> [a]
++ [SourcePos
pos]
                                  , blockData :: Dynamic
blockData = PipeTableData -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn PipeTableData
tabledata
                                  , blockAttributes :: Attributes
blockAttributes = BlockData m il bl -> Attributes
forall (m :: * -> *) il bl. BlockData m il bl -> Attributes
blockAttributes (BlockNode m il bl -> BlockData m il bl
forall a. Tree a -> a
rootLabel BlockNode m il bl
cur)
                                  } []
                Either ParseError [[Tok]]
_ ->
                   ParsecT [Tok] (BPState m il bl) m ()
forall (m :: * -> *) a. MonadPlus m => m a
mzero -- parse fail: not a table
             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 [BlockNode 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
         [[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 -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
ndata{ blockData :: Dynamic
blockData =
                               PipeTableData -> Dynamic
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 = 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 [BlockNode 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 (BlockData m il bl -> [BlockNode m il bl] -> BlockNode m il bl
forall a. a -> [Tree a] -> Tree a
Node BlockData m il bl
ndata [BlockNode m il bl]
children) BlockNode m il bl
parent
     }