Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
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.
- Loading branch information
Showing
2 changed files
with
164 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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 |