Skip to content
This repository
tag: v1279
Fetching contributors…

Cannot retrieve contributors at this time

file 101 lines (86 sloc) 2.813 kb
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
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* CF mli *)
type t = Buffer.t
type input = Directive of string | Code of string

let create () = Buffer.create 10000
let reset accu = Buffer.clear accu

let add accu b =
  Buffer.add_string accu b;
  Buffer.add_char accu '\n'

let accumulate accu str =
  let s = Base.String.rtrim str in
  let len = String.length s in
  let predlen = pred len in
  let rec aux i =
    if i >= predlen then (add accu s; None)
    else
      if (String.unsafe_get s i) = ';'
      then
        if String.unsafe_get s (succ i) = ';'
        then
          begin
            let input = Base.String.rtrim (Base.String.unsafe_sub s 0 i) in
            Buffer.add_string accu input;
            let input = Buffer.contents accu in
            reset accu;
            if String.length input > 0
            then
              if input.[0] = '#'
              then Some (Directive input)
              else Some (Code input)
            else None
          end
        else aux (i + 2)
      else aux (succ i)
  in aux 0

let flush accu = accumulate accu ";;"

module Directive =
struct
  type arguments = string list
  type 'env action = 'env -> arguments -> 'env

  type regexp = string
  type argument_number = int

  type 'env directive = regexp * argument_number * 'env action

  type 'env handler = ('env -> string -> 'env option) list

  let empty () = []
  let add handler directive =
    match directive with
    | regexp, argument_number, action ->
        let reg = Str.regexp regexp in
        let filter env dir =
          if Str.string_match reg dir 0
          then
            try
              let args =
                let rec aux accu i =
                  if i < 1 then accu else aux ((Str.matched_group i dir)::accu) (pred i)
                in aux [] argument_number
              in
              Some (action env args)
            with
            | Not_found -> None
          else None
        in
        filter :: handler

  let parse handler env input =
    let rec aux = function
      | [] -> None
      | hd::tl -> (
          match hd env input with
          | ( Some _ ) as result -> result
          | None -> aux tl
        )
    in aux handler

end
Something went wrong with that request. Please try again.