Commits

Paweł Wieczorek committed 90901ca

formatter uses StringPainter library instead of own renderer

Comments (0)

Files changed (2)

-<**/*>: package(batteries), thread
+<**/*>: package(batteries), package(stringpainter), thread

src/Language/Common/Formatter.ml

     | Keyword of string
     | IndentBreak of document list
     | Nested of document list
-    | NestedP of document * document * document list
     | Suffix of string
     | NestedIndent of document list
     | SyntaxSuffix of string
     | Newline
 
 (*************************************************************************************************
- * Color scheme
+ * The New Engine
  ************************************************************************************************)
+open StringPainter.Prioritized
 
-let cs_keyword      = Tty.blue -| Tty.emph
-let cs_operator     = Tty.yellow -| Tty.emph
-let cs_identifier   = Tty.green
-let cs_value        = Tty.cyan
-let cs_svalue       = Tty.emph -| cs_value
-let cs_syntax       = Tty.black -| Tty.emph
-let cs_special      = Tty.magenta
+module SP_Engine = struct
 
-(*************************************************************************************************
- * The Engine
- ************************************************************************************************)
+    let rec process = function
+        | Break  ->
+            psp_break
 
+        | Newline ->
+            psp_newline
 
-let rec indent = function
-    | 0 ->
-        ""
-    | n ->
-        indent (pred n) ^ "    "
+        | ChangeSep sep'  ->
+            psp_nested psp_max_priority []
 
+        | Word str ->
+            psp_word str
 
-let rec build_lines cont sep indentation buffer result = function
-    | Break :: rest ->
-        let line    = (indentation, buffer) in
-        let result' = if buffer = "" then result else line :: result in
-        let sep'    = "" in
-        build_lines cont sep' indentation "" result' rest
+        | Syntax str ->
+            psp_syntax str
 
-    | Newline :: rest ->
-        let line    = (indentation, buffer) in
-        let result' = line :: result in
-        let sep'    = "" in
-        build_lines cont sep' indentation "" result' rest
+        | SyntaxSuffix str ->
+            psp_syntax str
 
-    | [] ->
-        let line    = (indentation, buffer ) in
-        let result' = if buffer = "" then result else line :: result in
-        cont result'
+        | SyntaxPrefix str ->
+            psp_syntax str
 
-    | ChangeSep sep' :: rest ->
-        build_lines cont sep' indentation buffer result rest
+        | Var variable ->
+            psp_word (string_of_variable variable)
 
-    | Word str :: rest ->
-        let sep'    = " " in
-        update_buffer cont sep' indentation buffer result sep str rest
+        | Id identifier ->
+            psp_word (string_of_identifier identifier)
 
-    | Syntax str :: rest ->
-        let sep'    = " " in
-        let str'    = cs_syntax str in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | Suffix str ->
+            psp_syntax str
 
-    | SyntaxSuffix str :: rest ->
-        let str'    = cs_syntax str in
-        update_buffer cont sep indentation buffer result "" str' rest
+        | Oper str ->
+            psp_operator str
 
-    | SyntaxPrefix str :: rest ->
-        let str'    = cs_syntax str in
-        update_buffer cont "" indentation buffer result sep str' rest
+        | ABOper oper ->
+            psp_operator (string_of_arithmetic_binary_operator oper)      
 
-    | Var variable :: rest ->
-        let sep'    = " " in
-        let str     = string_of_variable variable in
-        update_buffer cont sep' indentation buffer result sep str rest
+        | BBOper oper ->
+            psp_operator (string_of_boolean_binary_operator oper)
 
-    | Id identifier :: rest ->
-        let sep'    = " " in
-        let str     = (cs_identifier -| string_of_identifier) identifier in
-        update_buffer cont sep' indentation buffer result sep str rest
+        | BUOper oper ->
+            psp_operator (string_of_boolean_unary_operator oper)
 
-    | Suffix str :: rest ->
-        update_buffer cont sep indentation buffer result "" str rest
+        | BABOper oper ->
+            psp_operator (string_of_boolean_arithmetic_binary_operator oper)
 
-    | Oper str :: rest ->
-        let sep'    = " " in
-        let str'    = cs_operator str in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | AUOper oper ->
+            psp_operator (string_of_arithmetic_unary_operator oper)
 
-    | ABOper oper :: rest ->
-        let sep'    = " " in
-        let str'    = (cs_operator -| string_of_arithmetic_binary_operator) oper in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | SQWord str ->
+            psp_word str
 
