Xorg: accept InputClass section

Xorg: accept InputClass section

(*
Module: Xorg
 Parses /etc/X11/xorg.conf

Authors: Raphael Pinson <raphink@gmail.com>
         Matthew Booth <mbooth@redhat.com>

About: Reference
 This lens tries to keep as close as possible to `man xorg.conf` where
 possible.

The definitions from `man xorg.conf` are put as commentaries for reference
throughout the file. More information can be found in the manual.

About: License
  This file is licensed under the LGPLv2+, like the rest of Augeas.

About: Lens Usage
  Sample usage of this lens in augtool

    * Get the identifier of the devices with a "Clone" option:
      > match "/files/etc/X11/xorg.conf/Device[Option = 'Clone']/Identifier"

About: Configuration files
  This lens applies to /etc/X11/xorg.conf. See <filter>.
*)

module Xorg =
  autoload xfm

(************************************************************************
 * Group:                 USEFUL PRIMITIVES
 *************************************************************************)

(* Group: Generic primitives *)

(* Variable: eol *)
let eol     = Util.eol

(* Variable: to_eol
 * Match everything from here to eol, cropping whitespace at both ends
 *)
let to_eol  = /[^ \t\n](.*[^ \t\n])?/

(* Variable: indent *)
let indent  = Util.indent

(* Variable: comment *)
let comment = Util.comment

(* Variable: empty *)
let empty   = Util.empty

(* Group: Separators *)

(* Variable: sep_spc *)
let sep_spc = Util.del_ws_spc

(* Variable: sep_dquote *)
let sep_dquote  = Util.del_str "\""

(* Group: Fields and values *)

(* Variable: entries_re
 * This is a list of all patterns which have specific handlers, and should
 * therefore not be matched by the generic handler
 *)
let entries_re  = /([oO]ption|[sS]creen|[iI]nput[dD]evice|[dD]river|[sS]ub[sS]ection|[dD]isplay|[iI]dentifier|[vV]ideo[rR]am|[dD]efault[dD]epth|[dD]evice)/

