├── .eslintrc.json ├── .github ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── bower.json ├── package.json ├── src └── Data │ ├── Date.js │ ├── Date.purs │ ├── Date │ ├── Component.purs │ ├── Component │ │ └── Gen.purs │ └── Gen.purs │ ├── DateTime.js │ ├── DateTime.purs │ ├── DateTime │ ├── Gen.purs │ ├── Instant.js │ └── Instant.purs │ ├── Interval.purs │ ├── Interval │ ├── Duration.purs │ └── Duration │ │ └── Iso.purs │ ├── Time.purs │ └── Time │ ├── Component.purs │ ├── Component │ └── Gen.purs │ ├── Duration.purs │ ├── Duration │ └── Gen.purs │ └── Gen.purs └── test └── Test └── Main.purs /.eslintrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "parserOptions": { 3 | "ecmaVersion": 6, 4 | "sourceType": "module" 5 | }, 6 | "extends": "eslint:recommended", 7 | "rules": { 8 | "strict": [2, "global"], 9 | "block-scoped-var": 2, 10 | "consistent-return": 2, 11 | "eqeqeq": [2, "smart"], 12 | "guard-for-in": 2, 13 | "no-caller": 2, 14 | "no-extend-native": 2, 15 | "no-loop-func": 2, 16 | "no-new": 2, 17 | "no-param-reassign": 2, 18 | "no-return-assign": 2, 19 | "no-unused-expressions": 2, 20 | "no-use-before-define": 2, 21 | "radix": [2, "always"], 22 | "indent": [2, 2], 23 | "quotes": [2, "double"], 24 | "semi": [2, "always"] 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | **Description of the change** 2 | 3 | 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. 4 | 5 | --- 6 | 7 | **Checklist:** 8 | 9 | - [ ] Added the change to the changelog's "Unreleased" section with a reference to this PR (e.g. "- Made a change (#0000)") 10 | - [ ] Linked any existing issues or proposals that this pull request should close 11 | - [ ] Updated or added relevant documentation 12 | - [ ] Added a test for the contribution (if applicable) 13 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | branches: [master] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: purescript-contrib/setup-purescript@main 16 | with: 17 | purescript: "unstable" 18 | 19 | - uses: actions/setup-node@v2 20 | with: 21 | node-version: "14.x" 22 | 23 | - name: Install dependencies 24 | run: | 25 | npm install -g bower 26 | npm install 27 | bower install --production 28 | 29 | - name: Build source 30 | run: npm run-script build 31 | 32 | - name: Run tests 33 | run: | 34 | bower install 35 | npm run-script test --if-present 36 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.* 2 | !/.gitignore 3 | !/.eslintrc.json 4 | !/.github/ 5 | package-lock.json 6 | /bower_components/ 7 | /node_modules/ 8 | /output/ 9 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | 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). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes: 8 | 9 | New features: 10 | 11 | Bugfixes: 12 | 13 | Other improvements: 14 | 15 | ## [v6.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v6.1.0) - 2022-07-13 16 | 17 | Breaking changes: 18 | 19 | New features: 20 | - Added `diff` for `Instant` (#99 by @i-am-the-slime, #100 by @garyb) 21 | 22 | Bugfixes: 23 | 24 | Other improvements: 25 | 26 | ## [v6.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v6.0.0) - 2022-04-27 27 | 28 | Breaking changes: 29 | - Migrate FFI to ES modules (#93 by @JordanMartinez) 30 | 31 | New features: 32 | 33 | Bugfixes: 34 | 35 | Other improvements: 36 | - Drop deprecated `math` dependency; update imports (#94 by @JordanMartinez) 37 | 38 | ## [v5.0.2](https://github.com/purescript/purescript-datetime/releases/tag/v5.0.2) - 2021-04-19 39 | 40 | Other improvements: 41 | - Fix one more UnusedName warning revealed by v0.14.1 PureScript release (@thomashoneyman) 42 | 43 | ## [v5.0.1](https://github.com/purescript/purescript-datetime/releases/tag/v5.0.1) - 2021-04-19 44 | 45 | Other improvements: 46 | - Fix UnusedName warnings revealed by v0.14.1 PureScript release (#91 by @JordanMartinez) 47 | 48 | ## [v5.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v5.0.0) - 2021-02-26 49 | 50 | Breaking changes: 51 | - Added support for PureScript 0.14 and dropped support for all previous versions (#81) 52 | 53 | New features: 54 | 55 | Bugfixes: 56 | - Fixed `genDate` generator frequency (#83) 57 | 58 | Other improvements: 59 | - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#82) 60 | - Added a CHANGELOG.md file and pull request template (#84, #85) 61 | 62 | ## [v4.1.1](https://github.com/purescript/purescript-datetime/releases/tag/v4.1.1) - 2019-02-09 63 | 64 | Fixed minimum bound on `toEnum` for `Year` (@bouzuya) 65 | 66 | ## [v4.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v4.1.0) - 2018-10-25 67 | 68 | Adds an `adjust` function to change a date by a specified duration of days 69 | 70 | ## [v4.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v4.0.0) - 2018-05-24 71 | 72 | - Updated for PureScript 0.12 73 | - Removed `Locale` - it was a glorified `Tuple` without any useful extra functionality 74 | - Duration values no longer implement `Ring` and `Semiring`, but now have `Semiring` and `Monoid` instances and a `negateDuration` function 75 | 76 | ## [v3.4.1](https://github.com/purescript/purescript-datetime/releases/tag/v3.4.1) - 2017-11-04 77 | 78 | - Fix for pursuit auto-publishing 79 | 80 | ## [v3.4.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.4.0) - 2017-09-22 81 | 82 | - Export `fromDate` for `Instant` (@javcasas) 83 | 84 | ## [v3.3.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.3.0) - 2017-06-26 85 | 86 | - Added types for intervals (@safareli) 87 | 88 | ## [v3.2.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.2.0) - 2017-06-08 89 | 90 | - Added generators for date/time types 91 | 92 | ## [v3.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.1.0) - 2017-06-04 93 | 94 | - Added `lastDayOfMonth` (@MichaelXavier) 95 | 96 | ## [v3.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v3.0.0) - 2017-03-27 97 | 98 | - Updated for PureScript 0.11 99 | 100 | ## [v2.2.0](https://github.com/purescript/purescript-datetime/releases/tag/v2.2.0) - 2017-03-13 101 | 102 | - Added functions to modify just the date or time component of a `DateTime` 103 | 104 | ## [v2.1.1](https://github.com/purescript/purescript-datetime/releases/tag/v2.1.1) - 2017-03-08 105 | 106 | - Fixed behaviour of `diff` for `Date` types 107 | 108 | ## [v2.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v2.1.0) - 2017-02-14 109 | 110 | - Added `isLeapYear` predicate function (@MichaelXavier) 111 | 112 | ## [v2.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v2.0.0) - 2016-10-13 113 | 114 | - Updated dependencies 115 | 116 | ## [v1.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v1.0.0) - 2016-06-09 117 | 118 | This release is intended for the PureScript 0.9.1 compiler and newer. 119 | 120 | 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. 121 | 122 | **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. 123 | 124 | ## [v0.9.2](https://github.com/purescript/purescript-datetime/releases/tag/v0.9.2) - 2016-04-05 125 | 126 | - Added `toISOString` (@parsonsmatt) 127 | 128 | ## [v0.9.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.9.1) - 2015-11-20 129 | 130 | - Removed unused import (@tfausak) 131 | 132 | ## [v0.9.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.9.0) - 2015-08-13 133 | 134 | - Updated dependencies 135 | 136 | ## [v0.8.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.8.0) - 2015-08-02 137 | 138 | - Updated dependencies 139 | 140 | ## [v0.7.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.7.0) - 2015-07-25 141 | 142 | - Fixed time values (`Hours`, `Minutes`, `Seconds`, `Milliseconds`) by changing the internal representation to `Number`. Previously `Milliseconds` would overflow when using functions like `toEpochMilliseconds`. (@nwolverson) 143 | 144 | ## [v0.6.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.6.0) - 2015-06-30 145 | 146 | 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. 147 | 148 | ## [v0.6.0-rc.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.6.0-rc.1) - 2015-06-14 149 | 150 | Initial release candidate of the library intended for the 0.7 compiler. 151 | 152 | ## [v0.5.3](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.3) - 2015-05-22 153 | 154 | - Added `toLocaleString` and variants (@hdgarrood) 155 | 156 | ## [v0.5.2](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.2) - 2015-04-13 157 | 158 | - Fixed bug with exceptions being thrown when attempting to use members of the UTC module #14 (@bkyrlach) 159 | 160 | ## [v0.5.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.1) - 2015-04-08 161 | 162 | - Fixed methods in `Locale` to not call the `UTC` variants #11 163 | 164 | ## [v0.5.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.5.0) - 2015-04-06 165 | 166 | - Update dependencies 167 | 168 | ## [v0.4.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.4.0) - 2015-03-28 169 | 170 | - Library has been redesigned for better safety 171 | - UTC dates can now be constructed 172 | - The current time in milliseconds since the unix epoch can now be fetched without having to construct a date 173 | 174 | ## [v0.3.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.3.1) - 2015-03-01 175 | 176 | - Days of the week are now exported (@nwolverson) 177 | 178 | ## [v0.3.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.3.0) - 2015-02-21 179 | 180 | **This release requires PureScript v0.6.8 or later** 181 | - Updated dependencies 182 | 183 | ## [v0.2.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.2.0) - 2015-01-11 184 | 185 | - Updated for new `purescript-enum` (@philopon) 186 | 187 | ## [v0.1.2](https://github.com/purescript/purescript-datetime/releases/tag/v0.1.2) - 2014-12-15 188 | 189 | - Fix `now` implementation (@Fresheyeball) 190 | 191 | ## [v0.1.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.1.1) - 2014-11-24 192 | 193 | Added `fromStringStrict` and updated dependencies (@jdegoes) 194 | 195 | ## [v0.1.0](https://github.com/purescript/purescript-datetime/releases/tag/v0.1.0) - 2014-10-14 196 | 197 | - Added `Eq` and `Ord` instances for `DayOfWeek` and `Month`, update for new `Enum` (@jdegoes) 198 | 199 | ## [v0.0.1](https://github.com/purescript/purescript-datetime/releases/tag/v0.0.1) - 2014-10-14 200 | 201 | Initial version release. 202 | 203 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2018 PureScript 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation and/or 11 | other materials provided with the distribution. 12 | 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software without 15 | specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 24 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-datetime 2 | 3 | [![Latest release](http://img.shields.io/github/release/purescript/purescript-datetime.svg)](https://github.com/purescript/purescript-datetime/releases) 4 | [![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) 5 | [![Pursuit](https://pursuit.purescript.org/packages/purescript-datetime/badge)](https://pursuit.purescript.org/packages/purescript-datetime) 6 | 7 | Date and time types and functions. 8 | 9 | ## Installation 10 | 11 | ``` 12 | spago install datetime 13 | ``` 14 | 15 | ## Documentation 16 | 17 | 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. 18 | 19 | Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-datetime). 20 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-datetime", 3 | "homepage": "https://github.com/purescript/purescript-datetime", 4 | "license": "BSD-3-Clause", 5 | "repository": { 6 | "type": "git", 7 | "url": "https://github.com/purescript/purescript-datetime.git" 8 | }, 9 | "ignore": [ 10 | "**/.*", 11 | "bower_components", 12 | "node_modules", 13 | "output", 14 | "bower.json", 15 | "package.json" 16 | ], 17 | "dependencies": { 18 | "purescript-bifunctors": "^6.0.0", 19 | "purescript-control": "^6.0.0", 20 | "purescript-either": "^6.0.0", 21 | "purescript-enums": "^6.0.0", 22 | "purescript-foldable-traversable": "^6.0.0", 23 | "purescript-functions": "^6.0.0", 24 | "purescript-gen": "^4.0.0", 25 | "purescript-integers": "^6.0.0", 26 | "purescript-lists": "^7.0.0", 27 | "purescript-maybe": "^6.0.0", 28 | "purescript-newtype": "^5.0.0", 29 | "purescript-numbers": "^9.0.0", 30 | "purescript-ordered-collections": "^3.0.0", 31 | "purescript-partial": "^4.0.0", 32 | "purescript-prelude": "^6.0.0", 33 | "purescript-tuples": "^7.0.0" 34 | }, 35 | "devDependencies": { 36 | "purescript-assert": "^6.0.0", 37 | "purescript-console": "^6.0.0", 38 | "purescript-strings": "^6.0.0" 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "eslint src && pulp build -- --censor-lib --strict", 6 | "test": "pulp test" 7 | }, 8 | "devDependencies": { 9 | "eslint": "^7.15.0", 10 | "pulp": "16.0.0-0", 11 | "purescript-psa": "^0.8.2", 12 | "rimraf": "^3.0.2" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /src/Data/Date.js: -------------------------------------------------------------------------------- 1 | var createDate = function (y, m, d) { 2 | var date = new Date(Date.UTC(y, m, d)); 3 | if (y >= 0 && y < 100) { 4 | date.setUTCFullYear(y); 5 | } 6 | return date; 7 | }; 8 | 9 | export function canonicalDateImpl(ctor, y, m, d) { 10 | var date = createDate(y, m - 1, d); 11 | return ctor(date.getUTCFullYear())(date.getUTCMonth() + 1)(date.getUTCDate()); 12 | } 13 | 14 | export function calcWeekday(y, m, d) { 15 | return createDate(y, m - 1, d).getUTCDay(); 16 | } 17 | 18 | export function calcDiff(y1, m1, d1, y2, m2, d2) { 19 | var dt1 = createDate(y1, m1 - 1, d1); 20 | var dt2 = createDate(y2, m2 - 1, d2); 21 | return dt1.getTime() - dt2.getTime(); 22 | } 23 | -------------------------------------------------------------------------------- /src/Data/Date.purs: -------------------------------------------------------------------------------- 1 | module Data.Date 2 | ( Date 3 | , canonicalDate 4 | , exactDate 5 | , year 6 | , month 7 | , day 8 | , weekday 9 | , diff 10 | , isLeapYear 11 | , lastDayOfMonth 12 | , adjust 13 | , module Data.Date.Component 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Data.Date.Component (Day, Month(..), Weekday(..), Year) 19 | import Data.Enum (class Enum, toEnum, fromEnum, succ, pred) 20 | import Data.Function.Uncurried (Fn3, runFn3, Fn4, runFn4, Fn6, runFn6) 21 | import Data.Int (fromNumber) 22 | import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing) 23 | import Data.Time.Duration (class Duration, Days(..), Milliseconds, toDuration) 24 | import Partial.Unsafe (unsafePartial) 25 | 26 | -- | A date value in the Gregorian calendar. 27 | data Date = Date Year Month Day 28 | 29 | -- | Constructs a date from year, month, and day components. The resulting date 30 | -- | components may not be identical to the input values, as the date will be 31 | -- | canonicalised according to the Gregorian calendar. For example, date 32 | -- | values for the invalid date 2016-02-31 will be corrected to 2016-03-02. 33 | canonicalDate :: Year -> Month -> Day -> Date 34 | canonicalDate y m d = runFn4 canonicalDateImpl mkDate y (fromEnum m) d 35 | where 36 | mkDate :: Year -> Int -> Day -> Date 37 | mkDate = unsafePartial \y' m' d' -> Date y' (fromJust (toEnum m')) d' 38 | 39 | -- | Constructs a date from year, month, and day components. The result will be 40 | -- | `Nothing` if the provided values result in an invalid date. 41 | exactDate :: Year -> Month -> Day -> Maybe Date 42 | exactDate y m d = 43 | let dt = Date y m d 44 | in if canonicalDate y m d == dt then Just dt else Nothing 45 | 46 | derive instance eqDate :: Eq Date 47 | derive instance ordDate :: Ord Date 48 | 49 | instance boundedDate :: Bounded Date where 50 | bottom = Date bottom bottom bottom 51 | top = Date top top top 52 | 53 | instance showDate :: Show Date where 54 | show (Date y m d) = "(Date " <> show y <> " " <> show m <> " " <> show d <> ")" 55 | 56 | instance enumDate :: Enum Date where 57 | succ (Date y m d) = Date <$> y' <*> pure m' <*> d' 58 | where 59 | d' = if isNothing sd then toEnum 1 else sd 60 | m' = if isNothing sd then fromMaybe January sm else m 61 | y' = if isNothing sd && isNothing sm then succ y else Just y 62 | sd = let v = succ d in if v > Just l then Nothing else v 63 | sm = succ m 64 | l = lastDayOfMonth y m 65 | pred (Date y m d) = Date <$> y' <*> pure m' <*> d' 66 | where 67 | d' = if isNothing pd then Just l else pd 68 | m' = if isNothing pd then fromMaybe December pm else m 69 | y' = if isNothing pd && isNothing pm then pred y else Just y 70 | pd = pred d 71 | pm = pred m 72 | l = lastDayOfMonth y m' 73 | 74 | -- | The year component of a date value. 75 | year :: Date -> Year 76 | year (Date y _ _) = y 77 | 78 | -- | The month component of a date value. 79 | month :: Date -> Month 80 | month (Date _ m _) = m 81 | 82 | -- | The day component of a date value. 83 | day :: Date -> Day 84 | day (Date _ _ d) = d 85 | 86 | -- | The weekday for a date value. 87 | weekday :: Date -> Weekday 88 | weekday = unsafePartial \(Date y m d) -> 89 | let n = runFn3 calcWeekday y (fromEnum m) d 90 | in if n == 0 then fromJust (toEnum 7) else fromJust (toEnum n) 91 | 92 | -- | Adjusts a date with a Duration in days. The number of days must 93 | -- | already be an integer and fall within the valid range of values 94 | -- | for the Int type. 95 | adjust :: Days -> Date -> Maybe Date 96 | adjust (Days n) date = fromNumber n >>= flip adj date 97 | where 98 | adj 0 dt = Just dt 99 | adj i (Date y m d) = adj i' =<< dt' 100 | where 101 | i' | low = j 102 | | hi = j - fromEnum l - 1 103 | | otherwise = 0 104 | dt' | low = pred =<< Date y m <$> toEnum 1 105 | | hi = succ (Date y m l) 106 | | otherwise = Date y m <$> toEnum j 107 | j = i + fromEnum d 108 | low = j < 1 109 | hi = j > fromEnum l 110 | l = lastDayOfMonth y (if low then fromMaybe December (pred m) else m) 111 | 112 | -- | Calculates the difference between two dates, returning the result as a 113 | -- | duration. 114 | diff :: forall d. Duration d => Date -> Date -> d 115 | diff (Date y1 m1 d1) (Date y2 m2 d2) = 116 | toDuration $ runFn6 calcDiff y1 (fromEnum m1) d1 y2 (fromEnum m2) d2 117 | 118 | -- | Checks whether a year is a leap year according to the proleptic Gregorian 119 | -- | calendar. 120 | isLeapYear :: Year -> Boolean 121 | isLeapYear y = (mod y' 4 == 0) && ((mod y' 400 == 0) || not (mod y' 100 == 0)) 122 | where 123 | y' = fromEnum y 124 | 125 | -- | Get the final day of a month and year, accounting for leap years. 126 | lastDayOfMonth :: Year -> Month -> Day 127 | lastDayOfMonth y m = case m of 128 | January -> unsafeDay 31 129 | February 130 | | isLeapYear y -> unsafeDay 29 131 | | otherwise -> unsafeDay 28 132 | March -> unsafeDay 31 133 | April -> unsafeDay 30 134 | May -> unsafeDay 31 135 | June -> unsafeDay 30 136 | July -> unsafeDay 31 137 | August -> unsafeDay 31 138 | September -> unsafeDay 30 139 | October -> unsafeDay 31 140 | November -> unsafeDay 30 141 | December -> unsafeDay 31 142 | where 143 | unsafeDay = unsafePartial fromJust <<< toEnum 144 | 145 | -- TODO: these could (and probably should) be implemented in PS 146 | foreign import canonicalDateImpl :: Fn4 (Year -> Int -> Day -> Date) Year Int Day Date 147 | foreign import calcWeekday :: Fn3 Year Int Day Int 148 | foreign import calcDiff :: Fn6 Year Int Day Year Int Day Milliseconds 149 | -------------------------------------------------------------------------------- /src/Data/Date/Component.purs: -------------------------------------------------------------------------------- 1 | module Data.Date.Component 2 | ( Year 3 | , Month(..) 4 | , Day 5 | , Weekday(..) 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) 11 | import Data.Maybe (Maybe(..)) 12 | 13 | -- | A year component for a date. 14 | -- | 15 | -- | The constructor is private as the `Year` type is bounded to the range 16 | -- | -271820 to 275759, inclusive. The `toEnum` function can be used to safely 17 | -- | acquire a year value from an integer. 18 | newtype Year = Year Int 19 | 20 | derive newtype instance eqYear :: Eq Year 21 | derive newtype instance ordYear :: Ord Year 22 | 23 | -- Note: these seemingly arbitrary bounds come from relying on JS for date 24 | -- manipulations, as it only supports date ±100,000,000 days of the Unix epoch. 25 | -- Using these year values means `Date bottom bottom bottom` is a valid date, 26 | -- likewise for `top`. 27 | instance boundedYear :: Bounded Year where 28 | bottom = Year (-271820) 29 | top = Year 275759 30 | 31 | instance enumYear :: Enum Year where 32 | succ = toEnum <<< (_ + 1) <<< fromEnum 33 | pred = toEnum <<< (_ - 1) <<< fromEnum 34 | 35 | instance boundedEnumYear :: BoundedEnum Year where 36 | cardinality = Cardinality 547580 37 | toEnum n 38 | | n >= (-271820) && n <= 275759 = Just (Year n) 39 | | otherwise = Nothing 40 | fromEnum (Year n) = n 41 | 42 | instance showYear :: Show Year where 43 | show (Year y) = "(Year " <> show y <> ")" 44 | 45 | -- | A month component for a date in the Gregorian calendar. 46 | data Month 47 | = January 48 | | February 49 | | March 50 | | April 51 | | May 52 | | June 53 | | July 54 | | August 55 | | September 56 | | October 57 | | November 58 | | December 59 | 60 | derive instance eqMonth :: Eq Month 61 | derive instance ordMonth :: Ord Month 62 | 63 | instance boundedMonth :: Bounded Month where 64 | bottom = January 65 | top = December 66 | 67 | instance enumMonth :: Enum Month where 68 | succ = toEnum <<< (_ + 1) <<< fromEnum 69 | pred = toEnum <<< (_ - 1) <<< fromEnum 70 | 71 | instance boundedEnumMonth :: BoundedEnum Month where 72 | cardinality = Cardinality 12 73 | toEnum = case _ of 74 | 1 -> Just January 75 | 2 -> Just February 76 | 3 -> Just March 77 | 4 -> Just April 78 | 5 -> Just May 79 | 6 -> Just June 80 | 7 -> Just July 81 | 8 -> Just August 82 | 9 -> Just September 83 | 10 -> Just October 84 | 11 -> Just November 85 | 12 -> Just December 86 | _ -> Nothing 87 | fromEnum = case _ of 88 | January -> 1 89 | February -> 2 90 | March -> 3 91 | April -> 4 92 | May -> 5 93 | June -> 6 94 | July -> 7 95 | August -> 8 96 | September -> 9 97 | October -> 10 98 | November -> 11 99 | December -> 12 100 | 101 | instance showMonth :: Show Month where 102 | show January = "January" 103 | show February = "February" 104 | show March = "March" 105 | show April = "April" 106 | show May = "May" 107 | show June = "June" 108 | show July = "July" 109 | show August = "August" 110 | show September = "September" 111 | show October = "October" 112 | show November = "November" 113 | show December = "December" 114 | 115 | -- | A day component for a date. 116 | -- | 117 | -- | The constructor is private as the `Day` type is bounded to the range 118 | -- | 1 to 31, inclusive. The `toEnum` function can be used to safely 119 | -- | acquire a day value from an integer. 120 | newtype Day = Day Int 121 | 122 | derive newtype instance eqDay :: Eq Day 123 | derive newtype instance ordDay :: Ord Day 124 | 125 | instance boundedDay :: Bounded Day where 126 | bottom = Day 1 127 | top = Day 31 128 | 129 | instance enumDay :: Enum Day where 130 | succ = toEnum <<< (_ + 1) <<< fromEnum 131 | pred = toEnum <<< (_ - 1) <<< fromEnum 132 | 133 | instance boundedEnumDay :: BoundedEnum Day where 134 | cardinality = Cardinality 31 135 | toEnum n 136 | | n >= 1 && n <= 31 = Just (Day n) 137 | | otherwise = Nothing 138 | fromEnum (Day n) = n 139 | 140 | instance showDay :: Show Day where 141 | show (Day d) = "(Day " <> show d <> ")" 142 | 143 | -- | A type representing the days of the week in the Gregorian calendar. 144 | data Weekday 145 | = Monday 146 | | Tuesday 147 | | Wednesday 148 | | Thursday 149 | | Friday 150 | | Saturday 151 | | Sunday 152 | 153 | derive instance eqWeekday :: Eq Weekday 154 | derive instance ordWeekday :: Ord Weekday 155 | 156 | instance boundedWeekday :: Bounded Weekday where 157 | bottom = Monday 158 | top = Sunday 159 | 160 | instance enumWeekday :: Enum Weekday where 161 | succ = toEnum <<< (_ + 1) <<< fromEnum 162 | pred = toEnum <<< (_ - 1) <<< fromEnum 163 | 164 | instance boundedEnumWeekday :: BoundedEnum Weekday where 165 | cardinality = Cardinality 7 166 | toEnum = case _ of 167 | 1 -> Just Monday 168 | 2 -> Just Tuesday 169 | 3 -> Just Wednesday 170 | 4 -> Just Thursday 171 | 5 -> Just Friday 172 | 6 -> Just Saturday 173 | 7 -> Just Sunday 174 | _ -> Nothing 175 | fromEnum = case _ of 176 | Monday -> 1 177 | Tuesday -> 2 178 | Wednesday -> 3 179 | Thursday -> 4 180 | Friday -> 5 181 | Saturday -> 6 182 | Sunday -> 7 183 | 184 | instance showWeekday :: Show Weekday where 185 | show Monday = "Monday" 186 | show Tuesday = "Tuesday" 187 | show Wednesday = "Wednesday" 188 | show Thursday = "Thursday" 189 | show Friday = "Friday" 190 | show Saturday = "Saturday" 191 | show Sunday = "Sunday" 192 | -------------------------------------------------------------------------------- /src/Data/Date/Component/Gen.purs: -------------------------------------------------------------------------------- 1 | module Data.Date.Component.Gen where 2 | 3 | import Prelude 4 | import Control.Monad.Gen (class MonadGen, chooseInt) 5 | import Data.Date.Component (Day, Month, Weekday, Year) 6 | import Data.Enum (toEnum) 7 | import Data.Enum.Gen (genBoundedEnum) 8 | import Data.Maybe (fromJust) 9 | import Partial.Unsafe (unsafePartial) 10 | 11 | -- | Generates a random `Year` in the range 1900-2100, inclusive. 12 | genYear :: forall m. MonadGen m => m Year 13 | genYear = unsafePartial fromJust <<< toEnum <$> chooseInt 1900 2100 14 | 15 | -- | Generates a random `Month` component. 16 | genMonth :: forall m. MonadGen m => m Month 17 | genMonth = genBoundedEnum 18 | 19 | -- | Generates a random `Day` component. 20 | genDay :: forall m. MonadGen m => m Day 21 | genDay = genBoundedEnum 22 | 23 | -- | Generates a random `Weekday` component. 24 | genWeekday :: forall m. MonadGen m => m Weekday 25 | genWeekday = genBoundedEnum 26 | -------------------------------------------------------------------------------- /src/Data/Date/Gen.purs: -------------------------------------------------------------------------------- 1 | module Data.Date.Gen 2 | ( genDate 3 | , module Data.Date.Component.Gen 4 | ) where 5 | 6 | import Prelude 7 | import Control.Monad.Gen (class MonadGen, chooseInt) 8 | import Data.Date (Date, adjust, exactDate, isLeapYear) 9 | import Data.Date.Component.Gen (genDay, genMonth, genWeekday, genYear) 10 | import Data.Int (toNumber) 11 | import Data.Maybe (fromJust) 12 | import Data.Time.Duration (Days(..)) 13 | import Partial.Unsafe (unsafePartial) 14 | 15 | -- | Generates a random `Date` between 1st Jan 1900 and 31st Dec 2100, 16 | -- | inclusive. 17 | genDate :: forall m. MonadGen m => m Date 18 | genDate = do 19 | year <- genYear 20 | let maxDays = if isLeapYear year then 365 else 364 21 | days <- Days <<< toNumber <$> chooseInt 0 maxDays 22 | pure $ unsafePartial $ fromJust do 23 | janFirst <- exactDate year bottom bottom 24 | adjust days janFirst 25 | -------------------------------------------------------------------------------- /src/Data/DateTime.js: -------------------------------------------------------------------------------- 1 | var createUTC = function (y, mo, d, h, m, s, ms) { 2 | var date = new Date(Date.UTC(y, mo, d, h, m, s, ms)); 3 | if (y >= 0 && y < 100) { 4 | date.setUTCFullYear(y); 5 | } 6 | return date.getTime(); 7 | }; 8 | 9 | export function calcDiff(rec1, rec2) { 10 | var msUTC1 = createUTC(rec1.year, rec1.month - 1, rec1.day, rec1.hour, rec1.minute, rec1.second, rec1.millisecond); 11 | var msUTC2 = createUTC(rec2.year, rec2.month - 1, rec2.day, rec2.hour, rec2.minute, rec2.second, rec2.millisecond); 12 | return msUTC1 - msUTC2; 13 | } 14 | 15 | export function adjustImpl(just) { 16 | return function (nothing) { 17 | return function (offset) { 18 | return function (rec) { 19 | var msUTC = createUTC(rec.year, rec.month - 1, rec.day, rec.hour, rec.minute, rec.second, rec.millisecond); 20 | var dt = new Date(msUTC + offset); 21 | return isNaN(dt.getTime()) ? nothing : just({ 22 | year: dt.getUTCFullYear(), 23 | month: dt.getUTCMonth() + 1, 24 | day: dt.getUTCDate(), 25 | hour: dt.getUTCHours(), 26 | minute: dt.getUTCMinutes(), 27 | second: dt.getUTCSeconds(), 28 | millisecond: dt.getUTCMilliseconds() 29 | }); 30 | }; 31 | }; 32 | }; 33 | } 34 | -------------------------------------------------------------------------------- /src/Data/DateTime.purs: -------------------------------------------------------------------------------- 1 | module Data.DateTime 2 | ( DateTime(..) 3 | , date 4 | , modifyDate 5 | , modifyDateF 6 | , time 7 | , modifyTime 8 | , modifyTimeF 9 | , adjust 10 | , diff 11 | , module Data.Date 12 | , module Data.Time 13 | ) where 14 | 15 | import Prelude 16 | 17 | import Data.Date (Date, Day, Month(..), Weekday(..), Year, canonicalDate, day, exactDate, month, weekday, year) 18 | import Data.Enum (toEnum, fromEnum) 19 | import Data.Function.Uncurried (Fn2, runFn2) 20 | import Data.Time (Hour, Millisecond, Minute, Second, Time(..), hour, setHour, millisecond, setMillisecond, minute, setMinute, second, setSecond) 21 | import Data.Time.Duration (class Duration, fromDuration, toDuration, Milliseconds) 22 | import Data.Maybe (Maybe(..)) 23 | 24 | -- | A date/time value in the Gregorian calendar/UTC time zone. 25 | data DateTime = DateTime Date Time 26 | 27 | derive instance eqDateTime :: Eq DateTime 28 | derive instance ordDateTime :: Ord DateTime 29 | 30 | instance boundedDateTime :: Bounded DateTime where 31 | bottom = DateTime bottom bottom 32 | top = DateTime top top 33 | 34 | instance showDateTime :: Show DateTime where 35 | show (DateTime d t) = "(DateTime " <> show d <> " " <> show t <> ")" 36 | 37 | date :: DateTime -> Date 38 | date (DateTime d _) = d 39 | 40 | modifyDate :: (Date -> Date) -> DateTime -> DateTime 41 | modifyDate f (DateTime d t) = DateTime (f d) t 42 | 43 | modifyDateF :: forall f. Functor f => (Date -> f Date) -> DateTime -> f DateTime 44 | modifyDateF f (DateTime d t) = flip DateTime t <$> f d 45 | 46 | time :: DateTime -> Time 47 | time (DateTime _ t) = t 48 | 49 | modifyTime :: (Time -> Time) -> DateTime -> DateTime 50 | modifyTime f (DateTime d t) = DateTime d (f t) 51 | 52 | modifyTimeF :: forall f. Functor f => (Time -> f Time) -> DateTime -> f DateTime 53 | modifyTimeF f (DateTime d t) = DateTime d <$> f t 54 | 55 | -- | Adjusts a date/time value with a duration offset. `Nothing` is returned 56 | -- | if the resulting date would be outside of the range of valid dates. 57 | adjust :: forall d. Duration d => d -> DateTime -> Maybe DateTime 58 | adjust d dt = 59 | adjustImpl Just Nothing (fromDuration d) (toRecord dt) >>= \rec -> 60 | DateTime 61 | <$> join (exactDate <$> toEnum rec.year <*> toEnum rec.month <*> toEnum rec.day) 62 | <*> (Time <$> toEnum rec.hour <*> toEnum rec.minute <*> toEnum rec.second <*> toEnum rec.millisecond) 63 | 64 | -- | Calculates the difference between two date/time values, returning the 65 | -- | result as a duration. 66 | diff :: forall d. Duration d => DateTime -> DateTime -> d 67 | diff dt1 dt2 = toDuration $ runFn2 calcDiff (toRecord dt1) (toRecord dt2) 68 | 69 | type DateRec = 70 | { year :: Int 71 | , month :: Int 72 | , day :: Int 73 | , hour :: Int 74 | , minute :: Int 75 | , second :: Int 76 | , millisecond :: Int 77 | } 78 | 79 | toRecord :: DateTime -> DateRec 80 | toRecord (DateTime d t) = 81 | { year: fromEnum (year d) 82 | , month: fromEnum (month d) 83 | , day: fromEnum (day d) 84 | , hour: fromEnum (hour t) 85 | , minute: fromEnum (minute t) 86 | , second: fromEnum (second t) 87 | , millisecond: fromEnum (millisecond t) 88 | } 89 | 90 | -- TODO: these could (and probably should) be implemented in PS 91 | 92 | foreign import calcDiff :: Fn2 DateRec DateRec Milliseconds 93 | 94 | foreign import adjustImpl 95 | :: (forall a. a -> Maybe a) 96 | -> (forall a. Maybe a) 97 | -> Milliseconds 98 | -> DateRec 99 | -> Maybe DateRec 100 | -------------------------------------------------------------------------------- /src/Data/DateTime/Gen.purs: -------------------------------------------------------------------------------- 1 | module Data.DateTime.Gen 2 | ( genDateTime 3 | , module Data.Date.Gen 4 | , module Data.Time.Gen 5 | ) where 6 | 7 | import Prelude 8 | import Control.Monad.Gen (class MonadGen) 9 | import Data.Date.Gen (genDate, genDay, genMonth, genWeekday, genYear) 10 | import Data.DateTime (DateTime(..)) 11 | import Data.Time.Gen (genHour, genMillisecond, genMinute, genSecond, genTime) 12 | 13 | -- | Generates a random `DateTime` between 1st Jan 1900 00:00:00 and 14 | -- | 31st Dec 2100 23:59:59, inclusive. 15 | genDateTime :: forall m. MonadGen m => m DateTime 16 | genDateTime = DateTime <$> genDate <*> genTime 17 | -------------------------------------------------------------------------------- /src/Data/DateTime/Instant.js: -------------------------------------------------------------------------------- 1 | var createDateTime = function (y, m, d, h, mi, s, ms) { 2 | var dateTime = new Date(Date.UTC(y, m, d, h, mi, s, ms)); 3 | if (y >= 0 && y < 100) { 4 | dateTime.setUTCFullYear(y); 5 | } 6 | return dateTime; 7 | }; 8 | 9 | export function fromDateTimeImpl(y, mo, d, h, mi, s, ms) { 10 | return createDateTime(y, mo - 1, d, h, mi, s, ms).getTime(); 11 | } 12 | 13 | export function toDateTimeImpl(ctor) { 14 | return function (instant) { 15 | var dt = new Date(instant); 16 | return ctor (dt.getUTCFullYear())(dt.getUTCMonth() + 1)(dt.getUTCDate())(dt.getUTCHours())(dt.getUTCMinutes())(dt.getUTCSeconds())(dt.getUTCMilliseconds()); 17 | }; 18 | } 19 | -------------------------------------------------------------------------------- /src/Data/DateTime/Instant.purs: -------------------------------------------------------------------------------- 1 | module Data.DateTime.Instant 2 | ( Instant 3 | , instant 4 | , unInstant 5 | , fromDateTime 6 | , fromDate 7 | , toDateTime 8 | , diff 9 | ) where 10 | 11 | import Prelude 12 | 13 | import Data.DateTime (Millisecond, Second, Minute, Hour, Day, Year, DateTime(..), Date, Time(..), canonicalDate, millisecond, second, minute, hour, day, month, year) 14 | import Data.Enum (fromEnum, toEnum) 15 | import Data.Function.Uncurried (Fn7, runFn7) 16 | import Data.Maybe (Maybe(..), fromJust) 17 | import Data.Time.Duration (class Duration, Milliseconds(..), negateDuration, toDuration) 18 | import Partial.Unsafe (unsafePartial) 19 | 20 | -- | An instant is a duration in milliseconds relative to the Unix epoch 21 | -- | (1970-01-01 00:00:00 UTC). 22 | -- | 23 | -- | The constructor is private as the `Instant` range matches that of the 24 | -- | `DateTime` type. 25 | newtype Instant = Instant Milliseconds 26 | 27 | derive newtype instance eqDateTime :: Eq Instant 28 | derive newtype instance ordDateTime :: Ord Instant 29 | 30 | instance boundedInstant :: Bounded Instant where 31 | bottom = Instant (Milliseconds (-8639977881600000.0)) 32 | top = Instant (Milliseconds 8639977881599999.0) 33 | 34 | instance showInstant :: Show Instant where 35 | show (Instant ms) = "(Instant " <> show ms <> ")" 36 | 37 | -- Unfortunately Instant cannot be made a `BoundedEnum` as it "should" be, 38 | -- unless enum cardinality and from/to range is extended to use a numeric type 39 | -- bigger than Int32 40 | 41 | -- | Attempts to create an `Instant` from a `Milliseconds` duration. The 42 | -- | minimum acceptable value equates to the `bottom` `DateTime` and the maximum 43 | -- | acceptable value equates to the `top` `DateTime`. 44 | instant :: Milliseconds -> Maybe Instant 45 | instant ms@(Milliseconds n) 46 | | n >= -8639977881600000.0 && n <= 8639977881599999.0 = Just (Instant ms) 47 | | otherwise = Nothing 48 | 49 | -- | Lowers an `Instant` to a `Milliseconds` duration. 50 | unInstant :: Instant -> Milliseconds 51 | unInstant (Instant ms) = ms 52 | 53 | -- | Creates an `Instant` from a `DateTime` value. 54 | fromDateTime :: DateTime -> Instant 55 | fromDateTime (DateTime d t) = 56 | runFn7 fromDateTimeImpl 57 | (year d) (fromEnum (month d)) (day d) 58 | (hour t) (minute t) (second t) (millisecond t) 59 | 60 | -- | Creates an `Instant` from a `Date` value, using the assumed time 00:00:00. 61 | fromDate :: Date -> Instant 62 | fromDate d = 63 | runFn7 fromDateTimeImpl 64 | (year d) (fromEnum (month d)) (day d) 65 | bottom bottom bottom bottom 66 | 67 | -- | Creates a `DateTime` value from an `Instant`. 68 | toDateTime :: Instant -> DateTime 69 | toDateTime = toDateTimeImpl mkDateTime 70 | where 71 | mkDateTime = unsafePartial \y mo d h mi s ms -> 72 | DateTime (canonicalDate y (fromJust (toEnum mo)) d) (Time h mi s ms) 73 | 74 | -- TODO: these could (and probably should) be implemented in PS 75 | foreign import fromDateTimeImpl :: Fn7 Year Int Day Hour Minute Second Millisecond Instant 76 | foreign import toDateTimeImpl :: (Year -> Int -> Day -> Hour -> Minute -> Second -> Millisecond -> DateTime) -> Instant -> DateTime 77 | 78 | -- | Calculates the difference between two instants, returning the result as a duration. 79 | -- | For example: 80 | -- | ``` 81 | -- | do 82 | -- | start <- liftEffect Now.now 83 | -- | aLongRunningAff 84 | -- | end <- liftEffect Now.now 85 | -- | let 86 | -- | hours :: Duration.Hours 87 | -- | hours = Instant.diff end start 88 | -- | log ("A long running Aff took " <> show hours) 89 | -- | ``` 90 | diff :: forall d. Duration d => Instant → Instant → d 91 | diff dt1 dt2 = toDuration (unInstant dt1 <> negateDuration (unInstant dt2)) 92 | -------------------------------------------------------------------------------- /src/Data/Interval.purs: -------------------------------------------------------------------------------- 1 | module Data.Interval 2 | ( Interval(..) 3 | , RecurringInterval(..) 4 | , module Exports 5 | ) where 6 | 7 | import Prelude 8 | 9 | import Control.Extend (class Extend, extend) 10 | import Data.Bifoldable (class Bifoldable, bifoldl, bifoldr, bifoldrDefault, bifoldMapDefaultL) 11 | import Data.Bifunctor (class Bifunctor, bimap) 12 | import Data.Bitraversable (class Bitraversable, bitraverse, bisequenceDefault) 13 | import Data.Foldable (class Foldable, foldl, foldr, foldrDefault, foldMapDefaultL) 14 | import Data.Interval.Duration (Duration(..), DurationComponent(..), day, hour, millisecond, minute, month, second, week, year) as Exports 15 | import Data.Maybe (Maybe) 16 | import Data.Traversable (class Traversable, traverse, sequenceDefault) 17 | 18 | data RecurringInterval d a = RecurringInterval (Maybe Int) (Interval d a) 19 | 20 | derive instance eqRecurringInterval :: (Eq d, Eq a) => Eq (RecurringInterval d a) 21 | derive instance ordRecurringInterval :: (Ord d, Ord a) => Ord (RecurringInterval d a) 22 | instance showRecurringInterval :: (Show d, Show a) => Show (RecurringInterval d a) where 23 | show (RecurringInterval x y) = "(RecurringInterval " <> show x <> " " <> show y <> ")" 24 | 25 | interval :: ∀ d a. RecurringInterval d a -> Interval d a 26 | interval (RecurringInterval _ i) = i 27 | 28 | over :: ∀ f d a d' a'. Functor f => (Interval d a -> f (Interval d' a')) -> RecurringInterval d a -> f (RecurringInterval d' a') 29 | over f (RecurringInterval n i) = map (RecurringInterval n) (f i) 30 | 31 | instance functorRecurringInterval :: Functor (RecurringInterval d) where 32 | map f (RecurringInterval n i) = RecurringInterval n (map f i) 33 | 34 | instance bifunctorRecurringInterval :: Bifunctor RecurringInterval where 35 | bimap f g (RecurringInterval n i) = RecurringInterval n (bimap f g i) 36 | 37 | instance foldableRecurringInterval :: Foldable (RecurringInterval d) where 38 | foldl f i = foldl f i <<< interval 39 | foldr f i = foldr f i <<< interval 40 | foldMap = foldMapDefaultL 41 | 42 | instance bifoldableRecurringInterval :: Bifoldable RecurringInterval where 43 | bifoldl f g i = bifoldl f g i <<< interval 44 | bifoldr f g i = bifoldr f g i <<< interval 45 | bifoldMap = bifoldMapDefaultL 46 | 47 | instance traversableRecurringInterval :: Traversable (RecurringInterval d) where 48 | traverse f i = traverse f `over` i 49 | sequence = sequenceDefault 50 | 51 | instance bitraversableRecurringInterval :: Bitraversable RecurringInterval where 52 | bitraverse l r i = bitraverse l r `over` i 53 | bisequence = bisequenceDefault 54 | 55 | instance extendRecurringInterval :: Extend (RecurringInterval d) where 56 | extend f a@(RecurringInterval n i) = RecurringInterval n (extend (const (f a)) i) 57 | 58 | data Interval d a 59 | = StartEnd a a 60 | | DurationEnd d a 61 | | StartDuration a d 62 | | DurationOnly d 63 | 64 | derive instance eqInterval :: (Eq d, Eq a) => Eq (Interval d a) 65 | derive instance ordInterval :: (Ord d, Ord a) => Ord (Interval d a) 66 | instance showInterval :: (Show d, Show a) => Show (Interval d a) where 67 | show (StartEnd x y) = "(StartEnd " <> show x <> " " <> show y <> ")" 68 | show (DurationEnd d x) = "(DurationEnd " <> show d <> " " <> show x <> ")" 69 | show (StartDuration x d) = "(StartDuration " <> show x <> " " <> show d <> ")" 70 | show (DurationOnly d) = "(DurationOnly " <> show d <> ")" 71 | 72 | instance functorInterval :: Functor (Interval d) where 73 | map = bimap identity 74 | 75 | instance bifunctorInterval :: Bifunctor Interval where 76 | bimap _ f (StartEnd x y) = StartEnd (f x) (f y) 77 | bimap g f (DurationEnd d x) = DurationEnd (g d) (f x) 78 | bimap g f (StartDuration x d) = StartDuration (f x) (g d) 79 | bimap g _ (DurationOnly d) = DurationOnly (g d) 80 | 81 | instance foldableInterval :: Foldable (Interval d) where 82 | foldl f z (StartEnd x y) = (z `f` x) `f` y 83 | foldl f z (DurationEnd _ x) = z `f` x 84 | foldl f z (StartDuration x _) = z `f` x 85 | foldl _ z _ = z 86 | foldr x = foldrDefault x 87 | foldMap = foldMapDefaultL 88 | 89 | instance bifoldableInterval :: Bifoldable Interval where 90 | bifoldl _ f z (StartEnd x y) = (z `f` x) `f` y 91 | bifoldl g f z (DurationEnd d x) = (z `g` d) `f` x 92 | bifoldl g f z (StartDuration x d) = (z `g` d) `f` x 93 | bifoldl g _ z (DurationOnly d) = z `g` d 94 | bifoldr x = bifoldrDefault x 95 | bifoldMap = bifoldMapDefaultL 96 | 97 | instance traversableInterval :: Traversable (Interval d) where 98 | traverse f (StartEnd x y) = StartEnd <$> f x <*> f y 99 | traverse f (DurationEnd d x) = f x <#> DurationEnd d 100 | traverse f (StartDuration x d) = f x <#> (_ `StartDuration` d) 101 | traverse _ (DurationOnly d) = pure (DurationOnly d) 102 | sequence = sequenceDefault 103 | 104 | instance bitraversableInterval :: Bitraversable Interval where 105 | bitraverse _ r (StartEnd x y) = StartEnd <$> r x <*> r y 106 | bitraverse l r (DurationEnd d x) = DurationEnd <$> l d <*> r x 107 | bitraverse l r (StartDuration x d) = StartDuration <$> r x <*> l d 108 | bitraverse l _ (DurationOnly d) = DurationOnly <$> l d 109 | bisequence = bisequenceDefault 110 | 111 | instance extendInterval :: Extend (Interval d) where 112 | extend f a@(StartEnd _ _) = StartEnd (f a) (f a) 113 | extend f a@(DurationEnd d _) = DurationEnd d (f a) 114 | extend f a@(StartDuration _ d) = StartDuration (f a) d 115 | extend _ (DurationOnly d) = DurationOnly d 116 | -------------------------------------------------------------------------------- /src/Data/Interval/Duration.purs: -------------------------------------------------------------------------------- 1 | module Data.Interval.Duration 2 | ( Duration(..) 3 | , DurationComponent(..) 4 | , year 5 | , month 6 | , week 7 | , day 8 | , hour 9 | , minute 10 | , second 11 | , millisecond 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Data.Map as Map 17 | import Data.Newtype (class Newtype) 18 | 19 | newtype Duration = Duration (Map.Map DurationComponent Number) 20 | 21 | derive instance eqDuration :: Eq Duration 22 | derive instance ordDuration :: Ord Duration 23 | derive instance newtypeDuration :: Newtype Duration _ 24 | 25 | instance showDuration :: Show Duration where 26 | show (Duration d) = "(Duration " <> show d <> ")" 27 | 28 | instance semigroupDuration :: Semigroup Duration where 29 | append (Duration a) (Duration b) = Duration (Map.unionWith (+) a b) 30 | 31 | instance monoidDuration :: Monoid Duration where 32 | mempty = Duration Map.empty 33 | 34 | data DurationComponent = Second | Minute | Hour | Day | Week | Month | Year 35 | derive instance eqDurationComponent :: Eq DurationComponent 36 | derive instance ordDurationComponent :: Ord DurationComponent 37 | 38 | instance showDurationComponent :: Show DurationComponent where 39 | show Minute = "Minute" 40 | show Second = "Second" 41 | show Hour = "Hour" 42 | show Day = "Day" 43 | show Week = "Week" 44 | show Month = "Month" 45 | show Year = "Year" 46 | 47 | 48 | week :: Number -> Duration 49 | week = durationFromComponent Week 50 | 51 | year :: Number -> Duration 52 | year = durationFromComponent Year 53 | 54 | month :: Number -> Duration 55 | month = durationFromComponent Month 56 | 57 | day :: Number -> Duration 58 | day = durationFromComponent Day 59 | 60 | hour :: Number -> Duration 61 | hour = durationFromComponent Hour 62 | 63 | minute :: Number -> Duration 64 | minute = durationFromComponent Minute 65 | 66 | second :: Number -> Duration 67 | second = durationFromComponent Second 68 | 69 | millisecond :: Number -> Duration 70 | millisecond = durationFromComponent Second <<< (_ / 1000.0) 71 | 72 | durationFromComponent :: DurationComponent -> Number -> Duration 73 | durationFromComponent k v = Duration (Map.singleton k v) 74 | -------------------------------------------------------------------------------- /src/Data/Interval/Duration/Iso.purs: -------------------------------------------------------------------------------- 1 | module Data.Interval.Duration.Iso 2 | ( IsoDuration 3 | , unIsoDuration 4 | , mkIsoDuration 5 | , Error(..) 6 | , Errors 7 | , prettyError 8 | ) where 9 | 10 | import Prelude 11 | 12 | import Control.Plus (empty) 13 | import Data.Either (Either(..)) 14 | import Data.Foldable (fold, foldMap) 15 | import Data.Interval.Duration (Duration(..), DurationComponent(..)) 16 | import Data.List (List(..), reverse, span, null) 17 | import Data.List.NonEmpty (fromList) 18 | import Data.List.Types (NonEmptyList) 19 | import Data.Map as Map 20 | import Data.Number as Number 21 | import Data.Maybe (Maybe(..), isJust) 22 | import Data.Monoid.Additive (Additive(..)) 23 | import Data.Newtype (unwrap) 24 | import Data.Tuple (Tuple(..), snd) 25 | 26 | newtype IsoDuration = IsoDuration Duration 27 | 28 | derive instance eqIsoDuration :: Eq IsoDuration 29 | derive instance ordIsoDuration :: Ord IsoDuration 30 | instance showIsoDuration :: Show IsoDuration where 31 | show (IsoDuration d) = "(IsoDuration " <> show d <> ")" 32 | 33 | type Errors = NonEmptyList Error 34 | 35 | data Error 36 | = IsEmpty 37 | | InvalidWeekComponentUsage 38 | | ContainsNegativeValue DurationComponent 39 | | InvalidFractionalUse DurationComponent 40 | 41 | derive instance eqError :: Eq Error 42 | derive instance ordError :: Ord Error 43 | instance showError :: Show Error where 44 | show (IsEmpty) = "(IsEmpty)" 45 | show (InvalidWeekComponentUsage) = "(InvalidWeekComponentUsage)" 46 | show (ContainsNegativeValue c) = "(ContainsNegativeValue " <> show c <> ")" 47 | show (InvalidFractionalUse c) = "(InvalidFractionalUse " <> show c <> ")" 48 | 49 | prettyError :: Error -> String 50 | prettyError (IsEmpty) = "Duration is empty (has no components)" 51 | prettyError (InvalidWeekComponentUsage) = "Week component of Duration is used with other components" 52 | prettyError (ContainsNegativeValue c) = "Component `" <> show c <> "` contains negative value" 53 | prettyError (InvalidFractionalUse c) = "Invalid usage of Fractional value at component `" <> show c <> "`" 54 | 55 | 56 | unIsoDuration :: IsoDuration -> Duration 57 | unIsoDuration (IsoDuration a) = a 58 | 59 | mkIsoDuration :: Duration -> Either Errors IsoDuration 60 | mkIsoDuration d = case fromList (checkValidIsoDuration d) of 61 | Just errs -> Left errs 62 | Nothing -> Right (IsoDuration d) 63 | 64 | checkValidIsoDuration :: Duration -> List Error 65 | checkValidIsoDuration (Duration asMap) = check {asList, asMap} 66 | where 67 | asList = reverse (Map.toUnfoldable asMap) 68 | check = fold 69 | [ checkWeekUsage 70 | , checkEmptiness 71 | , checkFractionalUse 72 | , checkNegativeValues 73 | ] 74 | 75 | 76 | type CheckEnv = 77 | { asList :: List (Tuple DurationComponent Number) 78 | , asMap :: Map.Map DurationComponent Number} 79 | 80 | checkWeekUsage :: CheckEnv -> List Error 81 | checkWeekUsage {asMap} = if isJust (Map.lookup Week asMap) && Map.size asMap > 1 82 | then pure InvalidWeekComponentUsage else empty 83 | 84 | checkEmptiness :: CheckEnv -> List Error 85 | checkEmptiness {asList} = if null asList then pure IsEmpty else empty 86 | 87 | checkFractionalUse :: CheckEnv -> List Error 88 | checkFractionalUse {asList} = case _.rest (span (snd >>> not isFractional) asList) of 89 | Cons (Tuple c _) rest | checkRest rest -> pure (InvalidFractionalUse c) 90 | _ -> empty 91 | where 92 | isFractional a = Number.floor a /= a 93 | checkRest rest = unwrap (foldMap (snd >>> Number.abs >>> Additive) rest) > 0.0 94 | 95 | checkNegativeValues :: CheckEnv -> List Error 96 | checkNegativeValues {asList} = flip foldMap asList \(Tuple c num) -> 97 | if num >= 0.0 then empty else pure (ContainsNegativeValue c) 98 | -------------------------------------------------------------------------------- /src/Data/Time.purs: -------------------------------------------------------------------------------- 1 | module Data.Time 2 | ( Time(..) 3 | , hour, setHour 4 | , minute, setMinute 5 | , second, setSecond 6 | , millisecond, setMillisecond 7 | , adjust 8 | , diff 9 | , module Data.Time.Component 10 | ) where 11 | 12 | import Prelude 13 | 14 | import Data.Enum (fromEnum, toEnum) 15 | import Data.Int as Int 16 | import Data.Maybe (fromJust) 17 | import Data.Number as Number 18 | import Data.Newtype (unwrap) 19 | import Data.Time.Component (Hour, Millisecond, Minute, Second) 20 | import Data.Time.Duration (class Duration, Days(..), Milliseconds(..), fromDuration, negateDuration, toDuration) 21 | import Data.Tuple (Tuple(..)) 22 | import Partial.Unsafe (unsafePartial) 23 | 24 | data Time = Time Hour Minute Second Millisecond 25 | 26 | derive instance eqTime :: Eq Time 27 | derive instance ordTime :: Ord Time 28 | 29 | instance boundedTime :: Bounded Time where 30 | bottom = Time bottom bottom bottom bottom 31 | top = Time top top top top 32 | 33 | instance showTime :: Show Time where 34 | show (Time h m s ms) = "(Time " <> show h <> " " <> show m <> " " <> show s <> " " <> show ms <> ")" 35 | 36 | -- | The hour component of a time value. 37 | hour :: Time -> Hour 38 | hour (Time h _ _ _) = h 39 | 40 | -- | Alters the hour component of a time value. 41 | setHour :: Hour -> Time -> Time 42 | setHour h (Time _ m s ms) = Time h m s ms 43 | 44 | -- | The minute component of a time value. 45 | minute :: Time -> Minute 46 | minute (Time _ m _ _) = m 47 | 48 | -- | Alters the minute component of a time value. 49 | setMinute :: Minute -> Time -> Time 50 | setMinute m (Time h _ s ms) = Time h m s ms 51 | 52 | -- | The second component of a time value. 53 | second :: Time -> Second 54 | second (Time _ _ s _) = s 55 | 56 | -- | Alters the second component of a time value. 57 | setSecond :: Second -> Time -> Time 58 | setSecond s (Time h m _ ms) = Time h m s ms 59 | 60 | -- | The millisecond component of a time value. 61 | millisecond :: Time -> Millisecond 62 | millisecond (Time _ _ _ ms) = ms 63 | 64 | -- | Alters the millisecond component of a time value. 65 | setMillisecond :: Millisecond -> Time -> Time 66 | setMillisecond ms (Time h m s _) = Time h m s ms 67 | 68 | -- | Adjusts a time value with a duration offset. The result includes a 69 | -- | remainder value of the whole number of days involved in the adjustment, 70 | -- | for example, if a time of 23:00:00:00 has a duration of +2 hours added to 71 | -- | it, the result will be 1 day, and 01:00:00:00. Correspondingly, if the 72 | -- | duration is negative, a negative number of days may also be returned as 73 | -- | the remainder. 74 | adjust :: forall d. Duration d => d -> Time -> Tuple Days Time 75 | adjust d t = 76 | let 77 | d' = fromDuration d 78 | tLength = timeToMillis t 79 | dayLength = 86400000.0 80 | wholeDays = Days $ Number.floor (unwrap d' / dayLength) 81 | msAdjust = d' <> negateDuration (fromDuration wholeDays) 82 | msAdjusted = tLength <> msAdjust 83 | wrap = if msAdjusted > maxTime then 1.0 else if msAdjusted < minTime then -1.0 else 0.0 84 | in 85 | Tuple 86 | (wholeDays <> Days wrap) 87 | (millisToTime (msAdjusted <> Milliseconds (dayLength * -wrap))) 88 | 89 | maxTime :: Milliseconds 90 | maxTime = timeToMillis top 91 | 92 | minTime :: Milliseconds 93 | minTime = timeToMillis bottom 94 | 95 | timeToMillis :: Time -> Milliseconds 96 | timeToMillis t = Milliseconds 97 | $ 3600000.0 * Int.toNumber (fromEnum (hour t)) 98 | + 60000.0 * Int.toNumber (fromEnum (minute t)) 99 | + 1000.0 * Int.toNumber (fromEnum (second t)) 100 | + Int.toNumber (fromEnum (millisecond t)) 101 | 102 | millisToTime :: Milliseconds -> Time 103 | millisToTime (Milliseconds ms') = 104 | let 105 | hourLength = 3600000.0 106 | minuteLength = 60000.0 107 | secondLength = 1000.0 108 | hours = Number.floor (ms' / hourLength) 109 | minutes = Number.floor ((ms' - hours * hourLength) / minuteLength) 110 | seconds = Number.floor ((ms' - (hours * hourLength + minutes * minuteLength)) / secondLength) 111 | milliseconds = ms' - (hours * hourLength + minutes * minuteLength + seconds * secondLength) 112 | in 113 | unsafePartial fromJust $ 114 | Time 115 | <$> toEnum (Int.floor hours) 116 | <*> toEnum (Int.floor minutes) 117 | <*> toEnum (Int.floor seconds) 118 | <*> toEnum (Int.floor milliseconds) 119 | 120 | -- | Calculates the difference between two times, returning the result as a 121 | -- | duration. 122 | diff :: forall d. Duration d => Time -> Time -> d 123 | diff t1 t2 = toDuration (timeToMillis t1 <> negateDuration (timeToMillis t2)) 124 | -------------------------------------------------------------------------------- /src/Data/Time/Component.purs: -------------------------------------------------------------------------------- 1 | module Data.Time.Component 2 | ( Hour 3 | , Minute 4 | , Second 5 | , Millisecond 6 | ) where 7 | 8 | import Prelude 9 | 10 | import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) 11 | import Data.Maybe (Maybe(..)) 12 | 13 | -- | An hour component for a time value. 14 | -- | 15 | -- | The constructor is private as values for the type are restricted to the 16 | -- | range 0 to 23, inclusive. The `toEnum` function can be used to safely 17 | -- | acquire an `Hour` value from an integer. Correspondingly, an `Hour` can be 18 | -- | lowered to a plain integer with the `fromEnum` function. 19 | newtype Hour = Hour Int 20 | 21 | derive newtype instance eqHour :: Eq Hour 22 | derive newtype instance ordHour :: Ord Hour 23 | 24 | instance boundedHour :: Bounded Hour where 25 | bottom = Hour 0 26 | top = Hour 23 27 | 28 | instance enumHour :: Enum Hour where 29 | succ = toEnum <<< (_ + 1) <<< fromEnum 30 | pred = toEnum <<< (_ - 1) <<< fromEnum 31 | 32 | instance boundedEnumHour :: BoundedEnum Hour where 33 | cardinality = Cardinality 24 34 | toEnum n 35 | | n >= 0 && n <= 23 = Just (Hour n) 36 | | otherwise = Nothing 37 | fromEnum (Hour n) = n 38 | 39 | instance showHour :: Show Hour where 40 | show (Hour h) = "(Hour " <> show h <> ")" 41 | 42 | -- | An minute component for a time value. 43 | -- | 44 | -- | The constructor is private as values for the type are restricted to the 45 | -- | range 0 to 59, inclusive. The `toEnum` function can be used to safely 46 | -- | acquire an `Minute` value from an integer. Correspondingly, a `Minute` can 47 | -- | be lowered to a plain integer with the `fromEnum` function. 48 | newtype Minute = Minute Int 49 | 50 | derive newtype instance eqMinute :: Eq Minute 51 | derive newtype instance ordMinute :: Ord Minute 52 | 53 | instance boundedMinute :: Bounded Minute where 54 | bottom = Minute 0 55 | top = Minute 59 56 | 57 | instance enumMinute :: Enum Minute where 58 | succ = toEnum <<< (_ + 1) <<< fromEnum 59 | pred = toEnum <<< (_ - 1) <<< fromEnum 60 | 61 | instance boundedEnumMinute :: BoundedEnum Minute where 62 | cardinality = Cardinality 60 63 | toEnum n 64 | | n >= 0 && n <= 59 = Just (Minute n) 65 | | otherwise = Nothing 66 | fromEnum (Minute n) = n 67 | 68 | instance showMinute :: Show Minute where 69 | show (Minute m) = "(Minute " <> show m <> ")" 70 | 71 | -- | An second component for a time value. 72 | -- | 73 | -- | The constructor is private as values for the type are restricted to the 74 | -- | range 0 to 59, inclusive. The `toEnum` function can be used to safely 75 | -- | acquire an `Second` value from an integer. Correspondingly, a `Second` can 76 | -- | be lowered to a plain integer with the `fromEnum` function. 77 | newtype Second = Second Int 78 | 79 | derive newtype instance eqSecond :: Eq Second 80 | derive newtype instance ordSecond :: Ord Second 81 | 82 | instance boundedSecond :: Bounded Second where 83 | bottom = Second 0 84 | top = Second 59 85 | 86 | instance enumSecond :: Enum Second where 87 | succ = toEnum <<< (_ + 1) <<< fromEnum 88 | pred = toEnum <<< (_ - 1) <<< fromEnum 89 | 90 | instance boundedEnumSecond :: BoundedEnum Second where 91 | cardinality = Cardinality 60 92 | toEnum n 93 | | n >= 0 && n <= 59 = Just (Second n) 94 | | otherwise = Nothing 95 | fromEnum (Second n) = n 96 | 97 | instance showSecond :: Show Second where 98 | show (Second m) = "(Second " <> show m <> ")" 99 | 100 | -- | An millisecond component for a time value. 101 | -- | 102 | -- | The constructor is private as values for the type are restricted to the 103 | -- | range 0 to 999, inclusive. The `toEnum` function can be used to safely 104 | -- | acquire an `Millisecond` value from an integer. Correspondingly, a 105 | -- | `Millisecond` can be lowered to a plain integer with the `fromEnum` 106 | -- | function. 107 | newtype Millisecond = Millisecond Int 108 | 109 | derive newtype instance eqMillisecond :: Eq Millisecond 110 | derive newtype instance ordMillisecond :: Ord Millisecond 111 | 112 | instance boundedMillisecond :: Bounded Millisecond where 113 | bottom = Millisecond 0 114 | top = Millisecond 999 115 | 116 | instance enumMillisecond :: Enum Millisecond where 117 | succ = toEnum <<< (_ + 1) <<< fromEnum 118 | pred = toEnum <<< (_ - 1) <<< fromEnum 119 | 120 | instance boundedEnumMillisecond :: BoundedEnum Millisecond where 121 | cardinality = Cardinality 1000 122 | toEnum n 123 | | n >= 0 && n <= 999 = Just (Millisecond n) 124 | | otherwise = Nothing 125 | fromEnum (Millisecond n) = n 126 | 127 | instance showMillisecond :: Show Millisecond where 128 | show (Millisecond m) = "(Millisecond " <> show m <> ")" 129 | -------------------------------------------------------------------------------- /src/Data/Time/Component/Gen.purs: -------------------------------------------------------------------------------- 1 | module Data.Time.Component.Gen where 2 | 3 | import Control.Monad.Gen (class MonadGen) 4 | import Data.Enum.Gen (genBoundedEnum) 5 | import Data.Time.Component (Hour, Millisecond, Minute, Second) 6 | 7 | -- | Generates a random `Hour` component. 8 | genHour :: forall m. MonadGen m => m Hour 9 | genHour = genBoundedEnum 10 | 11 | -- | Generates a random `Minute` component. 12 | genMinute :: forall m. MonadGen m => m Minute 13 | genMinute = genBoundedEnum 14 | 15 | -- | Generates a random `Second` component. 16 | genSecond :: forall m. MonadGen m => m Second 17 | genSecond = genBoundedEnum 18 | 19 | -- | Generates a random `Millisecond` component. 20 | genMillisecond :: forall m. MonadGen m => m Millisecond 21 | genMillisecond = genBoundedEnum 22 | -------------------------------------------------------------------------------- /src/Data/Time/Duration.purs: -------------------------------------------------------------------------------- 1 | module Data.Time.Duration where 2 | 3 | import Prelude 4 | 5 | import Data.Newtype (class Newtype, over) 6 | 7 | -- | A duration measured in milliseconds. 8 | newtype Milliseconds = Milliseconds Number 9 | 10 | derive instance newtypeMilliseconds :: Newtype Milliseconds _ 11 | derive newtype instance eqMilliseconds :: Eq Milliseconds 12 | derive newtype instance ordMilliseconds :: Ord Milliseconds 13 | 14 | instance semigroupMilliseconds :: Semigroup Milliseconds where 15 | append (Milliseconds x) (Milliseconds y) = Milliseconds (x + y) 16 | 17 | instance monoidMilliseconds :: Monoid Milliseconds where 18 | mempty = Milliseconds 0.0 19 | 20 | instance showMilliseconds :: Show Milliseconds where 21 | show (Milliseconds n) = "(Milliseconds " <> show n <> ")" 22 | 23 | -- | A duration measured in seconds. 24 | newtype Seconds = Seconds Number 25 | 26 | derive instance newtypeSeconds :: Newtype Seconds _ 27 | derive newtype instance eqSeconds :: Eq Seconds 28 | derive newtype instance ordSeconds :: Ord Seconds 29 | 30 | instance semigroupSeconds :: Semigroup Seconds where 31 | append (Seconds x) (Seconds y) = Seconds (x + y) 32 | 33 | instance monoidSeconds :: Monoid Seconds where 34 | mempty = Seconds 0.0 35 | 36 | instance showSeconds :: Show Seconds where 37 | show (Seconds n) = "(Seconds " <> show n <> ")" 38 | 39 | -- | A duration measured in minutes. 40 | newtype Minutes = Minutes Number 41 | 42 | derive instance newtypeMinutes :: Newtype Minutes _ 43 | derive newtype instance eqMinutes :: Eq Minutes 44 | derive newtype instance ordMinutes :: Ord Minutes 45 | 46 | instance semigroupMinutes :: Semigroup Minutes where 47 | append (Minutes x) (Minutes y) = Minutes (x + y) 48 | 49 | instance monoidMinutes :: Monoid Minutes where 50 | mempty = Minutes 0.0 51 | 52 | instance showMinutes :: Show Minutes where 53 | show (Minutes n) = "(Minutes " <> show n <> ")" 54 | 55 | -- | A duration measured in hours. 56 | newtype Hours = Hours Number 57 | 58 | derive instance newtypeHours :: Newtype Hours _ 59 | derive newtype instance eqHours :: Eq Hours 60 | derive newtype instance ordHours :: Ord Hours 61 | 62 | instance semigroupHours :: Semigroup Hours where 63 | append (Hours x) (Hours y) = Hours (x + y) 64 | 65 | instance monoidHours :: Monoid Hours where 66 | mempty = Hours 0.0 67 | 68 | instance showHours :: Show Hours where 69 | show (Hours n) = "(Hours " <> show n <> ")" 70 | 71 | -- | A duration measured in days, where a day is assumed to be exactly 24 hours. 72 | newtype Days = Days Number 73 | 74 | derive instance newtypeDays :: Newtype Days _ 75 | derive newtype instance eqDays :: Eq Days 76 | derive newtype instance ordDays :: Ord Days 77 | 78 | instance semigroupDays :: Semigroup Days where 79 | append (Days x) (Days y) = Days (x + y) 80 | 81 | instance monoidDays :: Monoid Days where 82 | mempty = Days 0.0 83 | 84 | instance showDays :: Show Days where 85 | show (Days n) = "(Days " <> show n <> ")" 86 | 87 | -- | A class for enabling conversions between duration types. 88 | class Duration a where 89 | fromDuration :: a -> Milliseconds 90 | toDuration :: Milliseconds -> a 91 | 92 | -- | Converts directly between durations of differing types. 93 | convertDuration :: forall a b. Duration a => Duration b => a -> b 94 | convertDuration = toDuration <<< fromDuration 95 | 96 | -- | Negates a duration, turning a positive duration negative or a negative 97 | -- | duration positive. 98 | negateDuration :: forall a. Duration a => a -> a 99 | negateDuration = toDuration <<< over Milliseconds negate <<< fromDuration 100 | 101 | instance durationMilliseconds :: Duration Milliseconds where 102 | fromDuration = identity 103 | toDuration = identity 104 | 105 | instance durationSeconds :: Duration Seconds where 106 | fromDuration = over Seconds (_ * 1000.0) 107 | toDuration = over Milliseconds (_ / 1000.0) 108 | 109 | instance durationMinutes :: Duration Minutes where 110 | fromDuration = over Minutes (_ * 60000.0) 111 | toDuration = over Milliseconds (_ / 60000.0) 112 | 113 | instance durationHours :: Duration Hours where 114 | fromDuration = over Hours (_ * 3600000.0) 115 | toDuration = over Milliseconds (_ / 3600000.0) 116 | 117 | instance durationDays :: Duration Days where 118 | fromDuration = over Days (_ * 86400000.0) 119 | toDuration = over Milliseconds (_ / 86400000.0) 120 | -------------------------------------------------------------------------------- /src/Data/Time/Duration/Gen.purs: -------------------------------------------------------------------------------- 1 | module Data.Time.Duration.Gen where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Gen (class MonadGen) 6 | import Control.Monad.Gen as Gen 7 | import Data.Time.Duration (Days(..), Hours(..), Milliseconds(..), Minutes(..), Seconds(..)) 8 | 9 | -- | Generates a random `Milliseconds` duration, up to 10 minutes. 10 | genMilliseconds :: forall m. MonadGen m => m Milliseconds 11 | genMilliseconds = Milliseconds <$> Gen.chooseFloat 0.0 600000.0 12 | 13 | -- | Generates a random `Seconds` duration, up to 10 minutes. 14 | genSeconds :: forall m. MonadGen m => m Seconds 15 | genSeconds = Seconds <$> Gen.chooseFloat 0.0 600.0 16 | 17 | -- | Generates a random `Seconds` duration, up to 10 hours. 18 | genMinutes :: forall m. MonadGen m => m Minutes 19 | genMinutes = Minutes <$> Gen.chooseFloat 0.0 600.0 20 | 21 | -- | Generates a random `Hours` duration, up to 10 days. 22 | genHours :: forall m. MonadGen m => m Hours 23 | genHours = Hours <$> Gen.chooseFloat 0.0 240.0 24 | 25 | -- | Generates a random `Days` duration, up to 6 weeks. 26 | genDays :: forall m. MonadGen m => m Days 27 | genDays = Days <$> Gen.chooseFloat 0.0 42.0 28 | -------------------------------------------------------------------------------- /src/Data/Time/Gen.purs: -------------------------------------------------------------------------------- 1 | module Data.Time.Gen 2 | ( genTime 3 | , module Data.Time.Component.Gen 4 | ) where 5 | 6 | import Prelude 7 | import Control.Monad.Gen (class MonadGen) 8 | import Data.Time (Time(..)) 9 | import Data.Time.Component.Gen (genHour, genMillisecond, genMinute, genSecond) 10 | 11 | -- | Generates a random `Time` between 00:00:00 and 23:59:59, inclusive. 12 | genTime :: forall m. MonadGen m => m Time 13 | genTime = Time <$> genHour <*> genMinute <*> genSecond <*> genMillisecond 14 | -------------------------------------------------------------------------------- /test/Test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Console (log) 7 | import Data.Array as Array 8 | import Data.Date as Date 9 | import Data.DateTime as DateTime 10 | import Data.DateTime.Instant as Instant 11 | import Data.Either (Either(..), isRight) 12 | import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred) 13 | import Data.Interval as Interval 14 | import Data.Interval.Duration.Iso as IsoDuration 15 | import Data.Maybe (Maybe(..), fromJust) 16 | import Data.Newtype (over, unwrap) 17 | import Data.Number (floor) 18 | import Data.Time as Time 19 | import Data.Time.Duration as Duration 20 | import Data.Tuple (Tuple(..), snd) 21 | import Partial.Unsafe (unsafePartial) 22 | import Test.Assert (assert) 23 | import Type.Proxy (Proxy(..)) 24 | 25 | main :: Effect Unit 26 | main = do 27 | log "check Duration monoid" 28 | assert $ Interval.year 1.0 == mempty <> Interval.year 2.0 <> Interval.year 1.0 <> Interval.year (-2.0) 29 | assert $ Interval.second 0.5 == Interval.millisecond 500.0 30 | assert $ IsoDuration.mkIsoDuration (Interval.week 1.2 <> Interval.week 1.2) 31 | == IsoDuration.mkIsoDuration (Interval.week 2.4) 32 | assert $ isRight $ IsoDuration.mkIsoDuration (Interval.day 1.2 <> mempty) 33 | assert $ isRight $ IsoDuration.mkIsoDuration (Interval.day 1.2 <> Interval.second 0.0) 34 | assert $ isRight $ IsoDuration.mkIsoDuration (Interval.year 2.0 <> Interval.day 1.0) 35 | assert $ IsoDuration.mkIsoDuration (Interval.year 2.5 <> Interval.day 1.0) 36 | == Left (pure (IsoDuration.InvalidFractionalUse Interval.Year)) 37 | log $ show $ IsoDuration.mkIsoDuration (Interval.year 2.5 <> Interval.week 1.0) 38 | == Left (pure IsoDuration.InvalidWeekComponentUsage <> pure (IsoDuration.InvalidFractionalUse Interval.Year)) 39 | assert $ IsoDuration.mkIsoDuration (Interval.year 2.0 <> Interval.day (-1.0)) 40 | == Left (pure (IsoDuration.ContainsNegativeValue Interval.Day)) 41 | assert $ IsoDuration.mkIsoDuration (mempty) 42 | == Left (pure IsoDuration.IsEmpty) 43 | 44 | let epochDate = unsafePartial fromJust $ Date.canonicalDate 45 | <$> toEnum 1 46 | <*> pure bottom 47 | <*> pure bottom 48 | let epochDateTime = DateTime.DateTime epochDate bottom 49 | let epochMillis = -62135596800000.0 50 | -- time -------------------------------------------------------------------- 51 | 52 | log "Check that Hour is a good BoundedEnum" 53 | checkBoundedEnum (Proxy :: Proxy Time.Hour) 54 | 55 | log "Check that Minute is a good BoundedEnum" 56 | checkBoundedEnum (Proxy :: Proxy Time.Minute) 57 | 58 | log "Check that Second is a good BoundedEnum" 59 | checkBoundedEnum (Proxy :: Proxy Time.Second) 60 | 61 | log "Check that Millisecond is a good BoundedEnum" 62 | checkBoundedEnum (Proxy :: Proxy Time.Millisecond) 63 | 64 | log "Check that Time is a good Bounded" 65 | checkBounded (Proxy :: Proxy Time.Time) 66 | 67 | let t1 = unsafePartial $ fromJust $ Time.Time <$> toEnum 17 <*> toEnum 42 <*> toEnum 16 <*> toEnum 362 68 | let t2 = unsafePartial $ fromJust $ Time.Time <$> toEnum 18 <*> toEnum 22 <*> toEnum 16 <*> toEnum 362 69 | let t3 = unsafePartial $ fromJust $ Time.Time <$> toEnum 17 <*> toEnum 2 <*> toEnum 16 <*> toEnum 362 70 | let t4 = unsafePartial $ fromJust $ Time.Time <$> toEnum 23 <*> toEnum 0 <*> toEnum 0 <*> toEnum 0 71 | let t5 = unsafePartial $ fromJust $ Time.Time <$> toEnum 1 <*> toEnum 0 <*> toEnum 0 <*> toEnum 0 72 | 73 | log "Check that adjust behaves as expected" 74 | assert $ Time.adjust (Duration.Milliseconds 1.0) top == Tuple (Duration.Days 1.0) bottom 75 | assert $ Time.adjust (Duration.Milliseconds (-1.0)) bottom == Tuple (Duration.Days (-1.0)) top 76 | assert $ Time.adjust (Duration.Minutes 40.0) t1 == Tuple (Duration.Days 0.0) t2 77 | assert $ Time.adjust (Duration.Days 40.0) t1 == Tuple (Duration.Days 40.0) t1 78 | assert $ Time.adjust (Duration.fromDuration (Duration.Days 2.0) <> Duration.fromDuration (Duration.Minutes 40.0)) t1 == Tuple (Duration.Days 2.0) t2 79 | assert $ Time.adjust (Duration.fromDuration (Duration.Days 2.0) <> Duration.fromDuration (Duration.Minutes (-40.0))) t1 == Tuple (Duration.Days 2.0) t3 80 | assert $ snd (Time.adjust (Duration.fromDuration (Duration.Days 3.872)) t1) == snd (Time.adjust (Duration.fromDuration (Duration.Days 0.872)) t1) 81 | assert $ Time.adjust (Duration.Hours 2.0) t4 == Tuple (Duration.Days 1.0) t5 82 | 83 | log "Check that diff behaves as expected" 84 | assert $ Time.diff t2 t1 == Duration.Minutes 40.0 85 | assert $ Time.diff t1 t2 == Duration.Minutes (-40.0) 86 | assert $ Time.diff t4 t5 == Duration.Hours 22.0 87 | 88 | -- date -------------------------------------------------------------------- 89 | 90 | log "Check that Year is a good BoundedEnum" 91 | checkBoundedEnum (Proxy :: Proxy Date.Year) 92 | 93 | log "Check that Month is a good BoundedEnum" 94 | checkBoundedEnum (Proxy :: Proxy Date.Month) 95 | 96 | log "Check that Day is a good BoundedEnum" 97 | checkBoundedEnum (Proxy :: Proxy Date.Day) 98 | 99 | log "Check that Date is a good Bounded" 100 | checkBounded (Proxy :: Proxy Date.Date) 101 | 102 | log "Check that the earliest date is a valid date" 103 | assert $ Just bottom == Date.exactDate bottom bottom bottom 104 | 105 | log "Check that the latest date is a valid date" 106 | assert $ Just top == Date.exactDate top top top 107 | 108 | log "Check that weekday behaves as expected" 109 | assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 6) == Date.Monday 110 | assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 7) == Date.Tuesday 111 | assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 8) == Date.Wednesday 112 | assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 9) == Date.Thursday 113 | assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 10) == Date.Friday 114 | assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 11) == Date.Saturday 115 | assert $ Date.weekday (unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 12) == Date.Sunday 116 | 117 | let d1 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.January <*> toEnum 1 118 | let d2 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.February <*> toEnum 1 119 | let d3 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.March <*> toEnum 1 120 | let d4 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2018 <*> pure Date.September <*> toEnum 26 121 | let d5 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 1988 <*> pure Date.August <*> toEnum 15 122 | 123 | log "Check that diff behaves as expected" 124 | assert $ Date.diff d2 d1 == Duration.Days 31.0 125 | assert $ Date.diff d3 d2 == Duration.Days 29.0 126 | 127 | let unsafeYear = unsafePartial fromJust <<< toEnum 128 | log "Check that isLeapYear behaves as expected" 129 | assert $ not $ Date.isLeapYear (unsafeYear 2017) 130 | assert $ Date.isLeapYear (unsafeYear 2016) 131 | 132 | log "Check that epoch is correctly constructed" 133 | assert $ Just (Date.year epochDate) == toEnum 1 134 | assert $ Date.month epochDate == bottom 135 | assert $ Date.day epochDate == bottom 136 | 137 | log "Check that adjust behaves as expected" 138 | assert $ Date.adjust (Duration.Days 31.0) d1 == Just d2 139 | assert $ Date.adjust (Duration.Days 999.0) d1 == Just d4 140 | assert $ Date.adjust (Duration.Days 10000.0) d5 == Just d1 141 | assert $ Date.adjust (Duration.Days (-31.0)) d2 == Just d1 142 | assert $ Date.adjust (Duration.Days (- 999.0)) d4 == Just d1 143 | assert $ Date.adjust (Duration.Days (-10000.0)) d1 == Just d5 144 | 145 | -- datetime ---------------------------------------------------------------- 146 | 147 | let dt1 = DateTime.DateTime d1 t1 148 | let dt2 = DateTime.DateTime d1 t2 149 | let dt3 = DateTime.DateTime d2 t1 150 | let dt4 = DateTime.DateTime d2 t2 151 | let dt5 = DateTime.DateTime d3 t1 152 | 153 | log "Check that adjust behaves as expected" 154 | assert $ DateTime.adjust (Duration.fromDuration (Duration.Days 31.0) <> Duration.fromDuration (Duration.Minutes 40.0)) dt1 == Just dt4 155 | assert $ (Date.year <<< DateTime.date <$> 156 | (DateTime.adjust (Duration.Days 735963.0) epochDateTime)) 157 | == toEnum 2016 158 | 159 | log "Check that diff behaves as expected" 160 | assert $ DateTime.diff dt2 dt1 == Duration.Minutes 40.0 161 | assert $ DateTime.diff dt1 dt2 == Duration.Minutes (-40.0) 162 | assert $ DateTime.diff dt3 dt1 == Duration.Days 31.0 163 | assert $ DateTime.diff dt5 dt3 == Duration.Days 29.0 164 | assert $ DateTime.diff dt1 dt3 == Duration.Days (-31.0) 165 | assert $ DateTime.diff dt4 dt1 == Duration.fromDuration (Duration.Days 31.0) <> Duration.fromDuration (Duration.Minutes 40.0) 166 | assert $ over Duration.Days floor (DateTime.diff dt1 epochDateTime) == Duration.Days 735963.0 167 | 168 | -- instant ----------------------------------------------------------------- 169 | 170 | let i1 = Instant.fromDateTime dt1 171 | let i2 = Instant.fromDateTime dt2 172 | let i3 = Instant.fromDateTime dt3 173 | let i4 = Instant.fromDateTime dt4 174 | let i5 = Instant.fromDateTime dt5 175 | 176 | log "Check that the earliest date is a valid Instant" 177 | let bottomInstant = Instant.fromDateTime bottom 178 | assert $ Just bottomInstant == Instant.instant (Instant.unInstant bottomInstant) 179 | 180 | log "Check that the latest date is a valid Instant" 181 | let topInstant = Instant.fromDateTime top 182 | assert $ Just topInstant == Instant.instant (Instant.unInstant topInstant) 183 | 184 | log "Check that an Instant can be constructed from epoch" 185 | assert $ (Instant.unInstant $ Instant.fromDateTime epochDateTime) == Duration.Milliseconds epochMillis 186 | 187 | log "Check that instant/datetime conversion is bijective" 188 | assert $ Instant.toDateTime (Instant.fromDateTime bottom) == bottom 189 | assert $ Instant.toDateTime (Instant.fromDateTime top) == top 190 | assert $ Instant.toDateTime i1 == dt1 191 | assert $ Instant.toDateTime i2 == dt2 192 | assert $ Instant.toDateTime i3 == dt3 193 | assert $ Instant.toDateTime i4 == dt4 194 | assert $ Instant.toDateTime i5 == dt5 195 | 196 | log "Check that diff behaves as expected" 197 | assert $ Instant.diff i2 i1 == Duration.Minutes 40.0 198 | assert $ Instant.diff i1 i2 == Duration.Minutes (-40.0) 199 | assert $ Instant.diff i3 i1 == Duration.Days 31.0 200 | assert $ Instant.diff i5 i3 == Duration.Days 29.0 201 | assert $ Instant.diff i1 i3 == Duration.Days (-31.0) 202 | assert $ Instant.diff i4 i1 == Duration.fromDuration (Duration.Days 31.0) <> Duration.fromDuration (Duration.Minutes 40.0) 203 | 204 | log "All tests done" 205 | 206 | checkBounded :: forall e. Bounded e => Proxy e -> Effect Unit 207 | checkBounded _ = do 208 | assert $ Just (bottom :: Time.Hour) == toEnum (fromEnum (bottom :: Time.Hour)) 209 | assert $ pred (bottom :: Time.Hour) == Nothing 210 | assert $ Just (top :: Time.Hour) == toEnum (fromEnum (top :: Time.Hour)) 211 | assert $ succ (top :: Time.Hour) == Nothing 212 | 213 | checkBoundedEnum :: forall e. BoundedEnum e => Proxy e -> Effect Unit 214 | checkBoundedEnum p = do 215 | checkBounded p 216 | let card = unwrap (cardinality :: Cardinality e) 217 | assert $ Array.length (enumFromTo bottom (top :: e)) == card 218 | --------------------------------------------------------------------------------