# hasexp / combinator.ml

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127``` ```open Sexplib open Sexp module Z = Zlist.Lazy open Zlist.Infix type filter = Sexp.t -> Sexp.t Zlist.t let none : filter = fun _ -> Zlist.nil let keep : filter = fun t -> Zlist.singleton t let atom : filter = fun t -> match t with | Atom _ -> Zlist.singleton t | _ -> Zlist.nil ;; let list : filter = fun t -> match t with | List _ -> Zlist.singleton t | _ -> Zlist.nil ;; let children : filter = function | List ts -> Zlist.of_list ts | _ -> Zlist.nil ;; let (^|) f g = fun x -> g (f x) (** pipe *) let (^.) f g = fun t -> Zlist.bind (g t) f let (|||) f g = fun t -> Zlist.append (f t) (g t) let with_ f g = f ^| Zlist.filter ~f:(fun v -> not (Zlist.is_nil (g v))) let without f g = f ^| Zlist.filter ~f:(g ^| Zlist.is_nil) let (/>) f g = g ^. children ^. f let ( if not (Zlist.is_nil (f t)) then then_ t else else_ t let (|>|) f g = fun t -> let t' = f t in if not (Zlist.is_nil t') then t' else g t let rec deep f = (* eta-expansion requred to prevent inf loop *) f |>| fun t -> (deep f ^. children) t let rec deepest f = (fun t -> (deepest f ^. children) t) |>| f module Xml = struct let pcdata = atom let tag_p p t = match t with | List [ List [ Atom "tag"; Atom s ]; List [ Atom "attrs"; List _ ]; List [ Atom "contents"; List _ ] ] when p s -> Zlist.singleton t | _ -> Zlist.nil let tag = tag_p (fun _ -> true) let tag_named s = tag_p (fun s' -> s = s') let contents t = match t with | List [ List [ Atom "tag"; Atom _ ]; List [ Atom "attrs"; List _ ]; List [ Atom "contents"; List ts ] ] -> Zlist.of_list ts | _ -> Zlist.nil let filter_attrs p t = match t with | List [ List [ Atom "tag"; Atom _ ]; List [ Atom "attrs"; List ts ]; List [ Atom "contents"; List _ ] ] -> begin Zlist.of_list ts >>= function | (List [Atom s1; Atom s2] as attr) when p s1 s2 -> Zlist.singleton attr | _ -> Zlist.nil end | _ -> Zlist.nil let filter_map_attrs p t = match t with | List [ List [ Atom "tag"; Atom _ ]; List [ Atom "attrs"; List ts ]; List [ Atom "contents"; List _ ] ] -> begin Zlist.of_list ts >>= function | List [Atom s1; Atom s2] -> begin match p s1 s2 with | Some v -> Zlist.singleton v | None -> Zlist.nil end | _ -> Zlist.nil end | _ -> Zlist.nil let attrs = filter_attrs (fun _ _ -> true) let assoc_attrs k = filter_map_attrs (fun key v -> if k = key then Some (Atom v) else None) let assoc_attrs_conv k conv t = match Zlist.npeek (assoc_attrs k t) 2 with | [] -> invalid_arg k | [Atom x] -> conv x (* CR jfuruse: optimize *) | _ -> invalid_arg k ;; module Make = struct let pcdata s = Atom s let tag s ~attrs ts = List [ List [ Atom "tag"; Atom s ]; List [ Atom "attrs"; List attrs ]; List [ Atom "contents"; List ts ] ] end end module Caml = struct let string v = Atom v let record_elt l v = List [Atom l; v] end ```
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.