7 people like it.

A Generic Pretty-Printer for Record types

The following is an implementation of a general-purpose pretty printer for tables. Its generality is achieved by passing an upcast rule to an untyped record type as argument.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77: 
78: 
79: 
80: 
81: 
82: 
83: 
84: 
85: 
86: 

// given a list of records as input, 
// generates text of the form:
// +--------+--------+--------+
// | Label1 | Label2 | Label3 |
// +--------+--------+--------+
// | Value1 | Value2 | Value3 |
// +--------+--------+--------+
// | Value1'| Value2'| Value3'|
// +--------+--------+--------+


open System
open System.Text

type UntypedRecord = (string * obj) list // label * value list

let prettyPrintTable (f : 'Record -> UntypedRecord) (template : 'Record) (table : 'Record list) =
// the template argument acts as a means to extract all labels, even if the table is empty. Any non-null value should do
    let labels = f template |> List.map fst
    let header = labels |> List.map (fun h -> h, h :> obj)
    let untypedTable = List.map f table

    let rec traverseEntryLengths (map : Map<string,int>) (line : UntypedRecord) =
        match line with
        | [] -> map
        | (label, value) :: rest ->
            let currentLength = defaultArg (map.TryFind label) 0
            let map' = map.Add (label, max currentLength <| value.ToString().Length + 2)
            traverseEntryLengths map' rest

    let lengthMap = List.fold traverseEntryLengths Map.empty (header :: untypedTable)

    let printRecord (record : UntypedRecord) =
        let printEntry (label,value) = //   value   |
            let field = value.ToString()
            let whites = lengthMap.[label] - field.Length
            let gapL = 1
            let gapR = whites - gapL
            String(' ',gapL) + field + String(' ',gapR) + "|"

        List.fold (fun str entry -> str + printEntry entry) "|" record

    let separator = 
        let printColSep label = // ---------+
            String('-', lengthMap.[label]) + "+"

        List.fold (fun str label -> str + printColSep label) "+" labels 

    let builder = new StringBuilder()
    let append txt = builder.AppendLine txt |> ignore

    do
        append separator
        append <| printRecord header
        append separator

        for record in untypedTable do
            append <| printRecord record
            append separator

    builder.ToString()

//
// Example
//

[<Measure>]
type cm

type Person = { Name : string ; Age : int ; Height : int<cm> }

let f (p : Person) = [ ("Name", p.Name :> obj) ; ("Age", p.Age :> obj) ; ("Height (cm)", p.Height :> obj) ]

let print = prettyPrintTable f { Name = "" ; Age = 0 ; Height = 0<cm> }

let people =
    [
        { Name = "Nick" ; Age = 32 ; Height = 175<cm> }
        { Name = "Eirik" ; Age = 27; Height = 175<cm> }
        { Name = "George" ; Age = 35 ; Height = 200<cm> }
    ]

people
|> List.sortBy (fun p -> - p.Age)
|> print
|> printf "%s"
namespace System
namespace System.Text
type UntypedRecord = (string * obj) list

Full name: Script.UntypedRecord
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
type obj = Object

Full name: Microsoft.FSharp.Core.obj
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val prettyPrintTable : f:('Record -> UntypedRecord) -> template:'Record -> table:'Record list -> string

Full name: Script.prettyPrintTable
val f : ('Record -> UntypedRecord)
val template : 'Record
val table : 'Record list
val labels : string list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val header : (string * obj) list
val h : string
val untypedTable : UntypedRecord list
val traverseEntryLengths : (Map<string,int> -> UntypedRecord -> Map<string,int>)
val map : Map<string,int>
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
val line : UntypedRecord
val label : string
val value : obj
val rest : (string * obj) list
val currentLength : int
val defaultArg : arg:'T option -> defaultValue:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.defaultArg
member Map.TryFind : key:'Key -> 'Value option
val map' : Map<string,int>
member Map.Add : key:'Key * value:'Value -> Map<'Key,'Value>
val max : e1:'T -> e2:'T -> 'T (requires comparison)

Full name: Microsoft.FSharp.Core.Operators.max
Object.ToString() : string
val lengthMap : Map<string,int>
val fold : folder:('State -> 'T -> 'State) -> state:'State -> list:'T list -> 'State

Full name: Microsoft.FSharp.Collections.List.fold
val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty
val printRecord : (UntypedRecord -> string)
val record : UntypedRecord
val printEntry : (string * 'a -> String)
val value : 'a
val field : string
val whites : int
property String.Length: int
val gapL : int
val gapR : int
Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
String(value: nativeptr<char>) : unit
String(value: nativeptr<sbyte>) : unit
String(value: char []) : unit
String(c: char, count: int) : unit
String(value: nativeptr<char>, startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
String(value: char [], startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Encoding) : unit
val str : string
val entry : string * obj
val separator : string
val printColSep : (string -> String)
val builder : StringBuilder
Multiple items
type StringBuilder =
  new : unit -> StringBuilder + 5 overloads
  member Append : value:string -> StringBuilder + 18 overloads
  member AppendFormat : format:string * arg0:obj -> StringBuilder + 4 overloads
  member AppendLine : unit -> StringBuilder + 1 overload
  member Capacity : int with get, set
  member Chars : int -> char with get, set
  member Clear : unit -> StringBuilder
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EnsureCapacity : capacity:int -> int
  member Equals : sb:StringBuilder -> bool
  ...

Full name: System.Text.StringBuilder

--------------------
StringBuilder() : unit
StringBuilder(capacity: int) : unit
StringBuilder(value: string) : unit
StringBuilder(value: string, capacity: int) : unit
StringBuilder(capacity: int, maxCapacity: int) : unit
StringBuilder(value: string, startIndex: int, length: int, capacity: int) : unit
val append : (string -> unit)
val txt : string
StringBuilder.AppendLine() : StringBuilder
StringBuilder.AppendLine(value: string) : StringBuilder
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
StringBuilder.ToString() : string
StringBuilder.ToString(startIndex: int, length: int) : string
Multiple items
type MeasureAttribute =
  inherit Attribute
  new : unit -> MeasureAttribute

Full name: Microsoft.FSharp.Core.MeasureAttribute

--------------------
new : unit -> MeasureAttribute
[<Measure>]
type cm

Full name: Script.cm
type Person =
  {Name: string;
   Age: int;
   Height: int<cm>;}

Full name: Script.Person
Person.Name: string
Person.Age: int
Person.Height: int<cm>
val f : p:Person -> (string * obj) list

Full name: Script.f
val p : Person
val print : (Person list -> string)

Full name: Script.print
val people : Person list

Full name: Script.people
val sortBy : projection:('T -> 'Key) -> list:'T list -> 'T list (requires comparison)

Full name: Microsoft.FSharp.Collections.List.sortBy
val printf : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printf

More information

Link:http://fssnip.net/cV
Posted:12 years ago
Author:Eirik Tsarpalis
Tags: prettyprinter , record types

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.