{-|
Module      : LinearTable
Description : An easy way to create tables with wrapped text in Markdown.
Copyright   : (c) 2020-2023 Amy de Buitléir
License     : BSD--3
Maintainer  : amy@nualeargais.ie
Stability   : experimental
Portability : POSIX

See <https://github.com/mhwombat/pandoc-linear-table> for information
on how to use this filter.
-}

{-# LANGUAGE OverloadedStrings #-}

module Text.Pandoc.Filters.LinearTable
  (
    transform,
    formatLinearTable
  ) where

import Data.Foldable    (foldl')
import Data.Text        qualified as T
import Text.Pandoc      qualified as P
import Text.Pandoc.Walk (walk)


-- | A transformation that can be used with Hakyll.
transform :: P.Pandoc -> P.Pandoc
transform :: Pandoc -> Pandoc
transform = forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
formatLinearTable

-- | Exported for use by the executable.
formatLinearTable :: P.Block -> P.Block
formatLinearTable :: Block -> Block
formatLinearTable x :: Block
x@(P.CodeBlock (Text
_,[Text]
cs,[(Text, Text)]
_) Text
s)
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cs                  = Block
x
  | forall a. [a] -> a
head [Text]
cs forall a. Eq a => a -> a -> Bool
== Text
"linear-table" = [[Text]] -> Block
toTable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *). Foldable t => t Text -> [[Text]]
splitRows forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
  | Bool
otherwise                = Block
x
formatLinearTable Block
x = Block
x

toTable :: [[T.Text]] -> P.Block
toTable :: [[Text]] -> Block
toTable [[Text]]
xss = (Text, [Text], [(Text, Text)])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
P.Table forall {a}. (Text, [Text], [a])
attr Caption
defaultTableCaption [ColSpec]
colSpecs
                    TableHead
defaultTableHeader [[[Text]] -> TableBody
toTableBody [[Text]]
xss]
                    TableFoot
defaultTableFooter
  where attr :: (Text, [Text], [a])
attr = (Text
"",[Text
"linear-table"],[])
        colSpecs :: [ColSpec]
colSpecs = forall a. Int -> a -> [a]
replicate Int
nCols ColSpec
defaultColSpec
        nCols :: Int
nCols = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
xss


toTableBody :: [[T.Text]] -> P.TableBody
toTableBody :: [[Text]] -> TableBody
toTableBody = (Text, [Text], [(Text, Text)])
-> RowHeadColumns -> [Row] -> [Row] -> TableBody
P.TableBody (Text, [Text], [(Text, Text)])
P.nullAttr (Int -> RowHeadColumns
P.RowHeadColumns Int
0) []
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Row
toTableRow


toTableRow :: [T.Text] -> P.Row
toTableRow :: [Text] -> Row
toTableRow = (Text, [Text], [(Text, Text)]) -> [Cell] -> Row
P.Row (Text, [Text], [(Text, Text)])
P.nullAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Cell
toCell

toCell :: T.Text -> P.Cell
toCell :: Text -> Cell
toCell = [Block] -> Cell
blocksToCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
removePara forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Block]
parseBlocks

blocksToCell :: [P.Block] -> P.Cell
blocksToCell :: [Block] -> Cell
blocksToCell
  = (Text, [Text], [(Text, Text)])
-> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
P.Cell (Text, [Text], [(Text, Text)])
P.nullAttr Alignment
P.AlignDefault (Int -> RowSpan
P.RowSpan Int
1) (Int -> ColSpan
P.ColSpan Int
1)

removePara :: P.Block -> P.Block
removePara :: Block -> Block
removePara (P.Para [Inline]
xs) = [Inline] -> Block
P.Plain [Inline]
xs
removePara Block
x           = Block
x

splitRows :: Foldable t => t T.Text -> [[T.Text]]
splitRows :: forall (t :: * -> *). Foldable t => t Text -> [[Text]]
splitRows t Text
xs = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [[Text]] -> Text -> [[Text]]
splitter [] t Text
xs

splitter :: [[T.Text]] -> T.Text -> [[T.Text]]
splitter :: [[Text]] -> Text -> [[Text]]
splitter [] Text
x | Text
x forall a. Eq a => a -> a -> Bool
== Text
""    = []
              | Bool
otherwise = [[Text
x]]
splitter [[Text]]
accum Text
x | Text
x forall a. Eq a => a -> a -> Bool
== Text
""    = []forall a. a -> [a] -> [a]
:[[Text]]
accum
                 | Bool
otherwise = (Text
xforall a. a -> [a] -> [a]
:(forall a. [a] -> a
head [[Text]]
accum)) forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
tail [[Text]]
accum




readDefaults :: P.ReaderOptions
readDefaults :: ReaderOptions
readDefaults = forall a. Default a => a
P.def { readerStandalone :: Bool
P.readerStandalone = Bool
True,
                       readerExtensions :: Extensions
P.readerExtensions = Extensions
P.pandocExtensions }

parseBlocks :: T.Text -> [P.Block]
parseBlocks :: Text -> [Block]
parseBlocks Text
s = forall {a}. Show a => Either a Pandoc -> [Block]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PandocPure a -> Either PandocError a
P.runPure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
P.readMarkdown ReaderOptions
readDefaults Text
s
  where f :: Either a Pandoc -> [Block]
f (Right (P.Pandoc Meta
_ [Block]
bs)) = [Block]
bs
        f (Left a
e) = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"readMarkdown failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
e

defaultColSpec :: P.ColSpec
defaultColSpec :: ColSpec
defaultColSpec = (Alignment
P.AlignDefault, ColWidth
P.ColWidthDefault)

defaultTableCaption :: P.Caption
defaultTableCaption :: Caption
defaultTableCaption = Maybe [Inline] -> [Block] -> Caption
P.Caption forall a. Maybe a
Nothing []

defaultTableHeader :: P.TableHead
defaultTableHeader :: TableHead
defaultTableHeader = (Text, [Text], [(Text, Text)]) -> [Row] -> TableHead
P.TableHead (Text, [Text], [(Text, Text)])
P.nullAttr []

defaultTableFooter :: P.TableFoot
defaultTableFooter :: TableFoot
defaultTableFooter = (Text, [Text], [(Text, Text)]) -> [Row] -> TableFoot
P.TableFoot (Text, [Text], [(Text, Text)])
P.nullAttr []