(* Variable: generic_entry_re *)
let generic_entry_re = /[^# \t\n\/]+/ - entries_re

(* Variable: quoted_string_val *)
let quoted_string_val = del "\"" "\"" . store /[^"\n]+/ . del "\"" "\""
                                              (* " relax, emacs *)

(* Variable: int *)
let int = /[0-9]+/

(************************************************************************
 * Group:                          ENTRIES AND OPTIONS
 *************************************************************************)

(* View: entry_int
 * This matches an entry which takes a single integer for an argument
 *)
let entry_int (canon:string) (re:regexp) =
        [ indent . del re canon . label canon . sep_spc . store int . eol ]

(* View: entry_rgb
 * This matches an entry which takes 3 integers as arguments representing red,
 * green and blue components
 *)
let entry_rgb (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "red"   . sep_spc . store int ]
          . [ label "green" . sep_spc . store int ]
          . [ label "blue"  . sep_spc . store int ]
          . eol ]

(* View: entry_xy
 * This matches an entry which takes 2 integers as arguments representing X and
 * Y coordinates
 *)
let entry_xy (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "x" . sep_spc . store int ]
          . [ label "y" . sep_spc . store int ]
          . eol ]

(* View: entry_str
 * This matches an entry which takes a single quoted string
 *)
let entry_str (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . sep_spc . quoted_string_val . eol ]

(* View: entry_generic
 * An entry without a specific handler. Store everything after the keyword,
 * cropping whitespace at both ends.
 *)
let entry_generic  = [ indent . key generic_entry_re
                       . sep_spc . store to_eol . eol ]

(* View: option *)
let option = [ indent . del /[oO]ption/ "Option" . label "Option" . sep_spc
               . quoted_string_val
               . [ label "value" . sep_spc . quoted_string_val ]*
               . eol ]

(* View: screen
 * The Screen entry of ServerLayout
 *)
let screen = [ indent . del /[sS]creen/ "Screen" . label "Screen" . sep_spc
               . [ label "num" . store int . sep_spc ]?
               . quoted_string_val
               . [ sep_spc . label "position" . store to_eol ]?
               . eol ]

(* View: input_device *)
let input_device = [ indent . del /[iI]nput[dD]evice/ "InputDevice"
                     . label "InputDevice" . sep_spc . quoted_string_val
                     . [ label "option" . sep_spc . quoted_string_val ]*
                     . eol ]

(* View: driver *)
let driver = entry_str "Driver" /[dD]river/

(* View: identifier *)
let identifier = entry_str "Identifier" /[iI]dentifier/

(* View: videoram *)
let videoram = entry_int "VideoRam" /[vV]ideo[rR]am/

(* View: default_depth *)
let default_depth = entry_int "DefaultDepth" /[dD]efault[dD]epth/

(* View: device *)
let device = entry_str "Device" /[dD]evice/

(************************************************************************
 * Group:                          DISPLAY SUBSECTION
 *************************************************************************)

(* View: display_modes *)
let display_modes = [ indent . del /[mM]odes/ "Modes" . label "Modes"
                      . [ label "mode" . sep_spc . quoted_string_val ]+
                      . eol ]

(*************************************************************************
 * View: display_entry
 *   Known values for entries in the Display subsection
 *
 *   Definition:
 *     > Depth    depth
 *     > FbBpp    bpp
 *     > Weight   red-weight green-weight blue-weight
 *     > Virtual  xdim ydim
 *     > ViewPort x0 y0
 *     > Modes    "mode-name" ...
 *     > Visual   "visual-name"
 *     > Black    red green blue
 *     > White    red green blue
 *     > Options
 *)

let display_entry = entry_int "Depth"    /[dD]epth/ |
                    entry_int "FbBpp"    /[fF]b[bB]pp/ |
                    entry_rgb "Weight"   /[wW]eight/ |
                    entry_xy  "Virtual"  /[vV]irtual/ |
                    entry_xy  "ViewPort" /[vV]iew[pP]ort/ |
                    display_modes |
                    entry_str "Visual"   /[vV]isual/ |
                    entry_rgb "Black"    /[bB]lack/ |
                    entry_rgb "White"    /[wW]hite/ |
                    entry_str "Options"  /[oO]ptions/ |
                    empty |
                    comment

(* View: display *)
let display = [ indent . del "SubSection" "SubSection" . sep_spc
                       . sep_dquote . key "Display" . sep_dquote
                       . eol
                       . display_entry*
                       . indent . del "EndSubSection" "EndSubSection" . eol ]

(************************************************************************
 * Group:                       SECTIONS
 *************************************************************************)

(************************************************************************
 * Variable: section_re
 *   Known values for Section names
 *
 *   Definition:
 *     >   The section names are:
 *     >
 *     >   Files          File pathnames
 *     >   ServerFlags    Server flags
 *     >   Module         Dynamic module loading
 *     >   Extensions     Extension Enabling
 *     >   InputDevice    Input device description
 *     >   InputClass     Input Class description
 *     >   Device         Graphics device description
 *     >   VideoAdaptor   Xv video adaptor description
 *     >   Monitor        Monitor description
 *     >   Modes          Video modes descriptions
 *     >   Screen         Screen configuration
 *     >   ServerLayout   Overall layout
 *     >   DRI            DRI-specific configuration
 *     >   Vendor         Vendor-specific configuration
 *************************************************************************)
let section_re = /(Extensions|Files|ServerFlags|Module|InputDevice|InputClass|Device|VideoAdaptor|Monitor|Modes|Screen|ServerLayout|DRI|Vendor)/

(************************************************************************
 * Variable: secton_re_obsolete
 *   The  following obsolete section names are still recognised for
 *   compatibility purposes.  In new config files, the InputDevice
 *   section should be used instead.
 *
 *   Definition:
 *     >  Keyboard       Keyboard configuration
 *     >  Pointer        Pointer/mouse configuration
 *************************************************************************)
let section_re_obsolete = /(Keyboard|Pointer)/

(* View: section_entry *)
let section_entry = option |
                    screen |
                    display |
                    input_device |
                    driver |
                    identifier |
                    videoram |
                    default_depth |
                    device |
                    entry_generic |
                    empty | comment

(************************************************************************
 * View: section
 *   A section in xorg.conf
 *
 *   Definition:
 *     > Section  "SectionName"
 *     >    SectionEntry
 *     >    ...
 *     > EndSection
 *************************************************************************)
let section = [ indent . del "Section" "Section"
                       . sep_spc . sep_dquote
                       . key (section_re|section_re_obsolete) . sep_dquote
                       . eol
                .  section_entry*
                . indent . del "EndSection" "EndSection" . eol ]

(*
 * View: lns
 *   The xorg.conf lens
 *)
let lns = ( empty | comment | section )*

(* Variable: filter *)
let filter = (incl "/etc/X11/xorg.conf") .
  (incl "/etc/X11/xorg.conf.d/*.conf") .
  Util.stdexcl

let xfm = transform lns filter

(*
Module: Xorg
 Parses /etc/X11/xorg.conf

Authors: Raphael Pinson <raphink@gmail.com>
         Matthew Booth <mbooth@redhat.com>

About: Reference
 This lens tries to keep as close as possible to `man xorg.conf` where
 possible.

The definitions from `man xorg.conf` are put as commentaries for reference
throughout the file. More information can be found in the manual.

About: License
  This file is licensed under the LGPLv2+, like the rest of Augeas.

About: Lens Usage
  Sample usage of this lens in augtool

    * Get the identifier of the devices with a "Clone" option:
      > match "/files/etc/X11/xorg.conf/Device[Option = 'Clone']/Identifier"

About: Configuration files
  This lens applies to /etc/X11/xorg.conf. See <filter>.
*)

module Xorg =
  autoload xfm

(************************************************************************
 * Group:                 USEFUL PRIMITIVES
 *************************************************************************)

(* Group: Generic primitives *)

(* Variable: eol *)
let eol     = Util.eol

(* Variable: to_eol
 * Match everything from here to eol, cropping whitespace at both ends
 *)
let to_eol  = /[^ \t\n](.*[^ \t\n])?/

(* Variable: indent *)
let indent  = Util.indent

(* Variable: comment *)
let comment = Util.comment

(* Variable: empty *)
let empty   = Util.empty

(* Group: Separators *)

(* Variable: sep_spc *)
let sep_spc = Util.del_ws_spc

(* Variable: sep_dquote *)
let sep_dquote  = Util.del_str "\""

(* Group: Fields and values *)

(* Variable: entries_re
 * This is a list of all patterns which have specific handlers, and should
 * therefore not be matched by the generic handler
 *)
let entries_re  = /([oO]ption|[sS]creen|[iI]nput[dD]evice|[dD]river|[sS]ub[sS]ection|[dD]isplay|[iI]dentifier|[vV]ideo[rR]am|[dD]efault[dD]epth|[dD]evice)/

(* Variable: generic_entry_re *)
let generic_entry_re = /[^# \t\n\/]+/ - entries_re

(* Variable: quoted_string_val *)
let quoted_string_val = del "\"" "\"" . store /[^"\n]+/ . del "\"" "\""
                                              (* " relax, emacs *)

(* Variable: int *)
let int = /[0-9]+/

(************************************************************************
 * Group:                          ENTRIES AND OPTIONS
 *************************************************************************)

(* View: entry_int
 * This matches an entry which takes a single integer for an argument
 *)
let entry_int (canon:string) (re:regexp) =
        [ indent . del re canon . label canon . sep_spc . store int . eol ]

(* View: entry_rgb
 * This matches an entry which takes 3 integers as arguments representing red,
 * green and blue components
 *)
let entry_rgb (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "red"   . sep_spc . store int ]
          . [ label "green" . sep_spc . store int ]
          . [ label "blue"  . sep_spc . store int ]
          . eol ]

(* View: entry_xy
 * This matches an entry which takes 2 integers as arguments representing X and
 * Y coordinates
 *)
let entry_xy (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . [ label "x" . sep_spc . store int ]
          . [ label "y" . sep_spc . store int ]
          . eol ]

(* View: entry_str
 * This matches an entry which takes a single quoted string
 *)
let entry_str (canon:string) (re:regexp) =
        [ indent . del re canon . label canon
          . sep_spc . quoted_string_val . eol ]

(* View: entry_generic
 * An entry without a specific handler. Store everything after the keyword,
 * cropping whitespace at both ends.
 *)
let entry_generic  = [ indent . key generic_entry_re
                       . sep_spc . store to_eol . eol ]

(* View: option *)
let option = [ indent . del /[oO]ption/ "Option" . label "Option" . sep_spc
               . quoted_string_val
               . [ label "value" . sep_spc . quoted_string_val ]*
               . eol ]

(* View: screen
 * The Screen entry of ServerLayout
 *)
let screen = [ indent . del /[sS]creen/ "Screen" . label "Screen" . sep_spc
               . [ label "num" . store int . sep_spc ]?
               . quoted_string_val
               . [ sep_spc . label "position" . store to_eol ]?
               . eol ]

(* View: input_device *)
let input_device = [ indent . del /[iI]nput[dD]evice/ "InputDevice"
                     . label "InputDevice" . sep_spc . quoted_string_val
                     . [ label "option" . sep_spc . quoted_string_val ]*
                     . eol ]

(* View: driver *)
let driver = entry_str "Driver" /[dD]river/

(* View: identifier *)
let identifier = entry_str "Identifier" /[iI]dentifier/

(* View: videoram *)
let videoram = entry_int "VideoRam" /[vV]ideo[rR]am/

(* View: default_depth *)
let default_depth = entry_int "DefaultDepth" /[dD]efault[dD]epth/

(* View: device *)
let device = entry_str "Device" /[dD]evice/

(************************************************************************
 * Group:                          DISPLAY SUBSECTION
 *************************************************************************)

(* View: display_modes *)
let display_modes = [ indent . del /[mM]odes/ "Modes" . label "Modes"
                      . [ label "mode" . sep_spc . quoted_string_val ]+
                      . eol ]

(*************************************************************************
 * View: display_entry
 *   Known values for entries in the Display subsection
 *
 *   Definition:
 *     > Depth    depth
 *     > FbBpp    bpp
 *     > Weight   red-weight green-weight blue-weight
 *     > Virtual  xdim ydim
 *     > ViewPort x0 y0
 *     > Modes    "mode-name" ...
 *     > Visual   "visual-name"
 *     > Black    red green blue
 *     > White    red green blue
 *     > Options
 *)

let display_entry = entry_int "Depth"    /[dD]epth/ |
                    entry_int "FbBpp"    /[fF]b[bB]pp/ |
                    entry_rgb "Weight"   /[wW]eight/ |
                    entry_xy  "Virtual"  /[vV]irtual/ |
                    entry_xy  "ViewPort" /[vV]iew[pP]ort/ |
                    display_modes |
                    entry_str "Visual"   /[vV]isual/ |
                    entry_rgb "Black"    /[bB]lack/ |
                    entry_rgb "White"    /[wW]hite/ |
                    entry_str "Options"  /[oO]ptions/ |
                    empty |
                    comment

(* View: display *)
let display = [ indent . del "SubSection" "SubSection" . sep_spc
                       . sep_dquote . key "Display" . sep_dquote
                       . eol
                       . display_entry*
                       . indent . del "EndSubSection" "EndSubSection" . eol ]

(************************************************************************
 * Group:                       SECTIONS
 *************************************************************************)

(************************************************************************
 * Variable: section_re
 *   Known values for Section names
 *
 *   Definition:
 *     >   The section names are:
 *     >
 *     >   Files          File pathnames
 *     >   ServerFlags    Server flags
 *     >   Module         Dynamic module loading
 *     >   Extensions     Extension Enabling
 *     >   InputDevice    Input device description
 *     >   InputClass     Input Class description
 *     >   Device         Graphics device description
 *     >   VideoAdaptor   Xv video adaptor description
 *     >   Monitor        Monitor description
 *     >   Modes          Video modes descriptions
 *     >   Screen         Screen configuration
 *     >   ServerLayout   Overall layout
 *     >   DRI            DRI-specific configuration
 *     >   Vendor         Vendor-specific configuration
 *************************************************************************)
let section_re = /(Extensions|Files|ServerFlags|Module|InputDevice|Device|VideoAdaptor|Monitor|Modes|Screen|ServerLayout|DRI|Vendor)/

(************************************************************************
 * Variable: secton_re_obsolete
 *   The  following obsolete section names are still recognised for
 *   compatibility purposes.  In new config files, the InputDevice
 *   section should be used instead.
 *
 *   Definition:
 *     >  Keyboard       Keyboard configuration
 *     >  Pointer        Pointer/mouse configuration
 *************************************************************************)
let section_re_obsolete = /(Keyboard|Pointer)/

(* View: section_entry *)
let section_entry = option |
                    screen |
                    display |
                    input_device |
                    driver |
                    identifier |
                    videoram |
                    default_depth |
                    device |
                    entry_generic |
                    empty | comment

(************************************************************************
 * View: section
 *   A section in xorg.conf
 *
 *   Definition:
 *     > Section  "SectionName"
 *     >    SectionEntry
 *     >    ...
 *     > EndSection
 *************************************************************************)
let section = [ indent . del "Section" "Section"
                       . sep_spc . sep_dquote
                       . key (section_re|section_re_obsolete) . sep_dquote
                       . eol
                .  section_entry*
                . indent . del "EndSection" "EndSection" . eol ]

(*
 * View: lns
 *   The xorg.conf lens
 *)
let lns = ( empty | comment | section )*

(* Variable: filter *)
let filter = (incl "/etc/X11/xorg.conf") .
  (incl "/etc/X11/xorg.conf.d/*.conf") .
  Util.stdexcl

let xfm = transform lns filter


Various fixes in bbhosts.aug

Various fixes in bbhosts.aug

(* BB-hosts module for Augeas                 *)
(* Author: Raphael Pinson <raphink@gmail.com> *)
(*                                            *)
(* Supported :                                *)
(*                                            *)
(* Todo :                                     *)
(*                                            *)

module BBhosts =
    autoload xfm

    (* Define useful shortcuts *)

    let eol = Util.eol
    let eol_no_spc = Util.del_str "\n"
    let sep_spc = Sep.space
    let word  = store /[^|;# \n\t]+/
    let value_to_eol = store /[^ \t][^\n]+/
    let ip    = store Rx.ipv4
    let url   = store /https?:[^# \n\t]+/
    let word_cont = store /[^;# \n\t]+/

    (* Define comments and empty lines *)
    let comment = Util.comment
    let empty   = Util.empty

    (* Define host *)
    let host_ip   = [ label "ip" . ip ]
    let host_fqdn = [ label "fqdn" . sep_spc . word ]

    let host_test_url  = [ label "url" . url ]
    let host_test_cont (kw:string) = [ store /!?/ . key kw .
                             (Util.del_str ";" .
                                [ label "url" . word_cont ] .
			        (Util.del_str ";" . [ label "keyword" . word ])?
			     )?
			     ]

    let host_test_flag_value = [ label "value" . Util.del_str ":"
                              . store Rx.word ]

    let host_test_flag (kw:string) = [ store /!?/ . key kw
                                     . host_test_flag_value? ]

    let host_test = host_test_cont "cont"
                  | host_test_cont "contInsecure"
                  | host_test_cont "dns"
                  | host_test_flag "CDB"
                  | host_test_flag "ftp"
                  | host_test_flag "front"
                  | host_test_flag "GTM"
		  | host_test_flag "noping"
		  | host_test_flag "noconn"
		  | host_test_flag "ssh"
		  | host_test_flag "ssh2"
		  | host_test_flag "smtp"
		  | host_test_flag "pop3"
		  | host_test_flag "imap2"
		  | host_test_flag "telnet"
		  | host_test_flag "BBDISPLAY"
		  | host_test_flag "BBNET"
		  | host_test_flag "BBPAGER"
		  | host_test_flag "XYMON"
                  | host_test_url

    let host_test_list = Build.opt_list host_test sep_spc

    let host_opts = [ label "probes" . sep_spc . Util.del_str "#" . (sep_spc . host_test_list)? ]

    let host = [ label "host" . host_ip . host_fqdn . host_opts . eol ]

    (* Define group-compress and group-only *)
    let group_compress = [ key /group(-compress)?/ . (sep_spc . value_to_eol)? . eol_no_spc .
                  ( comment | empty | host)*
		  ]

    let group_only_col  = [ label "col" . word ]
    let group_only_cols = sep_spc . group_only_col . ( Util.del_str "|" . group_only_col )*
    let group_only      = [ key "group-only" . group_only_cols . sep_spc . value_to_eol . eol_no_spc .
                  ( comment | empty | host)*
		  ]

    (* Define page *)
    let page_title = [ label "title" . sep_spc . value_to_eol ]
    let page = [ key "page" . sep_spc . word . page_title? . eol_no_spc .
                  ( comment | empty | host )* . ( group_compress | group_only )*
		  ]

    (* Define lens *)

    let lns = (comment | empty)* . page*

    let filter = incl "/etc/bb/bb-hosts"
               . Util.stdexcl

    let xfm = transform lns filter

(* BB-hosts module for Augeas                 *)
(* Author: Raphael Pinson <raphink@gmail.com> *)
(*                                            *)
(* Supported :                                *)
(*                                            *)
(* Todo :                                     *)
(*                                            *)

module BBhosts =
    autoload xfm

    (* Define useful shortcuts *)

    let eol = Util.eol
    let eol_no_spc = Util.del_str "\n"
    let sep_spc = Sep.space
    let word  = store /[^|;# \n\t]+/
    let value_to_eol = store /[^ \t][^\n]+/
    let ip    = store Rx.ipv4
    let url   = store /https?:[^;,# \n\t]+/

    (* Define comments and empty lines *)
    let comment = Util.comment
    let empty   = Util.empty

    (* Define host *)
    let host_ip   = [ label "ip" . ip ]
    let host_fqdn = [ label "fqdn" . sep_spc . word ]

    let host_test_url  = [ label "url" . sep_spc . url ]
    let host_test_cont (kw:string) = [ sep_spc . store /!?/ . key kw .
                             (Util.del_str ";" .
                                [ label "url" . word ] .
			        (Util.del_str ";" . [ label "keyword" . word ])?
			     )?
			     ]

    let host_test_flag (kw:string) = [ sep_spc . store /!?/ . key kw ]

    let host_test = host_test_cont "cont"
                  | host_test_cont "contInsecure"
                  | host_test_cont "dns"
		  | host_test_flag "noping"
		  | host_test_flag "noconn"
		  | host_test_flag "ssh"
		  | host_test_flag "smtp"
		  | host_test_flag "pop3"
		  | host_test_flag "imap2"
		  | host_test_flag "telnet"
		  | host_test_flag "BBDISPLAY"
		  | host_test_flag "BBNET"
		  | host_test_flag "BBPAGER"
                  | host_test_url

    let host_opts = [ label "probes" . sep_spc . Util.del_str "#" . host_test* ]

    let host = [ label "host" . host_ip . host_fqdn . host_opts . eol ]

    (* Define group-compress and group-only *)
    let group_compress = [ key "group-compress" . sep_spc . value_to_eol . eol_no_spc .
                  ( comment | empty | host)*
		  ]

    let group_only_col  = [ label "col" . word ]
    let group_only_cols = sep_spc . group_only_col . ( Util.del_str "|" . group_only_col )*
    let group_only      = [ key "group-only" . group_only_cols . sep_spc . value_to_eol . eol_no_spc .
                  ( comment | empty | host)*
		  ]

    (* Define page *)
    let page_title = [ label "title" . sep_spc . value_to_eol . eol_no_spc ]
    let page = [ key "page" . sep_spc . word . page_title .
                  ( comment | empty | host )* . ( group_compress | group_only )*
		  ]

    (* Define lens *)

    let lns = (comment | empty)* . page*

    let filter = incl "/etc/bb/bb-hosts"
               . Util.stdexcl

    let xfm = transform lns filter


added copy of yum.aug, rev 142cbf

added copy of yum.aug, rev 142cbf

(* Parsing yum's config files *)
module Yum =
  autoload xfm

  let eol = Util.del_str "\n"

  let key_re = /[^#;:= \t\n[\/]+/ - "baseurl"

  let eq = del /[ \t]*[:=][ \t]*/ "="
  let secname = /[^]\/]+/

  let value = /[^ \t\n][^\n]*/

  (* We really need to allow comments starting with REM and rem but that     *)
  (* leads to ambiguities with keys 'rem=' and 'REM=' The regular expression *)
  (* to do that cleanly is somewhat annoying to craft by hand; we'd need to  *)
  (* define KEY_RE as /[A-Za-z0-9]+/ - "REM" - "rem"                         *)
  let comment = [ del /([;#].*)?[ \t]*\n/ "\n" ]

  let list_sep = del /[ \t]*(,[ \t]*|\n[ \t]+)/ "\n\t"
  let list_value = store /[^ \t\n,]+/

  let kv_list(s:string) =
    [ key s . eq . list_value ] .
      [ list_sep . label s . list_value ]* . eol

  let kv = [ key key_re . eq . store value . eol ]

  let sechead = Util.del_str "[" . key secname . Util.del_str "]"
      . del /[ \t]*[;#]?.*/ ""
      . eol

  let entry = comment | kv

  (* A section is a section head, followed by any number of key value    *)
  (* entries, with comments and blank lines freely interspersed. The     *)
  (* continuation lines allowed for baseurl entries make this a little   *)
  (* more interesting: there can be at most one baseurl entry in each    *)
  (* section (more precisely, yum will only obey one of them, but we act *)
  (* as if yum would actually barf)                                      *)
  let section = [ sechead . (entry* | entry* . (kv_list "baseurl") . entry*)]

  let lns = (comment) * . (section) *

  let filter = (incl "/etc/yum.conf") . (incl "/etc/yum.repos.d/*")
      . Util.stdexcl

  let xfm = transform lns filter

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)

error: pathspec 'files/yum.aug' did not match any file(s) known to git


Improve documentation in test_xml.aug

Improve documentation in test_xml.aug

(*
Module: Test_Xml
  Provides unit tests and examples for the <Xml> lens.
*)

module Test_Xml =

(* View: knode
   A simple flag function

   Parameters:
    r:regexp - the pattern for the flag
*)
let knode (r:regexp) = [ key r ]

(************************************************************************
 *                          Group: Utilities lens
 *************************************************************************)
(*
let _ = print_regexp(lens_ctype(Xml.text))
let _ = print_endline ""
*)

(* Group: Comments *)

(* Test: Xml.comment
   Comments get mapped into "#comment" nodes. *)
test Xml.comment get
 "" =

  { "#comment" = " declarations for  &  " }

(* Test: Xml.comment
   This syntax is not understood. *)
test Xml.comment get
 "" = *

(* Group: Prolog and declarations *)

(* Test: Xml.prolog
   The XML prolog tag is mapped in a "#declaration" node,
   which contains an "#attribute" node with various attributes of the tag. *)
test Xml.prolog get
 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" =

  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }

(* Test: Xml.decl_def_item
   !ELEMENT declaration tags are mapped in "!ELEMENT" nodes.
   The associated declaration attribute is mapped in a "#decl" subnode. *)
test Xml.decl_def_item get
 "<!ELEMENT greeting (#PCDATA)>" =

  { "!ELEMENT" = "greeting"
    { "#decl" = "(#PCDATA)" }
  }

(* Test: Xml.decl_def_item
   !ENTITY declaration tags are mapped in "!ENTITY" nodes.
   The associated declaration attribute is mapped in a "#decl" subnode. *)
test Xml.decl_def_item get
 "<!ENTITY da \"
\">" =

  { "!ENTITY" = "da"
    { "#decl" = "
" }
  }

(* Test: Xml.doctype
   !DOCTYPE tags are mapped in "!DOCTYPE" nodes.
   The associated system attribute is mapped in a "SYSTEM" subnode. *)
test Xml.doctype get
 "<!DOCTYPE greeting SYSTEM \"hello.dtd\">" =

  { "!DOCTYPE" = "greeting"
    { "SYSTEM" = "hello.dtd" }
  }

(* Test: Xml.doctype
   This is an example of a !DOCTYPE tag with !ELEMENT children tags. *)
test Xml.doctype get "<!DOCTYPE foo [
<!ELEMENT bar (#PCDATA)>
<!ELEMENT baz (bar)* >
]>" =

  { "!DOCTYPE" = "foo"
    { "!ELEMENT" = "bar"
      { "#decl" = "(#PCDATA)" }
    }
    { "!ELEMENT" = "baz"
      { "#decl" = "(bar)*" }
    }
  }

(* Group: Attributes *)

(* Variable: att_def1 *)
let att_def1 = "<!ATTLIST termdef
id      ID      #REQUIRED
name    CDATA   #IMPLIED>"
(* Variable: att_def2 *)
let att_def2 = "<!ATTLIST list
type    (bullets|ordered|glossary)  \"ordered\">"
(* Variable: att_def3 *)
let att_def3 = "<!ATTLIST form
method  CDATA   #FIXED \"POST\">"

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def1 =

  { "!ATTLIST" = "termdef"
    { "1"
      { "#name" = "id" }
      { "#type" = "ID" }
      { "#REQUIRED" }
    }
    { "2"
      { "#name" = "name" }
      { "#type" = "CDATA" }
      { "#IMPLIED" }
    }
  }

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def2 =

  { "!ATTLIST" = "list"
    { "1"
      { "#name" = "type" }
      { "#type" = "(bullets|ordered|glossary)" }
      { "#FIXED" = "ordered" }
    }
  }

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def3 =

  { "!ATTLIST" = "form"
    { "1"
      { "#name" = "method" }
      { "#type" = "CDATA" }
      { "#FIXED" = "POST" }
    }
  }

(* Test: Xml.notation_def *)
test Xml.notation_def get
 "<!NOTATION not3 SYSTEM \"\">" =

  { "!NOTATION" = "not3"
    { "SYSTEM" = "" }
  }

(* Variable: cdata1 *)
let cdata1 = "<![CDATA[testing]]>"
(* Test: Xml.cdata *)
test Xml.cdata get cdata1 = { "#CDATA" = "testing" }

(* Variable: attr1 *)
let attr1 = " attr1=\"value1\" attr2=\"value2\""
(* Variable: attr2 *)
let attr2 = " attr2=\"foo\""
(* Test: Xml.attributes *)
test Xml.attributes get attr1 =
  { "#attribute"
    { "attr1" = "value1" }
    { "attr2" = "value2" }
  }

(* Test: Xml.attributes *)
test Xml.attributes get " refs=\"A1\nA2  A3\"" =
  { "#attribute"
    { "refs" = "A1\nA2  A3" }
  }

(* Test: Xml.attributes *)
test Xml.attributes put attr1 after rm "/#attribute[1]";
                                    set "/#attribute/attr2" "foo" = attr2

(* Group: empty *)

(* Variable: empty1 *)
let empty1 = ""
(* Variable: empty2 *)
let empty2 = ""
(* Variable: empty3 *)
let empty3 = "\n"
(* Variable: empty4 *)
let empty4 = ""
(* Test: Xml.empty_element *)
test Xml.empty_element get empty1 = { "a" = "#empty" }
(* Test: Xml.empty_element *)
test Xml.empty_element get empty2 =
  { "a" = "#empty" { "#attribute" { "foo" = "bar"} } }

(* Test: Xml.empty_element *)
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar" = empty2

(* Test: Xml.empty_element
   The attribute node must be the first child of the element *)
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar";
                                        set "/a/#attribute/far" "baz" = empty4

(* Test: Xml.content *)
test Xml.content put "" after clear "/a/b" = "\n"

(* Group: Full lens *)

(* Test: Xml.lns *)
test Xml.lns put "" after set "/a/#text[1]" "foo";
                                 set "/a/#text[2]" "bar" = "foobar"

(* Test: Xml.lns *)
test Xml.lns get "<?xml version=\"1.0\"?>
<!DOCTYPE catalog PUBLIC \"-//OASIS//DTD XML Catalogs V1.0//EN\"
  \"file:///usr/share/xml/schema/xml-core/catalog.dtd\">
  <doc/>" =
  { "#declaration"
  { "#attribute"
    { "version" = "1.0" }
  }
  }
  { "!DOCTYPE" = "catalog"
    { "PUBLIC"
      { "#literal" = "-//OASIS//DTD XML Catalogs V1.0//EN" }
      { "#literal" = "file:///usr/share/xml/schema/xml-core/catalog.dtd" }
    }
  }
  { "doc" = "#empty" }

(* Test: Xml.lns *)
test Xml.lns get "<oor:component-data xmlns:oor=\"http://openoffice.org/2001/registry\"/>
" =
  { "oor:component-data" = "#empty"
    { "#attribute"
      { "xmlns:oor" = "http://openoffice.org/2001/registry" }
    }
  }

(* Variable: input1 *)
let input1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>

        <title>Wiki</title>

Augeas

Augeas is now able to parse XML files!

Translate from XML to a tree syntax

Translate from the tree back to XML

this

"

(* Test: Xml.doc
   Test <input1> with <Xml.doc> *)
test Xml.doc get input1 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }
  { "html"
    { "#text" = "\n    " }
    { "head"
      { "#text" = "\n        " }
      { "title"
        { "#text" = "Wiki" }
      }
      { "#text" = "    " }
    }
    { "#text" = "    " }
    { "body"
      { "#text" = "
        " }
      { "h1"
        { "#text" = "Augeas" }
      }
      { "#text" = "        " }
      { "p"
        { "#attribute"
          { "class" = "main" }
        }
        { "#text" = "Augeas is now able to parse XML files!" }
      }
      { "#text" = "        " }
      { "ul"
        { "#text" = "\n            " }
        { "li"
          { "#text" = "Translate from XML to a tree syntax" }
        }
        { "#text" = "            " }
        { "li"
          { "#text" = "Translate from the tree back to XML" }
        }
        { "#text" = " " }
        { "#comment" = " this is some comment " }
        { "#text" = "
            " }
        { "li"
          { "#text" = "this" }
        }
        { "#text" = "        " }
      }
      { "#text" = "    " }
    }
  }

(* Test: Xml.doc
   Modify <input1> with <Xml.doc> *)
test Xml.doc put input1 after rm "/html/body" =
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>

        <title>Wiki</title>

"

(* Variable: ul1 *)
let ul1 = "

test1

test2

test3

test4

"

test Xml.doc get ul1 =
  { "ul"
    { "#text" = "
 " }
    { "li"
      { "#text" = "test1" }
    }
    { "#text" = "  " }
    { "li"
      { "#text" = "test2" }
    }
    { "#text" = "   " }
    { "li"
      { "#text" = "test3" }
    }
    { "#text" = "    " }
    { "li"
      { "#text" = "test4" }
    }
  }

test Xml.doc put ul1 after set "/ul/li[3]/#text" "bidon" = "

test1

test2

bidon

test4

"

test Xml.doc put ul1 after rm "/ul/li[2]" = "

test1

test3

test4

"

(* #text nodes don't move when inserting a node, the result depends on where the node is added *)
test Xml.doc put ul1 after insb "a" "/ul/li[2]" = "

test1

test2

test3

test4

"

test Xml.doc put ul1 after insa "a" "/ul/li[1]" = "

test1

test2

test3

test4

"

(* Attributes must be added before text nodes *)
test Xml.doc put ul1 after insb "#attribute" "/ul/li[2]/#text";
                           set "/ul/li[2]/#attribute/bidon" "gazou";
                           set "/ul/li[2]/#attribute/foo" "bar" = "

test1

test2

test3

test4

"

(* if empty element is allowed to be as root, this test triggers error *)
test Xml.lns get "<doc>
<c/><c/><c/><c/>
</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "a"
      { "c" = "#empty" }
      { "b"
        { "c" = "#empty" }
      }
      { "c" = "#empty" }
      { "c" = "#empty" }
      { "a" }
    }
  }

let p01pass2 = "<?PI before document element?>

<?PI before document element?>

<?PI before document element?>

<?PI before document element?>
<!DOCTYPE doc
[
<!ELEMENT doc ANY>
<!ELEMENT a ANY>
<!ELEMENT b ANY>
<!ELEMENT c ANY>
]>
<doc>
<c/>
</doc>

<?PI after document element?>

<?PI after document element?>

<?PI after document element?>
"

test Xml.lns get p01pass2 =
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "b"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "c"
      { "#decl" = "ANY" }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a"
      { "b"
        { "c" = "#empty" }
      }
    }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }

(* various valid Name constructions *)
test Xml.lns get "<doc>\n\n<::._-0/>\n<_:._-0/>\n\n<_/>\n<:/>\n</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "A:._-0" = "#empty" }
    { "::._-0" = "#empty" }
    { "_:._-0" = "#empty" }
    { "A" = "#empty" }
    { "_" = "#empty" }
    { ":" = "#empty" }
  }

test Xml.lns get "<doc>
<abcdefghijklmnopqrstuvwxyz/>
<ABCDEFGHIJKLMNOPQRSTUVWXYZ/>
<A01234567890/>

</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "abcdefghijklmnopqrstuvwxyz" = "#empty" }
    { "ABCDEFGHIJKLMNOPQRSTUVWXYZ" = "#empty" }
    { "A01234567890" = "#empty" }
    { "A.-:" = "#empty" }
  }

let p06fail1 = "
<!DOCTYPE doc
[
<!ELEMENT doc (a|refs)*>
<!ELEMENT a EMPTY>
<!ELEMENT refs EMPTY>
<!ATTLIST refs refs IDREFS #REQUIRED>
<!ATTLIST a id ID #REQUIRED>
]>
<doc>

<refs refs=\"\"/>
</doc>"

(* we accept this test because we do not verify XML references *)
test Xml.lns get p06fail1 =
  { "#comment" = "non-validating processors may pass this instance because they don't check the IDREFS attribute type" }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "(a|refs)*" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "EMPTY" }
    }
    { "!ELEMENT" = "refs"
      { "#decl" = "EMPTY" }
    }
    { "!ATTLIST" = "refs"
      { "1"
        { "#name" = "refs" }
        { "#type" = "IDREFS" }
        { "#REQUIRED" }
      }
    }
    { "!ATTLIST" = "a"
      { "1"
        { "#name" = "id" }
        { "#type" = "ID" }
        { "#REQUIRED" }
      }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A1" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A2" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A3" }
      }
    }
    { "refs" = "#empty"
      { "#attribute"
        { "refs" = "" }
      }
    }
  }

(* we accept dquote, but not single quotes, because of resulting ambiguity *)
let p10pass1_1 = "<doc>'">\nasdf\n    ?>%\"/></doc>"
let p10pass1_2 = "<doc>'"'/></doc>"

test Xml.lns get p10pass1_1 =
  { "doc"
    { "A" = "#empty"
      { "#attribute"
        { "a" = "asdf>'">\nasdf\n    ?>%" }
      }
    }
  }

test Xml.lns get p10pass1_2 = *

(* here again, test exclude single quote *)
let p11pass1 = "
<!DOCTYPE doc
[
<!ELEMENT doc EMPTY>
<!NOTATION not1 SYSTEM \"a%a&b&#0<!ELEMENT

<doc></doc>"

test Xml.lns get p15pass1 =
  { "#comment" = "a
<!DOCTYPE
<?-
]]>-<[ CDATA [
\"- -'-
-<doc>" }
  { "#comment" = "" }
  { "doc" }

let p22pass3 = "<?xml version=\"1.0\"?>
 <?pi some instruction ?>
<doc><?pi?></doc>"

test Xml.lns get p22pass3 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "#comment" = "comment" }
  { "#pi"
    { "#target" = "pi" }
    { "#instruction" = "some instruction" }
  }
  { "doc"
    { "#pi"
      { "#target" = "pi" }
    }
  }

let p25pass2 = "<?xml version

=

\"1.0\"?>
<doc></doc>"

test Xml.lns get p25pass2 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "doc" }

test Xml.lns get "<!DOCTYPE

doc

[
<!ELEMENT doc EMPTY>
]>
<doc></doc>" =
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "EMPTY" }
    }
  }
  { "doc" }

test Xml.lns get "<doc></doc  \n>" = { "doc" }

test Xml.lns get "<doc att=\"val\" \natt2=\"val2\" att3=\"val3\"/>" =
  { "a"
    { "doc" = "#empty"
      { "#attribute"
        { "att" = "val" }
        { "att2" = "val2" }
        { "att3" = "val3" }
      }
    }
  }

test Xml.lns get "<doc/>" = { "doc" = "#empty" }

(* failure tests *)
(* only one document element *)
test Xml.lns get "<doc></doc><bad/>" = *

(* document element must be complete *)
test Xml.lns get "<doc>" = *

(* emtpy document is rejected *)
test Xml.lns get "" = *

(* malformed element *)
test Xml.lns get "" = *

(* a Name cannot start with a digit *)
test Xml.lns get "<0A/>" = *

(* no space before "CDATA" *)
test Xml.lns get "<doc><![ CDATA[a]]></doc>" = *

(* no space after "CDATA" *)
test Xml.lns get "<doc><![CDATA [a]]></doc>" = *

(* CDSect's can't nest *)
test Xml.lns get "<doc>
<![CDATA[
<![CDATA[XML doesn't allow CDATA sections to nest]]>
]]>
</doc>" = *

(* Comment is illegal in VersionInfo *)
test Xml.lns get "<?xml version  =\"1.0\"?>
<doc></doc>" = *

(* only declarations in DTD *)
test Xml.lns get "<!DOCTYPE doc [
<!ELEMENT doc EMPTY>
<doc></doc>
]>" = *

(* we do not support external entities *)
test Xml.lns get "<!DOCTYPE doc [
<!ENTITY % eldecl \"<!ELEMENT doc EMPTY>\">
%eldecl;
]>
<doc></doc>" = *

module Test_xml =

let knode (r:regexp) = [ key r ]

(************************************************************************
 *                           Utilities lens
 *************************************************************************)
(*
let _ = print_regexp(lens_ctype(Xml.text))
let _ = print_endline ""
*)

test Xml.comment get "" =
  { "#comment" = " declarations for  &  " }

test Xml.comment get "" = *

test Xml.prolog get "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }

test Xml.decl_def_item get "<!ELEMENT greeting (#PCDATA)>" =
  { "!ELEMENT" = "greeting"
    { "#decl" = "(#PCDATA)" }
  }

test Xml.decl_def_item get "<!ENTITY da \"
\">" =
  { "!ENTITY" = "da"
    { "#decl" = "
" }
  }

test Xml.doctype get "<!DOCTYPE greeting SYSTEM \"hello.dtd\">" =
  { "!DOCTYPE" = "greeting"
    { "SYSTEM" = "hello.dtd" }
  }

test Xml.doctype get "<!DOCTYPE foo [
<!ELEMENT bar (#PCDATA)>
<!ELEMENT baz (bar)* >
]>" =
  { "!DOCTYPE" = "foo"
    { "!ELEMENT" = "bar"
      { "#decl" = "(#PCDATA)" }
    }
    { "!ELEMENT" = "baz"
      { "#decl" = "(bar)*" }
    }
  }

let att_def1 = "<!ATTLIST termdef
id      ID      #REQUIRED
name    CDATA   #IMPLIED>"
let att_def2 = "<!ATTLIST list
type    (bullets|ordered|glossary)  \"ordered\">"
let att_def3 = "<!ATTLIST form
method  CDATA   #FIXED \"POST\">"

test Xml.att_list_def get att_def1 =
  { "!ATTLIST" = "termdef"
    { "1"
      { "#name" = "id" }
      { "#type" = "ID" }
      { "#REQUIRED" }
    }
    { "2"
      { "#name" = "name" }
      { "#type" = "CDATA" }
      { "#IMPLIED" }
    }
  }

test Xml.att_list_def get att_def2 =
  { "!ATTLIST" = "list"
    { "1"
      { "#name" = "type" }
      { "#type" = "(bullets|ordered|glossary)" }
      { "#FIXED" = "ordered" }
    }
  }

test Xml.att_list_def get att_def3 =
  { "!ATTLIST" = "form"
    { "1"
      { "#name" = "method" }
      { "#type" = "CDATA" }
      { "#FIXED" = "POST" }
    }
  }

test Xml.notation_def get "<!NOTATION not3 SYSTEM \"\">" =
  { "!NOTATION" = "not3"
    { "SYSTEM" = "" }
  }

let cdata1 = "<![CDATA[testing]]>"
test Xml.cdata get cdata1 = { "#CDATA" = "testing" }

let attr1 = " attr1=\"value1\" attr2=\"value2\""
let attr2 = " attr2=\"foo\""
test Xml.attributes get attr1 =
  { "#attribute"
    { "attr1" = "value1" }
    { "attr2" = "value2" }
  }

test Xml.attributes get " refs=\"A1\nA2  A3\"" =
  { "#attribute"
    { "refs" = "A1\nA2  A3" }
  }

test Xml.attributes put attr1 after rm "/#attribute[1]";
                                    set "/#attribute/attr2" "foo" = attr2

let empty1 = ""
let empty2 = ""
let empty3 = "\n"
let empty4 = ""
test Xml.empty_element get empty1 = { "a" = "#empty" }
test Xml.empty_element get empty2 =
  { "a" = "#empty" { "#attribute" { "foo" = "bar"} } }

test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar" = empty2

(* the attribute node must be the first child of the element *)
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar";
                                        set "/a/#attribute/far" "baz" = empty4

test Xml.content put "" after clear "/a/b" = "\n"

test Xml.lns put "" after set "/a/#text[1]" "foo";
                                 set "/a/#text[2]" "bar" = "foobar"

test Xml.lns get "<?xml version=\"1.0\"?>
<!DOCTYPE catalog PUBLIC \"-//OASIS//DTD XML Catalogs V1.0//EN\"
  \"file:///usr/share/xml/schema/xml-core/catalog.dtd\">
  <doc/>" =
  { "#declaration"
  { "#attribute"
    { "version" = "1.0" }
  }
  }
  { "!DOCTYPE" = "catalog"
    { "PUBLIC"
      { "#literal" = "-//OASIS//DTD XML Catalogs V1.0//EN" }
      { "#literal" = "file:///usr/share/xml/schema/xml-core/catalog.dtd" }
    }
  }
  { "doc" = "#empty" }

test Xml.lns get "<oor:component-data xmlns:oor=\"http://openoffice.org/2001/registry\"/>
" =
  { "oor:component-data" = "#empty"
    { "#attribute"
      { "xmlns:oor" = "http://openoffice.org/2001/registry" }
    }
  }

let input1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>

        <title>Wiki</title>

Augeas

Augeas is now able to parse XML files!

Translate from XML to a tree syntax

Translate from the tree back to XML

this

"

test Xml.doc get input1 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }
  { "html"
    { "#text" = "\n    " }
    { "head"
      { "#text" = "\n        " }
      { "title"
        { "#text" = "Wiki" }
      }
      { "#text" = "    " }
    }
    { "#text" = "    " }
    { "body"
      { "#text" = "
        " }
      { "h1"
        { "#text" = "Augeas" }
      }
      { "#text" = "        " }
      { "p"
        { "#attribute"
          { "class" = "main" }
        }
        { "#text" = "Augeas is now able to parse XML files!" }
      }
      { "#text" = "        " }
      { "ul"
        { "#text" = "\n            " }
        { "li"
          { "#text" = "Translate from XML to a tree syntax" }
        }
        { "#text" = "            " }
        { "li"
          { "#text" = "Translate from the tree back to XML" }
        }
        { "#text" = " " }
        { "#comment" = " this is some comment " }
        { "#text" = "
            " }
        { "li"
          { "#text" = "this" }
        }
        { "#text" = "        " }
      }
      { "#text" = "    " }
    }
  }

test Xml.doc put input1 after rm "/html/body" =
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>

        <title>Wiki</title>

"

let ul1 = "

test1

test2

test3

test4

"

test Xml.doc get ul1 =
  { "ul"
    { "#text" = "
 " }
    { "li"
      { "#text" = "test1" }
    }
    { "#text" = "  " }
    { "li"
      { "#text" = "test2" }
    }
    { "#text" = "   " }
    { "li"
      { "#text" = "test3" }
    }
    { "#text" = "    " }
    { "li"
      { "#text" = "test4" }
    }
  }

test Xml.doc put ul1 after set "/ul/li[3]/#text" "bidon" = "

test1

test2

bidon

test4

"

test Xml.doc put ul1 after rm "/ul/li[2]" = "

test1

test3

test4

"

(* #text nodes don't move when inserting a node, the result depends on where the node is added *)
test Xml.doc put ul1 after insb "a" "/ul/li[2]" = "

test1

test2

test3

test4

"

test Xml.doc put ul1 after insa "a" "/ul/li[1]" = "

test1

test2

test3

test4

"

(* Attributes must be added before text nodes *)
test Xml.doc put ul1 after insb "#attribute" "/ul/li[2]/#text";
                           set "/ul/li[2]/#attribute/bidon" "gazou";
                           set "/ul/li[2]/#attribute/foo" "bar" = "

test1

test2

test3

test4

"

(* if empty element is allowed to be as root, this test triggers error *)
test Xml.lns get "<doc>
<c/><c/><c/><c/>
</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "a"
      { "c" = "#empty" }
      { "b"
        { "c" = "#empty" }
      }
      { "c" = "#empty" }
      { "c" = "#empty" }
      { "a" }
    }
  }

let p01pass2 = "<?PI before document element?>

<?PI before document element?>

<?PI before document element?>

<?PI before document element?>
<!DOCTYPE doc
[
<!ELEMENT doc ANY>
<!ELEMENT a ANY>
<!ELEMENT b ANY>
<!ELEMENT c ANY>
]>
<doc>
<c/>
</doc>

<?PI after document element?>

<?PI after document element?>

<?PI after document element?>
"

test Xml.lns get p01pass2 =
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "b"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "c"
      { "#decl" = "ANY" }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a"
      { "b"
        { "c" = "#empty" }
      }
    }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }

(* various valid Name constructions *)
test Xml.lns get "<doc>\n\n<::._-0/>\n<_:._-0/>\n\n<_/>\n<:/>\n</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "A:._-0" = "#empty" }
    { "::._-0" = "#empty" }
    { "_:._-0" = "#empty" }
    { "A" = "#empty" }
    { "_" = "#empty" }
    { ":" = "#empty" }
  }

test Xml.lns get "<doc>
<abcdefghijklmnopqrstuvwxyz/>
<ABCDEFGHIJKLMNOPQRSTUVWXYZ/>
<A01234567890/>

</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "abcdefghijklmnopqrstuvwxyz" = "#empty" }
    { "ABCDEFGHIJKLMNOPQRSTUVWXYZ" = "#empty" }
    { "A01234567890" = "#empty" }
    { "A.-:" = "#empty" }
  }

