{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Parsing.GridTable
( gridTableWith
, gridTableWith'
, tableWith
, tableWith'
, widthsFromIndices
, TableComponents (..)
, TableNormalization (..)
, toTableComponents
, toTableComponents'
)
where
import Control.Monad (guard)
import Data.List (transpose)
import Data.Text (Text)
import Text.Pandoc.Options (ReaderOptions (readerColumns))
import Text.Pandoc.Builder (Blocks)
import Text.Pandoc.Definition
import Text.Pandoc.Parsing.Capabilities
import Text.Pandoc.Parsing.General
import Text.Pandoc.Parsing.Types
import Text.Pandoc.Shared (compactify, splitTextByIndices, trim, trimr)
import Text.Pandoc.Sources
import Text.Parsec
( Stream (..), many1, notFollowedBy, option, optional, sepEndBy1, try )
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
data TableComponents = TableComponents
{ TableComponents -> Attr
tableAttr :: Attr
, TableComponents -> Caption
tableCaption :: Caption
, TableComponents -> [ColSpec]
tableColSpecs :: [ColSpec]
, TableComponents -> TableHead
tableHead :: TableHead
, TableComponents -> [TableBody]
tableBodies :: [TableBody]
, :: TableFoot
}
tableFromComponents :: TableComponents -> Blocks
tableFromComponents :: TableComponents -> Blocks
tableFromComponents (TableComponents Attr
attr Caption
capt [ColSpec]
colspecs TableHead
th [TableBody]
tb TableFoot
tf) =
Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Blocks
B.tableWith Attr
attr Caption
capt [ColSpec]
colspecs TableHead
th [TableBody]
tb TableFoot
tf
toTableComponents :: [Alignment] -> [Double] -> [Blocks] -> [[Blocks]]
-> TableComponents
toTableComponents :: [Alignment]
-> [Double] -> [Blocks] -> [[Blocks]] -> TableComponents
toTableComponents = TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
NoNormalization
toTableComponents' :: TableNormalization
-> [Alignment] -> [Double] -> [Blocks] -> [[Blocks]]
-> TableComponents
toTableComponents' :: TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
normalization [Alignment]
aligns [Double]
widths [Blocks]
heads [[Blocks]]
rows =
let th :: TableHead
th = Attr -> [Row] -> TableHead
TableHead Attr
nullAttr (TableNormalization -> [Blocks] -> [Row]
toHeaderRow TableNormalization
normalization [Blocks]
heads)
tb :: TableBody
tb = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] (([Blocks] -> Row) -> [[Blocks]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
rows)
tf :: TableFoot
tf = Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr []
colspecs :: [ColSpec]
colspecs = [Alignment] -> [Double] -> [ColSpec]
toColSpecs [Alignment]
aligns [Double]
widths
in Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> TableComponents
TableComponents Attr
nullAttr Caption
B.emptyCaption [ColSpec]
colspecs TableHead
th [TableBody
tb] TableFoot
tf
toColSpecs :: [Alignment]
-> [Double]
-> [ColSpec]
toColSpecs :: [Alignment] -> [Double] -> [ColSpec]
toColSpecs [Alignment]
aligns [Double]
widths = [Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns ((Double -> ColWidth) -> [Double] -> [ColWidth]
forall a b. (a -> b) -> [a] -> [b]
map Double -> ColWidth
fromWidth [Double]
widths')
where
fromWidth :: Double -> ColWidth
fromWidth Double
n
| Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double -> ColWidth
ColWidth Double
n
| Bool
otherwise = ColWidth
ColWidthDefault
totalWidth :: Double
totalWidth = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
widths
widths' :: [Double]
widths' = if Double
totalWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1
then [Double]
widths
else (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalWidth) [Double]
widths
data TableNormalization
= NoNormalization
|
gridTableWith :: (Monad m, Monad mf, HasLastStrPosition st, HasReaderOptions st)
=> ParserT Sources st m (mf Blocks)
-> Bool
-> ParserT Sources st m (mf Blocks)
gridTableWith :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st, HasReaderOptions st) =>
ParserT Sources st m (mf Blocks)
-> Bool -> ParserT Sources st m (mf Blocks)
gridTableWith ParserT Sources st m (mf Blocks)
blocks Bool
headless =
ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT Sources st m (mf [Blocks]))
-> ParserT Sources st m Char
-> ParserT Sources st m ()
-> ParserT Sources st m (mf Blocks)
forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf Blocks)
tableWith (Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
headless ParserT Sources st m (mf Blocks)
blocks) (ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
gridTableRow ParserT Sources st m (mf Blocks)
blocks)
(Char -> ParserT Sources st m Char
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
'-') ParserT Sources st m ()
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
gridTableFooter
gridTableWith' :: (Monad m, Monad mf,
HasReaderOptions st, HasLastStrPosition st)
=> TableNormalization
-> ParserT Sources st m (mf Blocks)
-> Bool
-> ParserT Sources st m (mf TableComponents)
gridTableWith' :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasReaderOptions st, HasLastStrPosition st) =>
TableNormalization
-> ParserT Sources st m (mf Blocks)
-> Bool
-> ParserT Sources st m (mf TableComponents)
gridTableWith' TableNormalization
normalization ParserT Sources st m (mf Blocks)
blocks Bool
headless =
TableNormalization
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT Sources st m (mf [Blocks]))
-> ParserT Sources st m Char
-> ParserT Sources st m ()
-> ParserT Sources st m (mf TableComponents)
forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
TableNormalization
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf TableComponents)
tableWith' TableNormalization
normalization
(Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
gridTableHeader Bool
headless ParserT Sources st m (mf Blocks)
blocks) (ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
gridTableRow ParserT Sources st m (mf Blocks)
blocks)
(Char -> ParserT Sources st m Char
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
'-') ParserT Sources st m ()
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m ()
gridTableFooter
gridTableSplitLine :: [Int] -> Text -> [Text]
gridTableSplitLine :: [Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices Text
line = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
removeFinalBar ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
[Int] -> Text -> [Text]
splitTextByIndices ([Int] -> [Int]
forall a. [a] -> [a]
init [Int]
indices) (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimr Text
line
gridPart :: Monad m => Char -> ParserT Sources st m (Int, Alignment)
gridPart :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m (Int, Alignment)
gridPart Char
ch = do
Bool
leftColon <- Bool -> ParsecT Sources st m Bool -> ParsecT Sources st 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 (Bool
True Bool -> ParsecT Sources st m Char -> ParsecT Sources st m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':')
[Char]
dashes <- ParsecT Sources st m Char -> ParsecT Sources st m [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
ch)
Bool
rightColon <- Bool -> ParsecT Sources st m Bool -> ParsecT Sources st 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 (Bool
True Bool -> ParsecT Sources st m Char -> ParsecT Sources st m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
':')
Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'+'
let lengthDashes :: Int
lengthDashes = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
dashes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
leftColon then Int
1 else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
(if Bool
rightColon then Int
1 else Int
0)
let alignment :: Alignment
alignment = case (Bool
leftColon, Bool
rightColon) of
(Bool
True, Bool
True) -> Alignment
AlignCenter
(Bool
True, Bool
False) -> Alignment
AlignLeft
(Bool
False, Bool
True) -> Alignment
AlignRight
(Bool
False, Bool
False) -> Alignment
AlignDefault
(Int, Alignment) -> ParserT Sources st m (Int, Alignment)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
lengthDashes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Alignment
alignment)
gridDashedLines :: Monad m
=> Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
ch = ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m [(Int, Alignment)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m [(Int, Alignment)])
-> ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m [(Int, Alignment)]
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT Sources st m Char
-> ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m [(Int, Alignment)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Sources st m (Int, Alignment)
-> ParsecT Sources st m [(Int, Alignment)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Char -> ParsecT Sources st m (Int, Alignment)
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m (Int, Alignment)
gridPart Char
ch) ParsecT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m Char
-> ParsecT Sources st m [(Int, Alignment)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Sources st m Char
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Char
blankline
removeFinalBar :: Text -> Text
removeFinalBar :: Text -> Text
removeFinalBar = (Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
go (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'|')
where
go :: Char -> Bool
go Char
c = (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c) Text
" \t"
gridTableSep :: Monad m => Char -> ParserT Sources st m Char
gridTableSep :: forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
ch = ParsecT Sources st m Char -> ParsecT Sources st m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Sources st m Char -> ParsecT Sources st m Char)
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall a b. (a -> b) -> a -> b
$ Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
ch ParserT Sources st m [(Int, Alignment)]
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources st m Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'\n'
gridTableHeader :: (Monad m, Monad mf, HasLastStrPosition st)
=> Bool
-> ParserT Sources st m (mf Blocks)
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
Bool
True ParserT Sources st m (mf Blocks)
_ = do
ParsecT Sources st m Text -> ParsecT Sources st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
[(Int, Alignment)]
dashes <- Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
'-'
let aligns :: [Alignment]
aligns = ((Int, Alignment) -> Alignment)
-> [(Int, Alignment)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Alignment
forall a b. (a, b) -> b
snd [(Int, Alignment)]
dashes
let lines' :: [Int]
lines' = ((Int, Alignment) -> Int) -> [(Int, Alignment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Int
forall a b. (a, b) -> a
fst [(Int, Alignment)]
dashes
let indices :: [Int]
indices = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
lines'
(mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Blocks] -> mf [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return [], [Alignment]
aligns, [Int]
indices)
gridTableHeader Bool
False ParserT Sources st m (mf Blocks)
blocks = ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int]))
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall a b. (a -> b) -> a -> b
$ do
ParsecT Sources st m Text -> ParsecT Sources st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT Sources st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
[(Int, Alignment)]
dashes <- Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
'-'
[Text]
rawContent <- ParsecT Sources st m Text -> ParsecT Sources st m [Text]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Sources st m Char -> ParsecT Sources st m ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Sources st m Char
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m Char
gridTableSep Char
'=') ParsecT Sources st m ()
-> ParsecT Sources st m Char -> ParsecT Sources st m Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|' ParsecT Sources st m Char
-> ParsecT Sources st m Text -> ParsecT Sources st m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
[Char] -> Text
T.pack ([Char] -> Text)
-> ParsecT Sources st m [Char] -> ParsecT Sources st m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Sources st m Char
-> ParsecT Sources st m Char -> ParsecT Sources st m [Char]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ParsecT Sources st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline)
[(Int, Alignment)]
underDashes <- Char -> ParserT Sources st m [(Int, Alignment)]
forall (m :: * -> *) st.
Monad m =>
Char -> ParserT Sources st m [(Int, Alignment)]
gridDashedLines Char
'='
Bool -> ParsecT Sources st m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParsecT Sources st m ())
-> Bool -> ParsecT Sources st m ()
forall a b. (a -> b) -> a -> b
$ [(Int, Alignment)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Alignment)]
dashes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Int, Alignment)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Alignment)]
underDashes
let lines' :: [Int]
lines' = ((Int, Alignment) -> Int) -> [(Int, Alignment)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Int
forall a b. (a, b) -> a
fst [(Int, Alignment)]
underDashes
let indices :: [Int]
indices = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 [Int]
lines'
let aligns :: [Alignment]
aligns = ((Int, Alignment) -> Alignment)
-> [(Int, Alignment)] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Alignment) -> Alignment
forall a b. (a, b) -> b
snd [(Int, Alignment)]
underDashes
let rawHeads :: [Text]
rawHeads = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim) ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose
([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ (Text -> [Text]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices) [Text]
rawContent
mf [Blocks]
heads <- [mf Blocks] -> mf [Blocks]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf Blocks] -> mf [Blocks])
-> ParsecT Sources st m [mf Blocks]
-> ParsecT Sources st m (mf [Blocks])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParserT Sources st m (mf Blocks))
-> [Text] -> ParsecT Sources st m [mf Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Sources st m (mf Blocks)
-> Text -> ParserT Sources st m (mf Blocks)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' ParserT Sources st m (mf Blocks)
blocks (Text -> ParserT Sources st m (mf Blocks))
-> (Text -> Text) -> Text -> ParserT Sources st m (mf Blocks)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
trim) [Text]
rawHeads
(mf [Blocks], [Alignment], [Int])
-> ParserT Sources st m (mf [Blocks], [Alignment], [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (mf [Blocks]
heads, [Alignment]
aligns, [Int]
indices)
gridTableRawLine :: (Stream s m Char, UpdateSourcePos s Char)
=> [Int] -> ParserT s st m [Text]
gridTableRawLine :: forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Int] -> ParserT s st m [Text]
gridTableRawLine [Int]
indices = do
Char -> ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'|'
[Char]
line <- ParsecT s st m Char -> ParsecT s st m Char -> ParserT s st m [Char]
forall end s (m :: * -> *) t st a.
(Show end, Stream s m t) =>
ParserT s st m a -> ParserT s st m end -> ParserT s st m [a]
many1Till ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar ParsecT s st m Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
newline
[Text] -> ParserT s st m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> Text -> [Text]
gridTableSplitLine [Int]
indices (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
line)
gridTableRow :: (Monad m, Monad mf, HasLastStrPosition st)
=> ParserT Sources st m (mf Blocks)
-> [Int]
-> ParserT Sources st m (mf [Blocks])
gridTableRow :: forall (m :: * -> *) (mf :: * -> *) st.
(Monad m, Monad mf, HasLastStrPosition st) =>
ParserT Sources st m (mf Blocks)
-> [Int] -> ParserT Sources st m (mf [Blocks])
gridTableRow ParserT Sources st m (mf Blocks)
blocks [Int]
indices = do
[[Text]]
colLines <- ParsecT Sources st m [Text] -> ParsecT Sources st m [[Text]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ([Int] -> ParsecT Sources st m [Text]
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
[Int] -> ParserT s st m [Text]
gridTableRawLine [Int]
indices)
let cols :: [Text]
cols = ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
removeOneLeadingSpace) ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$
[[Text]] -> [[Text]]
forall a. [[a]] -> [[a]]
transpose [[Text]]
colLines
compactifyCell :: Blocks -> Blocks
compactifyCell Blocks
bs = case [Blocks] -> [Blocks]
compactify [Blocks
bs] of
[] -> Blocks
forall a. Monoid a => a
mempty
Blocks
x:[Blocks]
_ -> Blocks
x
mf [Blocks]
cells <- [mf Blocks] -> mf [Blocks]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf Blocks] -> mf [Blocks])
-> ParsecT Sources st m [mf Blocks]
-> ParserT Sources st m (mf [Blocks])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ParserT Sources st m (mf Blocks))
-> [Text] -> ParsecT Sources st m [mf Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ParserT Sources st m (mf Blocks)
-> Text -> ParserT Sources st m (mf Blocks)
forall (m :: * -> *) u a.
(Monad m, HasLastStrPosition u) =>
ParserT Sources u m a -> Text -> ParserT Sources u m a
parseFromString' ParserT Sources st m (mf Blocks)
blocks) [Text]
cols
mf [Blocks] -> ParserT Sources st m (mf [Blocks])
forall (m :: * -> *) a. Monad m => a -> m a
return (mf [Blocks] -> ParserT Sources st m (mf [Blocks]))
-> mf [Blocks] -> ParserT Sources st m (mf [Blocks])
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> [Blocks]) -> mf [Blocks] -> mf [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Blocks -> Blocks) -> [Blocks] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Blocks
compactifyCell) mf [Blocks]
cells
removeOneLeadingSpace :: [Text] -> [Text]
removeOneLeadingSpace :: [Text] -> [Text]
removeOneLeadingSpace [Text]
xs =
if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
startsWithSpace [Text]
xs
then (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
T.drop Int
1) [Text]
xs
else [Text]
xs
where startsWithSpace :: Text -> Bool
startsWithSpace Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
Maybe (Char, Text)
Nothing -> Bool
True
Just (Char
c, Text
_) -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '
gridTableFooter :: (Stream s m Char, UpdateSourcePos s Char)
=> ParserT s st m ()
= ParsecT s st m Text -> ParsecT s st m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s st m Text
forall s (m :: * -> *) st.
(Stream s m Char, UpdateSourcePos s Char) =>
ParserT s st m Text
blanklines
tableWith :: (Stream s m Char, UpdateSourcePos s Char,
HasReaderOptions st, Monad mf)
=> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf Blocks)
tableWith :: forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf Blocks)
tableWith ParserT s st m (mf [Blocks], [Alignment], [Int])
hp [Int] -> ParserT s st m (mf [Blocks])
rp ParserT s st m sep
lp ParserT s st m end
fp = (TableComponents -> Blocks) -> mf TableComponents -> mf Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableComponents -> Blocks
tableFromComponents (mf TableComponents -> mf Blocks)
-> ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf Blocks)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
TableNormalization
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParsecT s st m (mf TableComponents)
forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
TableNormalization
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf TableComponents)
tableWith' TableNormalization
NoNormalization ParserT s st m (mf [Blocks], [Alignment], [Int])
hp [Int] -> ParserT s st m (mf [Blocks])
rp ParserT s st m sep
lp ParserT s st m end
fp
tableWith' :: (Stream s m Char, UpdateSourcePos s Char,
HasReaderOptions st, Monad mf)
=> TableNormalization
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf TableComponents)
tableWith' :: forall s (m :: * -> *) st (mf :: * -> *) sep end.
(Stream s m Char, UpdateSourcePos s Char, HasReaderOptions st,
Monad mf) =>
TableNormalization
-> ParserT s st m (mf [Blocks], [Alignment], [Int])
-> ([Int] -> ParserT s st m (mf [Blocks]))
-> ParserT s st m sep
-> ParserT s st m end
-> ParserT s st m (mf TableComponents)
tableWith' TableNormalization
n11n ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser [Int] -> ParserT s st m (mf [Blocks])
rowParser ParserT s st m sep
lineParser ParserT s st m end
footerParser = ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf TableComponents)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf TableComponents))
-> ParsecT s st m (mf TableComponents)
-> ParsecT s st m (mf TableComponents)
forall a b. (a -> b) -> a -> b
$ do
(mf [Blocks]
heads, [Alignment]
aligns, [Int]
indices) <- ParserT s st m (mf [Blocks], [Alignment], [Int])
headerParser
mf [[Blocks]]
lines' <- [mf [Blocks]] -> mf [[Blocks]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([mf [Blocks]] -> mf [[Blocks]])
-> ParsecT s st m [mf [Blocks]] -> ParsecT s st m (mf [[Blocks]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> ParserT s st m (mf [Blocks])
rowParser [Int]
indices ParserT s st m (mf [Blocks])
-> ParserT s st m sep -> ParsecT s st m [mf [Blocks]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy1` ParserT s st m sep
lineParser
ParserT s st m end
footerParser
Int
numColumns <- (ReaderOptions -> Int) -> ParserT s st m Int
forall st s (m :: * -> *) t b.
(HasReaderOptions st, Stream s m t) =>
(ReaderOptions -> b) -> ParserT s st m b
getOption ReaderOptions -> Int
readerColumns
let widths :: [Double]
widths = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
indices
then Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns) Double
0.0
else Int -> [Int] -> [Double]
widthsFromIndices Int
numColumns [Int]
indices
mf TableComponents -> ParsecT s st m (mf TableComponents)
forall (m :: * -> *) a. Monad m => a -> m a
return (mf TableComponents -> ParsecT s st m (mf TableComponents))
-> mf TableComponents -> ParsecT s st m (mf TableComponents)
forall a b. (a -> b) -> a -> b
$ TableNormalization
-> [Alignment]
-> [Double]
-> [Blocks]
-> [[Blocks]]
-> TableComponents
toTableComponents' TableNormalization
n11n [Alignment]
aligns [Double]
widths ([Blocks] -> [[Blocks]] -> TableComponents)
-> mf [Blocks] -> mf ([[Blocks]] -> TableComponents)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> mf [Blocks]
heads mf ([[Blocks]] -> TableComponents)
-> mf [[Blocks]] -> mf TableComponents
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> mf [[Blocks]]
lines'
toRow :: [Blocks] -> Row
toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Blocks] -> [Cell]) -> [Blocks] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Blocks -> Cell) -> [Blocks] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
B.simpleCell
toHeaderRow :: TableNormalization -> [Blocks] -> [Row]
= \case
TableNormalization
NoNormalization -> \[Blocks]
l -> [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
TableNormalization
NormalizeHeader -> \[Blocks]
l -> [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not ([Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Blocks -> Bool) -> [Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Blocks -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
widthsFromIndices :: Int
-> [Int]
-> [Double]
widthsFromIndices :: Int -> [Int] -> [Double]
widthsFromIndices Int
_ [] = []
widthsFromIndices Int
numColumns' [Int]
indices =
let numColumns :: Int
numColumns = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
numColumns' (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
indices then Int
0 else [Int] -> Int
forall a. [a] -> a
last [Int]
indices)
lengths' :: [Int]
lengths' = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
indices (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
indices)
lengths :: [Int]
lengths = [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
case [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
lengths' of
[] -> []
[Int
x] -> [Int
x]
(Int
x:Int
y:[Int]
zs) -> if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y Bool -> Bool -> Bool
&& Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2
then Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs
else Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:Int
yInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
zs
totLength :: Int
totLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
lengths
quotient :: Double
quotient = if Int
totLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
numColumns
then Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totLength
else Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numColumns
fracs :: [Double]
fracs = (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
l -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
quotient) [Int]
lengths in
[Double] -> [Double]
forall a. [a] -> [a]
tail [Double]
fracs