ocaml-stringpainter / src / Prioritized.ml

(*********************************************************************************************************************
 * Copyrights (C) by
 *  Pawel Wieczorek <wieczyk gmail>
 *
 * http://bitbucket.org/wieczyk/ocaml-stringpainter
 ********************************************************************************************************************)

type priority = int

type painter = priority * Basic.painter


type associativity
    = LeftAssociative
    | RightAssociative
    | NoAssociative


module Embedding = struct

    let with_priority p sp = (p, sp)

    let embed_sp1 prio sp x1 =
        with_priority prio (sp x1)

    let unhask_sp0 f (_, sp) = f sp

    let embed_sp2 prio sp x1 x2 =
        with_priority prio (sp x1 x2)

    let embed_sp3 prio sp x1 x2 x3 =
        with_priority prio (sp x1 x2 x3)

end

open Embedding


let with_priority = Embedding.with_priority

let get_priority p = fst p

let get_painter  p = snd p

let psp_nested prio (xs : painter list) : painter = (prio, Basic.sp_nested (List.map get_painter xs))

let psp_indent prio xs = (prio, Basic.sp_indent (List.map get_painter xs))

let psp_reprioritize n (_, sp) = (n, sp)

let psp_max_priority = pred max_int / 2

let is_multiline    = unhask_sp0 Basic.is_multiline

let any_multiline   = List.exists is_multiline

(*--------------------------------------------------------------------------------------------------------------------
 * Basic combinators
 *)

let psp_break           = with_priority psp_max_priority Basic.sp_break
let psp_newline         = with_priority psp_max_priority Basic.sp_newline

let psp_word            = embed_sp1 psp_max_priority Basic.sp_word
let psp_keyword         = embed_sp1 psp_max_priority Basic.sp_keyword
let psp_value           = embed_sp1 psp_max_priority Basic.sp_value
let psp_value_keyword   = embed_sp1 psp_max_priority Basic.sp_value_keyword
let psp_operator        = embed_sp1 psp_max_priority Basic.sp_operator
let psp_syntax          = embed_sp1 psp_max_priority Basic.sp_syntax
let psp_label           = embed_sp1 psp_max_priority Basic.sp_label
let psp_special         = embed_sp1 psp_max_priority Basic.sp_special

let psp_value_int       = embed_sp1 psp_max_priority Basic.sp_value_int
let psp_value_bool      = embed_sp1 psp_max_priority Basic.sp_value_bool


(*--------------------------------------------------------------------------------------------------------------------
 * 
 *)

let psp_bracket psp_opening psp_closing n psp_elem = psp_nested n
    [ psp_opening
    ; psp_elem
    ; psp_closing
    ]

let psp_std_bracket    = psp_bracket (psp_syntax "(") (psp_syntax ")") psp_max_priority
let psp_square_bracket = psp_bracket (psp_syntax "[") (psp_syntax "]") psp_max_priority
let psp_no_bracket     = psp_reprioritize 0

let psp_decide_bracket brackets = function
    | true ->
        brackets

    | false ->
        psp_no_bracket

let psp_decide_std_bracket = psp_decide_bracket psp_std_bracket

(*--------------------------------------------------------------------------------------------------------------------
 * 
 *)

let psp_associative_infix f_left f_right prio oper left right =
    let prio_left  = get_priority left in
    let prio_right = get_priority right in 
    psp_nested prio
        [ psp_decide_std_bracket (f_left prio_left prio) left
        ; oper
        ; psp_decide_std_bracket (f_right prio prio_right) right
        ]

let psp_left_associative_infix = psp_associative_infix
    (fun prio_left  prio -> prio_left  < prio)
    (fun prio prio_right -> prio_right < succ prio)

let psp_right_associative_infix = psp_associative_infix
    (fun prio_left  prio -> prio_left  < succ prio)
    (fun prio prio_right -> prio_right < prio)

let psp_no_associative_infix = psp_associative_infix
    (fun prio_left  prio -> prio_left  < succ prio)
    (fun prio prio_right -> prio_right < succ prio)


let psp_infix = function
    | LeftAssociative  -> psp_left_associative_infix 
    | RightAssociative -> psp_right_associative_infix 
    | NoAssociative    -> psp_no_associative_infix 

(*--------------------------------------------------------------------------------------------------------------------
 * Output
 *)

let print_painter_nl psp = Basic.print_painter_nl (get_painter psp)
let print_painter psp = Basic.print_painter (get_painter psp)
let render_painter psp = Basic.render_painter (get_painter psp)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.