let p06fail1 = "
<!DOCTYPE doc
[
<!ELEMENT doc (a|refs)*>
<!ELEMENT a EMPTY>
<!ELEMENT refs EMPTY>
<!ATTLIST refs refs IDREFS #REQUIRED>
<!ATTLIST a id ID #REQUIRED>
]>
<doc>

<refs refs=\"\"/>
</doc>"

(* we accept this test because we do not verify XML references *)
test Xml.lns get p06fail1 =
  { "#comment" = "non-validating processors may pass this instance because they don't check the IDREFS attribute type" }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "(a|refs)*" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "EMPTY" }
    }
    { "!ELEMENT" = "refs"
      { "#decl" = "EMPTY" }
    }
    { "!ATTLIST" = "refs"
      { "1"
        { "#name" = "refs" }
        { "#type" = "IDREFS" }
        { "#REQUIRED" }
      }
    }
    { "!ATTLIST" = "a"
      { "1"
        { "#name" = "id" }
        { "#type" = "ID" }
        { "#REQUIRED" }
      }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A1" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A2" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A3" }
      }
    }
    { "refs" = "#empty"
      { "#attribute"
        { "refs" = "" }
      }
    }
  }

(* we accept dquote, but not single quotes, because of resulting ambiguity *)
let p10pass1_1 = "<doc>'">\nasdf\n    ?>%\"/></doc>"
let p10pass1_2 = "<doc>'"'/></doc>"

