From 538f479b60eeef2a6a8fe6bb85785ab86a03da39 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Sat, 3 Oct 2015 07:51:37 -0400 Subject: [PATCH] Add sample Ur/Web files Taken from tokenrove/parsur so I don't have to worry about license hassles. (You may relicense these samples as necessary.) It would be nice to have an example of the embedded SQL syntax in a sample. --- samples/UrWeb/iso8601.ur | 79 +++++++++++++++++++++++++++++++++++++ samples/UrWeb/parse.urs | 85 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 164 insertions(+) create mode 100644 samples/UrWeb/iso8601.ur create mode 100644 samples/UrWeb/parse.urs diff --git a/samples/UrWeb/iso8601.ur b/samples/UrWeb/iso8601.ur new file mode 100644 index 00000000..7a6a3809 --- /dev/null +++ b/samples/UrWeb/iso8601.ur @@ -0,0 +1,79 @@ +open Parse.String + +val digit = satisfy isdigit + +val decimal_of_len n = + ds <- count n digit; + return (List.foldl (fn d acc => 10*acc + ((ord d)-(ord #"0"))) 0 ds) + +val date = + y <- decimal_of_len 4; + char' #"-"; + m <- decimal_of_len 2; + char' #"-"; + d <- decimal_of_len 2; + if m > 0 && m <= 12 then + return {Year=y, Month=(Datetime.intToMonth (m-1)), Day=d} + else + fail + +(* We parse fractions of a second, but ignore them since Datetime + doesn't permit representing them. *) +val time = + h <- decimal_of_len 2; + char' #":"; + m <- decimal_of_len 2; + s <- maybe (char' #":"; + s <- decimal_of_len 2; + maybe' (char' #"."; skipWhile isdigit); + return s); + return {Hour=h, Minute=m, Second=Option.get 0 s} + +val timezone_offset = + let val zulu = char' #"Z"; return 0 + val digits = decimal_of_len 2 + val sign = or (char' #"+"; return 1) + (char' #"-"; return (-1)) + in + zulu `or` (s <- sign; + h <- digits; + m <- (maybe' (char' #":"); or digits (return 0)); + return (s*(h*60+m))) + end + +val datetime_with_tz = + d <- date; char' #"T"; t <- time; + tz <- timezone_offset; + return (d ++ t ++ {TZOffsetMinutes=tz}) + +val datetime = + d <- datetime_with_tz; + return (d -- #TZOffsetMinutes) + +fun process v = + case parse (d <- datetime_with_tz; eof; return d) v of + Some r => + let + val {Year=year,Month=month,Day=day, + Hour=hour,Minute=minute,Second=second} = + Datetime.addMinutes (r.TZOffsetMinutes) (r -- #TZOffsetMinutes) + fun pad x = + if x < 10 then "0" `strcat` show x else show x + in + {[pad hour]}:{[pad minute]}:{[pad second]} {[month]} {[day]}, {[year]} + end + | None => none + +fun main () : transaction page = + input <- source "2012-01-01T01:10:42Z"; + return + + + + + diff --git a/samples/UrWeb/parse.urs b/samples/UrWeb/parse.urs new file mode 100644 index 00000000..3b2c1ed5 --- /dev/null +++ b/samples/UrWeb/parse.urs @@ -0,0 +1,85 @@ +functor Make(Stream : sig type t end) : sig + con t :: Type -> Type + + val mreturn : a ::: Type -> a -> t a + val mbind : a ::: Type -> b ::: Type -> + (t a) -> (a -> t b) -> (t b) + val monad_parse : monad t + + val parse : a ::: Type -> t a -> Stream.t -> option a + + (** Combinators *) + val fail : a ::: Type -> t a + val or : a ::: Type -> t a -> t a -> t a + val maybe : a ::: Type -> t a -> t (option a) + val maybe' : a ::: Type -> t a -> t unit + val many : a ::: Type -> t a -> t (list a) + val count : a ::: Type -> int -> t a -> t (list a) + val skipMany : a ::: Type -> t a -> t unit + val sepBy : a ::: Type -> s ::: Type -> t a -> t s -> t (list a) +end + +structure String : sig + con t :: Type -> Type + val monad_parse : monad t + + val parse : a ::: Type -> t a -> string -> option a + + (** Combinators *) + val fail : a ::: Type -> t a + val or : a ::: Type -> t a -> t a -> t a + val maybe : a ::: Type -> t a -> t (option a) + val maybe' : a ::: Type -> t a -> t unit + val many : a ::: Type -> t a -> t (list a) + val count : a ::: Type -> int -> t a -> t (list a) + val skipMany : a ::: Type -> t a -> t unit + val sepBy : a ::: Type -> s ::: Type -> t a -> t s -> t (list a) + + val eof : t unit + (* We provide alternative versions of some of these predicates + * that return t unit as a monadic syntactical convenience. *) + val string : string -> t string + val string' : string -> t unit + val stringCI : string -> t string + val stringCI' : string -> t unit + val char : char -> t char + val char' : char -> t unit + val take : int -> t (string*int) + val drop : int -> t unit + val satisfy : (char -> bool) -> t char + val skip : (char -> bool) -> t unit + val skipWhile : (char -> bool) -> t unit + val takeWhile : (char -> bool) -> t (string*int) + val takeWhile' : (char -> bool) -> t string (* conses *) + (* Well, "till" is the correct form; but "til" is in common enough + * usage that I'll prefer it for terseness. *) + val takeTil : (char -> bool) -> t (string*int) + val takeTil' : (char -> bool) -> t string (* conses *) + val takeRest : t string + + (** Convenience functions *) + val skipSpace : t unit + val endOfLine : t unit + val unsigned_int_of_radix : int -> t int + (* + * val signed_int_of_radix : int -> t int + * val double : t float + *) +end + +structure Blob : sig + con t :: Type -> Type + val monad_parse : monad t + + val parse : a ::: Type -> t a -> blob -> option a + + (** Combinators *) + val fail : a ::: Type -> t a + val or : a ::: Type -> t a -> t a -> t a + val maybe : a ::: Type -> t a -> t (option a) + val maybe' : a ::: Type -> t a -> t unit + val many : a ::: Type -> t a -> t (list a) + val count : a ::: Type -> int -> t a -> t (list a) + val skipMany : a ::: Type -> t a -> t unit + val sepBy : a ::: Type -> s ::: Type -> t a -> t s -> t (list a) +end