Rewrite text table generation

src/UToy/Table.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+
+module UToy.Table (Cell, cl, cr, render) where
+
+import Data.Text (Text)
+
+import qualified Data.Text as Text
+
+data Cell = C Align Text
+
+data Align = AlignLeft | AlignRight
+
+cl :: Text -> Cell
+cl = C AlignLeft
+
+cr :: Text -> Cell
+cr = C AlignRight
+
+render :: Text -> [[Cell]] -> Text
+render delim cells = Text.intercalate "\n" $ map showRow cells
+  where
+    showRow = Text.intercalate delim . map showCell . zipLongest columnWidths
+
+    showCell (L width) = Text.replicate width " "
+    showCell (R _) = error "unreachable"
+    showCell (B width (C align x)) = justify x
+      where 
+        justify = case align of
+          AlignLeft -> Text.justifyLeft width ' '
+          AlignRight -> Text.justifyRight width ' '
+
+    columnWidths = foldl go' [] cells
+
+    go' counts row = map (zipped id cellLength max) $ zipLongest counts row
+
+    cellLength (C _ x) = Text.length x
+
+data Zipped a b
+  = L a
+  | R b
+  | B a b
+
+zipped
+  :: (a -> t)
+  -> (b -> t)
+  -> (t -> t -> t)
+  -> Zipped a b
+  -> t
+zipped fl _ _ (L x) = fl x
+zipped _ fr _ (R x) = fr x
+zipped fl fr fb (B x y) = fb (fl x) (fr y)
+
+zipLongest :: [a] -> [b] -> [Zipped a b]
+zipLongest [] ys = map R ys
+zipLongest xs [] = map L xs
+zipLongest (x:xs) (y:ys) = B x y : zipLongest xs ys