{-| __Hable__ pretty-prints a table in a configurable way. See 'Hable.Config' for details on configuration. This is just an introduction. = Default Configuration and Basic Example > import Hable > > main :: IO () > main = putStr (hable defaultConfig) table > > table = > [ [ "Hello", "World!", "Nice to meet you!", ":)" ] > , [ "This cell\nhas two\nnewlines.", "Nice!", "And the next cell is empty:", ""] > , [ "Lorem", "Ipsum", "Dolor", "Sit Amet." ] > , [ "Foo", "Bar", "Baz", "Qux" ] > , [ "Hable", "is", "super", "amazing!" ] > ] will result in: @ ╔═══════════╤════════╤═════════════════════════════╤═══════════╗ ║ Hello │ World! │ Nice to meet you! │ :) ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ This cell │ Nice! │ And the next cell is empty: │ ║ ║ has two │ │ │ ║ ║ newlines. │ │ │ ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ Lorem │ Ipsum │ Dolor │ Sit Amet. ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ Foo │ Bar │ Baz │ Qux ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ Hable │ is │ super │ amazing! ║ ╚═══════════╧════════╧═════════════════════════════╧═══════════╝ @ = Line Styles >>> putStr (hable defaultConfig { hLineStyle = \_ _ -> Nothing }) table ║ Hello │ World! │ Nice to meet you! │ :) ║ ║ This cell │ Nice! │ And the next cell is empty: │ ║ ║ has two │ │ │ ║ ║ newlines. │ │ │ ║ ║ Lorem │ Ipsum │ Dolor │ Sit Amet. ║ ║ Foo │ Bar │ Baz │ Qux ║ ║ Hable │ is │ super │ amazing! ║ >>> putStr (hable defaultConfig { vLineStyle = \_ _ -> Nothing } table) ═══════════════════════════════════════════════════════════ Hello World! Nice to meet you! :) ─────────────────────────────────────────────────────────── This cell Nice! And the next cell is empty: has two newlines. ─────────────────────────────────────────────────────────── Lorem Ipsum Dolor Sit Amet. ─────────────────────────────────────────────────────────── Foo Bar Baz Qux ─────────────────────────────────────────────────────────── Hable is super amazing! ═══════════════════════════════════════════════════════════ >>> putStr (hable defaultConfig { hLineStyle = \m n -> if n `elem` [1,2,m] then Just Thick else Nothing, vLineStyle = \_ _ -> Just Normal } table) ┍━━━━━━━━━━━┯━━━━━━━━┯━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┯━━━━━━━━━━━┑ │ Hello │ World! │ Nice to meet you! │ :) │ ┝━━━━━━━━━━━┿━━━━━━━━┿━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┿━━━━━━━━━━━┥ │ This cell │ Nice! │ And the next cell is empty: │ │ │ has two │ │ │ │ │ newlines. │ │ │ │ │ Lorem │ Ipsum │ Dolor │ Sit Amet. │ │ Foo │ Bar │ Baz │ Qux │ │ Hable │ is │ super │ amazing! │ ┕━━━━━━━━━━━┷━━━━━━━━┷━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┷━━━━━━━━━━━┙ >>> putStr (hable defaultConfig { charset = orgModeCharset, hLineStyle = \_ _ -> Just (), vLineStyle = \_ _ -> Just () } table) |-----------+--------+-----------------------------+-----------| | Hello | World! | Nice to meet you! | :) | |-----------+--------+-----------------------------+-----------| | This cell | Nice! | And the next cell is empty: | | | has two | | | | | newlines. | | | | |-----------+--------+-----------------------------+-----------| | Lorem | Ipsum | Dolor | Sit Amet. | |-----------+--------+-----------------------------+-----------| | Foo | Bar | Baz | Qux | |-----------+--------+-----------------------------+-----------| | Hable | is | super | amazing! | |-----------+--------+-----------------------------+-----------| >>> putStr (hable (colored8Config (Just Green) Nothing defaultConfig) table) <<https://i.imgur.com/3Q2UUWH.png colored>> >>> putStr (hable defaultConfig { charset = colored8Charset (charset defaultConfig), vLineStyle = \m n -> Nothing, hLineStyle = \m n -> fmap (Colored8 (Just (toEnum (fromInteger ((n `mod` 6) + 1)))) Nothing) $ vLineStyle defaultConfig m n} table) <<https://i.imgur.com/gPopQqy.png circly colored>> >>> putStr (hable defaultConfig { hAlign = const HRight, vAlign = const VBottom} table) ╔═══════════╤════════╤═════════════════════════════╤═══════════╗ ║ Hello │ World! │ Nice to meet you! │ :) ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ This cell │ │ │ ║ ║ has two │ │ │ ║ ║ newlines. │ Nice! │ And the next cell is empty: │ ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ Lorem │ Ipsum │ Dolor │ Sit Amet. ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ Foo │ Bar │ Baz │ Qux ║ ╟───────────┼────────┼─────────────────────────────┼───────────╢ ║ Hable │ is │ super │ amazing! ║ ╚═══════════╧════════╧═════════════════════════════╧═══════════╝ >>> putStr (hable defaultConfig { hPadding = 5, hLineStyle = \_ _ -> Nothing, hAlign = const HCenter, vAlign = const VCenter} table) ║ Hello │ World! │ Nice to meet you! │ :) ║ ║ This cell │ │ │ ║ ║ has two │ Nice! │ And the next cell is empty: │ ║ ║ newlines. │ │ │ ║ ║ Lorem │ Ipsum │ Dolor │ Sit Amet. ║ ║ Foo │ Bar │ Baz │ Qux ║ ║ Hable │ is │ super │ amazing! ║ -} -------------------------------------------------------------------------------- module Hable ( hable , Hable.Config.defaultConfig ) where -------------------------------------------------------------------------------- import Hable.BoxChar import Hable.Config import Data.List import Data.Traversable -------------------------------------------------------------------------------- -- | Pretty-prints a row-wise given table using a given Hable Configuration. hable :: Config style -- ^ Hable Configuration -> [[String]] -- ^ Row-wise table to be pretty-printed -> String -- ^ Pretty-printed table hable config rows = concatMap (either -- insert a horizontal line (insertHLine config widths maxHLine maxVLine) -- insert a row (uncurry (insertRow config widths maxHLine maxVLine))) (intersperseIndex rows) where -- total number of (possible) horizontal lines maxHLine = succ (genericLength rows) -- total number of (possible) vertical lines maxVLine = succ (genericLength (head rows)) -- XXX: handle bad input -- list of horizontal widths of actual content of columns widths = map (maximum . (0:) . map (maximum . (0:) . map genericLength . lines)) (transpose rows) -------------------------------------------------------------------------------- -- | Respecting the configuration, either inserts a horizontal line or an empty -- string. insertHLine :: Config style -- Hable Configuration -> [Integer] -- List of widths of each column -> Integer -- Maximal index of horizontal line, i.e. number of rows + 1 -> Integer -- Maximal index of vertical line, i.e. number of rows + 1 -> Integer -- Index of current horizontal line which is being written -> String -- Pretty-printed horizontal line insertHLine config widths maxHLine maxVLine nowHLine = -- decide whether horizontal line is desired in config maybe -- case of no horizontal line "" -- case of horizontal line (\nowHStyle -> concatMap (either -- case of cross, edge or corner (\nowVLine -> -- decide whether vertical line is desired in config maybe -- case of no vertical line "" -- case of vertical line (\nowVStyle -> charset config (Angled (if nowVLine == 1 then HRight else if nowVLine < maxVLine then HCenter else HLeft) nowVStyle (if nowHLine == 1 then VBottom else if nowHLine < maxHLine then VCenter else VTop) nowHStyle )) -- determine desired horizontal style (vLineStyle config maxVLine nowVLine)) -- case of inner horizontal line (\(nowVLine, _) -> concat (genericReplicate -- length of horizontal line (hPadding config * 2 + genericIndex widths (nowVLine-1)) -- horizontal character shape (charset config (Dash nowHStyle))))) (intersperseIndex [1..maxVLine-1]) ++ "\n") -- determine desired horizontal style (hLineStyle config maxHLine nowHLine) -------------------------------------------------------------------------------- -- | Respecting the configuration, inserts the content of a row. insertRow :: Config style -- Hable Configuration -> [Integer] -- List of widths of each colum -> Integer -- Maximal index of horizontal line, i.e. number of rows + 1 -> Integer -- Maximal index of vertical line, i.e. number of rows + 1 -> Integer -- Index of current horizontal line which is being written -> [String] -- Content of current row -> String -- Pretty-printed row insertRow config widths maxHLine maxVLine nowHLine row = unlines ((map concat . transpose) (map (either -- insert vertical line (\nowVLine -> -- decide whether vertical line is desired in config maybe -- case of no vertical line [""] -- case of vertical line (\nowVStyle -> genericReplicate height (charset config (Bar nowVStyle))) -- determine desired vertical style (vLineStyle config maxVLine nowVLine)) -- insert cell content (\(nowVLine, cell) -> let -- calculate number of missing blank lines for vertical -- alignment (top, bottom) = align (vAlign config nowVLine) height (genericLength (lines cell)) -- such a blank line blankLine = genericReplicate -- inner width (2 * hPadding config + genericIndex widths (nowVLine-1)) ' ' in concat -- insert bottom filling area [ genericReplicate top blankLine -- insert content , map (\line -> concat -- insert left padding [ genericReplicate (hPadding config) ' ' , let -- calculate number of missing spaces for -- horizontal alignment (left, right) = align (hAlign config nowHLine) (genericIndex widths (nowVLine-1)) (genericLength line) in concat -- insert missing spaces on the left [ genericReplicate left ' ' -- insert line of content , line -- insert missing spaces on the right , genericReplicate right ' ' ] -- insert right padding , genericReplicate (hPadding config) ' ' ]) (lines cell) -- insert top filling area , genericReplicate bottom blankLine ])) (intersperseIndex row))) where -- height of the contents of this row height = maximum (map (genericLength . lines) row) -------------------------------------------------------------------------------- -- | An example: -- -- >>> intersperseIndex "abc" -- [Left 1,Right (1,'a'),Left 2,Right (2,'b'),Left 3,Right (3,'c'),Left 4] -- -- I.e. it adds the index to each element of the given list using pairs and -- adds the index of an element right before it and notably also at the and of -- the list, if you know what I mean. intersperseIndex :: [b] -> [Either Integer (Integer, b)] intersperseIndex = helper 1 where helper i [] = [Left i] helper i (b:bs) = Left i : Right (i, b) : helper (succ i) bs -------------------------------------------------------------------------------- -- | The first argument has to be either of type 'HAxis' or 'VAxis'. -- -- In case of 'HAxis', calculates the missing spaces on the left and right to -- horizontally align a content with the given aimed width and the actual width. -- -- In case of 'VAxis', calculates the missing blank lines at the top and -- bottom to vertically align a content with the given aimed width and the -- actual width. align :: Enum t => t -> Integer -> Integer -> (Integer, Integer) align a aimedSize actualSize | e == 0 -- top / left = (0, aimedSize-actualSize) | e == 1 -- center = (dv+md, dv) | otherwise -- e == 2 -- bottom / left = (aimedSize-actualSize, 0) where e = fromEnum a (dv, md) = (aimedSize - actualSize) `divMod` 2