mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-28 17:20:22 +00:00
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.
This commit is contained in:
Julian Squires
79
samples/UrWeb/iso8601.ur
Normal file
79
samples/UrWeb/iso8601.ur
Normal file
@@ -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
|
||||
<xml>{[pad hour]}:{[pad minute]}:{[pad second]} {[month]} {[day]}, {[year]}</xml>
|
||||
end
|
||||
| None => <xml>none</xml>
|
||||
|
||||
fun main () : transaction page =
|
||||
input <- source "2012-01-01T01:10:42Z";
|
||||
return <xml>
|
||||
<body>
|
||||
<label>
|
||||
Enter an
|
||||
<a href="https://en.wikipedia.org/wiki/ISO_8601">ISO 8601</a>
|
||||
datetime here:
|
||||
<ctextbox source={input} />
|
||||
</label>
|
||||
<ul><dyn signal={v <- signal input; return (process v)} /></ul>
|
||||
</body>
|
||||
</xml>
|
||||
85
samples/UrWeb/parse.urs
Normal file
85
samples/UrWeb/parse.urs
Normal file
@@ -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
|
||||
Reference in New Issue
Block a user