test Xml.lns get p10pass1_1 =
  { "doc"
    { "A" = "#empty"
      { "#attribute"
        { "a" = "asdf>'">\nasdf\n    ?>%" }
      }
    }
  }

test Xml.lns get p10pass1_2 = *

(* here again, test exclude single quote *)
let p11pass1 = "
<!DOCTYPE doc
[
<!ELEMENT doc EMPTY>
<!NOTATION not1 SYSTEM \"a%a&b&#0<!ELEMENT

<doc></doc>"

test Xml.lns get p15pass1 =
  { "#comment" = "a
<!DOCTYPE
<?-
]]>-<[ CDATA [
\"- -'-
-<doc>" }
  { "#comment" = "" }
  { "doc" }

let p22pass3 = "<?xml version=\"1.0\"?>
 <?pi some instruction ?>
<doc><?pi?></doc>"

test Xml.lns get p22pass3 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "#comment" = "comment" }
  { "#pi"
    { "#target" = "pi" }
    { "#instruction" = "some instruction" }
  }
  { "doc"
    { "#pi"
      { "#target" = "pi" }
    }
  }

let p25pass2 = "<?xml version

=

\"1.0\"?>
<doc></doc>"

test Xml.lns get p25pass2 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "doc" }

test Xml.lns get "<!DOCTYPE

doc

[
<!ELEMENT doc EMPTY>
]>
<doc></doc>" =
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "EMPTY" }
    }
  }
  { "doc" }

