lib/mlton/basic/justify.sml

   1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 structure Justify: JUSTIFY =
   9 struct
  10
  11 structure C = Char
  12 structure S = String
  13
  14 datatype t =
  15     Left
  16   | Center
  17   | Right
  18
  19 val toString =
  20    fn Left => "Left"
  21     | Center => "Center"
  22     | Right => "Right"
  23
  24 val layout = Layout.str o toString
  25
  26 fun spaces n = S.make (n, C.space)
  27
  28 fun justify (s, width, just) =
  29     let val numchars = S.size s
  30         val numspaces = width - numchars
  31     in S.concat
  32        (case just of
  33            Left => [s, spaces numspaces]
  34          | Center => let val numLeft = numspaces div 2
  35                          val numRight = numspaces - numLeft
  36                      in [spaces numLeft, s, spaces numRight]
  37                      end
  38          | Right => [spaces numspaces, s])
  39     end
  40
  41 fun table {columnHeads: string list option,
  42            justs: t list,
  43            rows: string list list} =
  44    let
  45       val headsAndRows =
  46          case columnHeads of
  47             NONE => rows
  48           | SOME h => h :: rows
  49       val maxs =
  50          List.fold (headsAndRows,
  51                     List.revMap (justs, fn _ => 0),
  52                     fn (row, ms) =>
  53                     List.map2 (row, ms, fn (s, m) => Int.max (m, String.size s)))
  54       val rows =
  55          List.map (rows, fn row => List.map3 (row, maxs, justs, justify))
  56       val rows =
  57          case columnHeads of
  58             NONE => rows
  59           | SOME heads =>
  60                let
  61                   val heads = List.map2 (heads, maxs, fn (s, i) =>
  62                                          justify (s, i, Center))
  63                   val dashes = List.map (maxs, fn i => String.make (i, #"-"))
  64                in
  65                   heads :: dashes :: rows
  66                end
  67    in
  68       rows
  69    end
  70
  71 val table =
  72    Trace.trace ("Justify.table",
  73                 fn {columnHeads, justs, rows} =>
  74                 Layout.record [("columnHeads",
  75                                 Option.layout (List.layout String.layout)
  76                                 columnHeads),
  77                                ("justs", List.layout layout justs),
  78                                ("rows",
  79                                 List.layout (List.layout String.layout) rows)],
  80                 List.layout (List.layout String.layout))
  81    table
  82
  83 fun tableOfColumns (columns: (t * string list) list) =
  84    let
  85       val justs = List.map (columns, #1)
  86       val columns = List.map (columns, #2)
  87       fun loop (columns: string list list, ac: string list list) =
  88          if List.isEmpty (hd columns)
  89             then rev ac
  90          else loop (List.map (columns, tl), List.map (columns, hd) :: ac)
  91       val rows = loop (columns, [])
  92    in
  93       table {columnHeads = NONE,
  94              justs = justs,
  95              rows = rows}
  96    end
  97
  98 fun outputTable (t, out) =
  99    let
 100       val print = Out.outputc out
 101    in
 102       List.foreach (t, fn ss =>
 103                     (case ss of
 104                         [] => ()
 105                       | s :: ss =>
 106                            (print s
 107                             ; List.foreach (ss, fn s => (print " "; print s)))
 108                            ; print "\n"))
 109    end
 110
 111 end