diff --git a/.eslintrc.json b/.eslintrc.json new file mode 100644 index 0000000..1c6afb9 --- /dev/null +++ b/.eslintrc.json @@ -0,0 +1,26 @@ +{ + "parserOptions": { + "ecmaVersion": 6, + "sourceType": "module" + }, + "extends": "eslint:recommended", + "rules": { + "strict": [2, "global"], + "block-scoped-var": 2, + "consistent-return": 2, + "eqeqeq": [2, "smart"], + "guard-for-in": 2, + "no-caller": 2, + "no-extend-native": 2, + "no-loop-func": 2, + "no-new": 2, + "no-param-reassign": 2, + "no-return-assign": 2, + "no-unused-expressions": 2, + "no-use-before-define": 2, + "radix": [2, "always"], + "indent": [2, 2], + "quotes": [2, "double"], + "semi": [2, "always"] + } +} diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 0000000..4435abb --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,12 @@ +**Description of the change** + +Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. + +--- + +**Checklist:** + +- [ ] Added the change to the changelog's "Unreleased" section with a reference to this PR (e.g. "- Made a change (#0000)") +- [ ] Linked any existing issues or proposals that this pull request should close +- [ ] Updated or added relevant documentation +- [ ] Added a test for the contribution (if applicable) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..c69237a --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,35 @@ +name: CI + +on: + push: + branches: [master] + pull_request: + branches: [master] + +jobs: + build: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + + - uses: purescript-contrib/setup-purescript@main + with: + purescript: "unstable" + + - uses: actions/setup-node@v2 + with: + node-version: "14.x" + + - name: Install dependencies + run: | + npm install -g bower + npm install + bower install --production + + - name: Build source + run: npm run-script build + + - name: Run tests + run: | + bower install + npm run-script test --if-present diff --git a/.gitignore b/.gitignore index e306283..7224331 100644 --- a/.gitignore +++ b/.gitignore @@ -1,8 +1,8 @@ /.* !/.gitignore -!/.jscsrc -!/.jshintrc -!/.travis.yml +!/.eslintrc.json +!/.github/ +package-lock.json /bower_components/ /node_modules/ /output/ diff --git a/.jscsrc b/.jscsrc deleted file mode 100644 index 342da66..0000000 --- a/.jscsrc +++ /dev/null @@ -1,12 +0,0 @@ -{ - "preset": "grunt", - "disallowSpacesInAnonymousFunctionExpression": null, - "requireSpacesInAnonymousFunctionExpression": { - "beforeOpeningRoundBrace": true, - "beforeOpeningCurlyBrace": true - }, - "disallowSpacesInsideObjectBrackets": null, - "requireSpacesInsideObjectBrackets": "all", - "validateQuoteMarks": "\"", - "requireCurlyBraces": null -} diff --git a/.jshintrc b/.jshintrc deleted file mode 100644 index 2240be2..0000000 --- a/.jshintrc +++ /dev/null @@ -1,19 +0,0 @@ -{ - "bitwise": true, - "eqeqeq": true, - "forin": true, - "freeze": true, - "funcscope": true, - "futurehostile": true, - "strict": "global", - "latedef": true, - "maxparams": 1, - "noarg": true, - "nocomma": true, - "nonew": true, - "notypeof": true, - "singleGroups": true, - "undef": true, - "unused": true, - "eqnull": true -} diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 791313a..0000000 --- a/.travis.yml +++ /dev/null @@ -1,14 +0,0 @@ -language: node_js -sudo: false -node_js: - - 0.10 -env: - - PATH=$HOME/purescript:$PATH -install: - - TAG=$(wget -q -O - https://github.com/purescript/purescript/releases/latest --server-response --max-redirect 0 2>&1 | sed -n -e 's/.*Location:.*tag\///p') - - wget -O $HOME/purescript.tar.gz https://github.com/purescript/purescript/releases/download/$TAG/linux64.tar.gz - - tar -xvf $HOME/purescript.tar.gz -C $HOME/ - - chmod a+x $HOME/purescript - - npm install -script: - - npm run build diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..cacc9ef --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,202 @@ +# Changelog + +Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +Breaking changes: + +New features: + +Bugfixes: + +Other improvements: + +## [v6.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v6.1.0) - 2022-07-13 + +Breaking changes: + +New features: +- Added `diff` for `Instant` (#99 by @i-am-the-slime, #100 by @garyb) + +Bugfixes: + +Other improvements: + +## [v6.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v6.0.0) - 2022-04-27 + +Breaking changes: +- Migrate FFI to ES modules (#93 by @JordanMartinez) + +New features: + +Bugfixes: + +Other improvements: +- Drop deprecated `math` dependency; update imports (#94 by @JordanMartinez) + +## [v5.0.2](https://github.com/purescript/purescript-datetime/releases/tag/v5.0.2) - 2021-04-19 + +Other improvements: +- Fix one more UnusedName warning revealed by v0.14.1 PureScript release (@thomashoneyman) + +## [v5.0.1](https://github.com/purescript/purescript-datetime/releases/tag/v5.0.1) - 2021-04-19 + +Other improvements: +- Fix UnusedName warnings revealed by v0.14.1 PureScript release (#91 by @JordanMartinez) + +## [v5.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v5.0.0) - 2021-02-26 + +Breaking changes: + - Added support for PureScript 0.14 and dropped support for all previous versions (#81) + +New features: + +Bugfixes: +- Fixed `genDate` generator frequency (#83) + +Other improvements: + - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#82) + - Added a CHANGELOG.md file and pull request template (#84, #85) + +## [v4.1.1](https://github.com/purescript/purescript-datetime/releases/tag/v4.1.1) - 2019-02-09 + +Fixed minimum bound on `toEnum` for `Year` (@bouzuya) + +## [v4.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v4.1.0) - 2018-10-25 + +Adds an `adjust` function to change a date by a specified duration of days + +## [v4.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v4.0.0) - 2018-05-24 + +- Updated for PureScript 0.12 +- Removed `Locale` - it was a glorified `Tuple` without any useful extra functionality +- Duration values no longer implement `Ring` and `Semiring`, but now have `Semiring` and `Monoid` instances and a `negateDuration` function + +## [v3.4.1](https://github.com/purescript/purescript-datetime/releases/tag/v3.4.1) - 2017-11-04 + +- Fix for pursuit auto-publishing + +## [v3.4.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.4.0) - 2017-09-22 + +- Export `fromDate` for `Instant` (@javcasas) + +## [v3.3.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.3.0) - 2017-06-26 + +- Added types for intervals (@safareli) + +## [v3.2.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.2.0) - 2017-06-08 + +- Added generators for date/time types + +## [v3.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.1.0) - 2017-06-04 + +- Added `lastDayOfMonth` (@MichaelXavier) + +## [v3.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.0.0) - 2017-03-27 + +- Updated for PureScript 0.11 + +## [v2.2.0](https://github.com/purescript/purescript-datetime/releases/tag/v2.2.0) - 2017-03-13 + +- Added functions to modify just the date or time component of a `DateTime` + +## [v2.1.1](https://github.com/purescript/purescript-datetime/releases/tag/v2.1.1) - 2017-03-08 + +- Fixed behaviour of `diff` for `Date` types + +## [v2.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v2.1.0) - 2017-02-14 + +- Added `isLeapYear` predicate function (@MichaelXavier) + +## [v2.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v2.0.0) - 2016-10-13 + +- Updated dependencies + +## [v1.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v1.0.0) - 2016-06-09 + +This release is intended for the PureScript 0.9.1 compiler and newer. + +The library has been redesigned, and now no longer provides a type for the JavaScript `Date` object or the ability to fetch the current time, these are now provided by [`purescript-js-date`](https://github.com/purescript-contrib/purescript-js-date) and [`purescript-now`](https://github.com/purescript-contrib/purescript-now) libraries. + +**Note**: The v1.0.0 tag is not meant to indicate the library is “finished”, the core libraries are all being bumped to this for the 0.9 compiler release so as to use semver more correctly. + +## [v0.9.2](https://github.com/purescript/purescript-datetime/releases/tag/v0.9.2) - 2016-04-05 + +- Added `toISOString` (@parsonsmatt) + +## [v0.9.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.9.1) - 2015-11-20 + +- Removed unused import (@tfausak) + +## [v0.9.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.9.0) - 2015-08-13 + +- Updated dependencies + +## [v0.8.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.8.0) - 2015-08-02 + +- Updated dependencies + +## [v0.7.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.7.0) - 2015-07-25 + +- Fixed time values (`Hours`, `Minutes`, `Seconds`, `Milliseconds`) by changing the internal representation to `Number`. Previously `Milliseconds` would overflow when using functions like `toEpochMilliseconds`. (@nwolverson) + +## [v0.6.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.6.0) - 2015-06-30 + +This release works with versions 0.7.\* of the PureScript compiler. It will not work with older versions. If you are using an older version, you should require an older, compatible version of this library. + +## [v0.6.0-rc.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.6.0-rc.1) - 2015-06-14 + +Initial release candidate of the library intended for the 0.7 compiler. + +## [v0.5.3](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.3) - 2015-05-22 + +- Added `toLocaleString` and variants (@hdgarrood) + +## [v0.5.2](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.2) - 2015-04-13 + +- Fixed bug with exceptions being thrown when attempting to use members of the UTC module #14 (@bkyrlach) + +## [v0.5.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.1) - 2015-04-08 + +- Fixed methods in `Locale` to not call the `UTC` variants #11 + +## [v0.5.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.0) - 2015-04-06 + +- Update dependencies + +## [v0.4.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.4.0) - 2015-03-28 + +- Library has been redesigned for better safety +- UTC dates can now be constructed +- The current time in milliseconds since the unix epoch can now be fetched without having to construct a date + +## [v0.3.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.3.1) - 2015-03-01 + +- Days of the week are now exported (@nwolverson) + +## [v0.3.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.3.0) - 2015-02-21 + +**This release requires PureScript v0.6.8 or later** +- Updated dependencies + +## [v0.2.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.2.0) - 2015-01-11 + +- Updated for new `purescript-enum` (@philopon) + +## [v0.1.2](https://github.com/purescript/purescript-datetime/releases/tag/v0.1.2) - 2014-12-15 + +- Fix `now` implementation (@Fresheyeball) + +## [v0.1.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.1.1) - 2014-11-24 + +Added `fromStringStrict` and updated dependencies (@jdegoes) + +## [v0.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.1.0) - 2014-10-14 + +- Added `Eq` and `Ord` instances for `DayOfWeek` and `Month`, update for new `Enum` (@jdegoes) + +## [v0.0.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.0.1) - 2014-10-14 + +Initial version release. + diff --git a/LICENSE b/LICENSE index 58b0299..311379c 100644 --- a/LICENSE +++ b/LICENSE @@ -1,20 +1,26 @@ -The MIT License (MIT) +Copyright 2018 PureScript -Copyright (c) 2014 PureScript +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal in -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of -the Software, and to permit persons to whom the Software is furnished to do so, -subject to the following conditions: +1. Redistributions of source code must retain the above copyright notice, this +list of conditions and the following disclaimer. -The above copyright notice and this permission notice shall be included in all -copies or substantial portions of the Software. +2. Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation and/or +other materials provided with the distribution. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS -FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR -COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER -IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +3. Neither the name of the copyright holder nor the names of its contributors +may be used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md index 4e9f7ea..adcc9b6 100644 --- a/README.md +++ b/README.md @@ -1,20 +1,19 @@ # purescript-datetime -[![Latest release](http://img.shields.io/bower/v/purescript-datetime.svg)](https://github.com/purescript/purescript-datetime/releases) -[![Build Status](https://travis-ci.org/purescript/purescript-datetime.svg?branch=master)](https://travis-ci.org/purescript/purescript-datetime) -[![Dependency Status](https://www.versioneye.com/user/projects/55848c1636386100150003d4/badge.svg?style=flat)](https://www.versioneye.com/user/projects/55848c1636386100150003d4) +[![Latest release](http://img.shields.io/github/release/purescript/purescript-datetime.svg)](https://github.com/purescript/purescript-datetime/releases) +[![Build status](https://github.com/purescript/purescript-datetime/workflows/CI/badge.svg?branch=master)](https://github.com/purescript/purescript-datetime/actions?query=workflow%3ACI+branch%3Amaster) +[![Pursuit](https://pursuit.purescript.org/packages/purescript-datetime/badge)](https://pursuit.purescript.org/packages/purescript-datetime) -Date and time functions and values. +Date and time types and functions. ## Installation ``` -bower install purescript-datetime +spago install datetime ``` -## Module documentation +## Documentation -- [Data.Date](docs/Data/Date.md) -- [Data.Date.Locale](docs/Data/Date/Locale.md) -- [Data.Date.UTC](docs/Data/Date/UTC.md) -- [Data.Time](docs/Data/Time.md) +This libary provides platform-independent representations of date and time. Parsing specific date formats, such as the ISO 8601 format, is the responsibility of other libraries, such as the [purescript-js-date](https://github.com/purescript-contrib/purescript-js-date) package. Likewise, writing a date/time type to string to display to humans is the responsibility of other libraries, such as the [purescript-formatters](https://github.com/slamdata/purescript-formatters) package. + +Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-datetime). diff --git a/bower.json b/bower.json index 499acf0..712032a 100644 --- a/bower.json +++ b/bower.json @@ -1,19 +1,10 @@ { "name": "purescript-datetime", "homepage": "https://github.com/purescript/purescript-datetime", - "authors": [ - "Gary Burgess " - ], - "description": "PureScript library for date and time values", - "keywords": [ - "purescript", - "date", - "time" - ], - "license": "MIT", + "license": "BSD-3-Clause", "repository": { "type": "git", - "url": "git://github.com/purescript/purescript-datetime.git" + "url": "https://github.com/purescript/purescript-datetime.git" }, "ignore": [ "**/.*", @@ -24,8 +15,26 @@ "package.json" ], "dependencies": { - "purescript-enums": "^0.7.0", - "purescript-functions": "^0.1.0", - "purescript-globals": "^0.2.0" + "purescript-bifunctors": "^6.0.0", + "purescript-control": "^6.0.0", + "purescript-either": "^6.0.0", + "purescript-enums": "^6.0.0", + "purescript-foldable-traversable": "^6.0.0", + "purescript-functions": "^6.0.0", + "purescript-gen": "^4.0.0", + "purescript-integers": "^6.0.0", + "purescript-lists": "^7.0.0", + "purescript-maybe": "^6.0.0", + "purescript-newtype": "^5.0.0", + "purescript-numbers": "^9.0.0", + "purescript-ordered-collections": "^3.0.0", + "purescript-partial": "^4.0.0", + "purescript-prelude": "^6.0.0", + "purescript-tuples": "^7.0.0" + }, + "devDependencies": { + "purescript-assert": "^6.0.0", + "purescript-console": "^6.0.0", + "purescript-strings": "^6.0.0" } } diff --git a/docs/Data/Date.md b/docs/Data/Date.md deleted file mode 100644 index 88bab3b..0000000 --- a/docs/Data/Date.md +++ /dev/null @@ -1,216 +0,0 @@ -## Module Data.Date - -#### `JSDate` - -``` purescript -data JSDate :: * -``` - -A native JavaScript `Date` object. - -#### `Date` - -``` purescript -newtype Date -``` - -A combined date/time value. `Date`s cannot be constructed directly to -ensure they are not the `Invalid Date` value, and instead must be created -via `fromJSDate`, `fromEpochMilliseconds`, `fromString`, etc. or the `date` -and `dateTime` functions in the `Data.Date.Locale` and `Data.Date.UTC` -modules. - -##### Instances -``` purescript -instance eqDate :: Eq Date -instance ordDate :: Ord Date -instance showDate :: Show Date -``` - -#### `fromJSDate` - -``` purescript -fromJSDate :: JSDate -> Maybe Date -``` - -Attempts to create a `Date` from a `JSDate`. If the `JSDate` is an invalid -date `Nothing` is returned. - -#### `toJSDate` - -``` purescript -toJSDate :: Date -> JSDate -``` - -Extracts a `JSDate` from a `Date`. - -#### `fromEpochMilliseconds` - -``` purescript -fromEpochMilliseconds :: Milliseconds -> Maybe Date -``` - -Creates a `Date` value from a number of milliseconds elapsed since 1st -January 1970 00:00:00 UTC. - -#### `toEpochMilliseconds` - -``` purescript -toEpochMilliseconds :: Date -> Milliseconds -``` - -Gets the number of milliseconds elapsed since 1st January 1970 00:00:00 -UTC for a `Date`. - -#### `fromString` - -``` purescript -fromString :: String -> Maybe Date -``` - -Attempts to construct a date from a string value using JavaScript’s -[Date.parse() method](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/parse). -`Nothing` is returned if the parse fails or the resulting date is invalid. - -#### `fromStringStrict` - -``` purescript -fromStringStrict :: String -> Maybe Date -``` - -Attempts to construct a date from a simplified extended ISO 8601 format -(`YYYY-MM-DDTHH:mm:ss.sssZ`). `Nothing` is returned if the format is not -an exact match or the resulting date is invalid. - -#### `Now` - -``` purescript -data Now :: ! -``` - -Effect type for when accessing the current date/time. - -#### `now` - -``` purescript -now :: forall e. Eff (now :: Now | e) Date -``` - -Gets a `Date` value for the current date/time according to the current -machine’s local time. - -#### `nowEpochMilliseconds` - -``` purescript -nowEpochMilliseconds :: forall e. Eff (now :: Now | e) Milliseconds -``` - -Gets the number of milliseconds elapsed milliseconds since 1st January -1970 00:00:00 UTC according to the current machine’s local time - -#### `LocaleOffset` - -``` purescript -newtype LocaleOffset - = LocaleOffset Minutes -``` - -A timezone locale offset, measured in minutes. - -#### `timezoneOffset` - -``` purescript -timezoneOffset :: Date -> LocaleOffset -``` - -Get the locale time offset for a `Date`. - -#### `Year` - -``` purescript -newtype Year - = Year Int -``` - -A year date component value. - -##### Instances -``` purescript -instance eqYear :: Eq Year -instance ordYear :: Ord Year -instance semiringYear :: Semiring Year -instance ringYear :: Ring Year -instance showYear :: Show Year -``` - -#### `Month` - -``` purescript -data Month - = January - | February - | March - | April - | May - | June - | July - | August - | September - | October - | November - | December -``` - -A month date component value. - -##### Instances -``` purescript -instance eqMonth :: Eq Month -instance ordMonth :: Ord Month -instance boundedMonth :: Bounded Month -instance boundedOrdMonth :: BoundedOrd Month -instance showMonth :: Show Month -instance enumMonth :: Enum Month -``` - -#### `DayOfMonth` - -``` purescript -newtype DayOfMonth - = DayOfMonth Int -``` - -A day-of-month date component value. - -##### Instances -``` purescript -instance eqDayOfMonth :: Eq DayOfMonth -instance ordDayOfMonth :: Ord DayOfMonth -``` - -#### `DayOfWeek` - -``` purescript -data DayOfWeek - = Sunday - | Monday - | Tuesday - | Wednesday - | Thursday - | Friday - | Saturday -``` - -A day-of-week date component value. - -##### Instances -``` purescript -instance eqDayOfWeek :: Eq DayOfWeek -instance ordDayOfWeek :: Ord DayOfWeek -instance boundedDayOfWeek :: Bounded DayOfWeek -instance boundedOrdDayOfWeek :: BoundedOrd DayOfWeek -instance showDayOfWeek :: Show DayOfWeek -instance enumDayOfWeek :: Enum DayOfWeek -``` - - diff --git a/docs/Data/Date/Locale.md b/docs/Data/Date/Locale.md deleted file mode 100644 index 5a14d6b..0000000 --- a/docs/Data/Date/Locale.md +++ /dev/null @@ -1,131 +0,0 @@ -## Module Data.Date.Locale - -#### `Locale` - -``` purescript -data Locale :: ! -``` - -The effect of reading the current system locale/timezone. - -#### `dateTime` - -``` purescript -dateTime :: forall e. Year -> Month -> DayOfMonth -> HourOfDay -> MinuteOfHour -> SecondOfMinute -> MillisecondOfSecond -> Eff (locale :: Locale | e) (Maybe Date) -``` - -Attempts to create a `Date` from date and time components based on the -current machine’s locale. `Nothing` is returned if the resulting date is -invalid. - -#### `date` - -``` purescript -date :: forall e. Year -> Month -> DayOfMonth -> Eff (locale :: Locale | e) (Maybe Date) -``` - -Attempts to create a `Date` from date components based on the current -machine’s locale. `Nothing` is returned if the resulting date is invalid. - -#### `year` - -``` purescript -year :: forall e. Date -> Eff (locale :: Locale | e) Year -``` - -Gets the year component for a date based on the current machine’s locale. - -#### `month` - -``` purescript -month :: forall e. Date -> Eff (locale :: Locale | e) Month -``` - -Gets the month component for a date based on the current machine’s locale. - -#### `dayOfMonth` - -``` purescript -dayOfMonth :: forall e. Date -> Eff (locale :: Locale | e) DayOfMonth -``` - -Gets the day-of-month value for a date based on the current machine’s -locale. - -#### `dayOfWeek` - -``` purescript -dayOfWeek :: forall e. Date -> Eff (locale :: Locale | e) DayOfWeek -``` - -Gets the day-of-week value for a date based on the current machine’s -locale. - -#### `hourOfDay` - -``` purescript -hourOfDay :: forall e. Date -> Eff (locale :: Locale | e) HourOfDay -``` - -Gets the hour-of-day value for a date based on the current machine’s -locale. - -#### `minuteOfHour` - -``` purescript -minuteOfHour :: forall e. Date -> Eff (locale :: Locale | e) MinuteOfHour -``` - -Gets the minute-of-hour value for a date based on the current machine’s -locale. - -#### `secondOfMinute` - -``` purescript -secondOfMinute :: forall e. Date -> Eff (locale :: Locale | e) SecondOfMinute -``` - -Get the second-of-minute value for a date based on the current machine’s -locale. - -#### `millisecondOfSecond` - -``` purescript -millisecondOfSecond :: forall e. Date -> Eff (locale :: Locale | e) MillisecondOfSecond -``` - -Get the millisecond-of-second value for a date based on the current -machine’s locale. - -#### `toLocaleString` - -``` purescript -toLocaleString :: forall e. Date -> Eff (locale :: Locale | e) String -``` - -Format a date as a human-readable string (including the date and the -time), based on the current machine's locale. Example output: -"Fri May 22 2015 19:45:07 GMT+0100 (BST)", although bear in mind that this -can vary significantly across platforms. - -#### `toLocaleTimeString` - -``` purescript -toLocaleTimeString :: forall e. Date -> Eff (locale :: Locale | e) String -``` - -Format a time as a human-readable string, based on the current machine's -locale. Example output: "19:45:07", although bear in mind that this -can vary significantly across platforms. - -#### `toLocaleDateString` - -``` purescript -toLocaleDateString :: forall e. Date -> Eff (locale :: Locale | e) String -``` - -Format a date as a human-readable string, based on the current machine's -locale. Example output: "Friday, May 22, 2015", although bear in mind that -this can vary significantly across platforms. - - diff --git a/docs/Data/Date/UTC.md b/docs/Data/Date/UTC.md deleted file mode 100644 index 621d116..0000000 --- a/docs/Data/Date/UTC.md +++ /dev/null @@ -1,85 +0,0 @@ -## Module Data.Date.UTC - -#### `dateTime` - -``` purescript -dateTime :: Year -> Month -> DayOfMonth -> HourOfDay -> MinuteOfHour -> SecondOfMinute -> MillisecondOfSecond -> Maybe Date -``` - -Attempts to create a `Date` from UTC date and time components. `Nothing` -is returned if the resulting date is invalid. - -#### `date` - -``` purescript -date :: Year -> Month -> DayOfMonth -> Maybe Date -``` - -Attempts to create a `Date` from UTC date components. `Nothing` is -returned if the resulting date is invalid. - -#### `year` - -``` purescript -year :: Date -> Year -``` - -Gets the UTC year component for a date. - -#### `month` - -``` purescript -month :: Date -> Month -``` - -Gets the UTC month component for a date. - -#### `dayOfMonth` - -``` purescript -dayOfMonth :: Date -> DayOfMonth -``` - -Gets the UTC day-of-month value for a date. - -#### `dayOfWeek` - -``` purescript -dayOfWeek :: Date -> DayOfWeek -``` - -Gets the UTC day-of-week value for a date. - -#### `hourOfDay` - -``` purescript -hourOfDay :: Date -> HourOfDay -``` - -Gets the UTC hour-of-day value for a date. - -#### `minuteOfHour` - -``` purescript -minuteOfHour :: Date -> MinuteOfHour -``` - -Gets the UTC minute-of-hour value for a date. - -#### `secondOfMinute` - -``` purescript -secondOfMinute :: Date -> SecondOfMinute -``` - -Get the UTC second-of-minute value for a date. - -#### `millisecondOfSecond` - -``` purescript -millisecondOfSecond :: Date -> MillisecondOfSecond -``` - -Get the UTC millisecond-of-second value for a date. - - diff --git a/docs/Data/Time.md b/docs/Data/Time.md deleted file mode 100644 index ce09e4d..0000000 --- a/docs/Data/Time.md +++ /dev/null @@ -1,177 +0,0 @@ -## Module Data.Time - -#### `HourOfDay` - -``` purescript -newtype HourOfDay - = HourOfDay Int -``` - -An hour component from a time value. Should fall between 0 and 23 -inclusive. - -##### Instances -``` purescript -instance eqHourOfDay :: Eq HourOfDay -instance ordHourOfDay :: Ord HourOfDay -``` - -#### `Hours` - -``` purescript -newtype Hours - = Hours Number -``` - -A quantity of hours (not necessarily a value between 0 and 23). - -##### Instances -``` purescript -instance eqHours :: Eq Hours -instance ordHours :: Ord Hours -instance semiringHours :: Semiring Hours -instance ringHours :: Ring Hours -instance moduloSemiringHours :: ModuloSemiring Hours -instance divisionRingHours :: DivisionRing Hours -instance numHours :: Num Hours -instance showHours :: Show Hours -instance timeValueHours :: TimeValue Hours -``` - -#### `MinuteOfHour` - -``` purescript -newtype MinuteOfHour - = MinuteOfHour Int -``` - -A minute component from a time value. Should fall between 0 and 59 -inclusive. - -##### Instances -``` purescript -instance eqMinuteOfHour :: Eq MinuteOfHour -instance ordMinuteOfHour :: Ord MinuteOfHour -``` - -#### `Minutes` - -``` purescript -newtype Minutes - = Minutes Number -``` - -A quantity of minutes (not necessarily a value between 0 and 60). - -##### Instances -``` purescript -instance eqMinutes :: Eq Minutes -instance ordMinutes :: Ord Minutes -instance semiringMinutes :: Semiring Minutes -instance ringMinutes :: Ring Minutes -instance moduloSemiringMinutes :: ModuloSemiring Minutes -instance divisionRingMinutes :: DivisionRing Minutes -instance numMinutes :: Num Minutes -instance showMinutes :: Show Minutes -instance timeValueMinutes :: TimeValue Minutes -``` - -#### `SecondOfMinute` - -``` purescript -newtype SecondOfMinute - = SecondOfMinute Int -``` - -A second component from a time value. Should fall between 0 and 59 -inclusive. - -##### Instances -``` purescript -instance eqSecondOfMinute :: Eq SecondOfMinute -instance ordSecondOfMinute :: Ord SecondOfMinute -``` - -#### `Seconds` - -``` purescript -newtype Seconds - = Seconds Number -``` - -A quantity of seconds (not necessarily a value between 0 and 60). - -##### Instances -``` purescript -instance eqSeconds :: Eq Seconds -instance ordSeconds :: Ord Seconds -instance semiringSeconds :: Semiring Seconds -instance ringSeconds :: Ring Seconds -instance moduloSemiringSeconds :: ModuloSemiring Seconds -instance divisionRingSeconds :: DivisionRing Seconds -instance numSeconds :: Num Seconds -instance showSeconds :: Show Seconds -instance timeValueSeconds :: TimeValue Seconds -``` - -#### `MillisecondOfSecond` - -``` purescript -newtype MillisecondOfSecond - = MillisecondOfSecond Int -``` - -A millisecond component from a time value. Should fall between 0 and 999 -inclusive. - -##### Instances -``` purescript -instance eqMillisecondOfSecond :: Eq MillisecondOfSecond -instance ordMillisecondOfSecond :: Ord MillisecondOfSecond -``` - -#### `Milliseconds` - -``` purescript -newtype Milliseconds - = Milliseconds Number -``` - -A quantity of milliseconds (not necessarily a value between 0 and 1000). - -##### Instances -``` purescript -instance eqMilliseconds :: Eq Milliseconds -instance ordMilliseconds :: Ord Milliseconds -instance semiringMilliseconds :: Semiring Milliseconds -instance ringMilliseconds :: Ring Milliseconds -instance moduloSemiringMilliseconds :: ModuloSemiring Milliseconds -instance divisionRingMilliseconds :: DivisionRing Milliseconds -instance numMilliseconds :: Num Milliseconds -instance showMilliseconds :: Show Milliseconds -instance timeValueMilliseconds :: TimeValue Milliseconds -``` - -#### `TimeValue` - -``` purescript -class TimeValue a where - toHours :: a -> Hours - toMinutes :: a -> Minutes - toSeconds :: a -> Seconds - toMilliseconds :: a -> Milliseconds - fromHours :: Hours -> a - fromMinutes :: Minutes -> a - fromSeconds :: Seconds -> a - fromMilliseconds :: Milliseconds -> a -``` - -##### Instances -``` purescript -instance timeValueHours :: TimeValue Hours -instance timeValueMinutes :: TimeValue Minutes -instance timeValueSeconds :: TimeValue Seconds -instance timeValueMilliseconds :: TimeValue Milliseconds -``` - - diff --git a/package.json b/package.json index d1bdeae..a1d6811 100644 --- a/package.json +++ b/package.json @@ -1,13 +1,14 @@ { "private": true, "scripts": { - "postinstall": "pulp dep install", - "build": "jshint src && jscs src && pulp build && rimraf docs && pulp docs" + "clean": "rimraf output && rimraf .pulp-cache", + "build": "eslint src && pulp build -- --censor-lib --strict", + "test": "pulp test" }, "devDependencies": { - "jscs": "^1.13.1", - "jshint": "^2.9.1-rc.1", - "pulp": "^4.0.2", - "rimraf": "^2.4.1" + "eslint": "^7.15.0", + "pulp": "16.0.0-0", + "purescript-psa": "^0.8.2", + "rimraf": "^3.0.2" } } diff --git a/src/Data/Date.js b/src/Data/Date.js index 88be134..e7a7abc 100644 --- a/src/Data/Date.js +++ b/src/Data/Date.js @@ -1,33 +1,22 @@ -/* global exports */ -"use strict"; - -// module Data.Date - -exports.nowEpochMilliseconds = function () { - return Date.now(); +var createDate = function (y, m, d) { + var date = new Date(Date.UTC(y, m, d)); + if (y >= 0 && y < 100) { + date.setUTCFullYear(y); + } + return date; }; -exports.nowImpl = function (ctor) { - return function () { - return ctor(new Date()); - }; -}; +export function canonicalDateImpl(ctor, y, m, d) { + var date = createDate(y, m - 1, d); + return ctor(date.getUTCFullYear())(date.getUTCMonth() + 1)(date.getUTCDate()); +} -exports.jsDateConstructor = function (x) { - return new Date(x); -}; +export function calcWeekday(y, m, d) { + return createDate(y, m - 1, d).getUTCDay(); +} -// jshint maxparams: 2 -exports.jsDateMethod = function (method, date) { - return date[method](); -}; - -// jshint maxparams: 3 -exports.strictJsDate = function (just, nothing, s) { - var epoch = Date.parse(s); - if (isNaN(epoch)) return nothing; - var date = new Date(epoch); - var s2 = date.toISOString(); - var idx = s2.indexOf(s); - return idx < 0 ? nothing : just(date); -}; +export function calcDiff(y1, m1, d1, y2, m2, d2) { + var dt1 = createDate(y1, m1 - 1, d1); + var dt2 = createDate(y2, m2 - 1, d2); + return dt1.getTime() - dt2.getTime(); +} diff --git a/src/Data/Date.purs b/src/Data/Date.purs index 6711739..fbee82b 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -1,293 +1,148 @@ module Data.Date - ( JSDate() - , Date() - , fromJSDate - , toJSDate - , fromEpochMilliseconds - , toEpochMilliseconds - , fromString - , fromStringStrict - , Now() - , now - , nowEpochMilliseconds - , LocaleOffset(..) - , timezoneOffset - , Year(..) - , Month(..) - , DayOfMonth(..) - , DayOfWeek(..) + ( Date + , canonicalDate + , exactDate + , year + , month + , day + , weekday + , diff + , isLeapYear + , lastDayOfMonth + , adjust + , module Data.Date.Component ) where import Prelude -import Control.Monad.Eff -import Data.Enum (Enum, Cardinality(..), fromEnum, defaultSucc, defaultPred) -import Data.Function (on, Fn2(), runFn2, Fn3(), runFn3) -import Data.Maybe (Maybe(..)) -import Data.Time - --- | A native JavaScript `Date` object. -foreign import data JSDate :: * - --- | A combined date/time value. `Date`s cannot be constructed directly to --- | ensure they are not the `Invalid Date` value, and instead must be created --- | via `fromJSDate`, `fromEpochMilliseconds`, `fromString`, etc. or the `date` --- | and `dateTime` functions in the `Data.Date.Locale` and `Data.Date.UTC` --- | modules. -newtype Date = DateTime JSDate - -instance eqDate :: Eq Date where - eq = eq `on` toEpochMilliseconds - -instance ordDate :: Ord Date where - compare = compare `on` toEpochMilliseconds +import Data.Date.Component (Day, Month(..), Weekday(..), Year) +import Data.Enum (class Enum, toEnum, fromEnum, succ, pred) +import Data.Function.Uncurried (Fn3, runFn3, Fn4, runFn4, Fn6, runFn6) +import Data.Int (fromNumber) +import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing) +import Data.Time.Duration (class Duration, Days(..), Milliseconds, toDuration) +import Partial.Unsafe (unsafePartial) + +-- | A date value in the Gregorian calendar. +data Date = Date Year Month Day + +-- | Constructs a date from year, month, and day components. The resulting date +-- | components may not be identical to the input values, as the date will be +-- | canonicalised according to the Gregorian calendar. For example, date +-- | values for the invalid date 2016-02-31 will be corrected to 2016-03-02. +canonicalDate :: Year -> Month -> Day -> Date +canonicalDate y m d = runFn4 canonicalDateImpl mkDate y (fromEnum m) d + where + mkDate :: Year -> Int -> Day -> Date + mkDate = unsafePartial \y' m' d' -> Date y' (fromJust (toEnum m')) d' + +-- | Constructs a date from year, month, and day components. The result will be +-- | `Nothing` if the provided values result in an invalid date. +exactDate :: Year -> Month -> Day -> Maybe Date +exactDate y m d = + let dt = Date y m d + in if canonicalDate y m d == dt then Just dt else Nothing + +derive instance eqDate :: Eq Date +derive instance ordDate :: Ord Date + +instance boundedDate :: Bounded Date where + bottom = Date bottom bottom bottom + top = Date top top top instance showDate :: Show Date where - show d = "(fromEpochMilliseconds " ++ show (toEpochMilliseconds d) ++ ")" - --- | Attempts to create a `Date` from a `JSDate`. If the `JSDate` is an invalid --- | date `Nothing` is returned. -fromJSDate :: JSDate -> Maybe Date -fromJSDate d = - if Global.isNaN (runFn2 jsDateMethod "getTime" d) - then Nothing - else Just (DateTime d) - --- | Extracts a `JSDate` from a `Date`. -toJSDate :: Date -> JSDate -toJSDate (DateTime d) = d - --- | Creates a `Date` value from a number of milliseconds elapsed since 1st --- | January 1970 00:00:00 UTC. -fromEpochMilliseconds :: Milliseconds -> Maybe Date -fromEpochMilliseconds = fromJSDate <<< jsDateConstructor - --- | Gets the number of milliseconds elapsed since 1st January 1970 00:00:00 --- | UTC for a `Date`. -toEpochMilliseconds :: Date -> Milliseconds -toEpochMilliseconds (DateTime d) = runFn2 jsDateMethod "getTime" d - --- | Attempts to construct a date from a string value using JavaScript’s --- | [Date.parse() method](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/parse). --- | `Nothing` is returned if the parse fails or the resulting date is invalid. -fromString :: String -> Maybe Date -fromString = fromJSDate <<< jsDateConstructor - --- | Attempts to construct a date from a simplified extended ISO 8601 format --- | (`YYYY-MM-DDTHH:mm:ss.sssZ`). `Nothing` is returned if the format is not --- | an exact match or the resulting date is invalid. -fromStringStrict :: String -> Maybe Date -fromStringStrict s = runFn3 strictJsDate Just Nothing s >>= fromJSDate - --- | Effect type for when accessing the current date/time. -foreign import data Now :: ! - --- | Gets a `Date` value for the current date/time according to the current --- | machine’s local time. -now :: forall e. Eff (now :: Now | e) Date -now = nowImpl DateTime - --- | Gets the number of milliseconds elapsed milliseconds since 1st January --- | 1970 00:00:00 UTC according to the current machine’s local time -foreign import nowEpochMilliseconds :: forall e. Eff (now :: Now | e) Milliseconds - --- | A timezone locale offset, measured in minutes. -newtype LocaleOffset = LocaleOffset Minutes - --- | Get the locale time offset for a `Date`. -timezoneOffset :: Date -> LocaleOffset -timezoneOffset (DateTime d) = runFn2 jsDateMethod "getTimezoneOffset" d - --- | A year date component value. -newtype Year = Year Int - -instance eqYear :: Eq Year where - eq (Year x) (Year y) = x == y - -instance ordYear :: Ord Year where - compare (Year x) (Year y) = compare x y - -instance semiringYear :: Semiring Year where - add (Year x) (Year y) = Year (x + y) - mul (Year x) (Year y) = Year (x * y) - zero = Year zero - one = Year one - -instance ringYear :: Ring Year where - sub (Year x) (Year y) = Year (x - y) - -instance showYear :: Show Year where - show (Year n) = "(Year " ++ show n ++ ")" - --- | A month date component value. -data Month - = January - | February - | March - | April - | May - | June - | July - | August - | September - | October - | November - | December - -instance eqMonth :: Eq Month where - eq January January = true - eq February February = true - eq March March = true - eq April April = true - eq May May = true - eq June June = true - eq July July = true - eq August August = true - eq September September = true - eq October October = true - eq November November = true - eq December December = true - eq _ _ = false - -instance ordMonth :: Ord Month where - compare = compare `on` fromEnum - -instance boundedMonth :: Bounded Month where - bottom = January - top = December - -instance boundedOrdMonth :: BoundedOrd Month - -instance showMonth :: Show Month where - show January = "January" - show February = "February" - show March = "March" - show April = "April" - show May = "May" - show June = "June" - show July = "July" - show August = "August" - show September = "September" - show October = "October" - show November = "November" - show December = "December" - -instance enumMonth :: Enum Month where - cardinality = Cardinality 12 - succ = defaultSucc monthToEnum monthFromEnum - pred = defaultPred monthToEnum monthFromEnum - toEnum = monthToEnum - fromEnum = monthFromEnum - -monthToEnum :: Int -> Maybe Month -monthToEnum 0 = Just January -monthToEnum 1 = Just February -monthToEnum 2 = Just March -monthToEnum 3 = Just April -monthToEnum 4 = Just May -monthToEnum 5 = Just June -monthToEnum 6 = Just July -monthToEnum 7 = Just August -monthToEnum 8 = Just September -monthToEnum 9 = Just October -monthToEnum 10 = Just November -monthToEnum 11 = Just December -monthToEnum _ = Nothing - -monthFromEnum :: Month -> Int -monthFromEnum January = 0 -monthFromEnum February = 1 -monthFromEnum March = 2 -monthFromEnum April = 3 -monthFromEnum May = 4 -monthFromEnum June = 5 -monthFromEnum July = 6 -monthFromEnum August = 7 -monthFromEnum September = 8 -monthFromEnum October = 9 -monthFromEnum November = 10 -monthFromEnum December = 11 - --- | A day-of-month date component value. -newtype DayOfMonth = DayOfMonth Int - -instance eqDayOfMonth :: Eq DayOfMonth where - eq (DayOfMonth x) (DayOfMonth y) = x == y - -instance ordDayOfMonth :: Ord DayOfMonth where - compare (DayOfMonth x) (DayOfMonth y) = compare x y - -instance showDayOfMonth :: Show DayOfMonth where - show (DayOfMonth day) = "(DayOfMonth " ++ show day ++ ")" - --- | A day-of-week date component value. -data DayOfWeek - = Sunday - | Monday - | Tuesday - | Wednesday - | Thursday - | Friday - | Saturday - -instance eqDayOfWeek :: Eq DayOfWeek where - eq Sunday Sunday = true - eq Monday Monday = true - eq Tuesday Tuesday = true - eq Wednesday Wednesday = true - eq Thursday Thursday = true - eq Friday Friday = true - eq Saturday Saturday = true - eq _ _ = false - -instance ordDayOfWeek :: Ord DayOfWeek where - compare = compare `on` fromEnum - -instance boundedDayOfWeek :: Bounded DayOfWeek where - bottom = Sunday - top = Saturday - -instance boundedOrdDayOfWeek :: BoundedOrd DayOfWeek - -instance showDayOfWeek :: Show DayOfWeek where - show Sunday = "Sunday" - show Monday = "Monday" - show Tuesday = "Tuesday" - show Wednesday = "Wednesday" - show Thursday = "Thursday" - show Friday = "Friday" - show Saturday = "Saturday" - -instance enumDayOfWeek :: Enum DayOfWeek where - cardinality = Cardinality 7 - succ = defaultSucc dayOfWeekToEnum dayOfWeekFromEnum - pred = defaultPred dayOfWeekToEnum dayOfWeekFromEnum - toEnum = dayOfWeekToEnum - fromEnum = dayOfWeekFromEnum - -dayOfWeekToEnum :: Int -> Maybe DayOfWeek -dayOfWeekToEnum 0 = Just Sunday -dayOfWeekToEnum 1 = Just Monday -dayOfWeekToEnum 2 = Just Tuesday -dayOfWeekToEnum 3 = Just Wednesday -dayOfWeekToEnum 4 = Just Thursday -dayOfWeekToEnum 5 = Just Friday -dayOfWeekToEnum 6 = Just Saturday -dayOfWeekToEnum _ = Nothing - -dayOfWeekFromEnum :: DayOfWeek -> Int -dayOfWeekFromEnum Sunday = 0 -dayOfWeekFromEnum Monday = 1 -dayOfWeekFromEnum Tuesday = 2 -dayOfWeekFromEnum Wednesday = 3 -dayOfWeekFromEnum Thursday = 4 -dayOfWeekFromEnum Friday = 5 -dayOfWeekFromEnum Saturday = 6 - -foreign import nowImpl :: forall e. (JSDate -> Date) -> Eff (now :: Now | e) Date - -foreign import jsDateConstructor :: forall a. a -> JSDate - -foreign import jsDateMethod :: forall a. Fn2 String JSDate a - -foreign import strictJsDate :: Fn3 (forall a. a -> Maybe a) (forall a. Maybe a) String (Maybe JSDate) + show (Date y m d) = "(Date " <> show y <> " " <> show m <> " " <> show d <> ")" + +instance enumDate :: Enum Date where + succ (Date y m d) = Date <$> y' <*> pure m' <*> d' + where + d' = if isNothing sd then toEnum 1 else sd + m' = if isNothing sd then fromMaybe January sm else m + y' = if isNothing sd && isNothing sm then succ y else Just y + sd = let v = succ d in if v > Just l then Nothing else v + sm = succ m + l = lastDayOfMonth y m + pred (Date y m d) = Date <$> y' <*> pure m' <*> d' + where + d' = if isNothing pd then Just l else pd + m' = if isNothing pd then fromMaybe December pm else m + y' = if isNothing pd && isNothing pm then pred y else Just y + pd = pred d + pm = pred m + l = lastDayOfMonth y m' + +-- | The year component of a date value. +year :: Date -> Year +year (Date y _ _) = y + +-- | The month component of a date value. +month :: Date -> Month +month (Date _ m _) = m + +-- | The day component of a date value. +day :: Date -> Day +day (Date _ _ d) = d + +-- | The weekday for a date value. +weekday :: Date -> Weekday +weekday = unsafePartial \(Date y m d) -> + let n = runFn3 calcWeekday y (fromEnum m) d + in if n == 0 then fromJust (toEnum 7) else fromJust (toEnum n) + +-- | Adjusts a date with a Duration in days. The number of days must +-- | already be an integer and fall within the valid range of values +-- | for the Int type. +adjust :: Days -> Date -> Maybe Date +adjust (Days n) date = fromNumber n >>= flip adj date + where + adj 0 dt = Just dt + adj i (Date y m d) = adj i' =<< dt' + where + i' | low = j + | hi = j - fromEnum l - 1 + | otherwise = 0 + dt' | low = pred =<< Date y m <$> toEnum 1 + | hi = succ (Date y m l) + | otherwise = Date y m <$> toEnum j + j = i + fromEnum d + low = j < 1 + hi = j > fromEnum l + l = lastDayOfMonth y (if low then fromMaybe December (pred m) else m) + +-- | Calculates the difference between two dates, returning the result as a +-- | duration. +diff :: forall d. Duration d => Date -> Date -> d +diff (Date y1 m1 d1) (Date y2 m2 d2) = + toDuration $ runFn6 calcDiff y1 (fromEnum m1) d1 y2 (fromEnum m2) d2 + +-- | Checks whether a year is a leap year according to the proleptic Gregorian +-- | calendar. +isLeapYear :: Year -> Boolean +isLeapYear y = (mod y' 4 == 0) && ((mod y' 400 == 0) || not (mod y' 100 == 0)) + where + y' = fromEnum y + +-- | Get the final day of a month and year, accounting for leap years. +lastDayOfMonth :: Year -> Month -> Day +lastDayOfMonth y m = case m of + January -> unsafeDay 31 + February + | isLeapYear y -> unsafeDay 29 + | otherwise -> unsafeDay 28 + March -> unsafeDay 31 + April -> unsafeDay 30 + May -> unsafeDay 31 + June -> unsafeDay 30 + July -> unsafeDay 31 + August -> unsafeDay 31 + September -> unsafeDay 30 + October -> unsafeDay 31 + November -> unsafeDay 30 + December -> unsafeDay 31 + where + unsafeDay = unsafePartial fromJust <<< toEnum + +-- TODO: these could (and probably should) be implemented in PS +foreign import canonicalDateImpl :: Fn4 (Year -> Int -> Day -> Date) Year Int Day Date +foreign import calcWeekday :: Fn3 Year Int Day Int +foreign import calcDiff :: Fn6 Year Int Day Year Int Day Milliseconds diff --git a/src/Data/Date/Component.purs b/src/Data/Date/Component.purs new file mode 100644 index 0000000..2762eaa --- /dev/null +++ b/src/Data/Date/Component.purs @@ -0,0 +1,191 @@ +module Data.Date.Component + ( Year + , Month(..) + , Day + , Weekday(..) + ) where + +import Prelude + +import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) +import Data.Maybe (Maybe(..)) + +-- | A year component for a date. +-- | +-- | The constructor is private as the `Year` type is bounded to the range +-- | -271820 to 275759, inclusive. The `toEnum` function can be used to safely +-- | acquire a year value from an integer. +newtype Year = Year Int + +derive newtype instance eqYear :: Eq Year +derive newtype instance ordYear :: Ord Year + +-- Note: these seemingly arbitrary bounds come from relying on JS for date +-- manipulations, as it only supports date ±100,000,000 days of the Unix epoch. +-- Using these year values means `Date bottom bottom bottom` is a valid date, +-- likewise for `top`. +instance boundedYear :: Bounded Year where + bottom = Year (-271820) + top = Year 275759 + +instance enumYear :: Enum Year where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumYear :: BoundedEnum Year where + cardinality = Cardinality 547580 + toEnum n + | n >= (-271820) && n <= 275759 = Just (Year n) + | otherwise = Nothing + fromEnum (Year n) = n + +instance showYear :: Show Year where + show (Year y) = "(Year " <> show y <> ")" + +-- | A month component for a date in the Gregorian calendar. +data Month + = January + | February + | March + | April + | May + | June + | July + | August + | September + | October + | November + | December + +derive instance eqMonth :: Eq Month +derive instance ordMonth :: Ord Month + +instance boundedMonth :: Bounded Month where + bottom = January + top = December + +instance enumMonth :: Enum Month where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumMonth :: BoundedEnum Month where + cardinality = Cardinality 12 + toEnum = case _ of + 1 -> Just January + 2 -> Just February + 3 -> Just March + 4 -> Just April + 5 -> Just May + 6 -> Just June + 7 -> Just July + 8 -> Just August + 9 -> Just September + 10 -> Just October + 11 -> Just November + 12 -> Just December + _ -> Nothing + fromEnum = case _ of + January -> 1 + February -> 2 + March -> 3 + April -> 4 + May -> 5 + June -> 6 + July -> 7 + August -> 8 + September -> 9 + October -> 10 + November -> 11 + December -> 12 + +instance showMonth :: Show Month where + show January = "January" + show February = "February" + show March = "March" + show April = "April" + show May = "May" + show June = "June" + show July = "July" + show August = "August" + show September = "September" + show October = "October" + show November = "November" + show December = "December" + +-- | A day component for a date. +-- | +-- | The constructor is private as the `Day` type is bounded to the range +-- | 1 to 31, inclusive. The `toEnum` function can be used to safely +-- | acquire a day value from an integer. +newtype Day = Day Int + +derive newtype instance eqDay :: Eq Day +derive newtype instance ordDay :: Ord Day + +instance boundedDay :: Bounded Day where + bottom = Day 1 + top = Day 31 + +instance enumDay :: Enum Day where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumDay :: BoundedEnum Day where + cardinality = Cardinality 31 + toEnum n + | n >= 1 && n <= 31 = Just (Day n) + | otherwise = Nothing + fromEnum (Day n) = n + +instance showDay :: Show Day where + show (Day d) = "(Day " <> show d <> ")" + +-- | A type representing the days of the week in the Gregorian calendar. +data Weekday + = Monday + | Tuesday + | Wednesday + | Thursday + | Friday + | Saturday + | Sunday + +derive instance eqWeekday :: Eq Weekday +derive instance ordWeekday :: Ord Weekday + +instance boundedWeekday :: Bounded Weekday where + bottom = Monday + top = Sunday + +instance enumWeekday :: Enum Weekday where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumWeekday :: BoundedEnum Weekday where + cardinality = Cardinality 7 + toEnum = case _ of + 1 -> Just Monday + 2 -> Just Tuesday + 3 -> Just Wednesday + 4 -> Just Thursday + 5 -> Just Friday + 6 -> Just Saturday + 7 -> Just Sunday + _ -> Nothing + fromEnum = case _ of + Monday -> 1 + Tuesday -> 2 + Wednesday -> 3 + Thursday -> 4 + Friday -> 5 + Saturday -> 6 + Sunday -> 7 + +instance showWeekday :: Show Weekday where + show Monday = "Monday" + show Tuesday = "Tuesday" + show Wednesday = "Wednesday" + show Thursday = "Thursday" + show Friday = "Friday" + show Saturday = "Saturday" + show Sunday = "Sunday" diff --git a/src/Data/Date/Component/Gen.purs b/src/Data/Date/Component/Gen.purs new file mode 100644 index 0000000..fb5fb80 --- /dev/null +++ b/src/Data/Date/Component/Gen.purs @@ -0,0 +1,25 @@ +module Data.Date.Component.Gen where + +import Prelude +import Control.Monad.Gen (class MonadGen, chooseInt) +import Data.Date.Component (Day, Month, Weekday, Year) +import Data.Enum (toEnum) +import Data.Enum.Gen (genBoundedEnum) +import Data.Maybe (fromJust) +import Partial.Unsafe (unsafePartial) + +-- | Generates a random `Year` in the range 1900-2100, inclusive. +genYear :: forall m. MonadGen m => m Year +genYear = unsafePartial fromJust <<< toEnum <$> chooseInt 1900 2100 + +-- | Generates a random `Month` component. +genMonth :: forall m. MonadGen m => m Month +genMonth = genBoundedEnum + +-- | Generates a random `Day` component. +genDay :: forall m. MonadGen m => m Day +genDay = genBoundedEnum + +-- | Generates a random `Weekday` component. +genWeekday :: forall m. MonadGen m => m Weekday +genWeekday = genBoundedEnum diff --git a/src/Data/Date/Gen.purs b/src/Data/Date/Gen.purs new file mode 100644 index 0000000..1608782 --- /dev/null +++ b/src/Data/Date/Gen.purs @@ -0,0 +1,24 @@ +module Data.Date.Gen + ( genDate + , module Data.Date.Component.Gen + ) where + +import Prelude +import Control.Monad.Gen (class MonadGen, chooseInt) +import Data.Date (Date, adjust, exactDate, isLeapYear) +import Data.Date.Component.Gen (genDay, genMonth, genWeekday, genYear) +import Data.Int (toNumber) +import Data.Maybe (fromJust) +import Data.Time.Duration (Days(..)) +import Partial.Unsafe (unsafePartial) + +-- | Generates a random `Date` between 1st Jan 1900 and 31st Dec 2100, +-- | inclusive. +genDate :: forall m. MonadGen m => m Date +genDate = do + year <- genYear + let maxDays = if isLeapYear year then 365 else 364 + days <- Days <<< toNumber <$> chooseInt 0 maxDays + pure $ unsafePartial $ fromJust do + janFirst <- exactDate year bottom bottom + adjust days janFirst diff --git a/src/Data/Date/Locale.js b/src/Data/Date/Locale.js deleted file mode 100644 index 7091c64..0000000 --- a/src/Data/Date/Locale.js +++ /dev/null @@ -1,18 +0,0 @@ -/* global exports */ -"use strict"; - -// module Data.Date.Locale - -// jshint maxparams: 2 -exports.dateMethod = function (method, date) { - return function () { - return date[method](); - }; -}; - -// jshint maxparams: 7 -exports.jsDateFromValues = function (y, mo, d, h, mi, s, ms) { - return function () { - return new Date(y, mo, d, h, mi, s, ms); - }; -}; diff --git a/src/Data/Date/Locale.purs b/src/Data/Date/Locale.purs deleted file mode 100644 index 50e6458..0000000 --- a/src/Data/Date/Locale.purs +++ /dev/null @@ -1,107 +0,0 @@ -module Data.Date.Locale - ( Locale() - , dateTime - , date - , year - , month - , dayOfMonth - , dayOfWeek - , hourOfDay - , minuteOfHour - , secondOfMinute - , millisecondOfSecond - , toLocaleString - , toLocaleTimeString - , toLocaleDateString - ) where - -import Control.Monad.Eff (Eff()) -import Data.Date -import Data.Enum (fromEnum, toEnum) -import Data.Function (Fn2(), runFn2, Fn7(), runFn7) -import Data.Maybe (Maybe()) -import Data.Maybe.Unsafe (fromJust) -import Data.Time - -import Prelude - ( (<$>) - , (<<<) - , zero ) - --- | The effect of reading the current system locale/timezone. -foreign import data Locale :: ! - --- | Attempts to create a `Date` from date and time components based on the --- | current machine’s locale. `Nothing` is returned if the resulting date is --- | invalid. -dateTime :: forall e. Year -> Month -> DayOfMonth - -> HourOfDay -> MinuteOfHour -> SecondOfMinute -> MillisecondOfSecond - -> Eff (locale :: Locale | e) (Maybe Date) -dateTime y mo d h mi s ms = - fromJSDate <$> runFn7 jsDateFromValues y (fromEnum mo) d h mi s ms - --- | Attempts to create a `Date` from date components based on the current --- | machine’s locale. `Nothing` is returned if the resulting date is invalid. -date :: forall e. Year -> Month -> DayOfMonth -> Eff (locale :: Locale | e) (Maybe Date) -date y m d = dateTime y m d (HourOfDay zero) (MinuteOfHour zero) (SecondOfMinute zero) (MillisecondOfSecond zero) - --- | Gets the year component for a date based on the current machine’s locale. -year :: forall e. Date -> Eff (locale :: Locale | e) Year -year d = runFn2 dateMethod "getFullYear" d - --- | Gets the month component for a date based on the current machine’s locale. -month :: forall e. Date -> Eff (locale :: Locale | e) Month -month d = fromJust <<< toEnum <$> runFn2 dateMethod "getMonth" d - --- | Gets the day-of-month value for a date based on the current machine’s --- | locale. -dayOfMonth :: forall e. Date -> Eff (locale :: Locale | e) DayOfMonth -dayOfMonth d = runFn2 dateMethod "getDate" d - --- | Gets the day-of-week value for a date based on the current machine’s --- | locale. -dayOfWeek :: forall e. Date -> Eff (locale :: Locale | e) DayOfWeek -dayOfWeek d = fromJust <<< toEnum <$> runFn2 dateMethod "getDay" d - --- | Gets the hour-of-day value for a date based on the current machine’s --- | locale. -hourOfDay :: forall e. Date -> Eff (locale :: Locale | e) HourOfDay -hourOfDay d = runFn2 dateMethod "getHours" d - --- | Gets the minute-of-hour value for a date based on the current machine’s --- | locale. -minuteOfHour :: forall e. Date -> Eff (locale :: Locale | e) MinuteOfHour -minuteOfHour d = runFn2 dateMethod "getMinutes" d - --- | Get the second-of-minute value for a date based on the current machine’s --- | locale. -secondOfMinute :: forall e. Date -> Eff (locale :: Locale | e) SecondOfMinute -secondOfMinute d = runFn2 dateMethod "getSeconds" d - --- | Get the millisecond-of-second value for a date based on the current --- | machine’s locale. -millisecondOfSecond :: forall e. Date -> Eff (locale :: Locale | e) MillisecondOfSecond -millisecondOfSecond d = runFn2 dateMethod "getMilliseconds" d - --- | Format a date as a human-readable string (including the date and the --- | time), based on the current machine's locale. Example output: --- | "Fri May 22 2015 19:45:07 GMT+0100 (BST)", although bear in mind that this --- | can vary significantly across platforms. -toLocaleString :: forall e. Date -> Eff (locale :: Locale | e) String -toLocaleString d = runFn2 dateMethod "toLocaleString" d - --- | Format a time as a human-readable string, based on the current machine's --- | locale. Example output: "19:45:07", although bear in mind that this --- | can vary significantly across platforms. -toLocaleTimeString :: forall e. Date -> Eff (locale :: Locale | e) String -toLocaleTimeString d = runFn2 dateMethod "toLocaleTimeString" d - --- | Format a date as a human-readable string, based on the current machine's --- | locale. Example output: "Friday, May 22, 2015", although bear in mind that --- | this can vary significantly across platforms. -toLocaleDateString :: forall e. Date -> Eff (locale :: Locale | e) String -toLocaleDateString d = runFn2 dateMethod "toLocaleDateString" d - -foreign import dateMethod :: forall e a. Fn2 String Date (Eff (locale :: Locale | e) a) - -foreign import jsDateFromValues :: forall e. Fn7 Year Int DayOfMonth HourOfDay MinuteOfHour SecondOfMinute MillisecondOfSecond (Eff (locale :: Locale | e) JSDate) diff --git a/src/Data/Date/UTC.js b/src/Data/Date/UTC.js deleted file mode 100644 index 09d05cf..0000000 --- a/src/Data/Date/UTC.js +++ /dev/null @@ -1,14 +0,0 @@ -/* global exports */ -"use strict"; - -// module Data.Date.UTC - -// jshint maxparams: 2 -exports.dateMethod = function (method, date) { - return date[method](); -}; - -// jshint maxparams: 7 -exports.jsDateFromValues = function (y, mo, d, h, mi, s, ms) { - return new Date(Date.UTC(y, mo, d, h, mi, s, ms)); -}; diff --git a/src/Data/Date/UTC.purs b/src/Data/Date/UTC.purs deleted file mode 100644 index d06afa5..0000000 --- a/src/Data/Date/UTC.purs +++ /dev/null @@ -1,71 +0,0 @@ -module Data.Date.UTC - ( dateTime - , date - , year - , month - , dayOfMonth - , dayOfWeek - , hourOfDay - , minuteOfHour - , secondOfMinute - , millisecondOfSecond - ) where - -import Data.Date -import Data.Enum (fromEnum, toEnum) -import Data.Function (Fn2(), runFn2, Fn7(), runFn7) -import Data.Maybe (Maybe()) -import Data.Maybe.Unsafe (fromJust) -import Data.Time - -import Prelude - ( zero ) - --- | Attempts to create a `Date` from UTC date and time components. `Nothing` --- | is returned if the resulting date is invalid. -dateTime :: Year -> Month -> DayOfMonth - -> HourOfDay -> MinuteOfHour -> SecondOfMinute -> MillisecondOfSecond - -> Maybe Date -dateTime y mo d h mi s ms = - fromJSDate (runFn7 jsDateFromValues y (fromEnum mo) d h mi s ms) - --- | Attempts to create a `Date` from UTC date components. `Nothing` is --- | returned if the resulting date is invalid. -date :: Year -> Month -> DayOfMonth -> Maybe Date -date y m d = dateTime y m d (HourOfDay zero) (MinuteOfHour zero) (SecondOfMinute zero) (MillisecondOfSecond zero) - --- | Gets the UTC year component for a date. -year :: Date -> Year -year d = runFn2 dateMethod "getUTCFullYear" d - --- | Gets the UTC month component for a date. -month :: Date -> Month -month d = fromJust (toEnum (runFn2 dateMethod "getUTCMonth" d)) - --- | Gets the UTC day-of-month value for a date. -dayOfMonth :: Date -> DayOfMonth -dayOfMonth d = runFn2 dateMethod "getUTCDate" d - --- | Gets the UTC day-of-week value for a date. -dayOfWeek :: Date -> DayOfWeek -dayOfWeek d = fromJust (toEnum (runFn2 dateMethod "getUTCDay" d)) - --- | Gets the UTC hour-of-day value for a date. -hourOfDay :: Date -> HourOfDay -hourOfDay d = runFn2 dateMethod "getUTCHours" d - --- | Gets the UTC minute-of-hour value for a date. -minuteOfHour :: Date -> MinuteOfHour -minuteOfHour d = runFn2 dateMethod "getUTCMinutes" d - --- | Get the UTC second-of-minute value for a date. -secondOfMinute :: Date -> SecondOfMinute -secondOfMinute d = runFn2 dateMethod "getUTCSeconds" d - --- | Get the UTC millisecond-of-second value for a date. -millisecondOfSecond :: Date -> MillisecondOfSecond -millisecondOfSecond d = runFn2 dateMethod "getUTCMilliseconds" d - -foreign import dateMethod :: forall a. Fn2 String Date a - -foreign import jsDateFromValues :: Fn7 Year Int DayOfMonth HourOfDay MinuteOfHour SecondOfMinute MillisecondOfSecond JSDate diff --git a/src/Data/DateTime.js b/src/Data/DateTime.js new file mode 100644 index 0000000..86578b7 --- /dev/null +++ b/src/Data/DateTime.js @@ -0,0 +1,33 @@ +var createUTC = function (y, mo, d, h, m, s, ms) { + var date = new Date(Date.UTC(y, mo, d, h, m, s, ms)); + if (y >= 0 && y < 100) { + date.setUTCFullYear(y); + } + return date.getTime(); +}; + +export function calcDiff(rec1, rec2) { + var msUTC1 = createUTC(rec1.year, rec1.month - 1, rec1.day, rec1.hour, rec1.minute, rec1.second, rec1.millisecond); + var msUTC2 = createUTC(rec2.year, rec2.month - 1, rec2.day, rec2.hour, rec2.minute, rec2.second, rec2.millisecond); + return msUTC1 - msUTC2; +} + +export function adjustImpl(just) { + return function (nothing) { + return function (offset) { + return function (rec) { + var msUTC = createUTC(rec.year, rec.month - 1, rec.day, rec.hour, rec.minute, rec.second, rec.millisecond); + var dt = new Date(msUTC + offset); + return isNaN(dt.getTime()) ? nothing : just({ + year: dt.getUTCFullYear(), + month: dt.getUTCMonth() + 1, + day: dt.getUTCDate(), + hour: dt.getUTCHours(), + minute: dt.getUTCMinutes(), + second: dt.getUTCSeconds(), + millisecond: dt.getUTCMilliseconds() + }); + }; + }; + }; +} diff --git a/src/Data/DateTime.purs b/src/Data/DateTime.purs new file mode 100644 index 0000000..2119ded --- /dev/null +++ b/src/Data/DateTime.purs @@ -0,0 +1,99 @@ +module Data.DateTime + ( DateTime(..) + , date + , modifyDate + , modifyDateF + , time + , modifyTime + , modifyTimeF + , adjust + , diff + , module Data.Date + , module Data.Time + ) where + +import Prelude + +import Data.Date (Date, Day, Month(..), Weekday(..), Year, canonicalDate, day, exactDate, month, weekday, year) +import Data.Enum (toEnum, fromEnum) +import Data.Function.Uncurried (Fn2, runFn2) +import Data.Time (Hour, Millisecond, Minute, Second, Time(..), hour, setHour, millisecond, setMillisecond, minute, setMinute, second, setSecond) +import Data.Time.Duration (class Duration, fromDuration, toDuration, Milliseconds) +import Data.Maybe (Maybe(..)) + +-- | A date/time value in the Gregorian calendar/UTC time zone. +data DateTime = DateTime Date Time + +derive instance eqDateTime :: Eq DateTime +derive instance ordDateTime :: Ord DateTime + +instance boundedDateTime :: Bounded DateTime where + bottom = DateTime bottom bottom + top = DateTime top top + +instance showDateTime :: Show DateTime where + show (DateTime d t) = "(DateTime " <> show d <> " " <> show t <> ")" + +date :: DateTime -> Date +date (DateTime d _) = d + +modifyDate :: (Date -> Date) -> DateTime -> DateTime +modifyDate f (DateTime d t) = DateTime (f d) t + +modifyDateF :: forall f. Functor f => (Date -> f Date) -> DateTime -> f DateTime +modifyDateF f (DateTime d t) = flip DateTime t <$> f d + +time :: DateTime -> Time +time (DateTime _ t) = t + +modifyTime :: (Time -> Time) -> DateTime -> DateTime +modifyTime f (DateTime d t) = DateTime d (f t) + +modifyTimeF :: forall f. Functor f => (Time -> f Time) -> DateTime -> f DateTime +modifyTimeF f (DateTime d t) = DateTime d <$> f t + +-- | Adjusts a date/time value with a duration offset. `Nothing` is returned +-- | if the resulting date would be outside of the range of valid dates. +adjust :: forall d. Duration d => d -> DateTime -> Maybe DateTime +adjust d dt = + adjustImpl Just Nothing (fromDuration d) (toRecord dt) >>= \rec -> + DateTime + <$> join (exactDate <$> toEnum rec.year <*> toEnum rec.month <*> toEnum rec.day) + <*> (Time <$> toEnum rec.hour <*> toEnum rec.minute <*> toEnum rec.second <*> toEnum rec.millisecond) + +-- | Calculates the difference between two date/time values, returning the +-- | result as a duration. +diff :: forall d. Duration d => DateTime -> DateTime -> d +diff dt1 dt2 = toDuration $ runFn2 calcDiff (toRecord dt1) (toRecord dt2) + +type DateRec = + { year :: Int + , month :: Int + , day :: Int + , hour :: Int + , minute :: Int + , second :: Int + , millisecond :: Int + } + +toRecord :: DateTime -> DateRec +toRecord (DateTime d t) = + { year: fromEnum (year d) + , month: fromEnum (month d) + , day: fromEnum (day d) + , hour: fromEnum (hour t) + , minute: fromEnum (minute t) + , second: fromEnum (second t) + , millisecond: fromEnum (millisecond t) + } + +-- TODO: these could (and probably should) be implemented in PS + +foreign import calcDiff :: Fn2 DateRec DateRec Milliseconds + +foreign import adjustImpl + :: (forall a. a -> Maybe a) + -> (forall a. Maybe a) + -> Milliseconds + -> DateRec + -> Maybe DateRec diff --git a/src/Data/DateTime/Gen.purs b/src/Data/DateTime/Gen.purs new file mode 100644 index 0000000..717d37a --- /dev/null +++ b/src/Data/DateTime/Gen.purs @@ -0,0 +1,16 @@ +module Data.DateTime.Gen + ( genDateTime + , module Data.Date.Gen + , module Data.Time.Gen + ) where + +import Prelude +import Control.Monad.Gen (class MonadGen) +import Data.Date.Gen (genDate, genDay, genMonth, genWeekday, genYear) +import Data.DateTime (DateTime(..)) +import Data.Time.Gen (genHour, genMillisecond, genMinute, genSecond, genTime) + +-- | Generates a random `DateTime` between 1st Jan 1900 00:00:00 and +-- | 31st Dec 2100 23:59:59, inclusive. +genDateTime :: forall m. MonadGen m => m DateTime +genDateTime = DateTime <$> genDate <*> genTime diff --git a/src/Data/DateTime/Instant.js b/src/Data/DateTime/Instant.js new file mode 100644 index 0000000..c016c34 --- /dev/null +++ b/src/Data/DateTime/Instant.js @@ -0,0 +1,18 @@ +var createDateTime = function (y, m, d, h, mi, s, ms) { + var dateTime = new Date(Date.UTC(y, m, d, h, mi, s, ms)); + if (y >= 0 && y < 100) { + dateTime.setUTCFullYear(y); + } + return dateTime; +}; + +export function fromDateTimeImpl(y, mo, d, h, mi, s, ms) { + return createDateTime(y, mo - 1, d, h, mi, s, ms).getTime(); +} + +export function toDateTimeImpl(ctor) { + return function (instant) { + var dt = new Date(instant); + return ctor (dt.getUTCFullYear())(dt.getUTCMonth() + 1)(dt.getUTCDate())(dt.getUTCHours())(dt.getUTCMinutes())(dt.getUTCSeconds())(dt.getUTCMilliseconds()); + }; +} diff --git a/src/Data/DateTime/Instant.purs b/src/Data/DateTime/Instant.purs new file mode 100644 index 0000000..ad32d8c --- /dev/null +++ b/src/Data/DateTime/Instant.purs @@ -0,0 +1,91 @@ +module Data.DateTime.Instant + ( Instant + , instant + , unInstant + , fromDateTime + , fromDate + , toDateTime + , diff + ) where + +import Prelude + +import Data.DateTime (Millisecond, Second, Minute, Hour, Day, Year, DateTime(..), Date, Time(..), canonicalDate, millisecond, second, minute, hour, day, month, year) +import Data.Enum (fromEnum, toEnum) +import Data.Function.Uncurried (Fn7, runFn7) +import Data.Maybe (Maybe(..), fromJust) +import Data.Time.Duration (class Duration, Milliseconds(..), negateDuration, toDuration) +import Partial.Unsafe (unsafePartial) + +-- | An instant is a duration in milliseconds relative to the Unix epoch +-- | (1970-01-01 00:00:00 UTC). +-- | +-- | The constructor is private as the `Instant` range matches that of the +-- | `DateTime` type. +newtype Instant = Instant Milliseconds + +derive newtype instance eqDateTime :: Eq Instant +derive newtype instance ordDateTime :: Ord Instant + +instance boundedInstant :: Bounded Instant where + bottom = Instant (Milliseconds (-8639977881600000.0)) + top = Instant (Milliseconds 8639977881599999.0) + +instance showInstant :: Show Instant where + show (Instant ms) = "(Instant " <> show ms <> ")" + +-- Unfortunately Instant cannot be made a `BoundedEnum` as it "should" be, +-- unless enum cardinality and from/to range is extended to use a numeric type +-- bigger than Int32 + +-- | Attempts to create an `Instant` from a `Milliseconds` duration. The +-- | minimum acceptable value equates to the `bottom` `DateTime` and the maximum +-- | acceptable value equates to the `top` `DateTime`. +instant :: Milliseconds -> Maybe Instant +instant ms@(Milliseconds n) + | n >= -8639977881600000.0 && n <= 8639977881599999.0 = Just (Instant ms) + | otherwise = Nothing + +-- | Lowers an `Instant` to a `Milliseconds` duration. +unInstant :: Instant -> Milliseconds +unInstant (Instant ms) = ms + +-- | Creates an `Instant` from a `DateTime` value. +fromDateTime :: DateTime -> Instant +fromDateTime (DateTime d t) = + runFn7 fromDateTimeImpl + (year d) (fromEnum (month d)) (day d) + (hour t) (minute t) (second t) (millisecond t) + +-- | Creates an `Instant` from a `Date` value, using the assumed time 00:00:00. +fromDate :: Date -> Instant +fromDate d = + runFn7 fromDateTimeImpl + (year d) (fromEnum (month d)) (day d) + bottom bottom bottom bottom + +-- | Creates a `DateTime` value from an `Instant`. +toDateTime :: Instant -> DateTime +toDateTime = toDateTimeImpl mkDateTime + where + mkDateTime = unsafePartial \y mo d h mi s ms -> + DateTime (canonicalDate y (fromJust (toEnum mo)) d) (Time h mi s ms) + +-- TODO: these could (and probably should) be implemented in PS +foreign import fromDateTimeImpl :: Fn7 Year Int Day Hour Minute Second Millisecond Instant +foreign import toDateTimeImpl :: (Year -> Int -> Day -> Hour -> Minute -> Second -> Millisecond -> DateTime) -> Instant -> DateTime + +-- | Calculates the difference between two instants, returning the result as a duration. +-- | For example: +-- | ``` +-- | do +-- | start <- liftEffect Now.now +-- | aLongRunningAff +-- | end <- liftEffect Now.now +-- | let +-- | hours :: Duration.Hours +-- | hours = Instant.diff end start +-- | log ("A long running Aff took " <> show hours) +-- | ``` +diff :: forall d. Duration d => Instant → Instant → d +diff dt1 dt2 = toDuration (unInstant dt1 <> negateDuration (unInstant dt2)) diff --git a/src/Data/Interval.purs b/src/Data/Interval.purs new file mode 100644 index 0000000..cff8f0b --- /dev/null +++ b/src/Data/Interval.purs @@ -0,0 +1,115 @@ +module Data.Interval + ( Interval(..) + , RecurringInterval(..) + , module Exports + ) where + +import Prelude + +import Control.Extend (class Extend, extend) +import Data.Bifoldable (class Bifoldable, bifoldl, bifoldr, bifoldrDefault, bifoldMapDefaultL) +import Data.Bifunctor (class Bifunctor, bimap) +import Data.Bitraversable (class Bitraversable, bitraverse, bisequenceDefault) +import Data.Foldable (class Foldable, foldl, foldr, foldrDefault, foldMapDefaultL) +import Data.Interval.Duration (Duration(..), DurationComponent(..), day, hour, millisecond, minute, month, second, week, year) as Exports +import Data.Maybe (Maybe) +import Data.Traversable (class Traversable, traverse, sequenceDefault) + +data RecurringInterval d a = RecurringInterval (Maybe Int) (Interval d a) + +derive instance eqRecurringInterval :: (Eq d, Eq a) => Eq (RecurringInterval d a) +derive instance ordRecurringInterval :: (Ord d, Ord a) => Ord (RecurringInterval d a) +instance showRecurringInterval :: (Show d, Show a) => Show (RecurringInterval d a) where + show (RecurringInterval x y) = "(RecurringInterval " <> show x <> " " <> show y <> ")" + +interval :: ∀ d a. RecurringInterval d a -> Interval d a +interval (RecurringInterval _ i) = i + +over :: ∀ f d a d' a'. Functor f => (Interval d a -> f (Interval d' a')) -> RecurringInterval d a -> f (RecurringInterval d' a') +over f (RecurringInterval n i) = map (RecurringInterval n) (f i) + +instance functorRecurringInterval :: Functor (RecurringInterval d) where + map f (RecurringInterval n i) = RecurringInterval n (map f i) + +instance bifunctorRecurringInterval :: Bifunctor RecurringInterval where + bimap f g (RecurringInterval n i) = RecurringInterval n (bimap f g i) + +instance foldableRecurringInterval :: Foldable (RecurringInterval d) where + foldl f i = foldl f i <<< interval + foldr f i = foldr f i <<< interval + foldMap = foldMapDefaultL + +instance bifoldableRecurringInterval :: Bifoldable RecurringInterval where + bifoldl f g i = bifoldl f g i <<< interval + bifoldr f g i = bifoldr f g i <<< interval + bifoldMap = bifoldMapDefaultL + +instance traversableRecurringInterval :: Traversable (RecurringInterval d) where + traverse f i = traverse f `over` i + sequence = sequenceDefault + +instance bitraversableRecurringInterval :: Bitraversable RecurringInterval where + bitraverse l r i = bitraverse l r `over` i + bisequence = bisequenceDefault + +instance extendRecurringInterval :: Extend (RecurringInterval d) where + extend f a@(RecurringInterval n i) = RecurringInterval n (extend (const (f a)) i) + +data Interval d a + = StartEnd a a + | DurationEnd d a + | StartDuration a d + | DurationOnly d + +derive instance eqInterval :: (Eq d, Eq a) => Eq (Interval d a) +derive instance ordInterval :: (Ord d, Ord a) => Ord (Interval d a) +instance showInterval :: (Show d, Show a) => Show (Interval d a) where + show (StartEnd x y) = "(StartEnd " <> show x <> " " <> show y <> ")" + show (DurationEnd d x) = "(DurationEnd " <> show d <> " " <> show x <> ")" + show (StartDuration x d) = "(StartDuration " <> show x <> " " <> show d <> ")" + show (DurationOnly d) = "(DurationOnly " <> show d <> ")" + +instance functorInterval :: Functor (Interval d) where + map = bimap identity + +instance bifunctorInterval :: Bifunctor Interval where + bimap _ f (StartEnd x y) = StartEnd (f x) (f y) + bimap g f (DurationEnd d x) = DurationEnd (g d) (f x) + bimap g f (StartDuration x d) = StartDuration (f x) (g d) + bimap g _ (DurationOnly d) = DurationOnly (g d) + +instance foldableInterval :: Foldable (Interval d) where + foldl f z (StartEnd x y) = (z `f` x) `f` y + foldl f z (DurationEnd _ x) = z `f` x + foldl f z (StartDuration x _) = z `f` x + foldl _ z _ = z + foldr x = foldrDefault x + foldMap = foldMapDefaultL + +instance bifoldableInterval :: Bifoldable Interval where + bifoldl _ f z (StartEnd x y) = (z `f` x) `f` y + bifoldl g f z (DurationEnd d x) = (z `g` d) `f` x + bifoldl g f z (StartDuration x d) = (z `g` d) `f` x + bifoldl g _ z (DurationOnly d) = z `g` d + bifoldr x = bifoldrDefault x + bifoldMap = bifoldMapDefaultL + +instance traversableInterval :: Traversable (Interval d) where + traverse f (StartEnd x y) = StartEnd <$> f x <*> f y + traverse f (DurationEnd d x) = f x <#> DurationEnd d + traverse f (StartDuration x d) = f x <#> (_ `StartDuration` d) + traverse _ (DurationOnly d) = pure (DurationOnly d) + sequence = sequenceDefault + +instance bitraversableInterval :: Bitraversable Interval where + bitraverse _ r (StartEnd x y) = StartEnd <$> r x <*> r y + bitraverse l r (DurationEnd d x) = DurationEnd <$> l d <*> r x + bitraverse l r (StartDuration x d) = StartDuration <$> r x <*> l d + bitraverse l _ (DurationOnly d) = DurationOnly <$> l d + bisequence = bisequenceDefault + +instance extendInterval :: Extend (Interval d) where + extend f a@(StartEnd _ _) = StartEnd (f a) (f a) + extend f a@(DurationEnd d _) = DurationEnd d (f a) + extend f a@(StartDuration _ d) = StartDuration (f a) d + extend _ (DurationOnly d) = DurationOnly d diff --git a/src/Data/Interval/Duration.purs b/src/Data/Interval/Duration.purs new file mode 100644 index 0000000..dac75c4 --- /dev/null +++ b/src/Data/Interval/Duration.purs @@ -0,0 +1,73 @@ +module Data.Interval.Duration + ( Duration(..) + , DurationComponent(..) + , year + , month + , week + , day + , hour + , minute + , second + , millisecond + ) where + +import Prelude + +import Data.Map as Map +import Data.Newtype (class Newtype) + +newtype Duration = Duration (Map.Map DurationComponent Number) + +derive instance eqDuration :: Eq Duration +derive instance ordDuration :: Ord Duration +derive instance newtypeDuration :: Newtype Duration _ + +instance showDuration :: Show Duration where + show (Duration d) = "(Duration " <> show d <> ")" + +instance semigroupDuration :: Semigroup Duration where + append (Duration a) (Duration b) = Duration (Map.unionWith (+) a b) + +instance monoidDuration :: Monoid Duration where + mempty = Duration Map.empty + +data DurationComponent = Second | Minute | Hour | Day | Week | Month | Year +derive instance eqDurationComponent :: Eq DurationComponent +derive instance ordDurationComponent :: Ord DurationComponent + +instance showDurationComponent :: Show DurationComponent where + show Minute = "Minute" + show Second = "Second" + show Hour = "Hour" + show Day = "Day" + show Week = "Week" + show Month = "Month" + show Year = "Year" + + +week :: Number -> Duration +week = durationFromComponent Week + +year :: Number -> Duration +year = durationFromComponent Year + +month :: Number -> Duration +month = durationFromComponent Month + +day :: Number -> Duration +day = durationFromComponent Day + +hour :: Number -> Duration +hour = durationFromComponent Hour + +minute :: Number -> Duration +minute = durationFromComponent Minute + +second :: Number -> Duration +second = durationFromComponent Second + +millisecond :: Number -> Duration +millisecond = durationFromComponent Second <<< (_ / 1000.0) + +durationFromComponent :: DurationComponent -> Number -> Duration +durationFromComponent k v = Duration (Map.singleton k v) diff --git a/src/Data/Interval/Duration/Iso.purs b/src/Data/Interval/Duration/Iso.purs new file mode 100644 index 0000000..19e42b1 --- /dev/null +++ b/src/Data/Interval/Duration/Iso.purs @@ -0,0 +1,97 @@ +module Data.Interval.Duration.Iso + ( IsoDuration + , unIsoDuration + , mkIsoDuration + , Error(..) + , Errors + , prettyError + ) where + +import Prelude + +import Control.Plus (empty) +import Data.Either (Either(..)) +import Data.Foldable (fold, foldMap) +import Data.Interval.Duration (Duration(..), DurationComponent(..)) +import Data.List (List(..), reverse, span, null) +import Data.List.NonEmpty (fromList) +import Data.List.Types (NonEmptyList) +import Data.Map as Map +import Data.Number as Number +import Data.Maybe (Maybe(..), isJust) +import Data.Monoid.Additive (Additive(..)) +import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..), snd) + +newtype IsoDuration = IsoDuration Duration + +derive instance eqIsoDuration :: Eq IsoDuration +derive instance ordIsoDuration :: Ord IsoDuration +instance showIsoDuration :: Show IsoDuration where + show (IsoDuration d) = "(IsoDuration " <> show d <> ")" + +type Errors = NonEmptyList Error + +data Error + = IsEmpty + | InvalidWeekComponentUsage + | ContainsNegativeValue DurationComponent + | InvalidFractionalUse DurationComponent + +derive instance eqError :: Eq Error +derive instance ordError :: Ord Error +instance showError :: Show Error where + show (IsEmpty) = "(IsEmpty)" + show (InvalidWeekComponentUsage) = "(InvalidWeekComponentUsage)" + show (ContainsNegativeValue c) = "(ContainsNegativeValue " <> show c <> ")" + show (InvalidFractionalUse c) = "(InvalidFractionalUse " <> show c <> ")" + +prettyError :: Error -> String +prettyError (IsEmpty) = "Duration is empty (has no components)" +prettyError (InvalidWeekComponentUsage) = "Week component of Duration is used with other components" +prettyError (ContainsNegativeValue c) = "Component `" <> show c <> "` contains negative value" +prettyError (InvalidFractionalUse c) = "Invalid usage of Fractional value at component `" <> show c <> "`" + + +unIsoDuration :: IsoDuration -> Duration +unIsoDuration (IsoDuration a) = a + +mkIsoDuration :: Duration -> Either Errors IsoDuration +mkIsoDuration d = case fromList (checkValidIsoDuration d) of + Just errs -> Left errs + Nothing -> Right (IsoDuration d) + +checkValidIsoDuration :: Duration -> List Error +checkValidIsoDuration (Duration asMap) = check {asList, asMap} + where + asList = reverse (Map.toUnfoldable asMap) + check = fold + [ checkWeekUsage + , checkEmptiness + , checkFractionalUse + , checkNegativeValues + ] + + +type CheckEnv = + { asList :: List (Tuple DurationComponent Number) + , asMap :: Map.Map DurationComponent Number} + +checkWeekUsage :: CheckEnv -> List Error +checkWeekUsage {asMap} = if isJust (Map.lookup Week asMap) && Map.size asMap > 1 + then pure InvalidWeekComponentUsage else empty + +checkEmptiness :: CheckEnv -> List Error +checkEmptiness {asList} = if null asList then pure IsEmpty else empty + +checkFractionalUse :: CheckEnv -> List Error +checkFractionalUse {asList} = case _.rest (span (snd >>> not isFractional) asList) of + Cons (Tuple c _) rest | checkRest rest -> pure (InvalidFractionalUse c) + _ -> empty + where + isFractional a = Number.floor a /= a + checkRest rest = unwrap (foldMap (snd >>> Number.abs >>> Additive) rest) > 0.0 + +checkNegativeValues :: CheckEnv -> List Error +checkNegativeValues {asList} = flip foldMap asList \(Tuple c num) -> + if num >= 0.0 then empty else pure (ContainsNegativeValue c) diff --git a/src/Data/Time.purs b/src/Data/Time.purs index dbc6754..7224b32 100644 --- a/src/Data/Time.purs +++ b/src/Data/Time.purs @@ -1,225 +1,123 @@ -module Data.Time where +module Data.Time + ( Time(..) + , hour, setHour + , minute, setMinute + , second, setSecond + , millisecond, setMillisecond + , adjust + , diff + , module Data.Time.Component + ) where import Prelude - ( (*) - , (+) - , (++) - , (-) - , (/) - , (==) - , DivisionRing - , Eq - , ModuloSemiring - , Num - , Ord - , Ring - , Semiring - , Show - , compare - , show ) --- | An hour component from a time value. Should fall between 0 and 23 --- | inclusive. -newtype HourOfDay = HourOfDay Int - -instance eqHourOfDay :: Eq HourOfDay where - eq (HourOfDay x) (HourOfDay y) = x == y - -instance ordHourOfDay :: Ord HourOfDay where - compare (HourOfDay x) (HourOfDay y) = compare x y - --- | A quantity of hours (not necessarily a value between 0 and 23). -newtype Hours = Hours Number - -instance eqHours :: Eq Hours where - eq (Hours x) (Hours y) = x == y - -instance ordHours :: Ord Hours where - compare (Hours x) (Hours y) = compare x y - -instance semiringHours :: Semiring Hours where - add (Hours x) (Hours y) = Hours (x + y) - mul (Hours x) (Hours y) = Hours (x * y) - zero = Hours 0.0 - one = Hours 1.0 - -instance ringHours :: Ring Hours where - sub (Hours x) (Hours y) = Hours (x - y) - -instance moduloSemiringHours :: ModuloSemiring Hours where - div (Hours x) (Hours y) = Hours (x / y) - mod _ _ = Hours 0.0 - -instance divisionRingHours :: DivisionRing Hours - -instance numHours :: Num Hours - -instance showHours :: Show Hours where - show (Hours n) = "(Hours " ++ show n ++ ")" - --- | A minute component from a time value. Should fall between 0 and 59 --- | inclusive. -newtype MinuteOfHour = MinuteOfHour Int - -instance eqMinuteOfHour :: Eq MinuteOfHour where - eq (MinuteOfHour x) (MinuteOfHour y) = x == y - -instance ordMinuteOfHour :: Ord MinuteOfHour where - compare (MinuteOfHour x) (MinuteOfHour y) = compare x y - --- | A quantity of minutes (not necessarily a value between 0 and 60). -newtype Minutes = Minutes Number - -instance eqMinutes :: Eq Minutes where - eq (Minutes x) (Minutes y) = x == y - -instance ordMinutes :: Ord Minutes where - compare (Minutes x) (Minutes y) = compare x y - -instance semiringMinutes :: Semiring Minutes where - add (Minutes x) (Minutes y) = Minutes (x + y) - mul (Minutes x) (Minutes y) = Minutes (x * y) - zero = Minutes 0.0 - one = Minutes 1.0 - -instance ringMinutes :: Ring Minutes where - sub (Minutes x) (Minutes y) = Minutes (x - y) - -instance moduloSemiringMinutes :: ModuloSemiring Minutes where - div (Minutes x) (Minutes y) = Minutes (x / y) - mod _ _ = Minutes 0.0 - -instance divisionRingMinutes :: DivisionRing Minutes - -instance numMinutes :: Num Minutes - -instance showMinutes :: Show Minutes where - show (Minutes n) = "(Minutes " ++ show n ++ ")" - --- | A second component from a time value. Should fall between 0 and 59 --- | inclusive. -newtype SecondOfMinute = SecondOfMinute Int - -instance eqSecondOfMinute :: Eq SecondOfMinute where - eq (SecondOfMinute x) (SecondOfMinute y) = x == y - -instance ordSecondOfMinute :: Ord SecondOfMinute where - compare (SecondOfMinute x) (SecondOfMinute y) = compare x y - --- | A quantity of seconds (not necessarily a value between 0 and 60). -newtype Seconds = Seconds Number - -instance eqSeconds :: Eq Seconds where - eq (Seconds x) (Seconds y) = x == y - -instance ordSeconds :: Ord Seconds where - compare (Seconds x) (Seconds y) = compare x y - -instance semiringSeconds :: Semiring Seconds where - add (Seconds x) (Seconds y) = Seconds (x + y) - mul (Seconds x) (Seconds y) = Seconds (x * y) - zero = Seconds 0.0 - one = Seconds 1.0 - -instance ringSeconds :: Ring Seconds where - sub (Seconds x) (Seconds y) = Seconds (x - y) - -instance moduloSemiringSeconds :: ModuloSemiring Seconds where - div (Seconds x) (Seconds y) = Seconds (x / y) - mod _ _ = Seconds 0.0 - -instance divisionRingSeconds :: DivisionRing Seconds - -instance numSeconds :: Num Seconds - -instance showSeconds :: Show Seconds where - show (Seconds n) = "(Seconds " ++ show n ++ ")" - --- | A millisecond component from a time value. Should fall between 0 and 999 --- | inclusive. -newtype MillisecondOfSecond = MillisecondOfSecond Int - -instance eqMillisecondOfSecond :: Eq MillisecondOfSecond where - eq (MillisecondOfSecond x) (MillisecondOfSecond y) = x == y - -instance ordMillisecondOfSecond :: Ord MillisecondOfSecond where - compare (MillisecondOfSecond x) (MillisecondOfSecond y) = compare x y - --- | A quantity of milliseconds (not necessarily a value between 0 and 1000). -newtype Milliseconds = Milliseconds Number - -instance eqMilliseconds :: Eq Milliseconds where - eq (Milliseconds x) (Milliseconds y) = x == y - -instance ordMilliseconds :: Ord Milliseconds where - compare (Milliseconds x) (Milliseconds y) = compare x y - -instance semiringMilliseconds :: Semiring Milliseconds where - add (Milliseconds x) (Milliseconds y) = Milliseconds (x + y) - mul (Milliseconds x) (Milliseconds y) = Milliseconds (x * y) - zero = Milliseconds 0.0 - one = Milliseconds 1.0 - -instance ringMilliseconds :: Ring Milliseconds where - sub (Milliseconds x) (Milliseconds y) = Milliseconds (x - y) - -instance moduloSemiringMilliseconds :: ModuloSemiring Milliseconds where - div (Milliseconds x) (Milliseconds y) = Milliseconds (x / y) - mod _ _ = Milliseconds 0.0 - -instance divisionRingMilliseconds :: DivisionRing Milliseconds - -instance numMilliseconds :: Num Milliseconds - -instance showMilliseconds :: Show Milliseconds where - show (Milliseconds n) = "(Milliseconds " ++ show n ++ ")" - -class TimeValue a where - toHours :: a -> Hours - toMinutes :: a -> Minutes - toSeconds :: a -> Seconds - toMilliseconds :: a -> Milliseconds - fromHours :: Hours -> a - fromMinutes :: Minutes -> a - fromSeconds :: Seconds -> a - fromMilliseconds :: Milliseconds -> a - -instance timeValueHours :: TimeValue Hours where - toHours n = n - toMinutes (Hours n) = Minutes (n * 60.0) - toSeconds (Hours n) = Seconds (n * 3600.0) - toMilliseconds (Hours n) = Milliseconds (n * 3600000.0) - fromHours n = n - fromMinutes (Minutes n) = Hours (n / 60.0) - fromSeconds (Seconds n) = Hours (n / 3600.0) - fromMilliseconds (Milliseconds n) = Hours (n / 3600000.0) - -instance timeValueMinutes :: TimeValue Minutes where - toHours (Minutes n) = Hours (n / 60.0) - toMinutes n = n - toSeconds (Minutes n) = Seconds (n * 60.0) - toMilliseconds (Minutes n) = Milliseconds (n * 60000.0) - fromHours (Hours n) = Minutes (n * 60.0) - fromMinutes n = n - fromSeconds (Seconds n) = Minutes (n / 60.0) - fromMilliseconds (Milliseconds n) = Minutes (n / 60000.0) - -instance timeValueSeconds :: TimeValue Seconds where - toHours (Seconds n) = Hours (n / 3600.0) - toMinutes (Seconds n) = Minutes (n / 60.0) - toSeconds n = n - toMilliseconds (Seconds n) = Milliseconds (n * 1000.0) - fromHours (Hours n) = Seconds (n * 3600.0) - fromMinutes (Minutes n) = Seconds (n * 60.0) - fromSeconds n = n - fromMilliseconds (Milliseconds n) = Seconds (n / 1000.0) - -instance timeValueMilliseconds :: TimeValue Milliseconds where - toHours (Milliseconds n) = Hours (n / 3600000.0) - toMinutes (Milliseconds n) = Minutes (n / 60000.0) - toSeconds (Milliseconds n) = Seconds (n / 1000.0) - toMilliseconds n = n - fromHours (Hours n) = Milliseconds (n * 3600000.0) - fromMinutes (Minutes n) = Milliseconds (n * 60000.0) - fromSeconds (Seconds n) = Milliseconds (n * 1000.0) - fromMilliseconds n = n +import Data.Enum (fromEnum, toEnum) +import Data.Int as Int +import Data.Maybe (fromJust) +import Data.Number as Number +import Data.Newtype (unwrap) +import Data.Time.Component (Hour, Millisecond, Minute, Second) +import Data.Time.Duration (class Duration, Days(..), Milliseconds(..), fromDuration, negateDuration, toDuration) +import Data.Tuple (Tuple(..)) +import Partial.Unsafe (unsafePartial) + +data Time = Time Hour Minute Second Millisecond + +derive instance eqTime :: Eq Time +derive instance ordTime :: Ord Time + +instance boundedTime :: Bounded Time where + bottom = Time bottom bottom bottom bottom + top = Time top top top top + +instance showTime :: Show Time where + show (Time h m s ms) = "(Time " <> show h <> " " <> show m <> " " <> show s <> " " <> show ms <> ")" + +-- | The hour component of a time value. +hour :: Time -> Hour +hour (Time h _ _ _) = h + +-- | Alters the hour component of a time value. +setHour :: Hour -> Time -> Time +setHour h (Time _ m s ms) = Time h m s ms + +-- | The minute component of a time value. +minute :: Time -> Minute +minute (Time _ m _ _) = m + +-- | Alters the minute component of a time value. +setMinute :: Minute -> Time -> Time +setMinute m (Time h _ s ms) = Time h m s ms + +-- | The second component of a time value. +second :: Time -> Second +second (Time _ _ s _) = s + +-- | Alters the second component of a time value. +setSecond :: Second -> Time -> Time +setSecond s (Time h m _ ms) = Time h m s ms + +-- | The millisecond component of a time value. +millisecond :: Time -> Millisecond +millisecond (Time _ _ _ ms) = ms + +-- | Alters the millisecond component of a time value. +setMillisecond :: Millisecond -> Time -> Time +setMillisecond ms (Time h m s _) = Time h m s ms + +-- | Adjusts a time value with a duration offset. The result includes a +-- | remainder value of the whole number of days involved in the adjustment, +-- | for example, if a time of 23:00:00:00 has a duration of +2 hours added to +-- | it, the result will be 1 day, and 01:00:00:00. Correspondingly, if the +-- | duration is negative, a negative number of days may also be returned as +-- | the remainder. +adjust :: forall d. Duration d => d -> Time -> Tuple Days Time +adjust d t = + let + d' = fromDuration d + tLength = timeToMillis t + dayLength = 86400000.0 + wholeDays = Days $ Number.floor (unwrap d' / dayLength) + msAdjust = d' <> negateDuration (fromDuration wholeDays) + msAdjusted = tLength <> msAdjust + wrap = if msAdjusted > maxTime then 1.0 else if msAdjusted < minTime then -1.0 else 0.0 + in + Tuple + (wholeDays <> Days wrap) + (millisToTime (msAdjusted <> Milliseconds (dayLength * -wrap))) + +maxTime :: Milliseconds +maxTime = timeToMillis top + +minTime :: Milliseconds +minTime = timeToMillis bottom + +timeToMillis :: Time -> Milliseconds +timeToMillis t = Milliseconds + $ 3600000.0 * Int.toNumber (fromEnum (hour t)) + + 60000.0 * Int.toNumber (fromEnum (minute t)) + + 1000.0 * Int.toNumber (fromEnum (second t)) + + Int.toNumber (fromEnum (millisecond t)) + +millisToTime :: Milliseconds -> Time +millisToTime (Milliseconds ms') = + let + hourLength = 3600000.0 + minuteLength = 60000.0 + secondLength = 1000.0 + hours = Number.floor (ms' / hourLength) + minutes = Number.floor ((ms' - hours * hourLength) / minuteLength) + seconds = Number.floor ((ms' - (hours * hourLength + minutes * minuteLength)) / secondLength) + milliseconds = ms' - (hours * hourLength + minutes * minuteLength + seconds * secondLength) + in + unsafePartial fromJust $ + Time + <$> toEnum (Int.floor hours) + <*> toEnum (Int.floor minutes) + <*> toEnum (Int.floor seconds) + <*> toEnum (Int.floor milliseconds) + +-- | Calculates the difference between two times, returning the result as a +-- | duration. +diff :: forall d. Duration d => Time -> Time -> d +diff t1 t2 = toDuration (timeToMillis t1 <> negateDuration (timeToMillis t2)) diff --git a/src/Data/Time/Component.purs b/src/Data/Time/Component.purs new file mode 100644 index 0000000..bbc6977 --- /dev/null +++ b/src/Data/Time/Component.purs @@ -0,0 +1,128 @@ +module Data.Time.Component + ( Hour + , Minute + , Second + , Millisecond + ) where + +import Prelude + +import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) +import Data.Maybe (Maybe(..)) + +-- | An hour component for a time value. +-- | +-- | The constructor is private as values for the type are restricted to the +-- | range 0 to 23, inclusive. The `toEnum` function can be used to safely +-- | acquire an `Hour` value from an integer. Correspondingly, an `Hour` can be +-- | lowered to a plain integer with the `fromEnum` function. +newtype Hour = Hour Int + +derive newtype instance eqHour :: Eq Hour +derive newtype instance ordHour :: Ord Hour + +instance boundedHour :: Bounded Hour where + bottom = Hour 0 + top = Hour 23 + +instance enumHour :: Enum Hour where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumHour :: BoundedEnum Hour where + cardinality = Cardinality 24 + toEnum n + | n >= 0 && n <= 23 = Just (Hour n) + | otherwise = Nothing + fromEnum (Hour n) = n + +instance showHour :: Show Hour where + show (Hour h) = "(Hour " <> show h <> ")" + +-- | An minute component for a time value. +-- | +-- | The constructor is private as values for the type are restricted to the +-- | range 0 to 59, inclusive. The `toEnum` function can be used to safely +-- | acquire an `Minute` value from an integer. Correspondingly, a `Minute` can +-- | be lowered to a plain integer with the `fromEnum` function. +newtype Minute = Minute Int + +derive newtype instance eqMinute :: Eq Minute +derive newtype instance ordMinute :: Ord Minute + +instance boundedMinute :: Bounded Minute where + bottom = Minute 0 + top = Minute 59 + +instance enumMinute :: Enum Minute where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumMinute :: BoundedEnum Minute where + cardinality = Cardinality 60 + toEnum n + | n >= 0 && n <= 59 = Just (Minute n) + | otherwise = Nothing + fromEnum (Minute n) = n + +instance showMinute :: Show Minute where + show (Minute m) = "(Minute " <> show m <> ")" + +-- | An second component for a time value. +-- | +-- | The constructor is private as values for the type are restricted to the +-- | range 0 to 59, inclusive. The `toEnum` function can be used to safely +-- | acquire an `Second` value from an integer. Correspondingly, a `Second` can +-- | be lowered to a plain integer with the `fromEnum` function. +newtype Second = Second Int + +derive newtype instance eqSecond :: Eq Second +derive newtype instance ordSecond :: Ord Second + +instance boundedSecond :: Bounded Second where + bottom = Second 0 + top = Second 59 + +instance enumSecond :: Enum Second where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumSecond :: BoundedEnum Second where + cardinality = Cardinality 60 + toEnum n + | n >= 0 && n <= 59 = Just (Second n) + | otherwise = Nothing + fromEnum (Second n) = n + +instance showSecond :: Show Second where + show (Second m) = "(Second " <> show m <> ")" + +-- | An millisecond component for a time value. +-- | +-- | The constructor is private as values for the type are restricted to the +-- | range 0 to 999, inclusive. The `toEnum` function can be used to safely +-- | acquire an `Millisecond` value from an integer. Correspondingly, a +-- | `Millisecond` can be lowered to a plain integer with the `fromEnum` +-- | function. +newtype Millisecond = Millisecond Int + +derive newtype instance eqMillisecond :: Eq Millisecond +derive newtype instance ordMillisecond :: Ord Millisecond + +instance boundedMillisecond :: Bounded Millisecond where + bottom = Millisecond 0 + top = Millisecond 999 + +instance enumMillisecond :: Enum Millisecond where + succ = toEnum <<< (_ + 1) <<< fromEnum + pred = toEnum <<< (_ - 1) <<< fromEnum + +instance boundedEnumMillisecond :: BoundedEnum Millisecond where + cardinality = Cardinality 1000 + toEnum n + | n >= 0 && n <= 999 = Just (Millisecond n) + | otherwise = Nothing + fromEnum (Millisecond n) = n + +instance showMillisecond :: Show Millisecond where + show (Millisecond m) = "(Millisecond " <> show m <> ")" diff --git a/src/Data/Time/Component/Gen.purs b/src/Data/Time/Component/Gen.purs new file mode 100644 index 0000000..79b4de0 --- /dev/null +++ b/src/Data/Time/Component/Gen.purs @@ -0,0 +1,21 @@ +module Data.Time.Component.Gen where + +import Control.Monad.Gen (class MonadGen) +import Data.Enum.Gen (genBoundedEnum) +import Data.Time.Component (Hour, Millisecond, Minute, Second) + +-- | Generates a random `Hour` component. +genHour :: forall m. MonadGen m => m Hour +genHour = genBoundedEnum + +-- | Generates a random `Minute` component. +genMinute :: forall m. MonadGen m => m Minute +genMinute = genBoundedEnum + +-- | Generates a random `Second` component. +genSecond :: forall m. MonadGen m => m Second +genSecond = genBoundedEnum + +-- | Generates a random `Millisecond` component. +genMillisecond :: forall m. MonadGen m => m Millisecond +genMillisecond = genBoundedEnum diff --git a/src/Data/Time/Duration.purs b/src/Data/Time/Duration.purs new file mode 100644 index 0000000..a8b0503 --- /dev/null +++ b/src/Data/Time/Duration.purs @@ -0,0 +1,119 @@ +module Data.Time.Duration where + +import Prelude + +import Data.Newtype (class Newtype, over) + +-- | A duration measured in milliseconds. +newtype Milliseconds = Milliseconds Number + +derive instance newtypeMilliseconds :: Newtype Milliseconds _ +derive newtype instance eqMilliseconds :: Eq Milliseconds +derive newtype instance ordMilliseconds :: Ord Milliseconds + +instance semigroupMilliseconds :: Semigroup Milliseconds where + append (Milliseconds x) (Milliseconds y) = Milliseconds (x + y) + +instance monoidMilliseconds :: Monoid Milliseconds where + mempty = Milliseconds 0.0 + +instance showMilliseconds :: Show Milliseconds where + show (Milliseconds n) = "(Milliseconds " <> show n <> ")" + +-- | A duration measured in seconds. +newtype Seconds = Seconds Number + +derive instance newtypeSeconds :: Newtype Seconds _ +derive newtype instance eqSeconds :: Eq Seconds +derive newtype instance ordSeconds :: Ord Seconds + +instance semigroupSeconds :: Semigroup Seconds where + append (Seconds x) (Seconds y) = Seconds (x + y) + +instance monoidSeconds :: Monoid Seconds where + mempty = Seconds 0.0 + +instance showSeconds :: Show Seconds where + show (Seconds n) = "(Seconds " <> show n <> ")" + +-- | A duration measured in minutes. +newtype Minutes = Minutes Number + +derive instance newtypeMinutes :: Newtype Minutes _ +derive newtype instance eqMinutes :: Eq Minutes +derive newtype instance ordMinutes :: Ord Minutes + +instance semigroupMinutes :: Semigroup Minutes where + append (Minutes x) (Minutes y) = Minutes (x + y) + +instance monoidMinutes :: Monoid Minutes where + mempty = Minutes 0.0 + +instance showMinutes :: Show Minutes where + show (Minutes n) = "(Minutes " <> show n <> ")" + +-- | A duration measured in hours. +newtype Hours = Hours Number + +derive instance newtypeHours :: Newtype Hours _ +derive newtype instance eqHours :: Eq Hours +derive newtype instance ordHours :: Ord Hours + +instance semigroupHours :: Semigroup Hours where + append (Hours x) (Hours y) = Hours (x + y) + +instance monoidHours :: Monoid Hours where + mempty = Hours 0.0 + +instance showHours :: Show Hours where + show (Hours n) = "(Hours " <> show n <> ")" + +-- | A duration measured in days, where a day is assumed to be exactly 24 hours. +newtype Days = Days Number + +derive instance newtypeDays :: Newtype Days _ +derive newtype instance eqDays :: Eq Days +derive newtype instance ordDays :: Ord Days + +instance semigroupDays :: Semigroup Days where + append (Days x) (Days y) = Days (x + y) + +instance monoidDays :: Monoid Days where + mempty = Days 0.0 + +instance showDays :: Show Days where + show (Days n) = "(Days " <> show n <> ")" + +-- | A class for enabling conversions between duration types. +class Duration a where + fromDuration :: a -> Milliseconds + toDuration :: Milliseconds -> a + +-- | Converts directly between durations of differing types. +convertDuration :: forall a b. Duration a => Duration b => a -> b +convertDuration = toDuration <<< fromDuration + +-- | Negates a duration, turning a positive duration negative or a negative +-- | duration positive. +negateDuration :: forall a. Duration a => a -> a +negateDuration = toDuration <<< over Milliseconds negate <<< fromDuration + +instance durationMilliseconds :: Duration Milliseconds where + fromDuration = identity + toDuration = identity + +instance durationSeconds :: Duration Seconds where + fromDuration = over Seconds (_ * 1000.0) + toDuration = over Milliseconds (_ / 1000.0) + +instance durationMinutes :: Duration Minutes where + fromDuration = over Minutes (_ * 60000.0) + toDuration = over Milliseconds (_ / 60000.0) + +instance durationHours :: Duration Hours where + fromDuration = over Hours (_ * 3600000.0) + toDuration = over Milliseconds (_ / 3600000.0) + +instance durationDays :: Duration Days where + fromDuration = over Days (_ * 86400000.0) + toDuration = over Milliseconds (_ / 86400000.0) diff --git a/src/Data/Time/Duration/Gen.purs b/src/Data/Time/Duration/Gen.purs new file mode 100644 index 0000000..84d350e --- /dev/null +++ b/src/Data/Time/Duration/Gen.purs @@ -0,0 +1,27 @@ +module Data.Time.Duration.Gen where + +import Prelude + +import Control.Monad.Gen (class MonadGen) +import Control.Monad.Gen as Gen +import Data.Time.Duration (Days(..), Hours(..), Milliseconds(..), Minutes(..), Seconds(..)) + +-- | Generates a random `Milliseconds` duration, up to 10 minutes. +genMilliseconds :: forall m. MonadGen m => m Milliseconds +genMilliseconds = Milliseconds <$> Gen.chooseFloat 0.0 600000.0 + +-- | Generates a random `Seconds` duration, up to 10 minutes. +genSeconds :: forall m. MonadGen m => m Seconds +genSeconds = Seconds <$> Gen.chooseFloat 0.0 600.0 + +-- | Generates a random `Seconds` duration, up to 10 hours. +genMinutes :: forall m. MonadGen m => m Minutes +genMinutes = Minutes <$> Gen.chooseFloat 0.0 600.0 + +-- | Generates a random `Hours` duration, up to 10 days. +genHours :: forall m. MonadGen m => m Hours +genHours = Hours <$> Gen.chooseFloat 0.0 240.0 + +-- | Generates a random `Days` duration, up to 6 weeks. +genDays :: forall m. MonadGen m => m Days +genDays = Days <$> Gen.chooseFloat 0.0 42.0 diff --git a/src/Data/Time/Gen.purs b/src/Data/Time/Gen.purs new file mode 100644 index 0000000..1aa5bb3 --- /dev/null +++ b/src/Data/Time/Gen.purs @@ -0,0 +1,13 @@ +module Data.Time.Gen + ( genTime + , module Data.Time.Component.Gen + ) where + +import Prelude +import Control.Monad.Gen (class MonadGen) +import Data.Time (Time(..)) +import Data.Time.Component.Gen (genHour, genMillisecond, genMinute, genSecond) + +-- | Generates a random `Time` between 00:00:00 and 23:59:59, inclusive. +genTime :: forall m. MonadGen m => m Time +genTime = Time <$> genHour <*> genMinute <*> genSecond <*> genMillisecond diff --git a/test/Test/Main.purs b/test/Test/Main.purs new file mode 100644 index 0000000..0388fcb --- /dev/null +++ b/test/Test/Main.purs @@ -0,0 +1,217 @@ +module Test.Main where + +import Prelude + +import Effect (Effect) +import Effect.Console (log) +import Data.Array as Array +import Data.Date as Date +import Data.DateTime as DateTime +import Data.DateTime.Instant as Instant +import Data.Either (Either(..), isRight) +import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred) +import Data.Interval as Interval +import Data.Interval.Duration.Iso as IsoDuration +import Data.Maybe (Maybe(..), fromJust) +import Data.Newtype (over, unwrap) +import Data.Number (floor) +import Data.Time as Time +import Data.Time.Duration as Duration +import Data.Tuple (Tuple(..), snd) +import Partial.Unsafe (unsafePartial) +import Test.Assert (assert) +import Type.Proxy (Proxy(..)) + +main :: Effect Unit +main = do + log "check Duration monoid" + assert $ Interval.year 1.0 == mempty <> Interval.year 2.0 <> Interval.year 1.0 <> Interval.year (-2.0) + assert $ Interval.second 0.5 == Interval.millisecond 500.0 + assert $ IsoDuration.mkIsoDuration (Interval.week 1.2 <> Interval.week 1.2) + == IsoDuration.mkIsoDuration (Interval.week 2.4) + assert $ isRight $ IsoDuration.mkIsoDuration (Interval.day 1.2 <> mempty) + assert $ isRight $ IsoDuration.mkIsoDuration (Interval.day 1.2 <> Interval.second 0.0) + assert $ isRight $ IsoDuration.mkIsoDuration (Interval.year 2.0 <> Interval.day 1.0) + assert $ IsoDuration.mkIsoDuration (Interval.year 2.5 <> Interval.day 1.0) + == Left (pure (IsoDuration.InvalidFractionalUse Interval.Year)) + log $ show $ IsoDuration.mkIsoDuration (Interval.year 2.5 <> Interval.week 1.0) + == Left (pure IsoDuration.InvalidWeekComponentUsage <> pure (IsoDuration.InvalidFractionalUse Interval.Year)) + assert $ IsoDuration.mkIsoDuration (Interval.year 2.0 <> Interval.day (-1.0)) + == Left (pure (IsoDuration.ContainsNegativeValue Interval.Day)) + assert $ IsoDuration.mkIsoDuration (mempty) + == Left (pure IsoDuration.IsEmpty) + + let epochDate = unsafePartial fromJust $ Date.canonicalDate + <$> toEnum 1 + <*> pure bottom + <*> pure bottom + let epochDateTime = DateTime.DateTime epochDate bottom + let epochMillis = -62135596800000.0 + -- time -------------------------------------------------------------------- + + log "Check that Hour is a good BoundedEnum" + checkBoundedEnum (Proxy :: Proxy Time.Hour) + + log "Check that Minute is a good BoundedEnum" + checkBoundedEnum (Proxy :: Proxy Time.Minute) + + log "Check that Second is a good BoundedEnum" + checkBoundedEnum (Proxy :: Proxy Time.Second) + + log "Check that Millisecond is a good BoundedEnum" + checkBoundedEnum (Proxy :: Proxy Time.Millisecond) + + log "Check that Time is a good Bounded" + checkBounded (Proxy :: Proxy Time.Time) + + let t1 = unsafePartial $ fromJust $ Time.Time <$> toEnum 17 <*> toEnum 42 <*> toEnum 16 <*> toEnum 362 + let t2 = unsafePartial $ fromJust $ Time.Time <$> toEnum 18 <*> toEnum 22 <*> toEnum 16 <*> toEnum 362 + let t3 = unsafePartial $ fromJust $ Time.Time <$> toEnum 17 <*> toEnum 2 <*> toEnum 16 <*> toEnum 362 + let t4 = unsafePartial $ fromJust $ Time.Time <$> toEnum 23 <*> toEnum 0 <*> toEnum 0 <*> toEnum 0 + let t5 = unsafePartial $ fromJust $ Time.Time <$> toEnum 1 <*> toEnum 0 <*> toEnum 0 <*> toEnum 0 + + log "Check that adjust behaves as expected" + assert $ Time.adjust (Duration.Milliseconds 1.0) top == Tuple (Duration.Days 1.0) bottom + assert $ Time.adjust (Duration.Milliseconds (-1.0)) bottom == Tuple (Duration.Days (-1.0)) top + assert $ Time.adjust (Duration.Minutes 40.0) t1 == Tuple (Duration.Days 0.0) t2 + assert $ Time.adjust (Duration.Days 40.0) t1 == Tuple (Duration.Days 40.0) t1 + assert $ Time.adjust (Duration.fromDuration (Duration.Days 2.0) <> Duration.fromDuration (Duration.Minutes 40.0)) t1 == Tuple (Duration.Days 2.0) t2 + assert $ Time.adjust (Duration.fromDuration (Duration.Days 2.0) <> Duration.fromDuration (Duration.Minutes (-40.0))) t1 == Tuple (Duration.Days 2.0) t3 + assert $ snd (Time.adjust (Duration.fromDuration (Duration.Days 3.872)) t1) == snd (Time.adjust (Duration.fromDuration (Duration.Days 0.872)) t1) + assert $ Time.adjust (Duration.Hours 2.0) t4 == Tuple (Duration.Days 1.0) t5 + + log "Check that diff behaves as expected" + assert $ Time.diff t2 t1 == Duration.Minutes 40.0 + assert $ Time.diff t1 t2 == Duration.Minutes (-40.0) + assert $ Time.diff t4 t5 == Duration.Hours 22.0 + + -- date -------------------------------------------------------------------- + + log "Check that Year is a good BoundedEnum" + checkBoundedEnum (Proxy :: Proxy Date.Year) + + log "Check that Month is a good BoundedEnum" + checkBoundedEnum (Proxy :: Proxy Date.Month) + + log "Check that Day is a good BoundedEnum" + checkBoundedEnum (Proxy :: Proxy Date.Day) + + log "Check that Date is a good Bounded" + checkBounded (Proxy :: Proxy Date.Date) + + log "Check that the earliest date is a valid date" + assert $ Just bottom == Date.exactDate bottom bottom bottom + + log "Check that the latest date is a valid date" + assert $ Just top == Date.exactDate top top top + + log "Check that weekday behaves as expected" + assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 6) == Date.Monday + assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 7) == Date.Tuesday + assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 8) == Date.Wednesday + assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 9) == Date.Thursday + assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 10) == Date.Friday + assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 11) == Date.Saturday + assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 12) == Date.Sunday + + let d1 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.January <*> toEnum 1 + let d2 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.February <*> toEnum 1 + let d3 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.March <*> toEnum 1 + let d4 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2018 <*> pure Date.September <*> toEnum 26 + let d5 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 1988 <*> pure Date.August <*> toEnum 15 + + log "Check that diff behaves as expected" + assert $ Date.diff d2 d1 == Duration.Days 31.0 + assert $ Date.diff d3 d2 == Duration.Days 29.0 + + let unsafeYear = unsafePartial fromJust <<< toEnum + log "Check that isLeapYear behaves as expected" + assert $ not $ Date.isLeapYear (unsafeYear 2017) + assert $ Date.isLeapYear (unsafeYear 2016) + + log "Check that epoch is correctly constructed" + assert $ Just (Date.year epochDate) == toEnum 1 + assert $ Date.month epochDate == bottom + assert $ Date.day epochDate == bottom + + log "Check that adjust behaves as expected" + assert $ Date.adjust (Duration.Days 31.0) d1 == Just d2 + assert $ Date.adjust (Duration.Days 999.0) d1 == Just d4 + assert $ Date.adjust (Duration.Days 10000.0) d5 == Just d1 + assert $ Date.adjust (Duration.Days (-31.0)) d2 == Just d1 + assert $ Date.adjust (Duration.Days (- 999.0)) d4 == Just d1 + assert $ Date.adjust (Duration.Days (-10000.0)) d1 == Just d5 + + -- datetime ---------------------------------------------------------------- + + let dt1 = DateTime.DateTime d1 t1 + let dt2 = DateTime.DateTime d1 t2 + let dt3 = DateTime.DateTime d2 t1 + let dt4 = DateTime.DateTime d2 t2 + let dt5 = DateTime.DateTime d3 t1 + + log "Check that adjust behaves as expected" + assert $ DateTime.adjust (Duration.fromDuration (Duration.Days 31.0) <> Duration.fromDuration (Duration.Minutes 40.0)) dt1 == Just dt4 + assert $ (Date.year <<< DateTime.date <$> + (DateTime.adjust (Duration.Days 735963.0) epochDateTime)) + == toEnum 2016 + + log "Check that diff behaves as expected" + assert $ DateTime.diff dt2 dt1 == Duration.Minutes 40.0 + assert $ DateTime.diff dt1 dt2 == Duration.Minutes (-40.0) + assert $ DateTime.diff dt3 dt1 == Duration.Days 31.0 + assert $ DateTime.diff dt5 dt3 == Duration.Days 29.0 + assert $ DateTime.diff dt1 dt3 == Duration.Days (-31.0) + assert $ DateTime.diff dt4 dt1 == Duration.fromDuration (Duration.Days 31.0) <> Duration.fromDuration (Duration.Minutes 40.0) + assert $ over Duration.Days floor (DateTime.diff dt1 epochDateTime) == Duration.Days 735963.0 + + -- instant ----------------------------------------------------------------- + + let i1 = Instant.fromDateTime dt1 + let i2 = Instant.fromDateTime dt2 + let i3 = Instant.fromDateTime dt3 + let i4 = Instant.fromDateTime dt4 + let i5 = Instant.fromDateTime dt5 + + log "Check that the earliest date is a valid Instant" + let bottomInstant = Instant.fromDateTime bottom + assert $ Just bottomInstant == Instant.instant (Instant.unInstant bottomInstant) + + log "Check that the latest date is a valid Instant" + let topInstant = Instant.fromDateTime top + assert $ Just topInstant == Instant.instant (Instant.unInstant topInstant) + + log "Check that an Instant can be constructed from epoch" + assert $ (Instant.unInstant $ Instant.fromDateTime epochDateTime) == Duration.Milliseconds epochMillis + + log "Check that instant/datetime conversion is bijective" + assert $ Instant.toDateTime (Instant.fromDateTime bottom) == bottom + assert $ Instant.toDateTime (Instant.fromDateTime top) == top + assert $ Instant.toDateTime i1 == dt1 + assert $ Instant.toDateTime i2 == dt2 + assert $ Instant.toDateTime i3 == dt3 + assert $ Instant.toDateTime i4 == dt4 + assert $ Instant.toDateTime i5 == dt5 + + log "Check that diff behaves as expected" + assert $ Instant.diff i2 i1 == Duration.Minutes 40.0 + assert $ Instant.diff i1 i2 == Duration.Minutes (-40.0) + assert $ Instant.diff i3 i1 == Duration.Days 31.0 + assert $ Instant.diff i5 i3 == Duration.Days 29.0 + assert $ Instant.diff i1 i3 == Duration.Days (-31.0) + assert $ Instant.diff i4 i1 == Duration.fromDuration (Duration.Days 31.0) <> Duration.fromDuration (Duration.Minutes 40.0) + + log "All tests done" + +checkBounded :: forall e. Bounded e => Proxy e -> Effect Unit +checkBounded _ = do + assert $ Just (bottom :: Time.Hour) == toEnum (fromEnum (bottom :: Time.Hour)) + assert $ pred (bottom :: Time.Hour) == Nothing + assert $ Just (top :: Time.Hour) == toEnum (fromEnum (top :: Time.Hour)) + assert $ succ (top :: Time.Hour) == Nothing + +checkBoundedEnum :: forall e. BoundedEnum e => Proxy e -> Effect Unit +checkBoundedEnum p = do + checkBounded p + let card = unwrap (cardinality :: Cardinality e) + assert $ Array.length (enumFromTo bottom (top :: e)) == card