1111-- projects as required. If the library grows to a substantial size or others
1212-- with to use it, I will reconsider.
1313--
14- -- Revision: 2021-06-24
14+ -- Revision: 2021-07-20
1515------------------------------------------------------------------------------
1616
1717{-# LANGUAGE CPP #-}
18+ {-# LANGUAGE LambdaCase #-}
19+ {-# LANGUAGE TupleSections #-}
1820
1921module LibOA
2022 ( -- * Options
@@ -27,6 +29,7 @@ module LibOA
2729 , (<||>)
2830 , section
2931 , table
32+ , table_
3033 , vspace
3134 ) where
3235
@@ -35,7 +38,8 @@ import qualified Text.PrettyPrint.ANSI.Leijen as Doc
3538import Text.PrettyPrint.ANSI.Leijen (Doc )
3639
3740-- https://hackage.haskell.org/package/base
38- import qualified Data.List as List
41+ import Data.List (intersperse , transpose )
42+ import Data.Maybe (fromMaybe )
3943#if !MIN_VERSION_base (4,11,0)
4044import Data.Monoid ((<>) )
4145#endif
@@ -115,15 +119,23 @@ infixr 5 <||>
115119section :: String -> Doc -> Doc
116120section title = (Doc. text title Doc. <$$> ) . Doc. indent 2
117121
118- -- | Create a two-column table
119- table :: [(String , String )] -> Doc
120- table rows =
121- let width = 1 + maximum (map (length . fst ) rows)
122- in Doc. vcat
123- [ Doc. fillBreak width (Doc. text l) Doc. <+> Doc. text r
124- | (l, r) <- rows
125- ]
122+ -- | Create a table, with formatting
123+ table :: Int -> [[(String , Doc -> Doc )]] -> Doc
124+ table sep rows = Doc. vcat $
125+ map (fromMaybe Doc. empty . foldr go Nothing . zip lengths) rows
126+ where
127+ lengths :: [Int ]
128+ lengths = map ((+) sep . maximum . map (length . fst )) $ transpose rows
129+
130+ go :: (Int , (String , Doc -> Doc )) -> Maybe Doc -> Maybe Doc
131+ go (len, (s, f)) = Just . \ case
132+ Just doc -> Doc. fill len (f $ Doc. string s) <> doc
133+ Nothing -> f $ Doc. string s
134+
135+ -- | Create a table, without formatting
136+ table_ :: Int -> [[String ]] -> Doc
137+ table_ sep = table sep . (map . map ) (, id )
126138
127139-- | Vertically space documents with blank lines between them
128140vspace :: [Doc ] -> Doc
129- vspace = mconcat . List. intersperse (Doc. line <> Doc. line)
141+ vspace = mconcat . intersperse (Doc. line <> Doc. line)
0 commit comments