{-|
Module      : Columns
Description : Pandoc filter to support columns 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.Columns
  (
    transform,
    formatColumns
  ) where

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
formatColumns

formatColumns :: P.Block -> P.Block
formatColumns :: Block -> Block
formatColumns (P.Div attr :: Attr
attr@(Text
_,[Text
"columns"],[(Text, Text)]
_) [Block]
bs)
  = Attr
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Block
P.Table Attr
attr Caption
defaultTableCaption [ColSpec]
colSpecs
                    TableHead
defaultTableHeader [TableBody
body]
                    TableFoot
defaultTableFooter
  where body :: TableBody
body = [Block] -> TableBody
blocksToTableBody [Block]
bs
        colSpecs :: [ColSpec]
colSpecs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const ColSpec
defaultColSpec) [Block]
bs
formatColumns Block
b = Block
b

blocksToTableBody :: [P.Block] -> P.TableBody
blocksToTableBody :: [Block] -> TableBody
blocksToTableBody [Block]
bs = Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
P.TableBody Attr
P.nullAttr (Int -> RowHeadColumns
P.RowHeadColumns Int
0) [] [Row
row]
  where row :: Row
row = [Block] -> Row
blocksToTableRow [Block]
bs

blocksToTableRow :: [P.Block] -> P.Row
blocksToTableRow :: [Block] -> Row
blocksToTableRow = Attr -> [Cell] -> Row
P.Row Attr
P.nullAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Block -> Cell
blockToCell

blockToCell :: P.Block -> P.Cell
blockToCell :: Block -> Cell
blockToCell Block
b = Attr -> Alignment -> RowSpan -> ColSpan -> [Block] -> Cell
P.Cell Attr
P.nullAttr Alignment
P.AlignDefault (Int -> RowSpan
P.RowSpan Int
1) (Int -> ColSpan
P.ColSpan Int
1) [Block
b]

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

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

defaultTableHeader :: P.TableHead
defaultTableHeader :: TableHead
defaultTableHeader = Attr -> [Row] -> TableHead
P.TableHead Attr
P.nullAttr []

defaultTableFooter :: P.TableFoot
defaultTableFooter :: TableFoot
defaultTableFooter = Attr -> [Row] -> TableFoot
P.TableFoot Attr
P.nullAttr []