-- | Render tables that can be used in <https://pandoc.org/ Pandoc>. In
-- particular, this supports the
-- <https://pandoc.org/MANUAL.html#tables pipe_tables> extension.
module Text.Layout.Table.Pandoc where

import Data.List

import Text.Layout.Table.Primitives.ColumnModifier
import Text.Layout.Table.Primitives.Header
import Text.Layout.Table.Spec.ColSpec
import Text.Layout.Table.Spec.HeaderSpec
import Text.Layout.Table.Spec.Position
import Text.Layout.Table.Spec.Util

-- | Generate a table that is readable but also serves as input to pandoc.
--
-- >>> mapM_ putStrLn $ pandocPipeTableLines [def, numCol] (titlesH ["text", "numeric value"]) [["a", "1.5"], ["b", "6.60000"]]
-- |text|numberic value|
-- |:---|-------------:|
-- |a   |       1.5    |
-- |b   |       6.60000|
pandocPipeTableLines
    :: [ColSpec]
    -> HeaderSpec
    -> [Row String]
    -> [String]
pandocPipeTableLines :: [ColSpec] -> HeaderSpec -> [Row String] -> Row String
pandocPipeTableLines [ColSpec]
specs HeaderSpec
h [Row String]
tab =
    (Row String -> String) -> [Row String] -> Row String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Row String -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (Row String -> String)
-> (Row String -> Row String) -> Row String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"" String -> Row String -> Row String
forall a. a -> [a] -> [a]
:) (Row String -> Row String)
-> (Row String -> Row String) -> Row String -> Row String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row String -> Row String -> Row String
forall a. [a] -> [a] -> [a]
++ [String
""])) ([Row String] -> Row String) -> [Row String] -> Row String
forall a b. (a -> b) -> a -> b
$ [Row String] -> [Row String]
consHeaderRow ([Row String] -> [Row String])
-> ([Row String] -> [Row String]) -> [Row String] -> [Row String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row String
vSeparators Row String -> [Row String] -> [Row String]
forall a. a -> [a] -> [a]
:) ([Row String] -> [Row String]) -> [Row String] -> [Row String]
forall a b. (a -> b) -> a -> b
$ ((String -> String) -> String -> String)
-> [String -> String] -> Row String -> Row String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
($) [String -> String]
cmfs (Row String -> Row String) -> [Row String] -> [Row String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Row String]
tab
  where
    cmfs :: [String -> String]
cmfs = (ColSpec -> ColModInfo -> String -> String)
-> [ColSpec] -> [ColModInfo] -> [String -> String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ColSpec
spec ColModInfo
cmi -> Position H -> CutMark -> ColModInfo -> String -> String
forall a b.
(Cell a, StringBuilder b) =>
Position H -> CutMark -> ColModInfo -> a -> b
columnModifier (ColSpec -> Position H
position ColSpec
spec) (ColSpec -> CutMark
cutMark ColSpec
spec) ColModInfo
cmi) [ColSpec]
specs [ColModInfo]
cmis
    cmis :: [ColModInfo]
cmis = (Position H -> ColModInfo -> ColModInfo)
-> [Position H] -> [ColModInfo] -> [ColModInfo]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int -> Position H -> ColModInfo -> ColModInfo
ensureWidthCMI Int
2) [Position H]
posSpecs ([ColModInfo] -> [ColModInfo]) -> [ColModInfo] -> [ColModInfo]
forall a b. (a -> b) -> a -> b
$ [ColModInfo] -> [ColModInfo]
fitHeaderIntoCMIs ([ColModInfo] -> [ColModInfo]) -> [ColModInfo] -> [ColModInfo]
forall a b. (a -> b) -> a -> b
$ [ColSpec] -> [Row String] -> [ColModInfo]
forall a. Cell a => [ColSpec] -> [Row a] -> [ColModInfo]
deriveColModInfos' [ColSpec]
specs [Row String]
tab

    posSpecs :: [Position H]
posSpecs = (ColSpec -> Position H) -> [ColSpec] -> [Position H]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ColSpec -> Position H
position [ColSpec]
specs

    ([ColModInfo] -> [ColModInfo]
fitHeaderIntoCMIs, [Row String] -> [Row String]
consHeaderRow) = case HeaderSpec
h of
        HeaderSpec
NoneHS                      -> ([ColModInfo] -> [ColModInfo]
forall a. a -> a
id, [Row String] -> [Row String]
forall a. a -> a
id)
        HeaderHS [HeaderColSpec]
headerSpecs Row String
titles ->
            ( Row String -> [Position H] -> [ColModInfo] -> [ColModInfo]
fitTitlesCMI Row String
titles [Position H]
posSpecs
            , ((HeaderColSpec -> CutMark -> ColModInfo -> String -> String)
-> [HeaderColSpec]
-> [CutMark]
-> [ColModInfo]
-> Row String
-> Row String
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 HeaderColSpec -> CutMark -> ColModInfo -> String -> String
headerCellModifier [HeaderColSpec]
headerSpecs (ColSpec -> CutMark
cutMark (ColSpec -> CutMark) -> [ColSpec] -> [CutMark]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ColSpec]
specs) [ColModInfo]
cmis Row String
titles Row String -> [Row String] -> [Row String]
forall a. a -> [a] -> [a]
:)
            )

    vSeparators :: Row String
vSeparators = (Position H -> ColModInfo -> String)
-> [Position H] -> [ColModInfo] -> Row String
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Position H
pos ColModInfo
cmi -> Position H -> String -> String
applyPandocPositionMarker Position H
pos (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (ColModInfo -> Int
widthCMI ColModInfo
cmi) Char
'-') [Position H]
posSpecs [ColModInfo]
cmis

applyPandocPositionMarker :: Position H -> String -> String
applyPandocPositionMarker :: Position H -> String -> String
applyPandocPositionMarker Position H
p = case Position H
p of
    Position H
Start  -> String -> String
markLeft
    Position H
Center -> String -> String
markRight (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
markLeft
    Position H
End    -> String -> String
markRight
  where
    markLeft :: String -> String
markLeft = (Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1
    markRight :: String -> String
markRight = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  String -> String
forall a. [a] -> [a]
reverse