Skip to content

Commit

Permalink
Add Date structure
Browse files Browse the repository at this point in the history
  • Loading branch information
@minoki
minoki committed Jul 18, 2023
1 parent f480ab5 commit 32a72a1
Show file tree
Hide file tree
Showing 9 changed files with 467 additions and 2 deletions.
33 changes: 31 additions & 2 deletions doc/BasisLibrary.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1287,6 +1287,37 @@ end
structure Time :> TIME
```

## structure Date - partial

```sml
signature DATE = sig
datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
datatype month = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
type date
exception Date
val date : { year : int, month : month, day : int, hour : int, minute : int, second : int, offset : Time.time option } -> date
val year : date -> int
val month : date -> month
val day : date -> int
val hour : date -> int
val minute : date -> int
val second : date -> int
val weekDay : date -> weekday
val offset : date -> Time.time option
val isDst : date -> bool option
val localOffset : unit -> Time.time
val fromTimeLocal : Time.time -> date
val fromTimeUniv : Time.time -> date
val toTime : date -> Time.time
val compare : date * date -> order
val fmt : string -> date -> string
val toString : date -> string
(* val scan : (char, 'a) StringCvt.reader -> (date, 'a) StringCvt.reader *)
(* val fromString : string -> date option *)
end
structure Date :> DATE
```

## structure Timer - complete

```sml
Expand Down Expand Up @@ -1314,8 +1345,6 @@ The GC time returned by this structure is always zero.
```sml
signature BIN_IO
structure BinIO :> BIN_IO
signature DATE
structure Date :> DATE
signature IMPERATIVE_IO
structure Position :> INTEGER
signature PRIM_IO
Expand Down
2 changes: 2 additions & 0 deletions lib/lunarml/ml/basis/basis-js-common.mlb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@ signature ARRAY_SLICE
signature BOOL
signature BYTE
signature CHAR
signature DATE
signature INTEGER
signature INT_INF
signature LIST
Expand Down Expand Up @@ -94,6 +95,7 @@ structure CharArray
structure CharArraySlice
structure CharVector
structure CharVectorSlice
structure Date
structure General
structure IEEEReal
structure IO
Expand Down
2 changes: 2 additions & 0 deletions lib/lunarml/ml/basis/basis-js-cps.mlb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ signature ARRAY_SLICE
signature BOOL
signature BYTE
signature CHAR
signature DATE
signature INTEGER
signature INT_INF
signature LIST
Expand Down Expand Up @@ -53,6 +54,7 @@ structure CharArray
structure CharArraySlice
structure CharVector
structure CommandLine
structure Date
structure General
structure IEEEReal
structure IO
Expand Down
2 changes: 2 additions & 0 deletions lib/lunarml/ml/basis/basis-js.mlb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ signature ARRAY_SLICE
signature BOOL
signature BYTE
signature CHAR
signature DATE
signature INTEGER
signature INT_INF
signature LIST
Expand Down Expand Up @@ -52,6 +53,7 @@ structure CharArray
structure CharArraySlice
structure CharVector
structure CommandLine
structure Date
structure General
structure IEEEReal
structure IO
Expand Down
2 changes: 2 additions & 0 deletions lib/lunarml/ml/basis/basis-lua.mlb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@ signature ARRAY_SLICE
signature BOOL
signature BYTE
signature CHAR
signature DATE
signature INTEGER
signature INT_INF
signature LIST
Expand Down Expand Up @@ -96,6 +97,7 @@ structure CharArraySlice
structure CharVector
structure CharVectorSlice
structure CommandLine
structure Date
structure General
structure IEEEReal
structure IO
Expand Down
2 changes: 2 additions & 0 deletions lib/lunarml/ml/basis/basis-luajit.mlb
View file
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,7 @@ signature ARRAY_SLICE
signature BOOL
signature BYTE
signature CHAR
signature DATE
signature INTEGER
signature INT_INF
signature LIST
Expand Down Expand Up @@ -96,6 +97,7 @@ structure CharArraySlice
structure CharVector
structure CharVectorSlice
structure CommandLine
structure Date
structure General
structure IEEEReal
structure IO
Expand Down
108 changes: 108 additions & 0 deletions lib/lunarml/ml/basis/js-common/time.sml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -64,3 +64,111 @@ val op <= = Int54.<=
val op > = Int54.>
val op >= = Int54.>=
end;
signature DATE = sig
datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
datatype month = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
type date
exception Date
val date : { year : int, month : month, day : int, hour : int, minute : int, second : int, offset : Time.time option } -> date
val year : date -> int
val month : date -> month
val day : date -> int
val hour : date -> int
val minute : date -> int
val second : date -> int
val weekDay : date -> weekday
val offset : date -> Time.time option
val isDst : date -> bool option
val localOffset : unit -> Time.time
val fromTimeLocal : Time.time -> date
val fromTimeUniv : Time.time -> date
val toTime : date -> Time.time
val compare : date * date -> order
val fmt : string -> date -> string
val toString : date -> string
(*
val scan : (char, 'a) StringCvt.reader -> (date, 'a) StringCvt.reader
val fromString : string -> date option
*)
end;
structure Date :> DATE = struct
datatype weekday = Mon | Tue | Wed | Thu | Fri | Sat | Sun
datatype month = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
type date = JavaScript.value * Time.time option
exception Date
fun monthToZeroBasedInt Jan = 0
| monthToZeroBasedInt Feb = 1
| monthToZeroBasedInt Mar = 2
| monthToZeroBasedInt Apr = 3
| monthToZeroBasedInt May = 4
| monthToZeroBasedInt Jun = 5
| monthToZeroBasedInt Jul = 6
| monthToZeroBasedInt Aug = 7
| monthToZeroBasedInt Sep = 8
| monthToZeroBasedInt Oct = 9
| monthToZeroBasedInt Nov = 10
| monthToZeroBasedInt Dec = 11
fun date { year : int, month : month, day : int, hour : int, minute : int, second : int, offset : Time.time option }
= let val d = JavaScript.new JavaScript.Lib.Date #[JavaScript.fromInt year, JavaScript.fromInt (monthToZeroBasedInt month), JavaScript.fromInt day, JavaScript.fromInt hour, JavaScript.fromInt minute, JavaScript.fromInt second]
in (d, offset)
end
fun year ((t, _) : date) : int = JavaScript.unsafeFromValue (JavaScript.method (t, "getFullYear") #[])
fun monthAsZeroBasedInt ((t, _) : date) : int = JavaScript.unsafeFromValue (JavaScript.method (t, "getMonth") #[])
fun month t : month = case monthAsZeroBasedInt t of
0 => Jan
| 1 => Feb
| 2 => Mar
| 3 => Apr
| 4 => May
| 5 => Jun
| 6 => Jul
| 7 => Aug
| 8 => Sep
| 9 => Oct
| 10 => Nov
| _ => Dec
fun day ((t, _) : date) : int = JavaScript.unsafeFromValue (JavaScript.method (t, "getDate") #[])
fun hour ((t, _) : date) : int = JavaScript.unsafeFromValue (JavaScript.method (t, "getHours") #[])
fun minute ((t, _) : date) : int = JavaScript.unsafeFromValue (JavaScript.method (t, "getMinutes") #[])
fun second ((t, _) : date) : int = JavaScript.unsafeFromValue (JavaScript.method (t, "genSeconds") #[])
fun weekDay ((t, _) : date) : weekday = case JavaScript.unsafeFromValue (JavaScript.method (t, "getDay") #[]) : int of
0 => Sun
| 1 => Mon
| 2 => Tue
| 3 => Wed
| 4 => Thu
| 5 => Fri
| _ => Sat
fun offset ((_, s) : date) = s
fun isDst (_ : date) : bool option = NONE
fun localOffset () : Time.time = let val min : Int54.int = JavaScript.unsafeFromValue (JavaScript.method (JavaScript.new JavaScript.Lib.Date #[], "getTimezoneOffset") #[])
in Time.fromSeconds (Int54.toLarge min * 60)
end
fun fromTimeLocal (t : Time.time) : date = (JavaScript.new JavaScript.Lib.Date #[JavaScript.unsafeToValue (Int54.fromLarge (Time.toMilliseconds t))], NONE)
fun fromTimeUniv (t : Time.time) : date = let val d = JavaScript.new JavaScript.Lib.Date #[]
val _ = JavaScript.method (d, "setUTCMilliseconds") #[JavaScript.unsafeToValue (Int54.fromLarge (Time.toMilliseconds t))]
in (d, SOME Time.zeroTime)
end
fun toTime ((d, f) : date) : Time.time = let val t = JavaScript.unsafeFromValue (JavaScript.method (d, "getTime") #[])
in case f of
NONE => t
| SOME u => Time.+ (t, u)
end
fun compare (date1, date2) = case Int.compare (year date1, year date2) of
EQUAL => (case Int.compare (monthAsZeroBasedInt date1, monthAsZeroBasedInt date2) of
EQUAL => (case Int.compare (day date1, day date2) of
EQUAL => (case Int.compare (hour date1, hour date2) of
EQUAL => (case Int.compare (minute date1, minute date2) of
EQUAL => Int.compare (second date1, second date2)
| r => r
)
| r => r
)
| r => r
)
| r => r
)
| r => r
fun fmt s date = raise Fail "Date.fmt: not implemented yet"
fun toString date = fmt "%a %b %d %H:%M:%S %Y" date
end;
Loading

0 comments on commit 32a72a1

Please sign in to comment.