test Xml.lns get "<doc></doc  \n>" = { "doc" }

test Xml.lns get "<doc att=\"val\" \natt2=\"val2\" att3=\"val3\"/>" =
  { "a"
    { "doc" = "#empty"
      { "#attribute"
        { "att" = "val" }
        { "att2" = "val2" }
        { "att3" = "val3" }
      }
    }
  }

test Xml.lns get "<doc/>" = { "doc" = "#empty" }

(* failure tests *)
(* only one document element *)
test Xml.lns get "<doc></doc><bad/>" = *

(* document element must be complete *)
test Xml.lns get "<doc>" = *

(* emtpy document is rejected *)
test Xml.lns get "" = *

(* malformed element *)
test Xml.lns get "" = *

(* a Name cannot start with a digit *)
test Xml.lns get "<0A/>" = *

(* no space before "CDATA" *)
test Xml.lns get "<doc><![ CDATA[a]]></doc>" = *

(* no space after "CDATA" *)
test Xml.lns get "<doc><![CDATA [a]]></doc>" = *

(* CDSect's can't nest *)
test Xml.lns get "<doc>
<![CDATA[
<![CDATA[XML doesn't allow CDATA sections to nest]]>
]]>
</doc>" = *

(* Comment is illegal in VersionInfo *)
test Xml.lns get "<?xml version  =\"1.0\"?>
<doc></doc>" = *

(* only declarations in DTD *)
test Xml.lns get "<!DOCTYPE doc [
<!ELEMENT doc EMPTY>
<doc></doc>
]>" = *

(* we do not support external entities *)
test Xml.lns get "<!DOCTYPE doc [
<!ENTITY % eldecl \"<!ELEMENT doc EMPTY>\">
%eldecl;
]>
<doc></doc>" = *


Fix put test - it was checking for hte wrong result

module Pass_subtree_growth =

  (* Make sure that a subtree that is not the lowest one does indeed *)
  (* grow the tree, instead of just setting the label of an enclosed *)
  (* subtree. This is only a problem if the enclosed subtree does    *)
  (* not have a label                                                *)

  let lns = [ label "outer" . [ store /a/ ] ]

  (* The improper result is { "outer" = "a" } *)
  test lns get "a" = { "outer" { = "a" } }

  (* This produces a tree { "outer" = "b" { = "a" } }         *)
  (* but the value for "outer" is never used in put           *)
  (* (That should probably be flagged as an error separately) *)
  test lns put "a" after set "outer" "b" = "a"

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)

module Pass_subtree_growth =

  (* Make sure that a subtree that is not the lowest one does indeed *)
  (* grow the tree, instead of just setting the label of an enclosed *)
  (* subtree. This is only a problem if the enclosed subtree does    *)
  (* not have a label                                                *)

  let lns = [ label "outer" . [ store /a/ ] ]

  (* The improper result is { "outer" = "a" } *)
  test lns get "a" = { "outer" { = "a" } }

  test lns put "a" after set "outer" "b" = "b"

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)


Add more recent nagios lens

Add more recent nagios lens