-    | BBOper oper :: rest ->
-        let sep'    = " " in
-        let str'    = (cs_operator -| string_of_boolean_binary_operator) oper in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | DQWord str ->
+            psp_word str
 
-    | BUOper oper :: rest ->
-        let sep'    = " " in
-        let str'    = (cs_operator -| string_of_boolean_unary_operator) oper in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | Keyword str ->
+            psp_keyword str
 
-    | BABOper oper :: rest ->
-        let sep'    = " " in
-        let str'    = (cs_operator -| string_of_boolean_arithmetic_binary_operator) oper in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | Int i ->
+            psp_value_int i
 
-    | AUOper oper :: rest ->
-        let sep'    = " " in
-        let str'    = (cs_operator -| string_of_arithmetic_unary_operator) oper in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | Bool b ->
+            psp_value_bool b
 
-    | SQWord str :: rest ->
-        let sep'    = " " in
-        let str'    = "\'" ^ str ^ "\'" in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | Value b ->
+            psp_value b
 
-    | DQWord str :: rest ->
-        let sep'    = " " in
-        let str'    = "\"" ^ str ^ "\"" in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | SpecialValue b ->
+            psp_value_keyword b
 
-    | Keyword str :: rest ->
-        let sep'    = " " in
-        let str'    = cs_keyword str in
-        update_buffer cont sep' indentation buffer result sep str' rest
+        | Special b ->
+            psp_word b
 
-    | Int i :: rest ->
-        let sep'    = " " in
-        let str     = (cs_value -| string_of_int) i in
-        update_buffer cont sep' indentation buffer result sep str rest
+        | Lb l ->
+            psp_word (string_of_label l)
 
-    | Bool b :: rest ->
-        let sep'    = " " in
-        let str     = (cs_value -| string_of_bool) b in
-        update_buffer cont sep' indentation buffer result sep str rest
+        | Nested nested ->
+            psp_nested psp_max_priority (List.map process nested)
 
-    | Value b :: rest ->
-        let sep'    = " " in
-        let str     = cs_value b in
-        update_buffer cont sep' indentation buffer result sep str rest
+        | NestedIndent nested ->
+            psp_nested psp_max_priority (List.map process nested)
 
-    | SpecialValue b :: rest ->
-        let sep'    = " " in
-        let str     = cs_svalue b in
-        update_buffer cont sep' indentation buffer result sep str rest
+        | IndentBreak nested ->
+            psp_indent psp_max_priority (List.map process nested)
 
-    | Special b :: rest ->
-        let sep'    = " " in
-        let str     = cs_special b in
-        update_buffer cont sep' indentation buffer result sep str rest
-
-    | Lb l :: rest ->
-        let sep'    = " " in
-        let str     = cs_special (string_of_label l) in
-        update_buffer cont sep' indentation buffer result sep str rest
-
-    | Nested nested :: rest ->
-        build_lines cont sep indentation buffer result (nested @ rest)
-
-    (* TODO, if ,,nested'' is multiline then behave like IndentBreak *)
-    | NestedIndent nested :: rest ->
-        build_lines cont sep indentation buffer result (nested @ rest)
-
-    | NestedP (at_start, at_end, nested) :: rest ->
-        let nested' = at_start :: (nested @ [at_end]) in
-        build_lines cont sep indentation buffer result (nested' @ rest)
-
-    | IndentBreak elems :: rest ->
-        let line         = (indentation, buffer) in
-        let result'      = if buffer = "" then result else (line :: result) in 
-        let sep'         = "" in
-        let buffer'      = "" in
-        let indentation' = succ indentation in
-        let cont' out    = build_lines cont sep' indentation buffer' out rest in 
-        build_lines cont' sep' indentation' buffer' result' elems
-
-and update_buffer cont sep' indentation buffer result sep str rest =
-        let buffer' = buffer ^ sep ^ str in
-        build_lines cont sep' indentation buffer' result rest
-
-let build_string = 
-    let mk_indent (indentation, line) = indent indentation ^ line in
-    Util.concat_lines -| List.map mk_indent -| build_lines (List.rev) "" 0 "" [] 
+end
 
 
 (*************************************************************************************************
  * Helpers
  ************************************************************************************************)
 
+let build_string = render_painter -| psp_nested 0 -| List.map SP_Engine.process
+
 let print_document = print_endline -| build_string
 
 let show_option cont = function