1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE MultiParamTypeClasses #-}
3 {-# LANGUAGE NamedFieldPuns #-}
4 module Hcompta.CLI.Lib.Leijen.Table where
6 import qualified Data.List
7 import Data.Maybe (fromMaybe)
8 import qualified Data.Text.Lazy as TL
9 import Data.Text (Text)
10 import qualified Data.Text as Text
12 import qualified Hcompta.Lib.Leijen as W
13 import Hcompta.Lib.Leijen ((<>), toDoc, ToDoc(..))
19 -- * The 'Column' type
23 { column_title :: Text
25 , column_align :: Align
26 , column_rows :: [Cell]
28 instance ToDoc m [Column] where
30 let rows = Data.List.transpose $ map column_rows cols
31 let has_title = any (not . Text.null . column_title) cols
33 W.intercalate (W.bold $ W.dullblack $ W.char '|')
34 (\col@Column{column_title} -> do
35 let cell_width = Text.length column_title
36 let under = W.bold $ W.dullblack $ W.char '_'
37 let cell_content = W.enclose under under $
39 (\c -> case c of { ' ' -> under; _ -> W.char c })
40 (Text.unpack column_title)
41 let pad len = W.bold $ W.dullblack $
42 W.text $ TL.pack $ replicate len '_'
44 Cell{cell_width, cell_content, cell_align=Just Align_Center}
47 (if has_title then (:) titles else id) $
49 ( W.intercalate (W.space <> do W.bold $ W.dullblack $ W.char '|') id
54 (if null cols then W.empty else W.line)
55 column :: Text -> Align -> [Cell] -> Column
56 column column_title column_align column_rows =
59 , column_width = max (Text.length column_title) $
60 foldr (max . cell_width) 0 column_rows
65 -- ** The 'Align' type
71 align :: Maybe (Int -> W.Doc) -> Column -> Cell -> W.Doc
73 Column{column_width, column_align}
74 Cell{cell_width, cell_content, cell_align} =
75 let pad = column_width - cell_width in
78 Nothing -> \l -> W.fill l W.empty
80 case fromMaybe column_align cell_align of
81 Align_Left -> cell_content <> fill pad
83 let half = fromInteger $ quot (toInteger pad) 2 in
84 fill half <> cell_content <> fill (pad - half)
85 Align_Right -> fill pad <> cell_content
88 (Cell_Line {cell_pad}) =
89 W.bold $ W.dullblack $ W.text $
90 TL.replicate (fromIntegral column_width) $
97 { cell_align :: Maybe Align
99 , cell_content :: W.Doc
109 , cell_content = W.empty
110 , cell_align = Nothing
112 instance ToDoc Column Cell where
113 toDoc = align Nothing