(*
Module: NagiosConfig
  Parses /etc/{nagios{3,},icinga/*.cfg

Authors: Sebastien Aperghis-Tramoni <sebastien@aperghis.net>
         Raphaël Pinson <raphink@gmail.com>

About: License
  This file is licenced under the LGPL v2+, like the rest of Augeas.

About: Lens Usage
  To be documented

About: Configuration files
  This lens applies to /etc/{nagios{3,},icinga/*.cfg. See <filter>.
*)

module NagiosCfg =
autoload xfm

(************************************************************************
 * Group: Utility variables/functions
 ************************************************************************)
(* View: param_def
    define a field *)
let param_def =
     let space_in  = /[^ \t\n][^\n=]*[^ \t\n]|[^ \t\n]/
  in key /[A-Za-z0-9_]+/
   . Sep.space_equal
   . store space_in

(* View: macro_def
    Macro line, as used in resource.cfg *)
let macro_def =
     let macro = /\$[A-Za-z0-9]+\$/
       in let macro_decl = Rx.word | Rx.fspath
     in key macro . Sep.space_equal . store macro_decl

(************************************************************************
 * Group: Entries
 ************************************************************************)
(* View: param
    Params can have sub params *)
let param =
     [ Util.indent . param_def
     . [ Sep.space . param_def ]*
     . Util.eol ]

(* View: macro *)
let macro = [ Util.indent . macro_def . Util.eol ]

(************************************************************************
 * Group: Lens
 ************************************************************************)
(* View: entry
    Define the accepted entries, such as param for regular configuration
    files, and macro for resources.cfg .*)
let entry = param
	  | macro

(* View: lns
    main structure *)
let lns = ( Util.empty | Util.comment | entry )*

(* View: filter *)
let filter = incl "/etc/nagios3/*.cfg"
           . incl "/etc/nagios/*.cfg"
	   . incl "/etc/icinga/*.cfg"
	   . excl "/etc/nagios3/commands.cfg"
	   . excl "/etc/nagios/commands.cfg"
	   . excl "/etc/nagios/nrpe.cfg"
	   . incl "/etc/icinga/commands.cfg"

let xfm = transform lns filter

error: pathspec 'modules/nagios/lib/augeas/lenses/nagioscfg.aug' did not match any file(s) known to git


Php: expand filter slightly

Php: expand filter slightly

Suggested by Robin Lee Powell <rlpowell@digitalkingdom.org>

(* PHP module for Augeas                      *)
(* Author: Raphael Pinson <raphink@gmail.com> *)
(*                                            *)

module PHP =
  autoload xfm

(************************************************************************
 * INI File settings
 *************************************************************************)

let comment  = IniFile.comment IniFile.comment_re IniFile.comment_default
let sep      = IniFile.sep IniFile.sep_re IniFile.sep_default
let empty    = IniFile.empty

(************************************************************************
 *                        ENTRY
 *
 * We have to remove the keyword "section" from possible entry keywords
 * otherwise it would lead to an ambiguity with the "section" label
 * since PHP allows entries outside of sections.
 *************************************************************************)
let entry    = IniFile.entry IniFile.entry_re sep comment

(************************************************************************
 *                         TITLE
 *
 * We use IniFile.title_label because there can be entries
 * outside of sections whose labels would conflict with section names
 *************************************************************************)
let title       = IniFile.title ( IniFile.record_re - ".anon" )
let record      = IniFile.record title entry

let record_anon = [ label ".anon" . ( entry | empty )+ ]

(************************************************************************
 *                         LENS & FILTER
 * There can be entries before any section
 * IniFile.entry includes comment management, so we just pass entry to lns
 *************************************************************************)
let lns    = record_anon? . record*

let filter = (incl "/etc/php*/*/*.ini")
             . Util.stdexcl

let xfm = transform lns filter

(* PHP module for Augeas                      *)
(* Author: Raphael Pinson <raphink@gmail.com> *)
(*                                            *)

module PHP =
  autoload xfm

(************************************************************************
 * INI File settings
 *************************************************************************)

let comment  = IniFile.comment IniFile.comment_re IniFile.comment_default
let sep      = IniFile.sep IniFile.sep_re IniFile.sep_default
let empty    = IniFile.empty

(************************************************************************
 *                        ENTRY
 *
 * We have to remove the keyword "section" from possible entry keywords
 * otherwise it would lead to an ambiguity with the "section" label
 * since PHP allows entries outside of sections.
 *************************************************************************)
let entry    = IniFile.entry IniFile.entry_re sep comment

(************************************************************************
 *                         TITLE
 *
 * We use IniFile.title_label because there can be entries
 * outside of sections whose labels would conflict with section names
 *************************************************************************)
let title       = IniFile.title ( IniFile.record_re - ".anon" )
let record      = IniFile.record title entry

let record_anon = [ label ".anon" . ( entry | empty )+ ]

(************************************************************************
 *                         LENS & FILTER
 * There can be entries before any section
 * IniFile.entry includes comment management, so we just pass entry to lns
 *************************************************************************)
let lns    = record_anon? . record*

let filter = (incl "/etc/php*/*/php.ini")
             . Util.stdexcl

let xfm = transform lns filter


Xml test (input1): modify to mildly check handling DOS line endings

(*
Module: Test_Xml
  Provides unit tests and examples for the <Xml> lens.
*)

module Test_Xml =

(* View: knode
   A simple flag function

   Parameters:
    r:regexp - the pattern for the flag
*)
let knode (r:regexp) = [ key r ]

(************************************************************************
 *                          Group: Utilities lens
 *************************************************************************)
(*
let _ = print_regexp(lens_ctype(Xml.text))
let _ = print_endline ""
*)

(* Group: Comments *)

(* Test: Xml.comment
   Comments get mapped into "#comment" nodes. *)
test Xml.comment get
 "" =

  { "#comment" = " declarations for  &  " }

(* Test: Xml.comment
   This syntax is not understood. *)
test Xml.comment get
 "" = *

(* Group: Prolog and declarations *)

(* Test: Xml.prolog
   The XML prolog tag is mapped in a "#declaration" node,
   which contains an "#attribute" node with various attributes of the tag. *)
test Xml.prolog get
 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" =

  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }

(* Test: Xml.decl_def_item
   !ELEMENT declaration tags are mapped in "!ELEMENT" nodes.
   The associated declaration attribute is mapped in a "#decl" subnode. *)
test Xml.decl_def_item get
 "<!ELEMENT greeting (#PCDATA)>" =

  { "!ELEMENT" = "greeting"
    { "#decl" = "(#PCDATA)" }
  }

(* Test: Xml.decl_def_item
   !ENTITY declaration tags are mapped in "!ENTITY" nodes.
   The associated declaration attribute is mapped in a "#decl" subnode. *)
test Xml.decl_def_item get
 "<!ENTITY da \"
\">" =

  { "!ENTITY" = "da"
    { "#decl" = "
" }
  }

(* Test: Xml.doctype
   !DOCTYPE tags are mapped in "!DOCTYPE" nodes.
   The associated system attribute is mapped in a "SYSTEM" subnode. *)
test Xml.doctype get
 "<!DOCTYPE greeting SYSTEM \"hello.dtd\">" =

  { "!DOCTYPE" = "greeting"
    { "SYSTEM" = "hello.dtd" }
  }

(* Test: Xml.doctype
   This is an example of a !DOCTYPE tag with !ELEMENT children tags. *)
test Xml.doctype get "<!DOCTYPE foo [
<!ELEMENT bar (#PCDATA)>
<!ELEMENT baz (bar)* >
]>" =

  { "!DOCTYPE" = "foo"
    { "!ELEMENT" = "bar"
      { "#decl" = "(#PCDATA)" }
    }
    { "!ELEMENT" = "baz"
      { "#decl" = "(bar)*" }
    }
  }

(* Group: Attributes *)

(* Variable: att_def1 *)
let att_def1 = "<!ATTLIST termdef
id      ID      #REQUIRED
name    CDATA   #IMPLIED>"
(* Variable: att_def2 *)
let att_def2 = "<!ATTLIST list
type    (bullets|ordered|glossary)  \"ordered\">"
(* Variable: att_def3 *)
let att_def3 = "<!ATTLIST form
method  CDATA   #FIXED \"POST\">"

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def1 =

  { "!ATTLIST" = "termdef"
    { "1"
      { "#name" = "id" }
      { "#type" = "ID" }
      { "#REQUIRED" }
    }
    { "2"
      { "#name" = "name" }
      { "#type" = "CDATA" }
      { "#IMPLIED" }
    }
  }

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def2 =

  { "!ATTLIST" = "list"
    { "1"
      { "#name" = "type" }
      { "#type" = "(bullets|ordered|glossary)" }
      { "#FIXED" = "ordered" }
    }
  }

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def3 =

  { "!ATTLIST" = "form"
    { "1"
      { "#name" = "method" }
      { "#type" = "CDATA" }
      { "#FIXED" = "POST" }
    }
  }

(* Test: Xml.notation_def *)
test Xml.notation_def get
 "<!NOTATION not3 SYSTEM \"\">" =

  { "!NOTATION" = "not3"
    { "SYSTEM" = "" }
  }

(* Variable: cdata1 *)
let cdata1 = "<![CDATA[testing]]>"
(* Test: Xml.cdata *)
test Xml.cdata get cdata1 = { "#CDATA" = "testing" }

(* Variable: attr1 *)
let attr1 = " attr1=\"value1\" attr2=\"value2\""
(* Variable: attr2 *)
let attr2 = " attr2=\"foo\""
(* Test: Xml.attributes *)
test Xml.attributes get attr1 =
  { "#attribute"
    { "attr1" = "value1" }
    { "attr2" = "value2" }
  }

(* Test: Xml.attributes *)
test Xml.attributes get " refs=\"A1\nA2  A3\"" =
  { "#attribute"
    { "refs" = "A1\nA2  A3" }
  }

(* Test: Xml.attributes *)
test Xml.attributes put attr1 after rm "/#attribute[1]";
                                    set "/#attribute/attr2" "foo" = attr2

(* test quoting *)
(* well formed values *)
test Xml.attributes get " attr1=\"value1\"" = { "#attribute" { "attr1" = "value1" } }
test Xml.attributes get " attr1='value1'" = { "#attribute" { "attr1" = "value1" } }
test Xml.attributes get " attr1='va\"lue1'" = { "#attribute" { "attr1" = "va\"lue1" } }
test Xml.attributes get " attr1=\"va'lue1\"" = { "#attribute" { "attr1" = "va'lue1" } }

(* illegal as per the XML standard *)
test Xml.attributes get " attr1=\"va\"lue1\"" = *
test Xml.attributes get " attr1='va'lue1'" = *

(* malformed values *)
test Xml.attributes get " attr1=\"value1'" = *
test Xml.attributes get " attr1='value1\"" = *

(* Group: empty *)

(* Variable: empty1 *)
let empty1 = ""
(* Variable: empty2 *)
let empty2 = ""
(* Variable: empty3 *)
let empty3 = "\n"
(* Variable: empty4 *)
let empty4 = ""
(* Test: Xml.empty_element *)
test Xml.empty_element get empty1 = { "a" = "#empty" }
(* Test: Xml.empty_element *)
test Xml.empty_element get empty2 =
  { "a" = "#empty" { "#attribute" { "foo" = "bar"} } }

(* Test: Xml.empty_element *)
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar" = empty2

(* Test: Xml.empty_element
   The attribute node must be the first child of the element *)
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar";
                                        set "/a/#attribute/far" "baz" = empty4

(* Test: Xml.content *)
test Xml.content put "" after clear "/a/b" = "\n"

(* Group: Full lens *)

(* Test: Xml.lns *)
test Xml.lns put "" after set "/a/#text[1]" "foo";
                                 set "/a/#text[2]" "bar" = "foobar"

(* Test: Xml.lns *)
test Xml.lns get "<?xml version=\"1.0\"?>
<!DOCTYPE catalog PUBLIC \"-//OASIS//DTD XML Catalogs V1.0//EN\"
  \"file:///usr/share/xml/schema/xml-core/catalog.dtd\">
  <doc/>" =
  { "#declaration"
  { "#attribute"
    { "version" = "1.0" }
  }
  }
  { "!DOCTYPE" = "catalog"
    { "PUBLIC"
      { "#literal" = "-//OASIS//DTD XML Catalogs V1.0//EN" }
      { "#literal" = "file:///usr/share/xml/schema/xml-core/catalog.dtd" }
    }
  }
  { "doc" = "#empty" }

(* Test: Xml.lns *)
test Xml.lns get "<oor:component-data xmlns:oor=\"http://openoffice.org/2001/registry\"/>
" =
  { "oor:component-data" = "#empty"
    { "#attribute"
      { "xmlns:oor" = "http://openoffice.org/2001/registry" }
    }
  }

(* Variable: input1 *)
let input1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
\r

        <title>Wiki</title>

Augeas

Augeas is now able to parse XML files!

Translate from XML to a tree syntax

Translate from the tree back to XML

this

"

(* Test: Xml.doc
   Test <input1> with <Xml.doc> *)
test Xml.doc get input1 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }
  { "html"
    { "#text" = "\r\n    " }
    { "head"
      { "#text" = "\n        " }
      { "title"
        { "#text" = "Wiki" }
      }
      { "#text" = "    " }
    }
    { "#text" = "    " }
    { "body"
      { "#text" = "
        " }
      { "h1"
        { "#text" = "Augeas" }
      }
      { "#text" = "        " }
      { "p"
        { "#attribute"
          { "class" = "main" }
        }
        { "#text" = "Augeas is now able to parse XML files!" }
      }
      { "#text" = "        " }
      { "ul"
        { "#text" = "\n            " }
        { "li"
          { "#text" = "Translate from XML to a tree syntax" }
        }
        { "#text" = "            " }
        { "li"
          { "#text" = "Translate from the tree back to XML" }
        }
        { "#text" = " " }
        { "#comment" = " this is some comment " }
        { "#text" = "
            " }
        { "li"
          { "#text" = "this" }
        }
        { "#text" = "        " }
      }
      { "#text" = "    " }
    }
  }

(* Test: Xml.doc
   Modify <input1> with <Xml.doc> *)
test Xml.doc put input1 after rm "/html/body" =
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
\r

        <title>Wiki</title>

"

(* Variable: ul1 *)
let ul1 = "

test1

test2

test3

test4

"

test Xml.doc get ul1 =
  { "ul"
    { "#text" = "
 " }
    { "li"
      { "#text" = "test1" }
    }
    { "#text" = "  " }
    { "li"
      { "#text" = "test2" }
    }
    { "#text" = "   " }
    { "li"
      { "#text" = "test3" }
    }
    { "#text" = "    " }
    { "li"
      { "#text" = "test4" }
    }
  }

test Xml.doc put ul1 after set "/ul/li[3]/#text" "bidon" = "

test1

test2

bidon

test4

"

test Xml.doc put ul1 after rm "/ul/li[2]" = "

test1

test3

test4

"

(* #text nodes don't move when inserting a node, the result depends on where the node is added *)
test Xml.doc put ul1 after insb "a" "/ul/li[2]" = "

test1

test2

test3

test4

"

test Xml.doc put ul1 after insa "a" "/ul/li[1]" = "

test1

test2

test3

test4

"

(* Attributes must be added before text nodes *)
test Xml.doc put ul1 after insb "#attribute" "/ul/li[2]/#text";
                           set "/ul/li[2]/#attribute/bidon" "gazou";
                           set "/ul/li[2]/#attribute/foo" "bar" = "

test1

test2

test3

test4

"

(* if empty element is allowed to be as root, this test triggers error *)
test Xml.lns get "<doc>
<c/><c/><c/><c/>
</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "a"
      { "c" = "#empty" }
      { "b"
        { "c" = "#empty" }
      }
      { "c" = "#empty" }
      { "c" = "#empty" }
      { "a" }
    }
  }

let p01pass2 = "<?PI before document element?>

<?PI before document element?>

<?PI before document element?>

<?PI before document element?>
<!DOCTYPE doc
[
<!ELEMENT doc ANY>
<!ELEMENT a ANY>
<!ELEMENT b ANY>
<!ELEMENT c ANY>
]>
<doc>
<c/>
</doc>

<?PI after document element?>

<?PI after document element?>

<?PI after document element?>
"

test Xml.lns get p01pass2 =
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "b"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "c"
      { "#decl" = "ANY" }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a"
      { "b"
        { "c" = "#empty" }
      }
    }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }

(* various valid Name constructions *)
test Xml.lns get "<doc>\n\n<::._-0/>\n<_:._-0/>\n\n<_/>\n<:/>\n</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "A:._-0" = "#empty" }
    { "::._-0" = "#empty" }
    { "_:._-0" = "#empty" }
    { "A" = "#empty" }
    { "_" = "#empty" }
    { ":" = "#empty" }
  }

test Xml.lns get "<doc>
<abcdefghijklmnopqrstuvwxyz/>
<ABCDEFGHIJKLMNOPQRSTUVWXYZ/>
<A01234567890/>

</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "abcdefghijklmnopqrstuvwxyz" = "#empty" }
    { "ABCDEFGHIJKLMNOPQRSTUVWXYZ" = "#empty" }
    { "A01234567890" = "#empty" }
    { "A.-:" = "#empty" }
  }

let p06fail1 = "
<!DOCTYPE doc
[
<!ELEMENT doc (a|refs)*>
<!ELEMENT a EMPTY>
<!ELEMENT refs EMPTY>
<!ATTLIST refs refs IDREFS #REQUIRED>
<!ATTLIST a id ID #REQUIRED>
]>
<doc>

