421 lines
17 KiB
Plaintext
421 lines
17 KiB
Plaintext
|
(*
|
||
|
|
Module: Build
|
||
|
|
Generic functions to build lenses
|
||
|
|
|
||
|
|
Author: Raphael Pinson <raphink@gmail.com>
|
||
|
|
|
||
|
|
About: License
|
||
|
|
This file is licensed under the LGPL v2+, like the rest of Augeas.
|
||
|
|
|
||
|
|
About: Reference
|
||
|
|
This file provides generic functions to build Augeas lenses
|
||
|
|
*)
|
||
|
|
|
||
|
|
|
||
|
|
module Build =
|
||
|
|
|
||
|
|
let eol = Util.eol
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: GENERIC CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: brackets
|
||
|
|
* Put a lens inside brackets
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* l:lens - the left bracket lens
|
||
|
|
* r: lens - the right bracket lens
|
||
|
|
* lns:lens - the lens to put inside brackets
|
||
|
|
************************************************************************)
|
||
|
|
let brackets (l:lens) (r:lens) (lns:lens) = l . lns . r
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: LIST CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: list
|
||
|
|
* Build a list of identical lenses separated with a given separator
|
||
|
|
* (at least 2 elements)
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* lns:lens - the lens to repeat in the list
|
||
|
|
* sep:lens - the separator lens, which can be taken from the <Sep> module
|
||
|
|
************************************************************************)
|
||
|
|
let list (lns:lens) (sep:lens) = lns . ( sep . lns )+
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: opt_list
|
||
|
|
* Same as <list>, but there might be only one element in the list
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* lns:lens - the lens to repeat in the list
|
||
|
|
* sep:lens - the separator lens, which can be taken from the <Sep> module
|
||
|
|
************************************************************************)
|
||
|
|
let opt_list (lns:lens) (sep:lens) = lns . ( sep . lns )*
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: LABEL OPERATIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: xchg
|
||
|
|
* Replace a pattern with a different label in the tree,
|
||
|
|
* thus emulating a key but allowing to replace the keyword
|
||
|
|
* with a different value than matched
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* m:regexp - the pattern to match
|
||
|
|
* d:string - the default value when a node in created
|
||
|
|
* l:string - the label to apply for such nodes
|
||
|
|
************************************************************************)
|
||
|
|
let xchg (m:regexp) (d:string) (l:string) = del m d . label l
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: xchgs
|
||
|
|
* Same as <xchg>, but the pattern is the default string
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* m:string - the string to replace, also used as default
|
||
|
|
* l:string - the label to apply for such nodes
|
||
|
|
************************************************************************)
|
||
|
|
let xchgs (m:string) (l:string) = xchg m m l
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: SUBNODE CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: key_value_line
|
||
|
|
* A subnode with a keyword, a separator and a storing lens,
|
||
|
|
* and an end of line
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* kw:regexp - the pattern to match as key
|
||
|
|
* sep:lens - the separator lens, which can be taken from the <Sep> module
|
||
|
|
* sto:lens - the storing lens
|
||
|
|
************************************************************************)
|
||
|
|
let key_value_line (kw:regexp) (sep:lens) (sto:lens) =
|
||
|
|
[ key kw . sep . sto . eol ]
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: key_value_line_comment
|
||
|
|
* Same as <key_value_line>, but allows to have a comment in the end of a line
|
||
|
|
* and an end of line
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* kw:regexp - the pattern to match as key
|
||
|
|
* sep:lens - the separator lens, which can be taken from the <Sep> module
|
||
|
|
* sto:lens - the storing lens
|
||
|
|
* comment:lens - the comment lens, which can be taken from <Util>
|
||
|
|
************************************************************************)
|
||
|
|
let key_value_line_comment (kw:regexp) (sep:lens) (sto:lens) (comment:lens) =
|
||
|
|
[ key kw . sep . sto . (eol|comment) ]
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: key_value
|
||
|
|
* Same as <key_value_line>, but does not end with an end of line
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* kw:regexp - the pattern to match as key
|
||
|
|
* sep:lens - the separator lens, which can be taken from the <Sep> module
|
||
|
|
* sto:lens - the storing lens
|
||
|
|
************************************************************************)
|
||
|
|
let key_value (kw: regexp) (sep:lens) (sto:lens) =
|
||
|
|
[ key kw . sep . sto ]
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: key_ws_value
|
||
|
|
*
|
||
|
|
* Store a key/value pair where key and value are separated by whitespace
|
||
|
|
* and the value goes to the end of the line. Leading and trailing
|
||
|
|
* whitespace is stripped from the value. The end of line is consumed by
|
||
|
|
* this lens
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* kw:regexp - the pattern to match as key
|
||
|
|
************************************************************************)
|
||
|
|
let key_ws_value (kw:regexp) =
|
||
|
|
key_value_line kw Util.del_ws_spc (store Rx.space_in)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: flag
|
||
|
|
* A simple flag subnode, consisting of a single key
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* kw:regexp - the pattern to match as key
|
||
|
|
************************************************************************)
|
||
|
|
let flag (kw:regexp) = [ key kw ]
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: flag_line
|
||
|
|
* A simple flag line, consisting of a single key
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* kw:regexp - the pattern to match as key
|
||
|
|
************************************************************************)
|
||
|
|
let flag_line (kw:regexp) = [ key kw . eol ]
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: BLOCK CONSTRUCTIONS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: block_generic
|
||
|
|
* A block enclosed in brackets
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* entry:lens - the entry to be stored inside the block.
|
||
|
|
* This entry should include <Util.empty>
|
||
|
|
* or its equivalent if necessary.
|
||
|
|
* entry_noindent:lens - the entry to be stored inside the block,
|
||
|
|
* without indentation.
|
||
|
|
* This entry should not include <Util.empty>
|
||
|
|
* entry_noeol:lens - the entry to be stored inside the block,
|
||
|
|
* without eol.
|
||
|
|
* This entry should not include <Util.empty>
|
||
|
|
* entry_noindent_noeol:lens - the entry to be stored inside the block,
|
||
|
|
* without indentation or eol.
|
||
|
|
* This entry should not include <Util.empty>
|
||
|
|
* comment:lens - the comment lens used in the block
|
||
|
|
* comment_noindent:lens - the comment lens used in the block,
|
||
|
|
* without indentation.
|
||
|
|
* ldelim_re:regexp - regexp for the left delimiter
|
||
|
|
* rdelim_re:regexp - regexp for the right delimiter
|
||
|
|
* ldelim_default:string - default value for the left delimiter
|
||
|
|
* rdelim_default:string - default value for the right delimiter
|
||
|
|
************************************************************************)
|
||
|
|
let block_generic
|
||
|
|
(entry:lens) (entry_noindent:lens)
|
||
|
|
(entry_noeol:lens) (entry_noindent_noeol:lens)
|
||
|
|
(comment:lens) (comment_noindent:lens)
|
||
|
|
(ldelim_re:regexp) (rdelim_re:regexp)
|
||
|
|
(ldelim_default:string) (rdelim_default:string) =
|
||
|
|
let block_single = entry_noindent_noeol | comment_noindent
|
||
|
|
in let block_start = entry_noindent | comment_noindent
|
||
|
|
in let block_middle = (entry | comment)*
|
||
|
|
in let block_end = entry_noeol | comment
|
||
|
|
in del ldelim_re ldelim_default
|
||
|
|
. ( ( block_start . block_middle . block_end )
|
||
|
|
| block_single )
|
||
|
|
. del rdelim_re rdelim_default
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: block_setdefault
|
||
|
|
* A block enclosed in brackets
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* entry:lens - the entry to be stored inside the block.
|
||
|
|
* This entry should not include <Util.empty>,
|
||
|
|
* <Util.comment> or <Util.comment_noindent>,
|
||
|
|
* should not be indented or finish with an eol.
|
||
|
|
* ldelim_re:regexp - regexp for the left delimiter
|
||
|
|
* rdelim_re:regexp - regexp for the left delimiter
|
||
|
|
* ldelim_default:string - default value for the left delimiter
|
||
|
|
* rdelim_default:string - default value for the right delimiter
|
||
|
|
************************************************************************)
|
||
|
|
let block_setdelim (entry:lens)
|
||
|
|
(ldelim_re:regexp)
|
||
|
|
(rdelim_re:regexp)
|
||
|
|
(ldelim_default:string)
|
||
|
|
(rdelim_default:string) =
|
||
|
|
block_generic (Util.empty | Util.indent . entry . eol)
|
||
|
|
(entry . eol) (Util.indent . entry) entry
|
||
|
|
Util.comment Util.comment_noindent
|
||
|
|
ldelim_re rdelim_re
|
||
|
|
ldelim_default rdelim_default
|
||
|
|
|
||
|
|
(* Variable: block_ldelim_re *)
|
||
|
|
let block_ldelim_re = /[ \t\n]+\{[ \t\n]*/
|
||
|
|
|
||
|
|
(* Variable: block_rdelim_re *)
|
||
|
|
let block_rdelim_re = /[ \t\n]*\}/
|
||
|
|
|
||
|
|
(* Variable: block_ldelim_default *)
|
||
|
|
let block_ldelim_default = " {\n"
|
||
|
|
|
||
|
|
(* Variable: block_rdelim_default *)
|
||
|
|
let block_rdelim_default = "}"
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: block
|
||
|
|
* A block enclosed in brackets
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* entry:lens - the entry to be stored inside the block.
|
||
|
|
* This entry should not include <Util.empty>,
|
||
|
|
* <Util.comment> or <Util.comment_noindent>,
|
||
|
|
* should not be indented or finish with an eol.
|
||
|
|
************************************************************************)
|
||
|
|
let block (entry:lens) = block_setdelim entry
|
||
|
|
block_ldelim_re block_rdelim_re
|
||
|
|
block_ldelim_default block_rdelim_default
|
||
|
|
|
||
|
|
(* Variable: block_ldelim_newlines_re *)
|
||
|
|
let block_ldelim_newlines_re = /[ \t\n]*\{([ \t\n]*\n)?/
|
||
|
|
|
||
|
|
(* Variable: block_rdelim_newlines_re *)
|
||
|
|
let block_rdelim_newlines_re = /[ \t]*\}/
|
||
|
|
|
||
|
|
(* Variable: block_ldelim_newlines_default *)
|
||
|
|
let block_ldelim_newlines_default = "\n{\n"
|
||
|
|
|
||
|
|
(* Variable: block_rdelim_newlines_default *)
|
||
|
|
let block_rdelim_newlines_default = "}"
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: block_newline
|
||
|
|
* A block enclosed in brackets, with newlines forced
|
||
|
|
* and indentation defaulting to a tab.
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* entry:lens - the entry to be stored inside the block.
|
||
|
|
* This entry should not include <Util.empty>,
|
||
|
|
* <Util.comment> or <Util.comment_noindent>,
|
||
|
|
* should be indented and finish with an eol.
|
||
|
|
************************************************************************)
|
||
|
|
let block_newlines (entry:lens) (comment:lens) =
|
||
|
|
del block_ldelim_newlines_re block_ldelim_newlines_default
|
||
|
|
. ((entry | comment) . (Util.empty | entry | comment)*)?
|
||
|
|
. del block_rdelim_newlines_re block_rdelim_newlines_default
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: block_newlines_spc
|
||
|
|
* A block enclosed in brackets, with newlines forced
|
||
|
|
* and indentation defaulting to a tab. The opening brace
|
||
|
|
* must be preceded by whitespace
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* entry:lens - the entry to be stored inside the block.
|
||
|
|
* This entry should not include <Util.empty>,
|
||
|
|
* <Util.comment> or <Util.comment_noindent>,
|
||
|
|
* should be indented and finish with an eol.
|
||
|
|
************************************************************************)
|
||
|
|
let block_newlines_spc (entry:lens) (comment:lens) =
|
||
|
|
del (/[ \t\n]/ . block_ldelim_newlines_re) block_ldelim_newlines_default
|
||
|
|
. ((entry | comment) . (Util.empty | entry | comment)*)?
|
||
|
|
. del block_rdelim_newlines_re block_rdelim_newlines_default
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: named_block
|
||
|
|
* A named <block> enclosed in brackets
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* kw:regexp - the regexp for the block name
|
||
|
|
* entry:lens - the entry to be stored inside the block
|
||
|
|
* this entry should not include <Util.empty>
|
||
|
|
************************************************************************)
|
||
|
|
let named_block (kw:regexp) (entry:lens) = [ key kw . block entry . eol ]
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* Group: COMBINATORICS
|
||
|
|
************************************************************************)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_two_ord
|
||
|
|
* Combine two lenses, ensuring first lens is first
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_two_ord (a:lens) (b:lens) = a . b
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_two
|
||
|
|
* Combine two lenses
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_two (a:lens) (b:lens) =
|
||
|
|
combine_two_ord a b | combine_two_ord b a
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_two_opt_ord
|
||
|
|
* Combine two lenses optionally, ensuring first lens is first
|
||
|
|
* (a, and optionally b)
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_two_opt_ord (a:lens) (b:lens) = a . b?
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_two_opt
|
||
|
|
* Combine two lenses optionally
|
||
|
|
* (either a, b, or both, in any order)
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_two_opt (a:lens) (b:lens) =
|
||
|
|
combine_two_opt_ord a b | combine_two_opt_ord b a
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_three_ord
|
||
|
|
* Combine three lenses, ensuring first lens is first
|
||
|
|
* (a followed by either b, c, in any order)
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
* c:lens - the third lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_three_ord (a:lens) (b:lens) (c:lens) =
|
||
|
|
combine_two_ord a (combine_two b c)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_three
|
||
|
|
* Combine three lenses
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
* c:lens - the third lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_three (a:lens) (b:lens) (c:lens) =
|
||
|
|
combine_three_ord a b c
|
||
|
|
| combine_three_ord b a c
|
||
|
|
| combine_three_ord c b a
|
||
|
|
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_three_opt_ord
|
||
|
|
* Combine three lenses optionally, ensuring first lens is first
|
||
|
|
* (a followed by either b, c, or any of them, in any order)
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
* c:lens - the third lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_three_opt_ord (a:lens) (b:lens) (c:lens) =
|
||
|
|
combine_two_opt_ord a (combine_two_opt b c)
|
||
|
|
|
||
|
|
(************************************************************************
|
||
|
|
* View: combine_three_opt
|
||
|
|
* Combine three lenses optionally
|
||
|
|
* (either a, b, c, or any of them, in any order)
|
||
|
|
*
|
||
|
|
* Parameters:
|
||
|
|
* a:lens - the first lens
|
||
|
|
* b:lens - the second lens
|
||
|
|
* c:lens - the third lens
|
||
|
|
************************************************************************)
|
||
|
|
let combine_three_opt (a:lens) (b:lens) (c:lens) =
|
||
|
|
combine_three_opt_ord a b c
|
||
|
|
| combine_three_opt_ord b a c
|
||
|
|
| combine_three_opt_ord c b a
|