<refs refs=\"\"/>
</doc>"

(* we accept this test because we do not verify XML references *)
test Xml.lns get p06fail1 =
  { "#comment" = "non-validating processors may pass this instance because they don't check the IDREFS attribute type" }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "(a|refs)*" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "EMPTY" }
    }
    { "!ELEMENT" = "refs"
      { "#decl" = "EMPTY" }
    }
    { "!ATTLIST" = "refs"
      { "1"
        { "#name" = "refs" }
        { "#type" = "IDREFS" }
        { "#REQUIRED" }
      }
    }
    { "!ATTLIST" = "a"
      { "1"
        { "#name" = "id" }
        { "#type" = "ID" }
        { "#REQUIRED" }
      }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A1" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A2" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A3" }
      }
    }
    { "refs" = "#empty"
      { "#attribute"
        { "refs" = "" }
      }
    }
  }

(* we accept dquote, but not single quotes, because of resulting ambiguity *)
let p10pass1_1 = "<doc>'">\nasdf\n    ?>%\"/></doc>"
let p10pass1_2 = "<doc>'"'/></doc>"

test Xml.lns get p10pass1_1 =
  { "doc"
    { "A" = "#empty"
      { "#attribute"
        { "a" = "asdf>'">\nasdf\n    ?>%" }
      }
    }
  }

test Xml.lns get p10pass1_2 =
  { "doc"
    { "A" = "#empty"
      { "#attribute"
        { "a" = "\"\">'"" }
      }
    }
  }

(* here again, test exclude single quote *)
let p11pass1 = "
<!DOCTYPE doc
[
<!ELEMENT doc EMPTY>
<!NOTATION not1 SYSTEM \"a%a&b&#0<!ELEMENT

<doc></doc>"

test Xml.lns get p15pass1 =
  { "#comment" = "a
<!DOCTYPE
<?-
]]>-<[ CDATA [
\"- -'-
-<doc>" }
  { "#comment" = "" }
  { "doc" }

let p22pass3 = "<?xml version=\"1.0\"?>
 <?pi some instruction ?>
<doc><?pi?></doc>"

test Xml.lns get p22pass3 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "#comment" = "comment" }
  { "#pi"
    { "#target" = "pi" }
    { "#instruction" = "some instruction" }
  }
  { "doc"
    { "#pi"
      { "#target" = "pi" }
    }
  }

let p25pass2 = "<?xml version

=

\"1.0\"?>
<doc></doc>"

test Xml.lns get p25pass2 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "doc" }

test Xml.lns get "<!DOCTYPE

doc

[
<!ELEMENT doc EMPTY>
]>
<doc></doc>" =
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "EMPTY" }
    }
  }
  { "doc" }

test Xml.lns get "<doc></doc  \n>" = { "doc" }

test Xml.lns get "<doc att=\"val\" \natt2=\"val2\" att3=\"val3\"/>" =
  { "a"
    { "doc" = "#empty"
      { "#attribute"
        { "att" = "val" }
        { "att2" = "val2" }
        { "att3" = "val3" }
      }
    }
  }

test Xml.lns get "<doc/>" = { "doc" = "#empty" }

(* failure tests *)
(* only one document element *)
test Xml.lns get "<doc></doc><bad/>" = *

(* document element must be complete *)
test Xml.lns get "<doc>" = *

(* emtpy document is rejected *)
test Xml.lns get "" = *

(* malformed element *)
test Xml.lns get "" = *

(* a Name cannot start with a digit *)
test Xml.lns get "<0A/>" = *

(* no space before "CDATA" *)
test Xml.lns get "<doc><![ CDATA[a]]></doc>" = *

(* no space after "CDATA" *)
test Xml.lns get "<doc><![CDATA [a]]></doc>" = *

(* CDSect's can't nest *)
test Xml.lns get "<doc>
<![CDATA[
<![CDATA[XML doesn't allow CDATA sections to nest]]>
]]>
</doc>" = *

(* Comment is illegal in VersionInfo *)
test Xml.lns get "<?xml version  =\"1.0\"?>
<doc></doc>" = *

(* only declarations in DTD *)
test Xml.lns get "<!DOCTYPE doc [
<!ELEMENT doc EMPTY>
<doc></doc>
]>" = *

(* we do not support external entities *)
test Xml.lns get "<!DOCTYPE doc [
<!ENTITY % eldecl \"<!ELEMENT doc EMPTY>\">
%eldecl;
]>
<doc></doc>" = *

(*
Module: Test_Xml
  Provides unit tests and examples for the <Xml> lens.
*)

module Test_Xml =

(* View: knode
   A simple flag function

   Parameters:
    r:regexp - the pattern for the flag
*)
let knode (r:regexp) = [ key r ]

(************************************************************************
 *                          Group: Utilities lens
 *************************************************************************)
(*
let _ = print_regexp(lens_ctype(Xml.text))
let _ = print_endline ""
*)

(* Group: Comments *)

(* Test: Xml.comment
   Comments get mapped into "#comment" nodes. *)
test Xml.comment get
 "" =

  { "#comment" = " declarations for  &  " }

(* Test: Xml.comment
   This syntax is not understood. *)
test Xml.comment get
 "" = *

(* Group: Prolog and declarations *)

(* Test: Xml.prolog
   The XML prolog tag is mapped in a "#declaration" node,
   which contains an "#attribute" node with various attributes of the tag. *)
test Xml.prolog get
 "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" =

  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }

(* Test: Xml.decl_def_item
   !ELEMENT declaration tags are mapped in "!ELEMENT" nodes.
   The associated declaration attribute is mapped in a "#decl" subnode. *)
test Xml.decl_def_item get
 "<!ELEMENT greeting (#PCDATA)>" =

  { "!ELEMENT" = "greeting"
    { "#decl" = "(#PCDATA)" }
  }

(* Test: Xml.decl_def_item
   !ENTITY declaration tags are mapped in "!ENTITY" nodes.
   The associated declaration attribute is mapped in a "#decl" subnode. *)
test Xml.decl_def_item get
 "<!ENTITY da \"
\">" =

  { "!ENTITY" = "da"
    { "#decl" = "
" }
  }

(* Test: Xml.doctype
   !DOCTYPE tags are mapped in "!DOCTYPE" nodes.
   The associated system attribute is mapped in a "SYSTEM" subnode. *)
test Xml.doctype get
 "<!DOCTYPE greeting SYSTEM \"hello.dtd\">" =

  { "!DOCTYPE" = "greeting"
    { "SYSTEM" = "hello.dtd" }
  }

(* Test: Xml.doctype
   This is an example of a !DOCTYPE tag with !ELEMENT children tags. *)
test Xml.doctype get "<!DOCTYPE foo [
<!ELEMENT bar (#PCDATA)>
<!ELEMENT baz (bar)* >
]>" =

  { "!DOCTYPE" = "foo"
    { "!ELEMENT" = "bar"
      { "#decl" = "(#PCDATA)" }
    }
    { "!ELEMENT" = "baz"
      { "#decl" = "(bar)*" }
    }
  }

(* Group: Attributes *)

(* Variable: att_def1 *)
let att_def1 = "<!ATTLIST termdef
id      ID      #REQUIRED
name    CDATA   #IMPLIED>"
(* Variable: att_def2 *)
let att_def2 = "<!ATTLIST list
type    (bullets|ordered|glossary)  \"ordered\">"
(* Variable: att_def3 *)
let att_def3 = "<!ATTLIST form
method  CDATA   #FIXED \"POST\">"

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def1 =

  { "!ATTLIST" = "termdef"
    { "1"
      { "#name" = "id" }
      { "#type" = "ID" }
      { "#REQUIRED" }
    }
    { "2"
      { "#name" = "name" }
      { "#type" = "CDATA" }
      { "#IMPLIED" }
    }
  }

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def2 =

  { "!ATTLIST" = "list"
    { "1"
      { "#name" = "type" }
      { "#type" = "(bullets|ordered|glossary)" }
      { "#FIXED" = "ordered" }
    }
  }

(* Test: Xml.att_list_def *)
test Xml.att_list_def get
 att_def3 =

  { "!ATTLIST" = "form"
    { "1"
      { "#name" = "method" }
      { "#type" = "CDATA" }
      { "#FIXED" = "POST" }
    }
  }

(* Test: Xml.notation_def *)
test Xml.notation_def get
 "<!NOTATION not3 SYSTEM \"\">" =

  { "!NOTATION" = "not3"
    { "SYSTEM" = "" }
  }

(* Variable: cdata1 *)
let cdata1 = "<![CDATA[testing]]>"
(* Test: Xml.cdata *)
test Xml.cdata get cdata1 = { "#CDATA" = "testing" }

(* Variable: attr1 *)
let attr1 = " attr1=\"value1\" attr2=\"value2\""
(* Variable: attr2 *)
let attr2 = " attr2=\"foo\""
(* Test: Xml.attributes *)
test Xml.attributes get attr1 =
  { "#attribute"
    { "attr1" = "value1" }
    { "attr2" = "value2" }
  }

(* Test: Xml.attributes *)
test Xml.attributes get " refs=\"A1\nA2  A3\"" =
  { "#attribute"
    { "refs" = "A1\nA2  A3" }
  }

(* Test: Xml.attributes *)
test Xml.attributes put attr1 after rm "/#attribute[1]";
                                    set "/#attribute/attr2" "foo" = attr2

(* test quoting *)
(* well formed values *)
test Xml.attributes get " attr1=\"value1\"" = { "#attribute" { "attr1" = "value1" } }
test Xml.attributes get " attr1='value1'" = { "#attribute" { "attr1" = "value1" } }
test Xml.attributes get " attr1='va\"lue1'" = { "#attribute" { "attr1" = "va\"lue1" } }
test Xml.attributes get " attr1=\"va'lue1\"" = { "#attribute" { "attr1" = "va'lue1" } }

(* illegal as per the XML standard *)
test Xml.attributes get " attr1=\"va\"lue1\"" = *
test Xml.attributes get " attr1='va'lue1'" = *

(* malformed values *)
test Xml.attributes get " attr1=\"value1'" = *
test Xml.attributes get " attr1='value1\"" = *

(* Group: empty *)

(* Variable: empty1 *)
let empty1 = ""
(* Variable: empty2 *)
let empty2 = ""
(* Variable: empty3 *)
let empty3 = "\n"
(* Variable: empty4 *)
let empty4 = ""
(* Test: Xml.empty_element *)
test Xml.empty_element get empty1 = { "a" = "#empty" }
(* Test: Xml.empty_element *)
test Xml.empty_element get empty2 =
  { "a" = "#empty" { "#attribute" { "foo" = "bar"} } }

(* Test: Xml.empty_element *)
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar" = empty2

(* Test: Xml.empty_element
   The attribute node must be the first child of the element *)
test Xml.empty_element put empty1 after set "/a/#attribute/foo" "bar";
                                        set "/a/#attribute/far" "baz" = empty4

(* Test: Xml.content *)
test Xml.content put "" after clear "/a/b" = "\n"

(* Group: Full lens *)

(* Test: Xml.lns *)
test Xml.lns put "" after set "/a/#text[1]" "foo";
                                 set "/a/#text[2]" "bar" = "foobar"

(* Test: Xml.lns *)
test Xml.lns get "<?xml version=\"1.0\"?>
<!DOCTYPE catalog PUBLIC \"-//OASIS//DTD XML Catalogs V1.0//EN\"
  \"file:///usr/share/xml/schema/xml-core/catalog.dtd\">
  <doc/>" =
  { "#declaration"
  { "#attribute"
    { "version" = "1.0" }
  }
  }
  { "!DOCTYPE" = "catalog"
    { "PUBLIC"
      { "#literal" = "-//OASIS//DTD XML Catalogs V1.0//EN" }
      { "#literal" = "file:///usr/share/xml/schema/xml-core/catalog.dtd" }
    }
  }
  { "doc" = "#empty" }

(* Test: Xml.lns *)
test Xml.lns get "<oor:component-data xmlns:oor=\"http://openoffice.org/2001/registry\"/>
" =
  { "oor:component-data" = "#empty"
    { "#attribute"
      { "xmlns:oor" = "http://openoffice.org/2001/registry" }
    }
  }

(* Variable: input1 *)
let input1 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>

        <title>Wiki</title>

Augeas

Augeas is now able to parse XML files!

Translate from XML to a tree syntax

Translate from the tree back to XML

this

"

(* Test: Xml.doc
   Test <input1> with <Xml.doc> *)
test Xml.doc get input1 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
      { "encoding" = "UTF-8" }
    }
  }
  { "html"
    { "#text" = "\n    " }
    { "head"
      { "#text" = "\n        " }
      { "title"
        { "#text" = "Wiki" }
      }
      { "#text" = "    " }
    }
    { "#text" = "    " }
    { "body"
      { "#text" = "
        " }
      { "h1"
        { "#text" = "Augeas" }
      }
      { "#text" = "        " }
      { "p"
        { "#attribute"
          { "class" = "main" }
        }
        { "#text" = "Augeas is now able to parse XML files!" }
      }
      { "#text" = "        " }
      { "ul"
        { "#text" = "\n            " }
        { "li"
          { "#text" = "Translate from XML to a tree syntax" }
        }
        { "#text" = "            " }
        { "li"
          { "#text" = "Translate from the tree back to XML" }
        }
        { "#text" = " " }
        { "#comment" = " this is some comment " }
        { "#text" = "
            " }
        { "li"
          { "#text" = "this" }
        }
        { "#text" = "        " }
      }
      { "#text" = "    " }
    }
  }

(* Test: Xml.doc
   Modify <input1> with <Xml.doc> *)
test Xml.doc put input1 after rm "/html/body" =
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>

        <title>Wiki</title>

"

(* Variable: ul1 *)
let ul1 = "

test1

test2

test3

test4

"

test Xml.doc get ul1 =
  { "ul"
    { "#text" = "
 " }
    { "li"
      { "#text" = "test1" }
    }
    { "#text" = "  " }
    { "li"
      { "#text" = "test2" }
    }
    { "#text" = "   " }
    { "li"
      { "#text" = "test3" }
    }
    { "#text" = "    " }
    { "li"
      { "#text" = "test4" }
    }
  }

test Xml.doc put ul1 after set "/ul/li[3]/#text" "bidon" = "

test1

test2

bidon

test4

"

test Xml.doc put ul1 after rm "/ul/li[2]" = "

test1

test3

test4

"

(* #text nodes don't move when inserting a node, the result depends on where the node is added *)
test Xml.doc put ul1 after insb "a" "/ul/li[2]" = "

test1

test2

test3

test4

"

test Xml.doc put ul1 after insa "a" "/ul/li[1]" = "

test1

test2

test3

test4

"

(* Attributes must be added before text nodes *)
test Xml.doc put ul1 after insb "#attribute" "/ul/li[2]/#text";
                           set "/ul/li[2]/#attribute/bidon" "gazou";
                           set "/ul/li[2]/#attribute/foo" "bar" = "

test1

test2

test3

test4

"

(* if empty element is allowed to be as root, this test triggers error *)
test Xml.lns get "<doc>
<c/><c/><c/><c/>
</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "a"
      { "c" = "#empty" }
      { "b"
        { "c" = "#empty" }
      }
      { "c" = "#empty" }
      { "c" = "#empty" }
      { "a" }
    }
  }

let p01pass2 = "<?PI before document element?>

<?PI before document element?>

<?PI before document element?>

<?PI before document element?>
<!DOCTYPE doc
[
<!ELEMENT doc ANY>
<!ELEMENT a ANY>
<!ELEMENT b ANY>
<!ELEMENT c ANY>
]>
<doc>
<c/>
</doc>

<?PI after document element?>

<?PI after document element?>

<?PI after document element?>
"

test Xml.lns get p01pass2 =
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "before document element" }
  }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "b"
      { "#decl" = "ANY" }
    }
    { "!ELEMENT" = "c"
      { "#decl" = "ANY" }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a"
      { "b"
        { "c" = "#empty" }
      }
    }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }
  { "#comment" = " comment after document element" }
  { "#pi"
    { "#target" = "PI" }
    { "#instruction" = "after document element" }
  }

(* various valid Name constructions *)
test Xml.lns get "<doc>\n\n<::._-0/>\n<_:._-0/>\n\n<_/>\n<:/>\n</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "A:._-0" = "#empty" }
    { "::._-0" = "#empty" }
    { "_:._-0" = "#empty" }
    { "A" = "#empty" }
    { "_" = "#empty" }
    { ":" = "#empty" }
  }

test Xml.lns get "<doc>
<abcdefghijklmnopqrstuvwxyz/>
<ABCDEFGHIJKLMNOPQRSTUVWXYZ/>
<A01234567890/>

</doc>" =
  { "doc"
    { "#text" = "\n" }
    { "abcdefghijklmnopqrstuvwxyz" = "#empty" }
    { "ABCDEFGHIJKLMNOPQRSTUVWXYZ" = "#empty" }
    { "A01234567890" = "#empty" }
    { "A.-:" = "#empty" }
  }

let p06fail1 = "
<!DOCTYPE doc
[
<!ELEMENT doc (a|refs)*>
<!ELEMENT a EMPTY>
<!ELEMENT refs EMPTY>
<!ATTLIST refs refs IDREFS #REQUIRED>
<!ATTLIST a id ID #REQUIRED>
]>
<doc>

<refs refs=\"\"/>
</doc>"

(* we accept this test because we do not verify XML references *)
test Xml.lns get p06fail1 =
  { "#comment" = "non-validating processors may pass this instance because they don't check the IDREFS attribute type" }
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "(a|refs)*" }
    }
    { "!ELEMENT" = "a"
      { "#decl" = "EMPTY" }
    }
    { "!ELEMENT" = "refs"
      { "#decl" = "EMPTY" }
    }
    { "!ATTLIST" = "refs"
      { "1"
        { "#name" = "refs" }
        { "#type" = "IDREFS" }
        { "#REQUIRED" }
      }
    }
    { "!ATTLIST" = "a"
      { "1"
        { "#name" = "id" }
        { "#type" = "ID" }
        { "#REQUIRED" }
      }
    }
  }
  { "doc"
    { "#text" = "
" }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A1" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A2" }
      }
    }
    { "a" = "#empty"
      { "#attribute"
        { "id" = "A3" }
      }
    }
    { "refs" = "#empty"
      { "#attribute"
        { "refs" = "" }
      }
    }
  }

(* we accept dquote, but not single quotes, because of resulting ambiguity *)
let p10pass1_1 = "<doc>'">\nasdf\n    ?>%\"/></doc>"
let p10pass1_2 = "<doc>'"'/></doc>"

test Xml.lns get p10pass1_1 =
  { "doc"
    { "A" = "#empty"
      { "#attribute"
        { "a" = "asdf>'">\nasdf\n    ?>%" }
      }
    }
  }

test Xml.lns get p10pass1_2 =
  { "doc"
    { "A" = "#empty"
      { "#attribute"
        { "a" = "\"\">'"" }
      }
    }
  }

(* here again, test exclude single quote *)
let p11pass1 = "
<!DOCTYPE doc
[
<!ELEMENT doc EMPTY>
<!NOTATION not1 SYSTEM \"a%a&b&#0<!ELEMENT

<doc></doc>"

test Xml.lns get p15pass1 =
  { "#comment" = "a
<!DOCTYPE
<?-
]]>-<[ CDATA [
\"- -'-
-<doc>" }
  { "#comment" = "" }
  { "doc" }

let p22pass3 = "<?xml version=\"1.0\"?>
 <?pi some instruction ?>
<doc><?pi?></doc>"

test Xml.lns get p22pass3 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "#comment" = "comment" }
  { "#pi"
    { "#target" = "pi" }
    { "#instruction" = "some instruction" }
  }
  { "doc"
    { "#pi"
      { "#target" = "pi" }
    }
  }

let p25pass2 = "<?xml version

=

\"1.0\"?>
<doc></doc>"

test Xml.lns get p25pass2 =
  { "#declaration"
    { "#attribute"
      { "version" = "1.0" }
    }
  }
  { "doc" }

test Xml.lns get "<!DOCTYPE

doc

[
<!ELEMENT doc EMPTY>
]>
<doc></doc>" =
  { "!DOCTYPE" = "doc"
    { "!ELEMENT" = "doc"
      { "#decl" = "EMPTY" }
    }
  }
  { "doc" }

test Xml.lns get "<doc></doc  \n>" = { "doc" }

test Xml.lns get "<doc att=\"val\" \natt2=\"val2\" att3=\"val3\"/>" =
  { "a"
    { "doc" = "#empty"
      { "#attribute"
        { "att" = "val" }
        { "att2" = "val2" }
        { "att3" = "val3" }
      }
    }
  }

test Xml.lns get "<doc/>" = { "doc" = "#empty" }

(* failure tests *)
(* only one document element *)
test Xml.lns get "<doc></doc><bad/>" = *

(* document element must be complete *)
test Xml.lns get "<doc>" = *

(* emtpy document is rejected *)
test Xml.lns get "" = *

(* malformed element *)
test Xml.lns get "" = *

(* a Name cannot start with a digit *)
test Xml.lns get "<0A/>" = *

(* no space before "CDATA" *)
test Xml.lns get "<doc><![ CDATA[a]]></doc>" = *

(* no space after "CDATA" *)
test Xml.lns get "<doc><![CDATA [a]]></doc>" = *

(* CDSect's can't nest *)
test Xml.lns get "<doc>
<![CDATA[
<![CDATA[XML doesn't allow CDATA sections to nest]]>
]]>
</doc>" = *

(* Comment is illegal in VersionInfo *)
test Xml.lns get "<?xml version  =\"1.0\"?>
<doc></doc>" = *

(* only declarations in DTD *)
test Xml.lns get "<!DOCTYPE doc [
<!ELEMENT doc EMPTY>
<doc></doc>
]>" = *

(* we do not support external entities *)
test Xml.lns get "<!DOCTYPE doc [
<!ENTITY % eldecl \"<!ELEMENT doc EMPTY>\">
%eldecl;
]>
<doc></doc>" = *


Use the new '-' operator for key_re

Use the new '-' operator for key_re

(* Parsing yum's config files *)
module Yum =
  autoload xfm

  let eol = Util.del_str "\n"

  (* Very painful: the regular expression is /[^#;:= \t\n[\/]/ - "baseurl" *)
  (* Clearly, we need support for forming the setminus of regular          *)
  (* languages.                                                            *)
  let key_re = /([^b#;:= \t\n[\/]|b[^a#;:= \t\n[\/]|ba[^s#;:= \t\n[\/]|bas[^e#;:= \t\n[\/]|base[^u#;:= \t\n[\/]|baseu[^r#;:= \t\n[\/]|baseur[^l#;:= \t\n[\/]|baseurl[^#;:= \t\n[\/])[^#;:= \t\n[\/]*/

  let eq = del /[ \t]*[:=][ \t]*/ "="
  let secname = /[^]\/]+/

  let value = /[^ \t\n][^\n]*/

  (* We really need to allow comments starting with REM and rem but that     *)
  (* leads to ambiguities with keys 'rem=' and 'REM=' The regular expression *)
  (* to do that cleanly is somewhat annoying to craft by hand; we'd need to  *)
  (* define KEY_RE as /[A-Za-z0-9]+/ - "REM" - "rem"                         *)
  let comment = [ del /([;#].*)?[ \t]*\n/ "\n" ]

  let list_sep = del /[ \t]*(,[ \t]*|\n[ \t]+)/ "\n\t"
  let list_value = store /[^ \t\n,]+/

  let kv_list(s:string) =
    [ key s . eq . list_value ] .
      [ list_sep . label s . list_value ]* . eol

  let kv = [ key key_re . eq . store value . eol ]

  let sechead = Util.del_str "[" . key secname . Util.del_str "]"
      . del /[ \t]*[;#]?.*/ ""
      . eol

  let entry = comment | kv

  (* A section is a section head, followed by any number of key value    *)
  (* entries, with comments and blank lines freely interspersed. The     *)
  (* continuation lines allowed for baseurl entries make this a little   *)
  (* more interesting: there can be at most one baseurl entry in each    *)
  (* section (more precisely, yum will only obey one of them, but we act *)
  (* as if yum would actually barf)                                      *)
  let section = [ sechead . (entry* | entry* . (kv_list "baseurl") . entry*)]

  let lns = (comment) * . (section) *

  let filter = (incl "/etc/yum.conf") . (incl "/etc/yum.repos.d/*")
      . Util.stdexcl

  let xfm = transform lns filter

(* Local Variables: *)
(* mode: caml       *)
(* End:             *)