From 0e5807f229a0a3efbbc32814514ee73d4cd6e433 Mon Sep 17 00:00:00 2001 From: Matt Parsons Date: Tue, 5 Apr 2016 11:17:18 -0400 Subject: [PATCH 01/54] Add function for printing as ISO 8601 string * Add iso8601 function * more consistent name * Export function --- src/Data/Date.purs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index 6711739..5174555 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -16,6 +16,7 @@ module Data.Date , Month(..) , DayOfMonth(..) , DayOfWeek(..) + , toISOString ) where import Prelude @@ -98,6 +99,10 @@ newtype LocaleOffset = LocaleOffset Minutes timezoneOffset :: Date -> LocaleOffset timezoneOffset (DateTime d) = runFn2 jsDateMethod "getTimezoneOffset" d +-- | Renders a Date as an ISO 8601 string. +toISOString :: Date -> String +toISOString (DateTime d) = runFn2 jsDateMethod "toISOString" d + -- | A year date component value. newtype Year = Year Int From 96c2bc8367bd10a331cd75bea7971179e5948337 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 9 Jun 2016 19:15:33 +0100 Subject: [PATCH 02/54] Date/time overhaul (#34) --- .jscsrc | 5 + .jshintrc | 4 +- .travis.yml | 17 +- README.md | 9 +- bower.json | 20 +- docs/Data/Date.md | 216 ------------------- docs/Data/Date/Locale.md | 131 ------------ docs/Data/Date/UTC.md | 85 -------- docs/Data/Time.md | 177 ---------------- package.json | 14 +- src/Data/Date.js | 35 +--- src/Data/Date.purs | 366 +++++++-------------------------- src/Data/Date/Component.purs | 200 ++++++++++++++++++ src/Data/Date/Locale.js | 18 -- src/Data/Date/Locale.purs | 107 ---------- src/Data/Date/UTC.js | 14 -- src/Data/Date/UTC.purs | 71 ------- src/Data/DateTime.js | 27 +++ src/Data/DateTime.purs | 85 ++++++++ src/Data/DateTime/Instant.js | 15 ++ src/Data/DateTime/Instant.purs | 77 +++++++ src/Data/DateTime/Locale.purs | 63 ++++++ src/Data/Time.purs | 343 +++++++++++------------------- src/Data/Time/Component.purs | 133 ++++++++++++ src/Data/Time/Duration.purs | 144 +++++++++++++ test/Test/Main.purs | 148 +++++++++++++ 26 files changed, 1137 insertions(+), 1387 deletions(-) delete mode 100644 docs/Data/Date.md delete mode 100644 docs/Data/Date/Locale.md delete mode 100644 docs/Data/Date/UTC.md delete mode 100644 docs/Data/Time.md create mode 100644 src/Data/Date/Component.purs delete mode 100644 src/Data/Date/Locale.js delete mode 100644 src/Data/Date/Locale.purs delete mode 100644 src/Data/Date/UTC.js delete mode 100644 src/Data/Date/UTC.purs create mode 100644 src/Data/DateTime.js create mode 100644 src/Data/DateTime.purs create mode 100644 src/Data/DateTime/Instant.js create mode 100644 src/Data/DateTime/Instant.purs create mode 100644 src/Data/DateTime/Locale.purs create mode 100644 src/Data/Time/Component.purs create mode 100644 src/Data/Time/Duration.purs create mode 100644 test/Test/Main.purs diff --git a/.jscsrc b/.jscsrc index 342da66..2561ce9 100644 --- a/.jscsrc +++ b/.jscsrc @@ -1,5 +1,10 @@ { "preset": "grunt", + "disallowSpacesInFunctionExpression": null, + "requireSpacesInFunctionExpression": { + "beforeOpeningRoundBrace": true, + "beforeOpeningCurlyBrace": true + }, "disallowSpacesInAnonymousFunctionExpression": null, "requireSpacesInAnonymousFunctionExpression": { "beforeOpeningRoundBrace": true, diff --git a/.jshintrc b/.jshintrc index 2240be2..81e6de7 100644 --- a/.jshintrc +++ b/.jshintrc @@ -7,7 +7,6 @@ "futurehostile": true, "strict": "global", "latedef": true, - "maxparams": 1, "noarg": true, "nocomma": true, "nonew": true, @@ -15,5 +14,6 @@ "singleGroups": true, "undef": true, "unused": true, - "eqnull": true + "eqnull": true, + "predef": ["exports"] } diff --git a/.travis.yml b/.travis.yml index 791313a..a79fb8b 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,7 @@ language: node_js -sudo: false -node_js: - - 0.10 +dist: trusty +sudo: required +node_js: 6 env: - PATH=$HOME/purescript:$PATH install: @@ -9,6 +9,15 @@ install: - 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 -g bower - npm install script: - - npm run build + - bower install --production + - npm run -s build + - bower install + - npm test +after_success: +- >- + test $TRAVIS_TAG && + echo $GITHUB_TOKEN | pulp login && + echo y | pulp publish --no-push diff --git a/README.md b/README.md index 4e9f7ea..b258a75 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ [![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) -Date and time functions and values. +Date and time types and functions. ## Installation @@ -12,9 +12,6 @@ Date and time functions and values. bower install purescript-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) +Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-datetime). diff --git a/bower.json b/bower.json index 499acf0..fc16fc9 100644 --- a/bower.json +++ b/bower.json @@ -1,15 +1,7 @@ { "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", "repository": { "type": "git", @@ -24,8 +16,14 @@ "package.json" ], "dependencies": { - "purescript-enums": "^0.7.0", - "purescript-functions": "^0.1.0", - "purescript-globals": "^0.2.0" + "purescript-enums": "^1.0.0", + "purescript-functions": "^1.0.0", + "purescript-generics": "^1.0.0", + "purescript-integers": "^1.0.0", + "purescript-math": "^2.0.0" + }, + "devDependencies": { + "purescript-assert": "^1.0.0", + "purescript-console": "^1.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..44534d6 100644 --- a/package.json +++ b/package.json @@ -1,13 +1,15 @@ { "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": "jshint src && jscs 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" + "jscs": "^2.8.0", + "jshint": "^2.9.1", + "pulp": "^9.0.0", + "purescript-psa": "^0.3.8", + "rimraf": "^2.5.0" } } diff --git a/src/Data/Date.js b/src/Data/Date.js index 88be134..e666221 100644 --- a/src/Data/Date.js +++ b/src/Data/Date.js @@ -1,33 +1,16 @@ -/* global exports */ "use strict"; -// module Data.Date - -exports.nowEpochMilliseconds = function () { - return Date.now(); -}; - -exports.nowImpl = function (ctor) { - return function () { - return ctor(new Date()); - }; -}; - -exports.jsDateConstructor = function (x) { - return new Date(x); +exports.canonicalDateImpl = function (ctor, y, m, d) { + var date = new Date(Date.UTC(y, m - 1, d)); + return ctor(date.getUTCFullYear())(date.getUTCMonth() + 1)(date.getUTCDate()); }; -// jshint maxparams: 2 -exports.jsDateMethod = function (method, date) { - return date[method](); +exports.calcWeekday = function (y, m, d) { + return new Date(Date.UTC(y, m - 1, d)).getUTCDay(); }; -// 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); +exports.calcDiff = function (y1, m1, d1, y2, m2, d2) { + var dt1 = new Date(Date.UTC(y1, m1, d1)); + var dt2 = new Date(Date.UTC(y2, m2, d2)); + return dt1.getTime() - dt2.getTime(); }; diff --git a/src/Data/Date.purs b/src/Data/Date.purs index 5174555..1a74cc0 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -1,298 +1,82 @@ module Data.Date - ( JSDate() - , Date() - , fromJSDate - , toJSDate - , fromEpochMilliseconds - , toEpochMilliseconds - , fromString - , fromStringStrict - , Now() - , now - , nowEpochMilliseconds - , LocaleOffset(..) - , timezoneOffset - , Year(..) - , Month(..) - , DayOfMonth(..) - , DayOfWeek(..) - , toISOString + ( Date + , canonicalDate + , exactDate + , year + , month + , day + , weekday + , diff + , 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 (toEnum, fromEnum) +import Data.Function.Uncurried (Fn3, runFn3, Fn4, runFn4, Fn6, runFn6) +import Data.Generic (class Generic) +import Data.Maybe (Maybe(..), fromJust) +import Data.Time.Duration (class Duration, toDuration, Milliseconds) + +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 +derive instance genericDate :: Generic 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 - --- | Renders a Date as an ISO 8601 string. -toISOString :: Date -> String -toISOString (DateTime d) = runFn2 jsDateMethod "toISOString" 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 <> ")" + +-- | 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) + +-- | 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 + +-- 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..c7feff5 --- /dev/null +++ b/src/Data/Date/Component.purs @@ -0,0 +1,200 @@ +module Data.Date.Component + ( Year + , Month(..) + , Day + , Weekday(..) + ) where + +import Prelude + +import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) +import Data.Generic (class Generic) +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 + +-- | Lowers a year value to a plain number. +unYear :: Year -> Int +unYear (Year y) = y + +derive instance eqYear :: Eq Year +derive instance ordYear :: Ord Year +derive instance genericYear :: Generic 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 >= (-271821) && 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 +derive instance genericMonth :: Generic 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 instance eqDay :: Eq Day +derive instance ordDay :: Ord Day +derive instance genericDay :: Generic 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 +derive instance genericWeekday :: Generic 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/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..2d722a8 --- /dev/null +++ b/src/Data/DateTime.js @@ -0,0 +1,27 @@ +"use strict"; + +exports.calcDiff = function (rec1, rec2) { + var msUTC1 = Date.UTC(rec1.year, rec1.month - 1, rec1.day, rec1.hour, rec1.minute, rec1.second, rec1.millisecond); + var msUTC2 = Date.UTC(rec2.year, rec2.month - 1, rec2.day, rec2.hour, rec2.minute, rec2.second, rec2.millisecond); + return msUTC1 - msUTC2; +}; + +exports.adjustImpl = function (just) { + return function (nothing) { + return function (offset) { + return function (rec) { + var msUTC = Date.UTC(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..eaaac10 --- /dev/null +++ b/src/Data/DateTime.purs @@ -0,0 +1,85 @@ +module Data.DateTime + ( DateTime(..) + , date + , time + , 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.Generic (class Generic) +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 +derive instance genericDateTime :: Generic 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 + +time :: DateTime -> Time +time (DateTime _ t) = 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/Instant.js b/src/Data/DateTime/Instant.js new file mode 100644 index 0000000..0653a15 --- /dev/null +++ b/src/Data/DateTime/Instant.js @@ -0,0 +1,15 @@ +"use strict"; + +exports.fromDateTimeImpl = function (y, mo, d, h, mi, s, ms) { + return new Date(Date.UTC(y, mo - 1, d, h, mi, s, ms)).getTime(); +}; + +exports.toDateTimeImpl = function (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..6a6944d --- /dev/null +++ b/src/Data/DateTime/Instant.purs @@ -0,0 +1,77 @@ +module Data.DateTime.Instant + ( Instant + , instant + , unInstant + , fromDateTime + , toDateTime + ) 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.Generic (class Generic) +import Data.Maybe (Maybe(..), fromJust) +import Data.Time.Duration (Milliseconds(..)) + +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 instance eqDateTime :: Eq Instant +derive instance ordDateTime :: Ord Instant +derive instance genericDateTime :: Generic 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 diff --git a/src/Data/DateTime/Locale.purs b/src/Data/DateTime/Locale.purs new file mode 100644 index 0000000..157d0f3 --- /dev/null +++ b/src/Data/DateTime/Locale.purs @@ -0,0 +1,63 @@ +module Data.DateTime.Locale where + +import Prelude + +import Control.Comonad (class Comonad, class Extend) + +import Data.DateTime (Date, Time, DateTime) +import Data.Generic (class Generic) +import Data.Maybe (Maybe) +import Data.Time.Duration (Minutes) + +-- | A date/time locale specifying an offset in minutes and an optional name for +-- | the locale. +data Locale = Locale (Maybe LocaleName) Minutes + +derive instance eqLocale :: Eq Locale +derive instance ordLocale :: Ord Locale +derive instance genericLocale :: Generic Locale + +instance showLocale :: Show Locale where + show (Locale name offset) = "(Locale " <> show name <> " " <> show offset <> ")" + +-- | The name of a date/time locale. For example: "GMT", "MDT", "CET", etc. +newtype LocaleName = LocaleName String + +derive instance eqLocaleName :: Eq LocaleName +derive instance ordLocaleName :: Ord LocaleName +derive instance genericLocaleName :: Generic LocaleName + +instance showLocaleName :: Show LocaleName where + show (LocaleName name) = "(LocaleName " <> show name <> ")" + +-- | A value that is subject to a `Locale`. +-- | +-- | There are `Functor`, `Extend`, and `Comonad` instances for `LocalValue` to +-- | enable the inner non-localised value to be manipulated while maintaining +-- | the locale. +data LocalValue a = LocalValue Locale a + +derive instance eqLocalValue :: Eq a => Eq (LocalValue a) +derive instance ordLocalValue :: Ord a => Ord (LocalValue a) +derive instance genericLocalValue :: Generic a => Generic (LocalValue a) + +instance showLocalValue :: Show a => Show (LocalValue a) where + show (LocalValue n a) = "(LocalValue " <> show n <> " " <> show a <> ")" + +instance functorLocalValue :: Functor LocalValue where + map f (LocalValue n a) = LocalValue n (f a) + +instance extendLocalValue :: Extend LocalValue where + extend f lv@(LocalValue n _) = LocalValue n (f lv) + +instance comonadLocalValue :: Comonad LocalValue where + extract (LocalValue _ a) = a + +-- | A date value with a locale. +type LocalDate = LocalValue Date + +-- | A time value with a locale. +type LocalTime = LocalValue Time + +-- | A date/time value with a locale. +type LocalDateTime = LocalValue DateTime diff --git a/src/Data/Time.purs b/src/Data/Time.purs index dbc6754..4ed9eaa 100644 --- a/src/Data/Time.purs +++ b/src/Data/Time.purs @@ -1,225 +1,124 @@ -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.Generic (class Generic) +import Data.Int as Int +import Data.Maybe (fromJust) +import Data.Time.Component (Hour, Millisecond, Minute, Second) +import Data.Time.Duration (class Duration, Days(..), Milliseconds(..), unMilliseconds, fromDuration, toDuration) +import Data.Tuple (Tuple(..)) + +import Math as Math + +import Partial.Unsafe (unsafePartial) + +data Time = Time Hour Minute Second Millisecond + +derive instance eqTime :: Eq Time +derive instance ordTime :: Ord Time +derive instance genericTime :: Generic 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 $ Math.floor (unMilliseconds d' / dayLength) + msAdjust = d' - fromDuration wholeDays + msAdjusted = tLength + msAdjust + wrap = if msAdjusted > maxTime then 1.0 else if msAdjusted < -maxTime then -1.0 else 0.0 + in + Tuple + (wholeDays + Days wrap) + (millisToTime (msAdjusted - Milliseconds (dayLength * wrap))) + +maxTime :: Milliseconds +maxTime = timeToMillis top + +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 ms = + let + ms' = unMilliseconds ms + hourLength = 3600000.0 + minuteLength = 60000.0 + secondLength = 1000.0 + hours = Math.floor (ms' / hourLength) + minutes = Math.floor ((ms' - hours * hourLength) / minuteLength) + seconds = Math.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 - timeToMillis t2) diff --git a/src/Data/Time/Component.purs b/src/Data/Time/Component.purs new file mode 100644 index 0000000..2395e78 --- /dev/null +++ b/src/Data/Time/Component.purs @@ -0,0 +1,133 @@ +module Data.Time.Component + ( Hour + , Minute + , Second + , Millisecond + ) where + +import Prelude + +import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) +import Data.Generic (class Generic) +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 instance eqHour :: Eq Hour +derive instance ordHour :: Ord Hour +derive instance genericHour :: Generic 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 instance eqMinute :: Eq Minute +derive instance ordMinute :: Ord Minute +derive instance genericMinute :: Generic 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 instance eqSecond :: Eq Second +derive instance ordSecond :: Ord Second +derive instance genericSecond :: Generic 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 59, 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 instance eqMillisecond :: Eq Millisecond +derive instance ordMillisecond :: Ord Millisecond +derive instance genericMillisecond :: Generic 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/Duration.purs b/src/Data/Time/Duration.purs new file mode 100644 index 0000000..c14cb5c --- /dev/null +++ b/src/Data/Time/Duration.purs @@ -0,0 +1,144 @@ +module Data.Time.Duration where + +import Prelude + +import Data.Generic (class Generic) + +-- | A duration measured in milliseconds. +newtype Milliseconds = Milliseconds Number + +unMilliseconds :: Milliseconds -> Number +unMilliseconds (Milliseconds ms) = ms + +derive instance eqMilliseconds :: Eq Milliseconds +derive instance ordMilliseconds :: Ord Milliseconds +derive instance genericMilliseconds :: Generic Milliseconds + +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 showMilliseconds :: Show Milliseconds where + show (Milliseconds n) = "(Milliseconds " <> show n <> ")" + +-- | A duration measured in seconds. +newtype Seconds = Seconds Number + +unSeconds :: Seconds -> Number +unSeconds (Seconds s) = s + +derive instance eqSeconds :: Eq Seconds +derive instance ordSeconds :: Ord Seconds +derive instance genericSeconds :: Generic Seconds + +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 showSeconds :: Show Seconds where + show (Seconds n) = "(Seconds " <> show n <> ")" + +-- | A duration measured in minutes. +newtype Minutes = Minutes Number + +unMinutes :: Minutes -> Number +unMinutes (Minutes m) = m + +derive instance eqMinutes :: Eq Minutes +derive instance ordMinutes :: Ord Minutes +derive instance genericMinutes :: Generic Minutes + +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 showMinutes :: Show Minutes where + show (Minutes n) = "(Minutes " <> show n <> ")" + +-- | A duration measured in hours. +newtype Hours = Hours Number + +unHours :: Hours -> Number +unHours (Hours m) = m + +derive instance eqHours :: Eq Hours +derive instance ordHours :: Ord Hours +derive instance genericHours :: Generic Hours + +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 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 + +unDays :: Days -> Number +unDays (Days m) = m + +derive instance eqDays :: Eq Days +derive instance ordDays :: Ord Days +derive instance genericDays :: Generic Days + +instance semiringDays :: Semiring Days where + add (Days x) (Days y) = Days (x + y) + mul (Days x) (Days y) = Days (x * y) + zero = Days 0.0 + one = Days 1.0 + +instance ringDays :: Ring Days where + sub (Days x) (Days y) = Days (x - y) + +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 + +instance durationMilliseconds :: Duration Milliseconds where + fromDuration = id + toDuration = id + +instance durationSeconds :: Duration Seconds where + fromDuration = Milliseconds <<< (_ * 1000.0) <<< unSeconds + toDuration (Milliseconds ms) = Seconds (ms / 1000.0) + +instance durationMinutes :: Duration Minutes where + fromDuration = Milliseconds <<< (_ * 60000.0) <<< unMinutes + toDuration (Milliseconds ms) = Minutes (ms / 60000.0) + +instance durationHours :: Duration Hours where + fromDuration = Milliseconds <<< (_ * 3600000.0) <<< unHours + toDuration (Milliseconds ms) = Hours (ms / 3600000.0) + +instance durationDays :: Duration Days where + fromDuration = Milliseconds <<< (_ * 86400000.0) <<< unDays + toDuration (Milliseconds ms) = Days (ms / 86400000.0) diff --git a/test/Test/Main.purs b/test/Test/Main.purs new file mode 100644 index 0000000..b67125a --- /dev/null +++ b/test/Test/Main.purs @@ -0,0 +1,148 @@ +module Test.Main where + +import Prelude + +import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE, log) + +import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, runCardinality, succ, fromEnum, pred) +import Data.Date as Date +import Data.Time as Time +import Data.Time.Duration as Duration +import Data.Array as Array +import Data.DateTime as DateTime +import Data.DateTime.Instant as Instant +import Data.Maybe (Maybe(..), fromJust) +import Data.Tuple (Tuple(..), snd) + +import Type.Proxy (Proxy(..)) +import Test.Assert (ASSERT, assert) +import Partial.Unsafe (unsafePartial) + +type Tests = Eff (console :: CONSOLE, assert :: ASSERT) Unit + +main :: Tests +main = do + + -- 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 zero 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.June <*> toEnum 1 + let d2 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 30 + + log "Check that diff behaves as expected" + assert $ Date.diff d2 d1 == Duration.Days 29.0 + + -- 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 + + log "Check that adjust behaves as expected" + assert $ DateTime.adjust (Duration.fromDuration (Duration.Days 29.0) + Duration.fromDuration (Duration.Minutes 40.0)) dt1 == Just dt4 + + 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 29.0 + assert $ DateTime.diff dt1 dt3 == Duration.Days (-29.0) + assert $ DateTime.diff dt4 dt1 == Duration.fromDuration (Duration.Days 29.0) + Duration.fromDuration (Duration.Minutes 40.0) + + -- instant ----------------------------------------------------------------- + + 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 instant/datetime conversion is bijective" + assert $ Instant.toDateTime (Instant.fromDateTime bottom) == bottom + assert $ Instant.toDateTime (Instant.fromDateTime top) == top + assert $ Instant.toDateTime (Instant.fromDateTime dt1) == dt1 + assert $ Instant.toDateTime (Instant.fromDateTime dt2) == dt2 + assert $ Instant.toDateTime (Instant.fromDateTime dt3) == dt3 + assert $ Instant.toDateTime (Instant.fromDateTime dt4) == dt4 + + log "All tests done" + +checkBounded :: forall e. Bounded e => Proxy e -> Tests +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 -> Tests +checkBoundedEnum p = do + checkBounded p + let card = runCardinality (cardinality :: Cardinality e) + assert $ Array.length (enumFromTo bottom (top :: e)) == card From 69481d3454576ceb7e184ec86cf13f03077cc0de Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Wed, 27 Jul 2016 11:24:53 -0500 Subject: [PATCH 03/54] Fix typo in millisecond documentation (#37) --- src/Data/Time/Component.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Time/Component.purs b/src/Data/Time/Component.purs index 2395e78..879d0a7 100644 --- a/src/Data/Time/Component.purs +++ b/src/Data/Time/Component.purs @@ -104,7 +104,7 @@ instance showSecond :: Show Second where -- | An millisecond 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 +-- | 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. From 1570af638a2ae8907c0ff54aec0542155d6fec06 Mon Sep 17 00:00:00 2001 From: Kirill Pertsev Date: Thu, 4 Aug 2016 12:13:10 -0700 Subject: [PATCH 04/54] Removes private unYear function Function is not used anywhere locally, not exported and is superseded by `fromEnum` --- src/Data/Date/Component.purs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Data/Date/Component.purs b/src/Data/Date/Component.purs index c7feff5..e6bde33 100644 --- a/src/Data/Date/Component.purs +++ b/src/Data/Date/Component.purs @@ -18,10 +18,6 @@ import Data.Maybe (Maybe(..)) -- | acquire a year value from an integer. newtype Year = Year Int --- | Lowers a year value to a plain number. -unYear :: Year -> Int -unYear (Year y) = y - derive instance eqYear :: Eq Year derive instance ordYear :: Ord Year derive instance genericYear :: Generic Year From 3fa686a2cee2981408845cd70e13d2401a730807 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 13 Oct 2016 14:45:27 +0100 Subject: [PATCH 05/54] Prepare for 2.0 release --- bower.json | 12 ++-- src/Data/Date/Component.purs | 8 +-- src/Data/DateTime/Instant.purs | 4 +- src/Data/DateTime/Locale.purs | 6 +- src/Data/Time.purs | 8 +-- src/Data/Time/Component.purs | 16 ++--- src/Data/Time/Duration.purs | 112 ++++++++++----------------------- test/Test/Main.purs | 5 +- 8 files changed, 65 insertions(+), 106 deletions(-) diff --git a/bower.json b/bower.json index fc16fc9..66db52d 100644 --- a/bower.json +++ b/bower.json @@ -16,14 +16,14 @@ "package.json" ], "dependencies": { - "purescript-enums": "^1.0.0", - "purescript-functions": "^1.0.0", - "purescript-generics": "^1.0.0", - "purescript-integers": "^1.0.0", + "purescript-enums": "^2.0.0", + "purescript-functions": "^2.0.0", + "purescript-generics": "^3.0.0", + "purescript-integers": "^2.0.0", "purescript-math": "^2.0.0" }, "devDependencies": { - "purescript-assert": "^1.0.0", - "purescript-console": "^1.0.0" + "purescript-assert": "^2.0.0", + "purescript-console": "^2.0.0" } } diff --git a/src/Data/Date/Component.purs b/src/Data/Date/Component.purs index e6bde33..2051d6a 100644 --- a/src/Data/Date/Component.purs +++ b/src/Data/Date/Component.purs @@ -18,8 +18,8 @@ import Data.Maybe (Maybe(..)) -- | acquire a year value from an integer. newtype Year = Year Int -derive instance eqYear :: Eq Year -derive instance ordYear :: Ord Year +derive newtype instance eqYear :: Eq Year +derive newtype instance ordYear :: Ord Year derive instance genericYear :: Generic Year -- Note: these seemingly arbitrary bounds come from relying on JS for date @@ -122,8 +122,8 @@ instance showMonth :: Show Month where -- | acquire a day value from an integer. newtype Day = Day Int -derive instance eqDay :: Eq Day -derive instance ordDay :: Ord Day +derive newtype instance eqDay :: Eq Day +derive newtype instance ordDay :: Ord Day derive instance genericDay :: Generic Day instance boundedDay :: Bounded Day where diff --git a/src/Data/DateTime/Instant.purs b/src/Data/DateTime/Instant.purs index 6a6944d..1f59a37 100644 --- a/src/Data/DateTime/Instant.purs +++ b/src/Data/DateTime/Instant.purs @@ -24,8 +24,8 @@ import Partial.Unsafe (unsafePartial) -- | `DateTime` type. newtype Instant = Instant Milliseconds -derive instance eqDateTime :: Eq Instant -derive instance ordDateTime :: Ord Instant +derive newtype instance eqDateTime :: Eq Instant +derive newtype instance ordDateTime :: Ord Instant derive instance genericDateTime :: Generic Instant instance boundedInstant :: Bounded Instant where diff --git a/src/Data/DateTime/Locale.purs b/src/Data/DateTime/Locale.purs index 157d0f3..4ad7701 100644 --- a/src/Data/DateTime/Locale.purs +++ b/src/Data/DateTime/Locale.purs @@ -7,6 +7,7 @@ import Control.Comonad (class Comonad, class Extend) import Data.DateTime (Date, Time, DateTime) import Data.Generic (class Generic) import Data.Maybe (Maybe) +import Data.Newtype (class Newtype) import Data.Time.Duration (Minutes) -- | A date/time locale specifying an offset in minutes and an optional name for @@ -23,8 +24,9 @@ instance showLocale :: Show Locale where -- | The name of a date/time locale. For example: "GMT", "MDT", "CET", etc. newtype LocaleName = LocaleName String -derive instance eqLocaleName :: Eq LocaleName -derive instance ordLocaleName :: Ord LocaleName +derive instance newtypeLocaleName :: Newtype LocaleName _ +derive newtype instance eqLocaleName :: Eq LocaleName +derive newtype instance ordLocaleName :: Ord LocaleName derive instance genericLocaleName :: Generic LocaleName instance showLocaleName :: Show LocaleName where diff --git a/src/Data/Time.purs b/src/Data/Time.purs index 4ed9eaa..190c4d6 100644 --- a/src/Data/Time.purs +++ b/src/Data/Time.purs @@ -15,8 +15,9 @@ import Data.Enum (fromEnum, toEnum) import Data.Generic (class Generic) import Data.Int as Int import Data.Maybe (fromJust) +import Data.Newtype (unwrap) import Data.Time.Component (Hour, Millisecond, Minute, Second) -import Data.Time.Duration (class Duration, Days(..), Milliseconds(..), unMilliseconds, fromDuration, toDuration) +import Data.Time.Duration (class Duration, Days(..), Milliseconds(..), fromDuration, toDuration) import Data.Tuple (Tuple(..)) import Math as Math @@ -80,7 +81,7 @@ adjust d t = d' = fromDuration d tLength = timeToMillis t dayLength = 86400000.0 - wholeDays = Days $ Math.floor (unMilliseconds d' / dayLength) + wholeDays = Days $ Math.floor (unwrap d' / dayLength) msAdjust = d' - fromDuration wholeDays msAdjusted = tLength + msAdjust wrap = if msAdjusted > maxTime then 1.0 else if msAdjusted < -maxTime then -1.0 else 0.0 @@ -100,9 +101,8 @@ timeToMillis t = Milliseconds + Int.toNumber (fromEnum (millisecond t)) millisToTime :: Milliseconds -> Time -millisToTime ms = +millisToTime ms@(Milliseconds ms') = let - ms' = unMilliseconds ms hourLength = 3600000.0 minuteLength = 60000.0 secondLength = 1000.0 diff --git a/src/Data/Time/Component.purs b/src/Data/Time/Component.purs index 879d0a7..345a592 100644 --- a/src/Data/Time/Component.purs +++ b/src/Data/Time/Component.purs @@ -19,8 +19,8 @@ import Data.Maybe (Maybe(..)) -- | lowered to a plain integer with the `fromEnum` function. newtype Hour = Hour Int -derive instance eqHour :: Eq Hour -derive instance ordHour :: Ord Hour +derive newtype instance eqHour :: Eq Hour +derive newtype instance ordHour :: Ord Hour derive instance genericHour :: Generic Hour instance boundedHour :: Bounded Hour where @@ -49,8 +49,8 @@ instance showHour :: Show Hour where -- | be lowered to a plain integer with the `fromEnum` function. newtype Minute = Minute Int -derive instance eqMinute :: Eq Minute -derive instance ordMinute :: Ord Minute +derive newtype instance eqMinute :: Eq Minute +derive newtype instance ordMinute :: Ord Minute derive instance genericMinute :: Generic Minute instance boundedMinute :: Bounded Minute where @@ -79,8 +79,8 @@ instance showMinute :: Show Minute where -- | be lowered to a plain integer with the `fromEnum` function. newtype Second = Second Int -derive instance eqSecond :: Eq Second -derive instance ordSecond :: Ord Second +derive newtype instance eqSecond :: Eq Second +derive newtype instance ordSecond :: Ord Second derive instance genericSecond :: Generic Second instance boundedSecond :: Bounded Second where @@ -110,8 +110,8 @@ instance showSecond :: Show Second where -- | function. newtype Millisecond = Millisecond Int -derive instance eqMillisecond :: Eq Millisecond -derive instance ordMillisecond :: Ord Millisecond +derive newtype instance eqMillisecond :: Eq Millisecond +derive newtype instance ordMillisecond :: Ord Millisecond derive instance genericMillisecond :: Generic Millisecond instance boundedMillisecond :: Bounded Millisecond where diff --git a/src/Data/Time/Duration.purs b/src/Data/Time/Duration.purs index c14cb5c..ea0dcf6 100644 --- a/src/Data/Time/Duration.purs +++ b/src/Data/Time/Duration.purs @@ -3,25 +3,17 @@ module Data.Time.Duration where import Prelude import Data.Generic (class Generic) +import Data.Newtype (class Newtype, over) -- | A duration measured in milliseconds. newtype Milliseconds = Milliseconds Number -unMilliseconds :: Milliseconds -> Number -unMilliseconds (Milliseconds ms) = ms - -derive instance eqMilliseconds :: Eq Milliseconds -derive instance ordMilliseconds :: Ord Milliseconds +derive instance newtypeMilliseconds :: Newtype Milliseconds _ derive instance genericMilliseconds :: Generic Milliseconds - -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) +derive newtype instance eqMilliseconds :: Eq Milliseconds +derive newtype instance ordMilliseconds :: Ord Milliseconds +derive newtype instance semiringMilliseconds :: Semiring Milliseconds +derive newtype instance ringMilliseconds :: Ring Milliseconds instance showMilliseconds :: Show Milliseconds where show (Milliseconds n) = "(Milliseconds " <> show n <> ")" @@ -29,21 +21,12 @@ instance showMilliseconds :: Show Milliseconds where -- | A duration measured in seconds. newtype Seconds = Seconds Number -unSeconds :: Seconds -> Number -unSeconds (Seconds s) = s - -derive instance eqSeconds :: Eq Seconds -derive instance ordSeconds :: Ord Seconds +derive instance newtypeSeconds :: Newtype Seconds _ derive instance genericSeconds :: Generic Seconds - -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) +derive newtype instance eqSeconds :: Eq Seconds +derive newtype instance ordSeconds :: Ord Seconds +derive newtype instance semiringSeconds :: Semiring Seconds +derive newtype instance ringSeconds :: Ring Seconds instance showSeconds :: Show Seconds where show (Seconds n) = "(Seconds " <> show n <> ")" @@ -51,21 +34,12 @@ instance showSeconds :: Show Seconds where -- | A duration measured in minutes. newtype Minutes = Minutes Number -unMinutes :: Minutes -> Number -unMinutes (Minutes m) = m - -derive instance eqMinutes :: Eq Minutes -derive instance ordMinutes :: Ord Minutes +derive instance newtypeMinutes :: Newtype Minutes _ derive instance genericMinutes :: Generic Minutes - -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) +derive newtype instance eqMinutes :: Eq Minutes +derive newtype instance ordMinutes :: Ord Minutes +derive newtype instance semiringMinutes :: Semiring Minutes +derive newtype instance ringMinutes :: Ring Minutes instance showMinutes :: Show Minutes where show (Minutes n) = "(Minutes " <> show n <> ")" @@ -73,21 +47,12 @@ instance showMinutes :: Show Minutes where -- | A duration measured in hours. newtype Hours = Hours Number -unHours :: Hours -> Number -unHours (Hours m) = m - -derive instance eqHours :: Eq Hours -derive instance ordHours :: Ord Hours +derive instance newtypeHours :: Newtype Hours _ derive instance genericHours :: Generic Hours - -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) +derive newtype instance eqHours :: Eq Hours +derive newtype instance ordHours :: Ord Hours +derive newtype instance semiringHours :: Semiring Hours +derive newtype instance ringHours :: Ring Hours instance showHours :: Show Hours where show (Hours n) = "(Hours " <> show n <> ")" @@ -95,21 +60,12 @@ instance showHours :: Show Hours where -- | A duration measured in days, where a day is assumed to be exactly 24 hours. newtype Days = Days Number -unDays :: Days -> Number -unDays (Days m) = m - -derive instance eqDays :: Eq Days -derive instance ordDays :: Ord Days +derive instance newtypeDays :: Newtype Days _ derive instance genericDays :: Generic Days - -instance semiringDays :: Semiring Days where - add (Days x) (Days y) = Days (x + y) - mul (Days x) (Days y) = Days (x * y) - zero = Days 0.0 - one = Days 1.0 - -instance ringDays :: Ring Days where - sub (Days x) (Days y) = Days (x - y) +derive newtype instance eqDays :: Eq Days +derive newtype instance ordDays :: Ord Days +derive newtype instance semiringDays :: Semiring Days +derive newtype instance ringDays :: Ring Days instance showDays :: Show Days where show (Days n) = "(Days " <> show n <> ")" @@ -128,17 +84,17 @@ instance durationMilliseconds :: Duration Milliseconds where toDuration = id instance durationSeconds :: Duration Seconds where - fromDuration = Milliseconds <<< (_ * 1000.0) <<< unSeconds - toDuration (Milliseconds ms) = Seconds (ms / 1000.0) + fromDuration = over Seconds (_ * 1000.0) + toDuration = over Milliseconds (_ / 1000.0) instance durationMinutes :: Duration Minutes where - fromDuration = Milliseconds <<< (_ * 60000.0) <<< unMinutes - toDuration (Milliseconds ms) = Minutes (ms / 60000.0) + fromDuration = over Minutes (_ * 60000.0) + toDuration = over Milliseconds (_ / 60000.0) instance durationHours :: Duration Hours where - fromDuration = Milliseconds <<< (_ * 3600000.0) <<< unHours - toDuration (Milliseconds ms) = Hours (ms / 3600000.0) + fromDuration = over Hours (_ * 3600000.0) + toDuration = over Milliseconds (_ / 3600000.0) instance durationDays :: Duration Days where - fromDuration = Milliseconds <<< (_ * 86400000.0) <<< unDays - toDuration (Milliseconds ms) = Days (ms / 86400000.0) + fromDuration = over Days (_ * 86400000.0) + toDuration = over Milliseconds (_ / 86400000.0) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index b67125a..a5a147b 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -5,7 +5,7 @@ import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) -import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, runCardinality, succ, fromEnum, pred) +import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred) import Data.Date as Date import Data.Time as Time import Data.Time.Duration as Duration @@ -14,6 +14,7 @@ import Data.DateTime as DateTime import Data.DateTime.Instant as Instant import Data.Maybe (Maybe(..), fromJust) import Data.Tuple (Tuple(..), snd) +import Data.Newtype (unwrap) import Type.Proxy (Proxy(..)) import Test.Assert (ASSERT, assert) @@ -144,5 +145,5 @@ checkBounded _ = do checkBoundedEnum :: forall e. BoundedEnum e => Proxy e -> Tests checkBoundedEnum p = do checkBounded p - let card = runCardinality (cardinality :: Cardinality e) + let card = unwrap (cardinality :: Cardinality e) assert $ Array.length (enumFromTo bottom (top :: e)) == card From bbcc1475f8460dc6e83c4e6ab150387dd197e1a0 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 18 Nov 2016 20:43:55 +0000 Subject: [PATCH 06/54] Update README.md --- README.md | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index b258a75..73163e1 100644 --- a/README.md +++ b/README.md @@ -1,8 +1,7 @@ # 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://travis-ci.org/purescript/purescript-datetime.svg?branch=master)](https://travis-ci.org/purescript/purescript-datetime) Date and time types and functions. From 6410428b01170bd43c6e6664cc0d89746c908612 Mon Sep 17 00:00:00 2001 From: Alex Berg Date: Mon, 19 Dec 2016 17:03:51 -0600 Subject: [PATCH 07/54] Note how to create instances of this type MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This question has come up many times, so we need to improve documentation. Here's from today: > given an ISO 8601 datetime string, eg “2016-07-22T01:00:00Z”, how can I create a purescript-datetime DateTime value? It’s probably a good idea to add a note to its documentation regarding conversion to/from iso strings." --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index 73163e1..b34cf15 100644 --- a/README.md +++ b/README.md @@ -13,4 +13,6 @@ bower install purescript-datetime ## Documentation +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. + Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-datetime). From 33ce8911aef98ddd5f9bb6df2be48e7969cad587 Mon Sep 17 00:00:00 2001 From: Alex Berg Date: Mon, 19 Dec 2016 17:15:01 -0600 Subject: [PATCH 08/54] Note how to write a date/time to formatted string. --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index b34cf15..95767de 100644 --- a/README.md +++ b/README.md @@ -13,6 +13,6 @@ bower install purescript-datetime ## Documentation -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. +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). From 5b007736c1fc20c433030ff5f44b3b5ae2b7018b Mon Sep 17 00:00:00 2001 From: Michael Xavier Date: Tue, 14 Feb 2017 13:18:00 -0800 Subject: [PATCH 09/54] Add isLeapYear function (#47) --- src/Data/Date.purs | 7 +++++++ test/Test/Main.purs | 6 ++++++ 2 files changed, 13 insertions(+) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index 1a74cc0..e797faa 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -7,6 +7,7 @@ module Data.Date , day , weekday , diff + , isLeapYear , module Data.Date.Component ) where @@ -76,6 +77,12 @@ 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 +-- | Is this year 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 + -- 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 diff --git a/test/Test/Main.purs b/test/Test/Main.purs index a5a147b..200008b 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -98,6 +98,12 @@ main = do log "Check that diff behaves as expected" assert $ Date.diff d2 d1 == 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) + + -- datetime ---------------------------------------------------------------- let dt1 = DateTime.DateTime d1 t1 From f215df240d1d1772de833c7df472726369406683 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 8 Mar 2017 15:19:49 +0000 Subject: [PATCH 10/54] Fix `diff` for `Date` --- src/Data/Date.js | 4 ++-- test/Test/Main.purs | 19 +++++++++++-------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/src/Data/Date.js b/src/Data/Date.js index e666221..a1b5669 100644 --- a/src/Data/Date.js +++ b/src/Data/Date.js @@ -10,7 +10,7 @@ exports.calcWeekday = function (y, m, d) { }; exports.calcDiff = function (y1, m1, d1, y2, m2, d2) { - var dt1 = new Date(Date.UTC(y1, m1, d1)); - var dt2 = new Date(Date.UTC(y2, m2, d2)); + var dt1 = new Date(Date.UTC(y1, m1 - 1, d1)); + var dt2 = new Date(Date.UTC(y2, m2 - 1, d2)); return dt1.getTime() - dt2.getTime(); }; diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 200008b..1d55817 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -92,34 +92,37 @@ main = do 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.June <*> toEnum 1 - let d2 = unsafePartial fromJust $ Date.canonicalDate <$> toEnum 2016 <*> pure Date.June <*> toEnum 30 + 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 log "Check that diff behaves as expected" - assert $ Date.diff d2 d1 == Duration.Days 29.0 + 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) - -- 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 29.0) + Duration.fromDuration (Duration.Minutes 40.0)) dt1 == Just dt4 + assert $ DateTime.adjust (Duration.fromDuration (Duration.Days 31.0) + Duration.fromDuration (Duration.Minutes 40.0)) dt1 == Just dt4 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 29.0 - assert $ DateTime.diff dt1 dt3 == Duration.Days (-29.0) - assert $ DateTime.diff dt4 dt1 == Duration.fromDuration (Duration.Days 29.0) + Duration.fromDuration (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) -- instant ----------------------------------------------------------------- From 352771fce7ff7494dfbcaa49a058ca87e620f064 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 13 Mar 2017 11:45:41 +0000 Subject: [PATCH 11/54] Add functions for modifying Date / Time parts of DateTime --- src/Data/DateTime.purs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/Data/DateTime.purs b/src/Data/DateTime.purs index eaaac10..dbca662 100644 --- a/src/Data/DateTime.purs +++ b/src/Data/DateTime.purs @@ -1,7 +1,11 @@ module Data.DateTime ( DateTime(..) , date + , modifyDate + , modifyDateF , time + , modifyTime + , modifyTimeF , adjust , diff , module Data.Date @@ -35,9 +39,21 @@ instance showDateTime :: Show DateTime where 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 From 0fca9b236a82c8dc7cf79a88e3b80b176bdd638e Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 13 Mar 2017 00:21:51 +0000 Subject: [PATCH 12/54] Update for PureScript 0.11 --- .eslintrc.json | 28 ++++++++++++++++++++++++++++ .gitignore | 3 +-- .jscsrc | 17 ----------------- .jshintrc | 19 ------------------- .travis.yml | 2 +- bower.json | 12 ++++++------ package.json | 11 +++++------ src/Data/DateTime/Instant.js | 5 +---- src/Data/Time/Duration.purs | 2 +- 9 files changed, 43 insertions(+), 56 deletions(-) create mode 100644 .eslintrc.json delete mode 100644 .jscsrc delete mode 100644 .jshintrc diff --git a/.eslintrc.json b/.eslintrc.json new file mode 100644 index 0000000..84cef4f --- /dev/null +++ b/.eslintrc.json @@ -0,0 +1,28 @@ +{ + "parserOptions": { + "ecmaVersion": 5 + }, + "extends": "eslint:recommended", + "env": { + "commonjs": true + }, + "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/.gitignore b/.gitignore index e306283..7050558 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,6 @@ /.* !/.gitignore -!/.jscsrc -!/.jshintrc +!/.eslintrc.json !/.travis.yml /bower_components/ /node_modules/ diff --git a/.jscsrc b/.jscsrc deleted file mode 100644 index 2561ce9..0000000 --- a/.jscsrc +++ /dev/null @@ -1,17 +0,0 @@ -{ - "preset": "grunt", - "disallowSpacesInFunctionExpression": null, - "requireSpacesInFunctionExpression": { - "beforeOpeningRoundBrace": true, - "beforeOpeningCurlyBrace": true - }, - "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 81e6de7..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, - "noarg": true, - "nocomma": true, - "nonew": true, - "notypeof": true, - "singleGroups": true, - "undef": true, - "unused": true, - "eqnull": true, - "predef": ["exports"] -} diff --git a/.travis.yml b/.travis.yml index a79fb8b..e06d3f0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,7 +1,7 @@ language: node_js dist: trusty sudo: required -node_js: 6 +node_js: stable env: - PATH=$HOME/purescript:$PATH install: diff --git a/bower.json b/bower.json index 66db52d..f081396 100644 --- a/bower.json +++ b/bower.json @@ -16,14 +16,14 @@ "package.json" ], "dependencies": { - "purescript-enums": "^2.0.0", - "purescript-functions": "^2.0.0", - "purescript-generics": "^3.0.0", - "purescript-integers": "^2.0.0", + "purescript-enums": "^3.0.0", + "purescript-functions": "^3.0.0", + "purescript-generics": "^4.0.0", + "purescript-integers": "^3.0.0", "purescript-math": "^2.0.0" }, "devDependencies": { - "purescript-assert": "^2.0.0", - "purescript-console": "^2.0.0" + "purescript-assert": "^3.0.0", + "purescript-console": "^3.0.0" } } diff --git a/package.json b/package.json index 44534d6..132cefc 100644 --- a/package.json +++ b/package.json @@ -2,14 +2,13 @@ "private": true, "scripts": { "clean": "rimraf output && rimraf .pulp-cache", - "build": "jshint src && jscs src && pulp build --censor-lib --strict", + "build": "eslint src && pulp build -- --censor-lib --strict", "test": "pulp test" }, "devDependencies": { - "jscs": "^2.8.0", - "jshint": "^2.9.1", - "pulp": "^9.0.0", - "purescript-psa": "^0.3.8", - "rimraf": "^2.5.0" + "eslint": "^3.17.1", + "pulp": "^10.0.4", + "purescript-psa": "^0.5.0-rc.1", + "rimraf": "^2.6.1" } } diff --git a/src/Data/DateTime/Instant.js b/src/Data/DateTime/Instant.js index 0653a15..e79b5e2 100644 --- a/src/Data/DateTime/Instant.js +++ b/src/Data/DateTime/Instant.js @@ -7,9 +7,6 @@ exports.fromDateTimeImpl = function (y, mo, d, h, mi, s, ms) { exports.toDateTimeImpl = function (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()); + return ctor (dt.getUTCFullYear())(dt.getUTCMonth() + 1)(dt.getUTCDate())(dt.getUTCHours())(dt.getUTCMinutes())(dt.getUTCSeconds())(dt.getUTCMilliseconds()); }; }; diff --git a/src/Data/Time/Duration.purs b/src/Data/Time/Duration.purs index ea0dcf6..4b9e21b 100644 --- a/src/Data/Time/Duration.purs +++ b/src/Data/Time/Duration.purs @@ -76,7 +76,7 @@ class Duration a where toDuration :: Milliseconds -> a -- | Converts directly between durations of differing types. -convertDuration :: forall a b. (Duration a, Duration b) => a -> b +convertDuration :: forall a b. Duration a => Duration b => a -> b convertDuration = toDuration <<< fromDuration instance durationMilliseconds :: Duration Milliseconds where From 658e64cfa405c922e53f1979e5b8b9e4c7ff7c56 Mon Sep 17 00:00:00 2001 From: Anil Anar Date: Tue, 4 Apr 2017 23:41:47 +0200 Subject: [PATCH 13/54] fix date/instant construction for years 0 <= y < 100 --- src/Data/Date.js | 16 ++++++++++++---- src/Data/DateTime/Instant.js | 10 +++++++++- test/Test/Main.purs | 14 ++++++++++++++ 3 files changed, 35 insertions(+), 5 deletions(-) diff --git a/src/Data/Date.js b/src/Data/Date.js index a1b5669..8125144 100644 --- a/src/Data/Date.js +++ b/src/Data/Date.js @@ -1,16 +1,24 @@ "use strict"; +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.canonicalDateImpl = function (ctor, y, m, d) { - var date = new Date(Date.UTC(y, m - 1, d)); + var date = createDate(y, m - 1, d); return ctor(date.getUTCFullYear())(date.getUTCMonth() + 1)(date.getUTCDate()); }; exports.calcWeekday = function (y, m, d) { - return new Date(Date.UTC(y, m - 1, d)).getUTCDay(); + return createDate(y, m - 1, d).getUTCDay(); }; exports.calcDiff = function (y1, m1, d1, y2, m2, d2) { - var dt1 = new Date(Date.UTC(y1, m1 - 1, d1)); - var dt2 = new Date(Date.UTC(y2, m2 - 1, 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/DateTime/Instant.js b/src/Data/DateTime/Instant.js index e79b5e2..9f883a9 100644 --- a/src/Data/DateTime/Instant.js +++ b/src/Data/DateTime/Instant.js @@ -1,7 +1,15 @@ "use strict"; +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; +}; + exports.fromDateTimeImpl = function (y, mo, d, h, mi, s, ms) { - return new Date(Date.UTC(y, mo - 1, d, h, mi, s, ms)).getTime(); + return createDateTime(y, mo - 1, d, h, mi, s, ms).getTime(); }; exports.toDateTimeImpl = function (ctor) { diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 1d55817..8bb528e 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -25,6 +25,12 @@ type Tests = Eff (console :: CONSOLE, assert :: ASSERT) Unit main :: Tests main = do + 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" @@ -105,6 +111,11 @@ main = do 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 + -- datetime ---------------------------------------------------------------- let dt1 = DateTime.DateTime d1 t1 @@ -134,6 +145,9 @@ main = do 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 From 5053ba9c25ca56a75c1de7eb46dd7b1a470b0a8a Mon Sep 17 00:00:00 2001 From: Anil Anar Date: Wed, 5 Apr 2017 09:57:03 +0200 Subject: [PATCH 14/54] add foldable and traversable instances to LocalValue --- bower.json | 6 ++++-- src/Data/DateTime/Locale.purs | 13 +++++++++++-- test/Test/Main.purs | 29 +++++++++++++++++++++++++++++ 3 files changed, 44 insertions(+), 4 deletions(-) diff --git a/bower.json b/bower.json index f081396..0bce8fb 100644 --- a/bower.json +++ b/bower.json @@ -20,10 +20,12 @@ "purescript-functions": "^3.0.0", "purescript-generics": "^4.0.0", "purescript-integers": "^3.0.0", - "purescript-math": "^2.0.0" + "purescript-math": "^2.0.0", + "purescript-foldable-traversable": "^3.0.0" }, "devDependencies": { "purescript-assert": "^3.0.0", - "purescript-console": "^3.0.0" + "purescript-console": "^3.0.0", + "purescript-strings": "^3.0.0" } } diff --git a/src/Data/DateTime/Locale.purs b/src/Data/DateTime/Locale.purs index 4ad7701..64b1b58 100644 --- a/src/Data/DateTime/Locale.purs +++ b/src/Data/DateTime/Locale.purs @@ -1,14 +1,14 @@ module Data.DateTime.Locale where import Prelude - import Control.Comonad (class Comonad, class Extend) - import Data.DateTime (Date, Time, DateTime) +import Data.Foldable (class Foldable) import Data.Generic (class Generic) import Data.Maybe (Maybe) import Data.Newtype (class Newtype) import Data.Time.Duration (Minutes) +import Data.Traversable (class Traversable, traverse) -- | A date/time locale specifying an offset in minutes and an optional name for -- | the locale. @@ -55,6 +55,15 @@ instance extendLocalValue :: Extend LocalValue where instance comonadLocalValue :: Comonad LocalValue where extract (LocalValue _ a) = a +instance foldableLocalValue :: Foldable LocalValue where + foldl f b (LocalValue _ a) = f b a + foldr f b (LocalValue _ a) = f a b + foldMap f (LocalValue _ a) = f a + +instance traversableLocalValue :: Traversable LocalValue where + traverse f (LocalValue n a) = LocalValue <$> pure n <*> f a + sequence = traverse id + -- | A date value with a locale. type LocalDate = LocalValue Date diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 1d55817..b7a9f0b 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -11,8 +11,12 @@ import Data.Time as Time import Data.Time.Duration as Duration import Data.Array as Array import Data.DateTime as DateTime +import Data.DateTime.Locale as Locale import Data.DateTime.Instant as Instant +import Data.Foldable (foldl, foldr, foldMap) import Data.Maybe (Maybe(..), fromJust) +import Data.String (length) +import Data.Traversable (sequence, traverse) import Data.Tuple (Tuple(..), snd) import Data.Newtype (unwrap) @@ -142,6 +146,31 @@ main = do assert $ Instant.toDateTime (Instant.fromDateTime dt3) == dt3 assert $ Instant.toDateTime (Instant.fromDateTime dt4) == dt4 + -- locale ------------------------------------------------------------------ + + let locale = Locale.Locale (Just $ Locale.LocaleName "UTC") + $ Duration.Minutes 0.0 + let crLocalVal = Locale.LocalValue locale + + log "Check that LocalValue folds left" + assert $ foldl (<>) "prepend " (crLocalVal "foo") == "prepend foo" + + log "Check that LocalValue folds right" + assert $ foldr (<>) " append" (crLocalVal "foo") == "foo append" + + log "Check that LocalValue fold-maps" + assert $ foldMap ((<>) "prepend ") (crLocalVal "foo") == "prepend foo" + + log "Check that LocalValue sequences" + assert $ sequence (Locale.LocalValue locale $ Just "foo") + == (Just $ Locale.LocalValue locale "foo") + assert $ sequence (Locale.LocalValue locale (Nothing :: Maybe Int)) + == Nothing + + log "Check that LocalValue traverses" + assert $ traverse (Just <<< length) (crLocalVal "foo") + == (Just $ Locale.LocalValue locale 3) + log "All tests done" checkBounded :: forall e. Bounded e => Proxy e -> Tests From ca573048c0c5f06c5a9ee3a6433ea83251452aec Mon Sep 17 00:00:00 2001 From: Anil Anar Date: Sun, 9 Apr 2017 22:57:14 +0200 Subject: [PATCH 15/54] make diff/adjust produce correct values involving years 0-100 --- src/Data/DateTime.js | 14 +++++++++++--- test/Test/Main.purs | 9 ++++++++- 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/src/Data/DateTime.js b/src/Data/DateTime.js index 2d722a8..7f172f0 100644 --- a/src/Data/DateTime.js +++ b/src/Data/DateTime.js @@ -1,8 +1,16 @@ "use strict"; +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(); +}; + exports.calcDiff = function (rec1, rec2) { - var msUTC1 = Date.UTC(rec1.year, rec1.month - 1, rec1.day, rec1.hour, rec1.minute, rec1.second, rec1.millisecond); - var msUTC2 = Date.UTC(rec2.year, rec2.month - 1, rec2.day, rec2.hour, rec2.minute, rec2.second, rec2.millisecond); + 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; }; @@ -10,7 +18,7 @@ exports.adjustImpl = function (just) { return function (nothing) { return function (offset) { return function (rec) { - var msUTC = Date.UTC(rec.year, rec.month - 1, rec.day, rec.hour, rec.minute, rec.second, rec.millisecond); + 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(), diff --git a/test/Test/Main.purs b/test/Test/Main.purs index eb0fe89..723e51f 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -18,7 +18,9 @@ import Data.Maybe (Maybe(..), fromJust) import Data.String (length) import Data.Traversable (sequence, traverse) import Data.Tuple (Tuple(..), snd) -import Data.Newtype (unwrap) +import Data.Newtype (over, unwrap) + +import Math (floor) import Type.Proxy (Proxy(..)) import Test.Assert (ASSERT, assert) @@ -130,6 +132,9 @@ main = do 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 @@ -138,6 +143,8 @@ main = do 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 ----------------------------------------------------------------- From 06036afcf238f87c80ddd2f31f35d8181f8e36d8 Mon Sep 17 00:00:00 2001 From: Michael Xavier Date: Tue, 16 May 2017 09:40:53 -0700 Subject: [PATCH 16/54] Add lastDayOfMonth This function can be found in the Haskell time library and is especially useful for building calendar views. --- src/Data/Date.purs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index e797faa..c2a500e 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -8,6 +8,7 @@ module Data.Date , weekday , diff , isLeapYear + , lastDayOfMonth , module Data.Date.Component ) where @@ -83,6 +84,26 @@ 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 From bfc3c23d6492ec380df01e96ddbdbe76df4f3612 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 8 Jun 2017 14:37:55 +0100 Subject: [PATCH 17/54] Add generators for date and time types --- bower.json | 2 +- src/Data/Date/Component/Gen.purs | 25 +++++++++++++++++++++++++ src/Data/Date/Gen.purs | 14 ++++++++++++++ src/Data/DateTime/Gen.purs | 16 ++++++++++++++++ src/Data/Time/Component/Gen.purs | 21 +++++++++++++++++++++ src/Data/Time/Duration/Gen.purs | 27 +++++++++++++++++++++++++++ src/Data/Time/Gen.purs | 13 +++++++++++++ 7 files changed, 117 insertions(+), 1 deletion(-) create mode 100644 src/Data/Date/Component/Gen.purs create mode 100644 src/Data/Date/Gen.purs create mode 100644 src/Data/DateTime/Gen.purs create mode 100644 src/Data/Time/Component/Gen.purs create mode 100644 src/Data/Time/Duration/Gen.purs create mode 100644 src/Data/Time/Gen.purs diff --git a/bower.json b/bower.json index 0bce8fb..cbdaf33 100644 --- a/bower.json +++ b/bower.json @@ -16,7 +16,7 @@ "package.json" ], "dependencies": { - "purescript-enums": "^3.0.0", + "purescript-enums": "^3.1.0", "purescript-functions": "^3.0.0", "purescript-generics": "^4.0.0", "purescript-integers": "^3.0.0", 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..6709a40 --- /dev/null +++ b/src/Data/Date/Gen.purs @@ -0,0 +1,14 @@ +module Data.Date.Gen + ( genDate + , module Data.Date.Component.Gen + ) where + +import Prelude +import Control.Monad.Gen (class MonadGen) +import Data.Date (Date, canonicalDate) +import Data.Date.Component.Gen (genDay, genMonth, genWeekday, genYear) + +-- | Generates a random `Date` between 1st Jan 1900 and 31st Dec 2100, +-- | inclusive. +genDate :: forall m. MonadGen m => m Date +genDate = canonicalDate <$> genYear <*> genMonth <*> genDay 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/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/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 From 3cb01cdbb3bb86507f2bfbc184be531d229fadcc Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Mon, 26 Jun 2017 16:55:24 +0400 Subject: [PATCH 18/54] Add Interval (#52) * WIP: Add Interval * remove unused imports * remove dublicats * update Duration * add couple instances for Duration and Interval * reorder code * remove mkDuration DurationView and Milliseconds component * fis ord instance of DurationComponent * make Interval Bifunctor * add Bifoldable for Interval * add IsoDuration; use Map instead of List Tuple * derive instances for RecurringInterval * fix derivations * add Bitraversable and Eq instances * export Duration and DurationComponent * make sure IsoDuraiton is not empty * add ^ to PS version * revert travis changes * make Duration new type and derive Newype * make duration components singular * reverse duration component order * make isoDuration newtype * allow only positive values in duration * remove some TODOs * fix spaces and unicodes * add ord instances * fix spacing, parens and $ usage * rename JustDuration to DurationOnly * split Interval - move Interval.purs up one level - move Duration and IsoDuration parts away * reverse DurationComponent order * add Week component to Duration; refactor Duration.Iso * move checkWeekUsage up add tests This way InvalidWeekComponentUsage will be first if it is present in errors * use NonEmptyList instead of NonEmpty Array; add prettyError --- .travis.yml | 2 +- bower.json | 5 +- package.json | 4 +- src/Data/Interval.purs | 115 ++++++++++++++++++++++++++++ src/Data/Interval/Duration.purs | 74 ++++++++++++++++++ src/Data/Interval/Duration/Iso.purs | 97 +++++++++++++++++++++++ test/Test/Main.purs | 39 +++++++--- 7 files changed, 320 insertions(+), 16 deletions(-) create mode 100644 src/Data/Interval.purs create mode 100644 src/Data/Interval/Duration.purs create mode 100644 src/Data/Interval/Duration/Iso.purs diff --git a/.travis.yml b/.travis.yml index e06d3f0..d980b08 100644 --- a/.travis.yml +++ b/.travis.yml @@ -15,7 +15,7 @@ script: - bower install --production - npm run -s build - bower install - - npm test + - npm run -s test after_success: - >- test $TRAVIS_TAG && diff --git a/bower.json b/bower.json index cbdaf33..1776f48 100644 --- a/bower.json +++ b/bower.json @@ -20,8 +20,9 @@ "purescript-functions": "^3.0.0", "purescript-generics": "^4.0.0", "purescript-integers": "^3.0.0", - "purescript-math": "^2.0.0", - "purescript-foldable-traversable": "^3.0.0" + "purescript-foldable-traversable": "^3.0.0", + "purescript-maps": "^3.0.0", + "purescript-math": "^2.0.0" }, "devDependencies": { "purescript-assert": "^3.0.0", diff --git a/package.json b/package.json index 132cefc..017bc40 100644 --- a/package.json +++ b/package.json @@ -7,8 +7,8 @@ }, "devDependencies": { "eslint": "^3.17.1", - "pulp": "^10.0.4", - "purescript-psa": "^0.5.0-rc.1", + "pulp": "^11.0.x", + "purescript-psa": "^0.5.x", "rimraf": "^2.6.1" } } diff --git a/src/Data/Interval.purs b/src/Data/Interval.purs new file mode 100644 index 0000000..d3c75ad --- /dev/null +++ b/src/Data/Interval.purs @@ -0,0 +1,115 @@ +module Data.Interval + ( Interval(..) + , RecurringInterval(..) + , module DurationExports + ) 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 as DurationExports +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 id + +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 d x) = z `f` x + foldl f z (StartDuration x d) = 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 x y) = StartEnd (f a) (f a) + extend f a@(DurationEnd d x) = DurationEnd d (f a) + extend f a@(StartDuration x d) = StartDuration (f a) d + extend f (DurationOnly d) = DurationOnly d diff --git a/src/Data/Interval/Duration.purs b/src/Data/Interval/Duration.purs new file mode 100644 index 0000000..9af57e4 --- /dev/null +++ b/src/Data/Interval/Duration.purs @@ -0,0 +1,74 @@ +module Data.Interval.Duration + ( Duration(..) + , DurationComponent(..) + , year + , month + , week + , day + , hour + , minute + , second + , millisecond + ) where + +import Prelude + +import Data.Map as Map +import Data.Monoid (class Monoid, mempty) +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 mempty + +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..10fe187 --- /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.Maybe (Maybe(..), isJust) +import Data.Monoid.Additive (Additive(..)) +import Data.Newtype (unwrap) +import Data.Tuple (Tuple(..), snd) +import Math as Math + +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.toAscUnfoldable 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 = Math.floor a /= a + checkRest rest = unwrap (foldMap (snd >>> Math.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/test/Test/Main.purs b/test/Test/Main.purs index 723e51f..35fbfb8 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -4,32 +4,49 @@ import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) - -import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred) -import Data.Date as Date -import Data.Time as Time -import Data.Time.Duration as Duration import Data.Array as Array +import Data.Date as Date import Data.DateTime as DateTime -import Data.DateTime.Locale as Locale import Data.DateTime.Instant as Instant +import Data.DateTime.Locale as Locale +import Data.Either (Either(..), isRight) +import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred) import Data.Foldable (foldl, foldr, foldMap) +import Data.Interval as Interval +import Data.Interval.Duration.Iso as IsoDuration import Data.Maybe (Maybe(..), fromJust) +import Data.Monoid (mempty) +import Data.Newtype (over, unwrap) import Data.String (length) +import Data.Time as Time +import Data.Time.Duration as Duration import Data.Traversable (sequence, traverse) import Data.Tuple (Tuple(..), snd) -import Data.Newtype (over, unwrap) - import Math (floor) - -import Type.Proxy (Proxy(..)) -import Test.Assert (ASSERT, assert) import Partial.Unsafe (unsafePartial) +import Test.Assert (ASSERT, assert) +import Type.Proxy (Proxy(..)) type Tests = Eff (console :: CONSOLE, assert :: ASSERT) Unit main :: Tests 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 From cf6d25c58a130e69e909ec4420d09c8d9748d6af Mon Sep 17 00:00:00 2001 From: Javier Casas Date: Fri, 22 Sep 2017 15:56:11 -0500 Subject: [PATCH 19/54] Expose `fromDate` --- src/Data/DateTime/Instant.purs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Data/DateTime/Instant.purs b/src/Data/DateTime/Instant.purs index 1f59a37..fd54932 100644 --- a/src/Data/DateTime/Instant.purs +++ b/src/Data/DateTime/Instant.purs @@ -3,6 +3,7 @@ module Data.DateTime.Instant , instant , unInstant , fromDateTime + , fromDate , toDateTime ) where From 7f61bdc73c5fdc672eb3e43e79b84e0ebd1d3f3c Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 4 Nov 2017 12:34:50 +0000 Subject: [PATCH 20/54] Fix pursuit auto publishing from Travis --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 7050558..709fd09 100644 --- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ !/.gitignore !/.eslintrc.json !/.travis.yml +package-lock.json /bower_components/ /node_modules/ /output/ From cea78fba1580a6c16362f4dc4e2747414f0163f9 Mon Sep 17 00:00:00 2001 From: Liam Goodacre Date: Fri, 27 Apr 2018 15:02:50 +0100 Subject: [PATCH 21/54] Bump deps for compiler/0.12 --- bower.json | 21 +++++++++++---------- package.json | 10 +++++----- src/Data/Date.purs | 4 ++-- src/Data/Date/Component.purs | 10 +++++----- src/Data/DateTime.purs | 4 ++-- src/Data/DateTime/Instant.purs | 4 ++-- src/Data/DateTime/Locale.purs | 10 +++++----- src/Data/Interval.purs | 2 +- src/Data/Interval/Duration.purs | 1 - src/Data/Time.purs | 4 ++-- src/Data/Time/Component.purs | 10 +++++----- src/Data/Time/Duration.purs | 16 ++++++++-------- test/Test/Main.purs | 15 ++++++--------- 13 files changed, 54 insertions(+), 57 deletions(-) diff --git a/bower.json b/bower.json index 1776f48..2a546bd 100644 --- a/bower.json +++ b/bower.json @@ -16,17 +16,18 @@ "package.json" ], "dependencies": { - "purescript-enums": "^3.1.0", - "purescript-functions": "^3.0.0", - "purescript-generics": "^4.0.0", - "purescript-integers": "^3.0.0", - "purescript-foldable-traversable": "^3.0.0", - "purescript-maps": "^3.0.0", - "purescript-math": "^2.0.0" + "purescript-enums": "#compiler/0.12", + "purescript-functions": "#compiler/0.12", + "purescript-generics-rep": "#compiler/0.12", + "purescript-integers": "#compiler/0.12", + "purescript-foldable-traversable": "#compiler/0.12", + "purescript-maps": "#compiler/0.12", + "purescript-math": "#compiler/0.12", + "purescript-proxy": "#compiler/0.12" }, "devDependencies": { - "purescript-assert": "^3.0.0", - "purescript-console": "^3.0.0", - "purescript-strings": "^3.0.0" + "purescript-assert": "#compiler/0.12", + "purescript-console": "#compiler/0.12", + "purescript-strings": "#compiler/0.12" } } diff --git a/package.json b/package.json index 017bc40..c9e5a5b 100644 --- a/package.json +++ b/package.json @@ -3,12 +3,12 @@ "scripts": { "clean": "rimraf output && rimraf .pulp-cache", "build": "eslint src && pulp build -- --censor-lib --strict", - "test": "pulp test" + "test": "pulp test --check-main-type Effect.Effect" }, "devDependencies": { - "eslint": "^3.17.1", - "pulp": "^11.0.x", - "purescript-psa": "^0.5.x", - "rimraf": "^2.6.1" + "eslint": "^4.19.1", + "pulp": "^12.0.x", + "purescript-psa": "^0.6.x", + "rimraf": "^2.6.2" } } diff --git a/src/Data/Date.purs b/src/Data/Date.purs index c2a500e..7756121 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -17,7 +17,7 @@ import Prelude import Data.Date.Component (Day, Month(..), Weekday(..), Year) import Data.Enum (toEnum, fromEnum) import Data.Function.Uncurried (Fn3, runFn3, Fn4, runFn4, Fn6, runFn6) -import Data.Generic (class Generic) +import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..), fromJust) import Data.Time.Duration (class Duration, toDuration, Milliseconds) @@ -45,7 +45,7 @@ exactDate y m d = derive instance eqDate :: Eq Date derive instance ordDate :: Ord Date -derive instance genericDate :: Generic Date +derive instance genericDate :: Generic Date _ instance boundedDate :: Bounded Date where bottom = Date bottom bottom bottom diff --git a/src/Data/Date/Component.purs b/src/Data/Date/Component.purs index 2051d6a..b604caf 100644 --- a/src/Data/Date/Component.purs +++ b/src/Data/Date/Component.purs @@ -8,7 +8,7 @@ module Data.Date.Component import Prelude import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) -import Data.Generic (class Generic) +import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..)) -- | A year component for a date. @@ -20,7 +20,7 @@ newtype Year = Year Int derive newtype instance eqYear :: Eq Year derive newtype instance ordYear :: Ord Year -derive instance genericYear :: Generic Year +derive instance genericYear :: Generic 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. @@ -61,7 +61,7 @@ data Month derive instance eqMonth :: Eq Month derive instance ordMonth :: Ord Month -derive instance genericMonth :: Generic Month +derive instance genericMonth :: Generic Month _ instance boundedMonth :: Bounded Month where bottom = January @@ -124,7 +124,7 @@ newtype Day = Day Int derive newtype instance eqDay :: Eq Day derive newtype instance ordDay :: Ord Day -derive instance genericDay :: Generic Day +derive instance genericDay :: Generic Day _ instance boundedDay :: Bounded Day where bottom = Day 1 @@ -156,7 +156,7 @@ data Weekday derive instance eqWeekday :: Eq Weekday derive instance ordWeekday :: Ord Weekday -derive instance genericWeekday :: Generic Weekday +derive instance genericWeekday :: Generic Weekday _ instance boundedWeekday :: Bounded Weekday where bottom = Monday diff --git a/src/Data/DateTime.purs b/src/Data/DateTime.purs index dbca662..5eaff5f 100644 --- a/src/Data/DateTime.purs +++ b/src/Data/DateTime.purs @@ -17,7 +17,7 @@ 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.Generic (class Generic) +import Data.Generic.Rep (class Generic) 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(..)) @@ -27,7 +27,7 @@ data DateTime = DateTime Date Time derive instance eqDateTime :: Eq DateTime derive instance ordDateTime :: Ord DateTime -derive instance genericDateTime :: Generic DateTime +derive instance genericDateTime :: Generic DateTime _ instance boundedDateTime :: Bounded DateTime where bottom = DateTime bottom bottom diff --git a/src/Data/DateTime/Instant.purs b/src/Data/DateTime/Instant.purs index fd54932..707acd4 100644 --- a/src/Data/DateTime/Instant.purs +++ b/src/Data/DateTime/Instant.purs @@ -12,7 +12,7 @@ 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.Generic (class Generic) +import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..), fromJust) import Data.Time.Duration (Milliseconds(..)) @@ -27,7 +27,7 @@ newtype Instant = Instant Milliseconds derive newtype instance eqDateTime :: Eq Instant derive newtype instance ordDateTime :: Ord Instant -derive instance genericDateTime :: Generic Instant +derive instance genericDateTime :: Generic Instant _ instance boundedInstant :: Bounded Instant where bottom = Instant (Milliseconds (-8639977881600000.0)) diff --git a/src/Data/DateTime/Locale.purs b/src/Data/DateTime/Locale.purs index 64b1b58..a449f17 100644 --- a/src/Data/DateTime/Locale.purs +++ b/src/Data/DateTime/Locale.purs @@ -4,7 +4,7 @@ import Prelude import Control.Comonad (class Comonad, class Extend) import Data.DateTime (Date, Time, DateTime) import Data.Foldable (class Foldable) -import Data.Generic (class Generic) +import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe) import Data.Newtype (class Newtype) import Data.Time.Duration (Minutes) @@ -16,7 +16,7 @@ data Locale = Locale (Maybe LocaleName) Minutes derive instance eqLocale :: Eq Locale derive instance ordLocale :: Ord Locale -derive instance genericLocale :: Generic Locale +derive instance genericLocale :: Generic Locale _ instance showLocale :: Show Locale where show (Locale name offset) = "(Locale " <> show name <> " " <> show offset <> ")" @@ -27,7 +27,7 @@ newtype LocaleName = LocaleName String derive instance newtypeLocaleName :: Newtype LocaleName _ derive newtype instance eqLocaleName :: Eq LocaleName derive newtype instance ordLocaleName :: Ord LocaleName -derive instance genericLocaleName :: Generic LocaleName +derive instance genericLocaleName :: Generic LocaleName _ instance showLocaleName :: Show LocaleName where show (LocaleName name) = "(LocaleName " <> show name <> ")" @@ -41,7 +41,7 @@ data LocalValue a = LocalValue Locale a derive instance eqLocalValue :: Eq a => Eq (LocalValue a) derive instance ordLocalValue :: Ord a => Ord (LocalValue a) -derive instance genericLocalValue :: Generic a => Generic (LocalValue a) +derive instance genericLocalValue :: Generic (LocalValue a) _ instance showLocalValue :: Show a => Show (LocalValue a) where show (LocalValue n a) = "(LocalValue " <> show n <> " " <> show a <> ")" @@ -62,7 +62,7 @@ instance foldableLocalValue :: Foldable LocalValue where instance traversableLocalValue :: Traversable LocalValue where traverse f (LocalValue n a) = LocalValue <$> pure n <*> f a - sequence = traverse id + sequence = traverse identity -- | A date value with a locale. type LocalDate = LocalValue Date diff --git a/src/Data/Interval.purs b/src/Data/Interval.purs index d3c75ad..ac4fda0 100644 --- a/src/Data/Interval.purs +++ b/src/Data/Interval.purs @@ -70,7 +70,7 @@ instance showInterval :: (Show d, Show a) => Show (Interval d a) where show (DurationOnly d) = "(DurationOnly " <> show d <> ")" instance functorInterval :: Functor (Interval d) where - map = bimap id + map = bimap identity instance bifunctorInterval :: Bifunctor Interval where bimap _ f (StartEnd x y) = StartEnd (f x) (f y) diff --git a/src/Data/Interval/Duration.purs b/src/Data/Interval/Duration.purs index 9af57e4..252f77c 100644 --- a/src/Data/Interval/Duration.purs +++ b/src/Data/Interval/Duration.purs @@ -14,7 +14,6 @@ module Data.Interval.Duration import Prelude import Data.Map as Map -import Data.Monoid (class Monoid, mempty) import Data.Newtype (class Newtype) newtype Duration = Duration (Map.Map DurationComponent Number) diff --git a/src/Data/Time.purs b/src/Data/Time.purs index 190c4d6..64c2ec2 100644 --- a/src/Data/Time.purs +++ b/src/Data/Time.purs @@ -12,7 +12,7 @@ module Data.Time import Prelude import Data.Enum (fromEnum, toEnum) -import Data.Generic (class Generic) +import Data.Generic.Rep (class Generic) import Data.Int as Int import Data.Maybe (fromJust) import Data.Newtype (unwrap) @@ -28,7 +28,7 @@ data Time = Time Hour Minute Second Millisecond derive instance eqTime :: Eq Time derive instance ordTime :: Ord Time -derive instance genericTime :: Generic Time +derive instance genericTime :: Generic Time _ instance boundedTime :: Bounded Time where bottom = Time bottom bottom bottom bottom diff --git a/src/Data/Time/Component.purs b/src/Data/Time/Component.purs index 345a592..47ac537 100644 --- a/src/Data/Time/Component.purs +++ b/src/Data/Time/Component.purs @@ -8,7 +8,7 @@ module Data.Time.Component import Prelude import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) -import Data.Generic (class Generic) +import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..)) -- | An hour component for a time value. @@ -21,7 +21,7 @@ newtype Hour = Hour Int derive newtype instance eqHour :: Eq Hour derive newtype instance ordHour :: Ord Hour -derive instance genericHour :: Generic Hour +derive instance genericHour :: Generic Hour _ instance boundedHour :: Bounded Hour where bottom = Hour 0 @@ -51,7 +51,7 @@ newtype Minute = Minute Int derive newtype instance eqMinute :: Eq Minute derive newtype instance ordMinute :: Ord Minute -derive instance genericMinute :: Generic Minute +derive instance genericMinute :: Generic Minute _ instance boundedMinute :: Bounded Minute where bottom = Minute 0 @@ -81,7 +81,7 @@ newtype Second = Second Int derive newtype instance eqSecond :: Eq Second derive newtype instance ordSecond :: Ord Second -derive instance genericSecond :: Generic Second +derive instance genericSecond :: Generic Second _ instance boundedSecond :: Bounded Second where bottom = Second 0 @@ -112,7 +112,7 @@ newtype Millisecond = Millisecond Int derive newtype instance eqMillisecond :: Eq Millisecond derive newtype instance ordMillisecond :: Ord Millisecond -derive instance genericMillisecond :: Generic Millisecond +derive instance genericMillisecond :: Generic Millisecond _ instance boundedMillisecond :: Bounded Millisecond where bottom = Millisecond 0 diff --git a/src/Data/Time/Duration.purs b/src/Data/Time/Duration.purs index 4b9e21b..fc14610 100644 --- a/src/Data/Time/Duration.purs +++ b/src/Data/Time/Duration.purs @@ -2,14 +2,14 @@ module Data.Time.Duration where import Prelude -import Data.Generic (class Generic) +import Data.Generic.Rep (class Generic) import Data.Newtype (class Newtype, over) -- | A duration measured in milliseconds. newtype Milliseconds = Milliseconds Number derive instance newtypeMilliseconds :: Newtype Milliseconds _ -derive instance genericMilliseconds :: Generic Milliseconds +derive instance genericMilliseconds :: Generic Milliseconds _ derive newtype instance eqMilliseconds :: Eq Milliseconds derive newtype instance ordMilliseconds :: Ord Milliseconds derive newtype instance semiringMilliseconds :: Semiring Milliseconds @@ -22,7 +22,7 @@ instance showMilliseconds :: Show Milliseconds where newtype Seconds = Seconds Number derive instance newtypeSeconds :: Newtype Seconds _ -derive instance genericSeconds :: Generic Seconds +derive instance genericSeconds :: Generic Seconds _ derive newtype instance eqSeconds :: Eq Seconds derive newtype instance ordSeconds :: Ord Seconds derive newtype instance semiringSeconds :: Semiring Seconds @@ -35,7 +35,7 @@ instance showSeconds :: Show Seconds where newtype Minutes = Minutes Number derive instance newtypeMinutes :: Newtype Minutes _ -derive instance genericMinutes :: Generic Minutes +derive instance genericMinutes :: Generic Minutes _ derive newtype instance eqMinutes :: Eq Minutes derive newtype instance ordMinutes :: Ord Minutes derive newtype instance semiringMinutes :: Semiring Minutes @@ -48,7 +48,7 @@ instance showMinutes :: Show Minutes where newtype Hours = Hours Number derive instance newtypeHours :: Newtype Hours _ -derive instance genericHours :: Generic Hours +derive instance genericHours :: Generic Hours _ derive newtype instance eqHours :: Eq Hours derive newtype instance ordHours :: Ord Hours derive newtype instance semiringHours :: Semiring Hours @@ -61,7 +61,7 @@ instance showHours :: Show Hours where newtype Days = Days Number derive instance newtypeDays :: Newtype Days _ -derive instance genericDays :: Generic Days +derive instance genericDays :: Generic Days _ derive newtype instance eqDays :: Eq Days derive newtype instance ordDays :: Ord Days derive newtype instance semiringDays :: Semiring Days @@ -80,8 +80,8 @@ convertDuration :: forall a b. Duration a => Duration b => a -> b convertDuration = toDuration <<< fromDuration instance durationMilliseconds :: Duration Milliseconds where - fromDuration = id - toDuration = id + fromDuration = identity + toDuration = identity instance durationSeconds :: Duration Seconds where fromDuration = over Seconds (_ * 1000.0) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 35fbfb8..062ceaa 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -2,8 +2,8 @@ module Test.Main where import Prelude -import Control.Monad.Eff (Eff) -import Control.Monad.Eff.Console (CONSOLE, log) +import Effect (Effect) +import Effect.Console (log) import Data.Array as Array import Data.Date as Date import Data.DateTime as DateTime @@ -15,7 +15,6 @@ import Data.Foldable (foldl, foldr, foldMap) import Data.Interval as Interval import Data.Interval.Duration.Iso as IsoDuration import Data.Maybe (Maybe(..), fromJust) -import Data.Monoid (mempty) import Data.Newtype (over, unwrap) import Data.String (length) import Data.Time as Time @@ -24,12 +23,10 @@ import Data.Traversable (sequence, traverse) import Data.Tuple (Tuple(..), snd) import Math (floor) import Partial.Unsafe (unsafePartial) -import Test.Assert (ASSERT, assert) +import Test.Assert (assert) import Type.Proxy (Proxy(..)) -type Tests = Eff (console :: CONSOLE, assert :: ASSERT) Unit - -main :: Tests +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) @@ -211,14 +208,14 @@ main = do log "All tests done" -checkBounded :: forall e. Bounded e => Proxy e -> Tests +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 -> Tests +checkBoundedEnum :: forall e. BoundedEnum e => Proxy e -> Effect Unit checkBoundedEnum p = do checkBounded p let card = unwrap (cardinality :: Cardinality e) From abd139d529a1b0866e22003a7fc3f2faa877afca Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 3 May 2018 12:42:00 +0100 Subject: [PATCH 22/54] Remove useless Locale, use ord-collections --- bower.json | 2 +- src/Data/DateTime/Locale.purs | 74 ----------------------------------- src/Data/Interval.purs | 4 +- 3 files changed, 3 insertions(+), 77 deletions(-) delete mode 100644 src/Data/DateTime/Locale.purs diff --git a/bower.json b/bower.json index 2a546bd..b8e14ce 100644 --- a/bower.json +++ b/bower.json @@ -21,7 +21,7 @@ "purescript-generics-rep": "#compiler/0.12", "purescript-integers": "#compiler/0.12", "purescript-foldable-traversable": "#compiler/0.12", - "purescript-maps": "#compiler/0.12", + "purescript-ordered-collections": "#compiler/0.12", "purescript-math": "#compiler/0.12", "purescript-proxy": "#compiler/0.12" }, diff --git a/src/Data/DateTime/Locale.purs b/src/Data/DateTime/Locale.purs deleted file mode 100644 index a449f17..0000000 --- a/src/Data/DateTime/Locale.purs +++ /dev/null @@ -1,74 +0,0 @@ -module Data.DateTime.Locale where - -import Prelude -import Control.Comonad (class Comonad, class Extend) -import Data.DateTime (Date, Time, DateTime) -import Data.Foldable (class Foldable) -import Data.Generic.Rep (class Generic) -import Data.Maybe (Maybe) -import Data.Newtype (class Newtype) -import Data.Time.Duration (Minutes) -import Data.Traversable (class Traversable, traverse) - --- | A date/time locale specifying an offset in minutes and an optional name for --- | the locale. -data Locale = Locale (Maybe LocaleName) Minutes - -derive instance eqLocale :: Eq Locale -derive instance ordLocale :: Ord Locale -derive instance genericLocale :: Generic Locale _ - -instance showLocale :: Show Locale where - show (Locale name offset) = "(Locale " <> show name <> " " <> show offset <> ")" - --- | The name of a date/time locale. For example: "GMT", "MDT", "CET", etc. -newtype LocaleName = LocaleName String - -derive instance newtypeLocaleName :: Newtype LocaleName _ -derive newtype instance eqLocaleName :: Eq LocaleName -derive newtype instance ordLocaleName :: Ord LocaleName -derive instance genericLocaleName :: Generic LocaleName _ - -instance showLocaleName :: Show LocaleName where - show (LocaleName name) = "(LocaleName " <> show name <> ")" - --- | A value that is subject to a `Locale`. --- | --- | There are `Functor`, `Extend`, and `Comonad` instances for `LocalValue` to --- | enable the inner non-localised value to be manipulated while maintaining --- | the locale. -data LocalValue a = LocalValue Locale a - -derive instance eqLocalValue :: Eq a => Eq (LocalValue a) -derive instance ordLocalValue :: Ord a => Ord (LocalValue a) -derive instance genericLocalValue :: Generic (LocalValue a) _ - -instance showLocalValue :: Show a => Show (LocalValue a) where - show (LocalValue n a) = "(LocalValue " <> show n <> " " <> show a <> ")" - -instance functorLocalValue :: Functor LocalValue where - map f (LocalValue n a) = LocalValue n (f a) - -instance extendLocalValue :: Extend LocalValue where - extend f lv@(LocalValue n _) = LocalValue n (f lv) - -instance comonadLocalValue :: Comonad LocalValue where - extract (LocalValue _ a) = a - -instance foldableLocalValue :: Foldable LocalValue where - foldl f b (LocalValue _ a) = f b a - foldr f b (LocalValue _ a) = f a b - foldMap f (LocalValue _ a) = f a - -instance traversableLocalValue :: Traversable LocalValue where - traverse f (LocalValue n a) = LocalValue <$> pure n <*> f a - sequence = traverse identity - --- | A date value with a locale. -type LocalDate = LocalValue Date - --- | A time value with a locale. -type LocalTime = LocalValue Time - --- | A date/time value with a locale. -type LocalDateTime = LocalValue DateTime diff --git a/src/Data/Interval.purs b/src/Data/Interval.purs index ac4fda0..8d90412 100644 --- a/src/Data/Interval.purs +++ b/src/Data/Interval.purs @@ -1,7 +1,7 @@ module Data.Interval ( Interval(..) , RecurringInterval(..) - , module DurationExports + , module Exports ) where import Prelude @@ -11,7 +11,7 @@ import Data.Bifoldable (class Bifoldable, bifoldl, bifoldr, bifoldrDefault, bifo 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 as DurationExports +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) From 3273b3a10cd9415f201bf4b5e6726ea3414206d3 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sat, 19 May 2018 11:45:50 +0100 Subject: [PATCH 23/54] Update for Map.toAscUnfoldable becoming default --- src/Data/Interval/Duration/Iso.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Interval/Duration/Iso.purs b/src/Data/Interval/Duration/Iso.purs index 10fe187..4b79068 100644 --- a/src/Data/Interval/Duration/Iso.purs +++ b/src/Data/Interval/Duration/Iso.purs @@ -64,7 +64,7 @@ mkIsoDuration d = case fromList (checkValidIsoDuration d) of checkValidIsoDuration :: Duration -> List Error checkValidIsoDuration (Duration asMap) = check {asList, asMap} where - asList = reverse (Map.toAscUnfoldable asMap) + asList = reverse (Map.toUnfoldable asMap) check = fold [ checkWeekUsage , checkEmptiness From f7eb801d86a0b1f360bb534311db8cea71eaee48 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Tue, 22 May 2018 14:49:39 +0100 Subject: [PATCH 24/54] Remove unused generic instances, strange ring instances for durations --- bower.json | 1 - src/Data/Date.purs | 32 ++++++++++----------- src/Data/Date/Component.purs | 5 ---- src/Data/DateTime.purs | 2 -- src/Data/DateTime/Instant.purs | 2 -- src/Data/Time.purs | 21 +++++++------- src/Data/Time/Component.purs | 5 ---- src/Data/Time/Duration.purs | 51 +++++++++++++++++++++++----------- test/Test/Main.purs | 39 ++++---------------------- 9 files changed, 65 insertions(+), 93 deletions(-) diff --git a/bower.json b/bower.json index b8e14ce..b5079b1 100644 --- a/bower.json +++ b/bower.json @@ -18,7 +18,6 @@ "dependencies": { "purescript-enums": "#compiler/0.12", "purescript-functions": "#compiler/0.12", - "purescript-generics-rep": "#compiler/0.12", "purescript-integers": "#compiler/0.12", "purescript-foldable-traversable": "#compiler/0.12", "purescript-ordered-collections": "#compiler/0.12", diff --git a/src/Data/Date.purs b/src/Data/Date.purs index 7756121..1ac11bd 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -17,10 +17,8 @@ import Prelude import Data.Date.Component (Day, Month(..), Weekday(..), Year) import Data.Enum (toEnum, fromEnum) import Data.Function.Uncurried (Fn3, runFn3, Fn4, runFn4, Fn6, runFn6) -import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..), fromJust) -import Data.Time.Duration (class Duration, toDuration, Milliseconds) - +import Data.Time.Duration (class Duration, Milliseconds, toDuration) import Partial.Unsafe (unsafePartial) -- | A date value in the Gregorian calendar. @@ -45,7 +43,6 @@ exactDate y m d = derive instance eqDate :: Eq Date derive instance ordDate :: Ord Date -derive instance genericDate :: Generic Date _ instance boundedDate :: Bounded Date where bottom = Date bottom bottom bottom @@ -78,29 +75,30 @@ 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 --- | Is this year a leap year according to the proleptic Gregorian calendar? +-- | 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 +-- | 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 + 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 + | 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 + October -> unsafeDay 31 + November -> unsafeDay 30 + December -> unsafeDay 31 where unsafeDay = unsafePartial fromJust <<< toEnum diff --git a/src/Data/Date/Component.purs b/src/Data/Date/Component.purs index b604caf..8c13315 100644 --- a/src/Data/Date/Component.purs +++ b/src/Data/Date/Component.purs @@ -8,7 +8,6 @@ module Data.Date.Component import Prelude import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) -import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..)) -- | A year component for a date. @@ -20,7 +19,6 @@ newtype Year = Year Int derive newtype instance eqYear :: Eq Year derive newtype instance ordYear :: Ord Year -derive instance genericYear :: Generic 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. @@ -61,7 +59,6 @@ data Month derive instance eqMonth :: Eq Month derive instance ordMonth :: Ord Month -derive instance genericMonth :: Generic Month _ instance boundedMonth :: Bounded Month where bottom = January @@ -124,7 +121,6 @@ newtype Day = Day Int derive newtype instance eqDay :: Eq Day derive newtype instance ordDay :: Ord Day -derive instance genericDay :: Generic Day _ instance boundedDay :: Bounded Day where bottom = Day 1 @@ -156,7 +152,6 @@ data Weekday derive instance eqWeekday :: Eq Weekday derive instance ordWeekday :: Ord Weekday -derive instance genericWeekday :: Generic Weekday _ instance boundedWeekday :: Bounded Weekday where bottom = Monday diff --git a/src/Data/DateTime.purs b/src/Data/DateTime.purs index 5eaff5f..2119ded 100644 --- a/src/Data/DateTime.purs +++ b/src/Data/DateTime.purs @@ -17,7 +17,6 @@ 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.Generic.Rep (class Generic) 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(..)) @@ -27,7 +26,6 @@ data DateTime = DateTime Date Time derive instance eqDateTime :: Eq DateTime derive instance ordDateTime :: Ord DateTime -derive instance genericDateTime :: Generic DateTime _ instance boundedDateTime :: Bounded DateTime where bottom = DateTime bottom bottom diff --git a/src/Data/DateTime/Instant.purs b/src/Data/DateTime/Instant.purs index 707acd4..d196249 100644 --- a/src/Data/DateTime/Instant.purs +++ b/src/Data/DateTime/Instant.purs @@ -12,7 +12,6 @@ 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.Generic.Rep (class Generic) import Data.Maybe (Maybe(..), fromJust) import Data.Time.Duration (Milliseconds(..)) @@ -27,7 +26,6 @@ newtype Instant = Instant Milliseconds derive newtype instance eqDateTime :: Eq Instant derive newtype instance ordDateTime :: Ord Instant -derive instance genericDateTime :: Generic Instant _ instance boundedInstant :: Bounded Instant where bottom = Instant (Milliseconds (-8639977881600000.0)) diff --git a/src/Data/Time.purs b/src/Data/Time.purs index 64c2ec2..4adde81 100644 --- a/src/Data/Time.purs +++ b/src/Data/Time.purs @@ -12,23 +12,19 @@ module Data.Time import Prelude import Data.Enum (fromEnum, toEnum) -import Data.Generic.Rep (class Generic) import Data.Int as Int import Data.Maybe (fromJust) import Data.Newtype (unwrap) import Data.Time.Component (Hour, Millisecond, Minute, Second) -import Data.Time.Duration (class Duration, Days(..), Milliseconds(..), fromDuration, toDuration) +import Data.Time.Duration (class Duration, Days(..), Milliseconds(..), fromDuration, negateDuration, toDuration) import Data.Tuple (Tuple(..)) - import Math as Math - import Partial.Unsafe (unsafePartial) data Time = Time Hour Minute Second Millisecond derive instance eqTime :: Eq Time derive instance ordTime :: Ord Time -derive instance genericTime :: Generic Time _ instance boundedTime :: Bounded Time where bottom = Time bottom bottom bottom bottom @@ -82,17 +78,20 @@ adjust d t = tLength = timeToMillis t dayLength = 86400000.0 wholeDays = Days $ Math.floor (unwrap d' / dayLength) - msAdjust = d' - fromDuration wholeDays - msAdjusted = tLength + msAdjust - wrap = if msAdjusted > maxTime then 1.0 else if msAdjusted < -maxTime then -1.0 else 0.0 + 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))) + (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)) @@ -121,4 +120,4 @@ millisToTime ms@(Milliseconds ms') = -- | 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 - timeToMillis t2) +diff t1 t2 = toDuration (timeToMillis t1 <> negateDuration (timeToMillis t2)) diff --git a/src/Data/Time/Component.purs b/src/Data/Time/Component.purs index 47ac537..bbc6977 100644 --- a/src/Data/Time/Component.purs +++ b/src/Data/Time/Component.purs @@ -8,7 +8,6 @@ module Data.Time.Component import Prelude import Data.Enum (class Enum, class BoundedEnum, toEnum, fromEnum, Cardinality(..)) -import Data.Generic.Rep (class Generic) import Data.Maybe (Maybe(..)) -- | An hour component for a time value. @@ -21,7 +20,6 @@ newtype Hour = Hour Int derive newtype instance eqHour :: Eq Hour derive newtype instance ordHour :: Ord Hour -derive instance genericHour :: Generic Hour _ instance boundedHour :: Bounded Hour where bottom = Hour 0 @@ -51,7 +49,6 @@ newtype Minute = Minute Int derive newtype instance eqMinute :: Eq Minute derive newtype instance ordMinute :: Ord Minute -derive instance genericMinute :: Generic Minute _ instance boundedMinute :: Bounded Minute where bottom = Minute 0 @@ -81,7 +78,6 @@ newtype Second = Second Int derive newtype instance eqSecond :: Eq Second derive newtype instance ordSecond :: Ord Second -derive instance genericSecond :: Generic Second _ instance boundedSecond :: Bounded Second where bottom = Second 0 @@ -112,7 +108,6 @@ newtype Millisecond = Millisecond Int derive newtype instance eqMillisecond :: Eq Millisecond derive newtype instance ordMillisecond :: Ord Millisecond -derive instance genericMillisecond :: Generic Millisecond _ instance boundedMillisecond :: Bounded Millisecond where bottom = Millisecond 0 diff --git a/src/Data/Time/Duration.purs b/src/Data/Time/Duration.purs index fc14610..a8b0503 100644 --- a/src/Data/Time/Duration.purs +++ b/src/Data/Time/Duration.purs @@ -2,18 +2,20 @@ module Data.Time.Duration where import Prelude -import Data.Generic.Rep (class Generic) import Data.Newtype (class Newtype, over) -- | A duration measured in milliseconds. newtype Milliseconds = Milliseconds Number derive instance newtypeMilliseconds :: Newtype Milliseconds _ -derive instance genericMilliseconds :: Generic Milliseconds _ derive newtype instance eqMilliseconds :: Eq Milliseconds derive newtype instance ordMilliseconds :: Ord Milliseconds -derive newtype instance semiringMilliseconds :: Semiring Milliseconds -derive newtype instance ringMilliseconds :: Ring 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 <> ")" @@ -22,11 +24,14 @@ instance showMilliseconds :: Show Milliseconds where newtype Seconds = Seconds Number derive instance newtypeSeconds :: Newtype Seconds _ -derive instance genericSeconds :: Generic Seconds _ derive newtype instance eqSeconds :: Eq Seconds derive newtype instance ordSeconds :: Ord Seconds -derive newtype instance semiringSeconds :: Semiring Seconds -derive newtype instance ringSeconds :: Ring 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 <> ")" @@ -35,11 +40,14 @@ instance showSeconds :: Show Seconds where newtype Minutes = Minutes Number derive instance newtypeMinutes :: Newtype Minutes _ -derive instance genericMinutes :: Generic Minutes _ derive newtype instance eqMinutes :: Eq Minutes derive newtype instance ordMinutes :: Ord Minutes -derive newtype instance semiringMinutes :: Semiring Minutes -derive newtype instance ringMinutes :: Ring 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 <> ")" @@ -48,11 +56,14 @@ instance showMinutes :: Show Minutes where newtype Hours = Hours Number derive instance newtypeHours :: Newtype Hours _ -derive instance genericHours :: Generic Hours _ derive newtype instance eqHours :: Eq Hours derive newtype instance ordHours :: Ord Hours -derive newtype instance semiringHours :: Semiring Hours -derive newtype instance ringHours :: Ring 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 <> ")" @@ -61,11 +72,14 @@ instance showHours :: Show Hours where newtype Days = Days Number derive instance newtypeDays :: Newtype Days _ -derive instance genericDays :: Generic Days _ derive newtype instance eqDays :: Eq Days derive newtype instance ordDays :: Ord Days -derive newtype instance semiringDays :: Semiring Days -derive newtype instance ringDays :: Ring 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 <> ")" @@ -79,6 +93,11 @@ class Duration a where 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 diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 062ceaa..4de3b6f 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -8,18 +8,14 @@ import Data.Array as Array import Data.Date as Date import Data.DateTime as DateTime import Data.DateTime.Instant as Instant -import Data.DateTime.Locale as Locale import Data.Either (Either(..), isRight) import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred) -import Data.Foldable (foldl, foldr, foldMap) import Data.Interval as Interval import Data.Interval.Duration.Iso as IsoDuration import Data.Maybe (Maybe(..), fromJust) import Data.Newtype (over, unwrap) -import Data.String (length) import Data.Time as Time import Data.Time.Duration as Duration -import Data.Traversable (sequence, traverse) import Data.Tuple (Tuple(..), snd) import Math (floor) import Partial.Unsafe (unsafePartial) @@ -77,10 +73,10 @@ main = do 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 zero t2 + 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 $ 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 @@ -145,7 +141,7 @@ main = do 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 $ 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 @@ -156,7 +152,7 @@ main = do 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 $ 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 @@ -181,31 +177,6 @@ main = do assert $ Instant.toDateTime (Instant.fromDateTime dt3) == dt3 assert $ Instant.toDateTime (Instant.fromDateTime dt4) == dt4 - -- locale ------------------------------------------------------------------ - - let locale = Locale.Locale (Just $ Locale.LocaleName "UTC") - $ Duration.Minutes 0.0 - let crLocalVal = Locale.LocalValue locale - - log "Check that LocalValue folds left" - assert $ foldl (<>) "prepend " (crLocalVal "foo") == "prepend foo" - - log "Check that LocalValue folds right" - assert $ foldr (<>) " append" (crLocalVal "foo") == "foo append" - - log "Check that LocalValue fold-maps" - assert $ foldMap ((<>) "prepend ") (crLocalVal "foo") == "prepend foo" - - log "Check that LocalValue sequences" - assert $ sequence (Locale.LocalValue locale $ Just "foo") - == (Just $ Locale.LocalValue locale "foo") - assert $ sequence (Locale.LocalValue locale (Nothing :: Maybe Int)) - == Nothing - - log "Check that LocalValue traverses" - assert $ traverse (Just <<< length) (crLocalVal "foo") - == (Just $ Locale.LocalValue locale 3) - log "All tests done" checkBounded :: forall e. Bounded e => Proxy e -> Effect Unit From e125b49e8433001294155edffca7de0c350b3b86 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 24 May 2018 02:33:21 +0100 Subject: [PATCH 25/54] Update dependencies, license --- LICENSE | 38 ++++++++++++++++++++++---------------- bower.json | 33 +++++++++++++++++++++------------ package.json | 4 ++-- 3 files changed, 45 insertions(+), 30 deletions(-) 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/bower.json b/bower.json index b5079b1..764bbf0 100644 --- a/bower.json +++ b/bower.json @@ -1,8 +1,7 @@ { "name": "purescript-datetime", "homepage": "https://github.com/purescript/purescript-datetime", - "description": "PureScript library for date and time values", - "license": "MIT", + "license": "BSD-3-Clause", "repository": { "type": "git", "url": "git://github.com/purescript/purescript-datetime.git" @@ -16,17 +15,27 @@ "package.json" ], "dependencies": { - "purescript-enums": "#compiler/0.12", - "purescript-functions": "#compiler/0.12", - "purescript-integers": "#compiler/0.12", - "purescript-foldable-traversable": "#compiler/0.12", - "purescript-ordered-collections": "#compiler/0.12", - "purescript-math": "#compiler/0.12", - "purescript-proxy": "#compiler/0.12" + "purescript-bifunctors": "^4.0.0", + "purescript-control": "^4.0.0", + "purescript-either": "^4.0.0", + "purescript-enums": "^4.0.0", + "purescript-foldable-traversable": "^4.0.0", + "purescript-functions": "^4.0.0", + "purescript-gen": "^2.0.0", + "purescript-integers": "^4.0.0", + "purescript-lists": "^5.0.0", + "purescript-math": "^2.1.1", + "purescript-maybe": "^4.0.0", + "purescript-newtype": "^3.0.0", + "purescript-ordered-collections": "^1.0.0", + "purescript-partial": "^2.0.0", + "purescript-prelude": "^4.0.0", + "purescript-tuples": "^5.0.0" }, "devDependencies": { - "purescript-assert": "#compiler/0.12", - "purescript-console": "#compiler/0.12", - "purescript-strings": "#compiler/0.12" + "purescript-assert": "^4.0.0", + "purescript-console": "^4.0.0", + "purescript-strings": "^4.0.0", + "purescript-proxy": "^3.0.0" } } diff --git a/package.json b/package.json index c9e5a5b..657080a 100644 --- a/package.json +++ b/package.json @@ -7,8 +7,8 @@ }, "devDependencies": { "eslint": "^4.19.1", - "pulp": "^12.0.x", - "purescript-psa": "^0.6.x", + "pulp": "^12.2.0", + "purescript-psa": "^0.6.0", "rimraf": "^2.6.2" } } From 24d91e0379ad9bcd66f5bce2cce3fd2c8151c891 Mon Sep 17 00:00:00 2001 From: Mikkel Christiansen Date: Thu, 16 Aug 2018 06:24:19 +0200 Subject: [PATCH 26/54] Added enum instance for Date and date implementation of adjust --- src/Data/Date.purs | 36 +++++++++++++++++++++++++++++++++--- test/Test/Main.purs | 7 +++++++ 2 files changed, 40 insertions(+), 3 deletions(-) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index 1ac11bd..c556fe3 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -9,16 +9,19 @@ module Data.Date , diff , isLeapYear , lastDayOfMonth + , adjust , module Data.Date.Component ) where import Prelude import Data.Date.Component (Day, Month(..), Weekday(..), Year) -import Data.Enum (toEnum, fromEnum) +import Data.Enum (class Enum, toEnum, fromEnum, succ, pred) import Data.Function.Uncurried (Fn3, runFn3, Fn4, runFn4, Fn6, runFn6) -import Data.Maybe (Maybe(..), fromJust) -import Data.Time.Duration (class Duration, Milliseconds, toDuration) +import Data.Int (fromNumber) +import Data.Ord (abs) +import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing, maybe) +import Data.Time.Duration (class Duration, Days(..), Milliseconds, toDuration) import Partial.Unsafe (unsafePartial) -- | A date value in the Gregorian calendar. @@ -51,6 +54,24 @@ instance boundedDate :: Bounded Date where instance showDate :: Show Date where 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 = let v = pred d in if v < toEnum 1 then Nothing else v + pm = pred m + l = lastDayOfMonth y m' + -- | The year component of a date value. year :: Date -> Year year (Date y _ _) = y @@ -69,6 +90,15 @@ 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 day duration is +-- | converted to an Int using fromNumber. +adjust :: Days -> Date -> Maybe Date +adjust (Days n) dt = maybe Nothing (\i -> go (abs i) (Just dt)) (fromNumber n) + where + adj = if n < 0.0 then pred else succ + go 0 dt' = dt' + go n' dt' = go (n' - 1) (adj =<< dt') + -- | Calculates the difference between two dates, returning the result as a -- | duration. diff :: forall d. Duration d => Date -> Date -> d diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 4de3b6f..e27d997 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -117,6 +117,8 @@ main = do 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 @@ -132,6 +134,11 @@ main = do 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)) d1 == Just d5 + -- datetime ---------------------------------------------------------------- let dt1 = DateTime.DateTime d1 t1 From 04d61af7ae217353fbccc798c720977e772c5349 Mon Sep 17 00:00:00 2001 From: Mikkel Christiansen Date: Fri, 21 Sep 2018 14:45:48 +0200 Subject: [PATCH 27/54] Changes requested --- src/Data/Date.purs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index c556fe3..b7aad18 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -20,7 +20,7 @@ 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.Ord (abs) -import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing, maybe) +import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing) import Data.Time.Duration (class Duration, Days(..), Milliseconds, toDuration) import Partial.Unsafe (unsafePartial) @@ -68,7 +68,7 @@ instance enumDate :: Enum Date 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 = let v = pred d in if v < toEnum 1 then Nothing else v + pd = pred d pm = pred m l = lastDayOfMonth y m' @@ -93,7 +93,7 @@ weekday = unsafePartial \(Date y m d) -> -- | Adjusts a date with a Duration in days. The day duration is -- | converted to an Int using fromNumber. adjust :: Days -> Date -> Maybe Date -adjust (Days n) dt = maybe Nothing (\i -> go (abs i) (Just dt)) (fromNumber n) +adjust (Days n) dt = fromNumber n >>= (\i -> go (abs i) (Just dt)) where adj = if n < 0.0 then pred else succ go 0 dt' = dt' From 64246dbf8a02267b5591c0354edb23503c94f0bb Mon Sep 17 00:00:00 2001 From: Mikkel Christiansen Date: Fri, 21 Sep 2018 21:35:11 +0200 Subject: [PATCH 28/54] Changed `adjust` to use "chunked" days --- src/Data/Date.purs | 32 +++++++++++++++++++++++++++----- test/Test/Main.purs | 3 +++ 2 files changed, 30 insertions(+), 5 deletions(-) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index b7aad18..bf3391d 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -19,7 +19,6 @@ 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.Ord (abs) import Data.Maybe (Maybe(..), fromJust, fromMaybe, isNothing) import Data.Time.Duration (class Duration, Days(..), Milliseconds, toDuration) import Partial.Unsafe (unsafePartial) @@ -93,11 +92,34 @@ weekday = unsafePartial \(Date y m d) -> -- | Adjusts a date with a Duration in days. The day duration is -- | converted to an Int using fromNumber. adjust :: Days -> Date -> Maybe Date -adjust (Days n) dt = fromNumber n >>= (\i -> go (abs i) (Just dt)) +adjust (Days n) date = + fromNumber n >>= \i -> (if i < 0 then adjustDown else adjustUp) i date where - adj = if n < 0.0 then pred else succ - go 0 dt' = dt' - go n' dt' = go (n' - 1) (adj =<< dt') + adjustUp :: Int -> Date -> Maybe Date + adjustUp 0 dt = Just dt + adjustUp i (Date y m d) = adjustUp i' =<< Date <$> y' <*> pure m' <*> d' + where + i' = if isNothing md then j - l - 1 else 0 + d' = if isNothing md then toEnum 1 else md + m' = if isNothing md then fromMaybe January sm else m + y' = if isNothing md && isNothing sm then succ y else Just y + j = i + fromEnum d + md = if j > l then Nothing else toEnum j + sm = succ m + l = fromEnum $ lastDayOfMonth y m + + adjustDown :: Int -> Date -> Maybe Date + adjustDown 0 dt = Just dt + adjustDown i (Date y m d) = adjustDown i' =<< Date <$> y' <*> pure m' <*> d' + where + i' = if isNothing md then j else 0 + d' = if isNothing md then Just l else md + m' = if isNothing md then fromMaybe December pm else m + y' = if isNothing md && isNothing pm then pred y else Just y + j = i + fromEnum d + md = if j < 1 then Nothing else toEnum j + pm = pred m + l = lastDayOfMonth y m' -- | Calculates the difference between two dates, returning the result as a -- | duration. diff --git a/test/Test/Main.purs b/test/Test/Main.purs index e27d997..efeef62 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -137,6 +137,9 @@ main = do 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 ---------------------------------------------------------------- From e63a2a0a3e615e6598b2bb84b787115d753412fe Mon Sep 17 00:00:00 2001 From: Mikkel Christiansen Date: Fri, 21 Sep 2018 23:09:08 +0200 Subject: [PATCH 29/54] Use enum methods to simplify adjust --- src/Data/Date.purs | 37 ++++++++++++------------------------- 1 file changed, 12 insertions(+), 25 deletions(-) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index bf3391d..ddda4a7 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -92,34 +92,21 @@ weekday = unsafePartial \(Date y m d) -> -- | Adjusts a date with a Duration in days. The day duration is -- | converted to an Int using fromNumber. adjust :: Days -> Date -> Maybe Date -adjust (Days n) date = - fromNumber n >>= \i -> (if i < 0 then adjustDown else adjustUp) i date +adjust (Days n) date = fromNumber n >>= flip adj date where - adjustUp :: Int -> Date -> Maybe Date - adjustUp 0 dt = Just dt - adjustUp i (Date y m d) = adjustUp i' =<< Date <$> y' <*> pure m' <*> d' + adj 0 dt = Just dt + adj i (Date y m d) = adj i' =<< dt' where - i' = if isNothing md then j - l - 1 else 0 - d' = if isNothing md then toEnum 1 else md - m' = if isNothing md then fromMaybe January sm else m - y' = if isNothing md && isNothing sm then succ y else Just y + 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 - md = if j > l then Nothing else toEnum j - sm = succ m - l = fromEnum $ lastDayOfMonth y m - - adjustDown :: Int -> Date -> Maybe Date - adjustDown 0 dt = Just dt - adjustDown i (Date y m d) = adjustDown i' =<< Date <$> y' <*> pure m' <*> d' - where - i' = if isNothing md then j else 0 - d' = if isNothing md then Just l else md - m' = if isNothing md then fromMaybe December pm else m - y' = if isNothing md && isNothing pm then pred y else Just y - j = i + fromEnum d - md = if j < 1 then Nothing else toEnum j - pm = pred m - l = lastDayOfMonth y m' + 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. From 78c15447174b021293f0dff875df4be0ae587d5f Mon Sep 17 00:00:00 2001 From: Mikkel Christiansen Date: Tue, 23 Oct 2018 13:58:07 +0200 Subject: [PATCH 30/54] Clarify valid range of days --- src/Data/Date.purs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index ddda4a7..9039d20 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -89,8 +89,9 @@ 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 day duration is --- | converted to an Int using fromNumber. +-- | Adjusts a date with a Duration in days. The number of days must +-- | fall within the valid range for an `Int` type otherwise `Nothing` +-- | is returned. adjust :: Days -> Date -> Maybe Date adjust (Days n) date = fromNumber n >>= flip adj date where From ae79529e3841f494d56d924484dc04d5420283d5 Mon Sep 17 00:00:00 2001 From: Mikkel Christiansen Date: Thu, 25 Oct 2018 17:21:20 +0200 Subject: [PATCH 31/54] Further clarification --- src/Data/Date.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Date.purs b/src/Data/Date.purs index 9039d20..fbee82b 100644 --- a/src/Data/Date.purs +++ b/src/Data/Date.purs @@ -90,8 +90,8 @@ weekday = unsafePartial \(Date y 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 --- | fall within the valid range for an `Int` type otherwise `Nothing` --- | is returned. +-- | 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 From 2bd4cebdc866dec58b6d302863fe5b0e01758ea5 Mon Sep 17 00:00:00 2001 From: bouzuya Date: Sat, 9 Feb 2019 18:24:30 +0900 Subject: [PATCH 32/54] fix toEnum --- src/Data/Date/Component.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Date/Component.purs b/src/Data/Date/Component.purs index 8c13315..2762eaa 100644 --- a/src/Data/Date/Component.purs +++ b/src/Data/Date/Component.purs @@ -35,7 +35,7 @@ instance enumYear :: Enum Year where instance boundedEnumYear :: BoundedEnum Year where cardinality = Cardinality 547580 toEnum n - | n >= (-271821) && n <= 275759 = Just (Year n) + | n >= (-271820) && n <= 275759 = Just (Year n) | otherwise = Nothing fromEnum (Year n) = n From 7bd2fb1f1f8c75cde1bb210403f17f94ccf94214 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 27 Apr 2020 17:02:39 +0100 Subject: [PATCH 33/54] Update CI --- .travis.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.travis.yml b/.travis.yml index d980b08..0bfe1a4 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,8 +5,8 @@ node_js: stable 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 + - TAG=$(basename $(curl --location --silent --output /dev/null -w %{url_effective} https://github.com/purescript/purescript/releases/latest)) + - curl --location --output $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 -g bower From 8aa91324de1a69713f6e3bee65636babb94056a9 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sun, 7 Jun 2020 15:15:02 +0100 Subject: [PATCH 34/54] Bump pulp version --- package.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.json b/package.json index 657080a..f3a5369 100644 --- a/package.json +++ b/package.json @@ -7,7 +7,7 @@ }, "devDependencies": { "eslint": "^4.19.1", - "pulp": "^12.2.0", + "pulp": "^15.0.0", "purescript-psa": "^0.6.0", "rimraf": "^2.6.2" } From 5807b1a832d40b48dcb3901cde873eadc27448a7 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Sun, 7 Jun 2020 16:18:48 +0100 Subject: [PATCH 35/54] Fix test command --- package.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.json b/package.json index f3a5369..42af30f 100644 --- a/package.json +++ b/package.json @@ -3,7 +3,7 @@ "scripts": { "clean": "rimraf output && rimraf .pulp-cache", "build": "eslint src && pulp build -- --censor-lib --strict", - "test": "pulp test --check-main-type Effect.Effect" + "test": "pulp test" }, "devDependencies": { "eslint": "^4.19.1", From 7362375423934233d67511d5b2c43e9c980132b5 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Mon, 16 Nov 2020 18:02:42 -0800 Subject: [PATCH 36/54] Update to v0.14.0-rc3 (#81) * Update TAG to v0.14.0-rc3; dependencies to master; psa to v0.8.0 * Remove dependency on --- .travis.yml | 3 ++- bower.json | 39 +++++++++++++++++++-------------------- package.json | 2 +- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/.travis.yml b/.travis.yml index 0bfe1a4..1994adc 100644 --- a/.travis.yml +++ b/.travis.yml @@ -5,7 +5,8 @@ node_js: stable env: - PATH=$HOME/purescript:$PATH install: - - TAG=$(basename $(curl --location --silent --output /dev/null -w %{url_effective} https://github.com/purescript/purescript/releases/latest)) + # - TAG=$(basename $(curl --location --silent --output /dev/null -w %{url_effective} https://github.com/purescript/purescript/releases/latest)) + - TAG=v0.14.0-rc3 - curl --location --output $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 diff --git a/bower.json b/bower.json index 764bbf0..ddfe98a 100644 --- a/bower.json +++ b/bower.json @@ -15,27 +15,26 @@ "package.json" ], "dependencies": { - "purescript-bifunctors": "^4.0.0", - "purescript-control": "^4.0.0", - "purescript-either": "^4.0.0", - "purescript-enums": "^4.0.0", - "purescript-foldable-traversable": "^4.0.0", - "purescript-functions": "^4.0.0", - "purescript-gen": "^2.0.0", - "purescript-integers": "^4.0.0", - "purescript-lists": "^5.0.0", - "purescript-math": "^2.1.1", - "purescript-maybe": "^4.0.0", - "purescript-newtype": "^3.0.0", - "purescript-ordered-collections": "^1.0.0", - "purescript-partial": "^2.0.0", - "purescript-prelude": "^4.0.0", - "purescript-tuples": "^5.0.0" + "purescript-bifunctors": "master", + "purescript-control": "master", + "purescript-either": "master", + "purescript-enums": "master", + "purescript-foldable-traversable": "master", + "purescript-functions": "master", + "purescript-gen": "master", + "purescript-integers": "master", + "purescript-lists": "master", + "purescript-math": "master", + "purescript-maybe": "master", + "purescript-newtype": "master", + "purescript-ordered-collections": "master", + "purescript-partial": "master", + "purescript-prelude": "master", + "purescript-tuples": "master" }, "devDependencies": { - "purescript-assert": "^4.0.0", - "purescript-console": "^4.0.0", - "purescript-strings": "^4.0.0", - "purescript-proxy": "^3.0.0" + "purescript-assert": "master", + "purescript-console": "master", + "purescript-strings": "master" } } diff --git a/package.json b/package.json index 42af30f..8985bcf 100644 --- a/package.json +++ b/package.json @@ -8,7 +8,7 @@ "devDependencies": { "eslint": "^4.19.1", "pulp": "^15.0.0", - "purescript-psa": "^0.6.0", + "purescript-psa": "^0.8.0", "rimraf": "^2.6.2" } } From 922b0cadd5099ee2b737cfa15130bc1fcf4c2667 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Fri, 4 Dec 2020 17:25:56 -0800 Subject: [PATCH 37/54] Migrate to GitHub Actions and update installation instructions. --- .github/workflows/ci.yml | 31 +++++++++++++++++++++++++++++++ .gitignore | 2 +- .travis.yml | 24 ------------------------ README.md | 4 ++-- 4 files changed, 34 insertions(+), 27 deletions(-) create mode 100644 .github/workflows/ci.yml delete mode 100644 .travis.yml diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..e2972ba --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,31 @@ +name: CI + +on: push + +jobs: + build: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + + - uses: purescript-contrib/setup-purescript@main + with: + purescript: "0.14.0-rc3" + + - uses: actions/setup-node@v1 + with: + node-version: "12" + + - 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 709fd09..7224331 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,7 @@ /.* !/.gitignore !/.eslintrc.json -!/.travis.yml +!/.github/ package-lock.json /bower_components/ /node_modules/ diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 1994adc..0000000 --- a/.travis.yml +++ /dev/null @@ -1,24 +0,0 @@ -language: node_js -dist: trusty -sudo: required -node_js: stable -env: - - PATH=$HOME/purescript:$PATH -install: - # - TAG=$(basename $(curl --location --silent --output /dev/null -w %{url_effective} https://github.com/purescript/purescript/releases/latest)) - - TAG=v0.14.0-rc3 - - curl --location --output $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 -g bower - - npm install -script: - - bower install --production - - npm run -s build - - bower install - - npm run -s test -after_success: -- >- - test $TRAVIS_TAG && - echo $GITHUB_TOKEN | pulp login && - echo y | pulp publish --no-push diff --git a/README.md b/README.md index 95767de..eb2671c 100644 --- a/README.md +++ b/README.md @@ -1,14 +1,14 @@ # purescript-datetime [![Latest release](http://img.shields.io/github/release/purescript/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) +[![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) Date and time types and functions. ## Installation ``` -bower install purescript-datetime +spago install datetime ``` ## Documentation From a365027b4bbedcd0363fb2915e0d0c0bfd6bc670 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Mon, 7 Dec 2020 19:45:01 -0800 Subject: [PATCH 38/54] Run CI on push / pull_request to master --- .github/workflows/ci.yml | 6 +++++- README.md | 1 + package.json | 4 ++-- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index e2972ba..55efa3d 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -1,6 +1,10 @@ name: CI -on: push +on: + push: + branches: [master] + pull_request: + branches: [master] jobs: build: diff --git a/README.md b/README.md index eb2671c..adcc9b6 100644 --- a/README.md +++ b/README.md @@ -2,6 +2,7 @@ [![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 types and functions. diff --git a/package.json b/package.json index 8985bcf..fd4391e 100644 --- a/package.json +++ b/package.json @@ -6,9 +6,9 @@ "test": "pulp test" }, "devDependencies": { - "eslint": "^4.19.1", + "eslint": "^7.15.0", "pulp": "^15.0.0", "purescript-psa": "^0.8.0", - "rimraf": "^2.6.2" + "rimraf": "^3.0.2" } } From 4ed0626e06c1404912573b7bb47c03ee42cc5bb1 Mon Sep 17 00:00:00 2001 From: antoine-fl Date: Fri, 18 Dec 2020 09:05:58 +0100 Subject: [PATCH 39/54] Fix genDate generator frequency (#83) --- src/Data/Date/Gen.purs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/Data/Date/Gen.purs b/src/Data/Date/Gen.purs index 6709a40..1608782 100644 --- a/src/Data/Date/Gen.purs +++ b/src/Data/Date/Gen.purs @@ -4,11 +4,21 @@ module Data.Date.Gen ) where import Prelude -import Control.Monad.Gen (class MonadGen) -import Data.Date (Date, canonicalDate) +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 = canonicalDate <$> genYear <*> genMonth <*> genDay +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 From 7d7931c6bcc260524476b098645aefd851695c89 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Sun, 10 Jan 2021 14:57:20 -0800 Subject: [PATCH 40/54] Generate changelog and add PR template (#84) * Generate CHANGELOG.md file using notes from previous GH releases * Add pull request template * Update CI in PS to v0.14.0-rc5 --- .github/PULL_REQUEST_TEMPLATE.md | 12 +++ .github/workflows/ci.yml | 2 +- CHANGELOG.md | 155 +++++++++++++++++++++++++++++++ 3 files changed, 168 insertions(+), 1 deletion(-) create mode 100644 .github/PULL_REQUEST_TEMPLATE.md create mode 100644 CHANGELOG.md 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 index 55efa3d..f4f44e5 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -14,7 +14,7 @@ jobs: - uses: purescript-contrib/setup-purescript@main with: - purescript: "0.14.0-rc3" + purescript: "0.14.0-rc5" - uses: actions/setup-node@v1 with: diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..b5f5bf6 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,155 @@ +# 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: + +## [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. + From 69880eb8bf97395d64fd5a8b6c6b19541b23a70b Mon Sep 17 00:00:00 2001 From: milesfrain Date: Mon, 18 Jan 2021 21:56:11 -0800 Subject: [PATCH 41/54] Changelog updates since v4.1.1 (#85) --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b5f5bf6..e72e1c7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,12 +5,16 @@ Notable changes to this project are documented in this file. The format is based ## [Unreleased] 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 From fd5c1551a2572da4317e9d6c0741225330a14e14 Mon Sep 17 00:00:00 2001 From: Nick Scheel <11701520+MonoidMusician@users.noreply.github.com> Date: Sun, 31 Jan 2021 15:32:59 -0500 Subject: [PATCH 42/54] Update for changes to Data.Map (#86) --- src/Data/Interval/Duration.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Interval/Duration.purs b/src/Data/Interval/Duration.purs index 252f77c..dac75c4 100644 --- a/src/Data/Interval/Duration.purs +++ b/src/Data/Interval/Duration.purs @@ -29,7 +29,7 @@ instance semigroupDuration :: Semigroup Duration where append (Duration a) (Duration b) = Duration (Map.unionWith (+) a b) instance monoidDuration :: Monoid Duration where - mempty = Duration mempty + mempty = Duration Map.empty data DurationComponent = Second | Minute | Hour | Day | Week | Month | Year derive instance eqDurationComponent :: Eq DurationComponent From e52f1fd50c05dad05709319d86b8b022b7c0485a Mon Sep 17 00:00:00 2001 From: Cyril Date: Fri, 26 Feb 2021 20:07:17 +0100 Subject: [PATCH 43/54] Prepare v5.0.0 release (#89) * Update CI to build with the latest version of the compiler * Update the bower repository URL to match the URL in the registry * Upgrade bower dependencies * Update the changelog --- .github/workflows/ci.yml | 2 -- CHANGELOG.md | 10 ++++++++++ bower.json | 40 ++++++++++++++++++++-------------------- 3 files changed, 30 insertions(+), 22 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f4f44e5..43d2897 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,8 +13,6 @@ jobs: - uses: actions/checkout@v2 - uses: purescript-contrib/setup-purescript@main - with: - purescript: "0.14.0-rc5" - uses: actions/setup-node@v1 with: diff --git a/CHANGELOG.md b/CHANGELOG.md index e72e1c7..eda80a4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,16 @@ Notable changes to this project are documented in this file. The format is based ## [Unreleased] +Breaking changes: + +New features: + +Bugfixes: + +Other improvements: + +## [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) diff --git a/bower.json b/bower.json index ddfe98a..2d1970d 100644 --- a/bower.json +++ b/bower.json @@ -4,7 +4,7 @@ "license": "BSD-3-Clause", "repository": { "type": "git", - "url": "git://github.com/purescript/purescript-datetime.git" + "url": "https://github.com/purescript/purescript-datetime.git" }, "ignore": [ "**/.*", @@ -15,26 +15,26 @@ "package.json" ], "dependencies": { - "purescript-bifunctors": "master", - "purescript-control": "master", - "purescript-either": "master", - "purescript-enums": "master", - "purescript-foldable-traversable": "master", - "purescript-functions": "master", - "purescript-gen": "master", - "purescript-integers": "master", - "purescript-lists": "master", - "purescript-math": "master", - "purescript-maybe": "master", - "purescript-newtype": "master", - "purescript-ordered-collections": "master", - "purescript-partial": "master", - "purescript-prelude": "master", - "purescript-tuples": "master" + "purescript-bifunctors": "^5.0.0", + "purescript-control": "^5.0.0", + "purescript-either": "^5.0.0", + "purescript-enums": "^5.0.0", + "purescript-foldable-traversable": "^5.0.0", + "purescript-functions": "^5.0.0", + "purescript-gen": "^3.0.0", + "purescript-integers": "^5.0.0", + "purescript-lists": "^6.0.0", + "purescript-math": "^3.0.0", + "purescript-maybe": "^5.0.0", + "purescript-newtype": "^4.0.0", + "purescript-ordered-collections": "^2.0.0", + "purescript-partial": "^3.0.0", + "purescript-prelude": "^5.0.0", + "purescript-tuples": "^6.0.0" }, "devDependencies": { - "purescript-assert": "master", - "purescript-console": "master", - "purescript-strings": "master" + "purescript-assert": "^5.0.0", + "purescript-console": "^5.0.0", + "purescript-strings": "^5.0.0" } } From e400d73438dab49863ddd170a5d3896e96398883 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Mon, 19 Apr 2021 17:07:10 -0700 Subject: [PATCH 44/54] Fix UnusedName warning revealed by v0.14.1 PS release (#91) * Fix UnusedName warning revealed by v0.14.1 PS release * Update changelog --- CHANGELOG.md | 1 + src/Data/Interval.purs | 10 +++++----- src/Data/Time.purs | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index eda80a4..54e93c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ New features: Bugfixes: Other improvements: +- Fix UnusedName warnings revealed by v0.14.1 PS release (#91) ## [v5.0.0](https://github.com/purescript/purescript-datetime/releases/tag/v5.0.0) - 2021-02-26 diff --git a/src/Data/Interval.purs b/src/Data/Interval.purs index 8d90412..b71de85 100644 --- a/src/Data/Interval.purs +++ b/src/Data/Interval.purs @@ -80,8 +80,8 @@ instance bifunctorInterval :: Bifunctor Interval where instance foldableInterval :: Foldable (Interval d) where foldl f z (StartEnd x y) = (z `f` x) `f` y - foldl f z (DurationEnd d x) = z `f` x - foldl f z (StartDuration x d) = z `f` x + 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 @@ -109,7 +109,7 @@ instance bitraversableInterval :: Bitraversable Interval where bisequence = bisequenceDefault instance extendInterval :: Extend (Interval d) where - extend f a@(StartEnd x y) = StartEnd (f a) (f a) - extend f a@(DurationEnd d x) = DurationEnd d (f a) - extend f a@(StartDuration x d) = StartDuration (f a) d + 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 f (DurationOnly d) = DurationOnly d diff --git a/src/Data/Time.purs b/src/Data/Time.purs index 4adde81..bf9a464 100644 --- a/src/Data/Time.purs +++ b/src/Data/Time.purs @@ -100,7 +100,7 @@ timeToMillis t = Milliseconds + Int.toNumber (fromEnum (millisecond t)) millisToTime :: Milliseconds -> Time -millisToTime ms@(Milliseconds ms') = +millisToTime (Milliseconds ms') = let hourLength = 3600000.0 minuteLength = 60000.0 From aa03f97391a34b31621010e0e3cab3b7c81c44c1 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Mon, 19 Apr 2021 17:09:14 -0700 Subject: [PATCH 45/54] Update changelog for v5.0.1 release --- CHANGELOG.md | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 54e93c5..ac6e353 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,7 +11,11 @@ New features: Bugfixes: Other improvements: -- Fix UnusedName warnings revealed by v0.14.1 PS release (#91) + +## [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 From 940009e510aa8c150a5905cc2c0198f807fea179 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Mon, 19 Apr 2021 17:09:35 -0700 Subject: [PATCH 46/54] v5.0.1 From 88d0b96e3f211a9dfe6d6389da9e07cf6445ff77 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Mon, 19 Apr 2021 17:11:19 -0700 Subject: [PATCH 47/54] Remove unused variable from Data.Interval --- src/Data/Interval.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Interval.purs b/src/Data/Interval.purs index b71de85..cff8f0b 100644 --- a/src/Data/Interval.purs +++ b/src/Data/Interval.purs @@ -112,4 +112,4 @@ 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 f (DurationOnly d) = DurationOnly d + extend _ (DurationOnly d) = DurationOnly d From ba36e78ce1e5a351ba6caa6d44d018edb3b6c0ec Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Mon, 19 Apr 2021 17:14:10 -0700 Subject: [PATCH 48/54] Update CHANGELOG.md --- CHANGELOG.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ac6e353..e615443 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,11 @@ Bugfixes: Other improvements: +## [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: From e110462829ea656d2bc0924266d4edff222108d4 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Mon, 19 Apr 2021 17:14:27 -0700 Subject: [PATCH 49/54] v5.0.2 From 89799b746af0a9d5d8b067495f03780602fff080 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Tue, 15 Mar 2022 15:50:39 -0700 Subject: [PATCH 50/54] Update to v0.15.0 (#93) * Migrated FFI to ES modules via 'lebab' * Removed '"use strict";' in FFI files * Update to CI to use 'unstable' purescript * Update pulp to 16.0.0-0 and psa to 0.8.2 * Update Bower dependencies to master * Update .eslintrc.json to ES6 * Added changelog entry --- .eslintrc.json | 6 ++---- .github/workflows/ci.yml | 2 ++ CHANGELOG.md | 1 + bower.json | 38 ++++++++++++++++++------------------ package.json | 4 ++-- src/Data/Date.js | 14 ++++++------- src/Data/DateTime.js | 10 ++++------ src/Data/DateTime/Instant.js | 10 ++++------ 8 files changed, 40 insertions(+), 45 deletions(-) diff --git a/.eslintrc.json b/.eslintrc.json index 84cef4f..1c6afb9 100644 --- a/.eslintrc.json +++ b/.eslintrc.json @@ -1,11 +1,9 @@ { "parserOptions": { - "ecmaVersion": 5 + "ecmaVersion": 6, + "sourceType": "module" }, "extends": "eslint:recommended", - "env": { - "commonjs": true - }, "rules": { "strict": [2, "global"], "block-scoped-var": 2, diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 43d2897..b6ebf3a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -13,6 +13,8 @@ jobs: - uses: actions/checkout@v2 - uses: purescript-contrib/setup-purescript@main + with: + purescript: "unstable" - uses: actions/setup-node@v1 with: diff --git a/CHANGELOG.md b/CHANGELOG.md index e615443..3bb4f45 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ Notable changes to this project are documented in this file. The format is based ## [Unreleased] Breaking changes: +- Migrate FFI to ES modules (#93 by @JordanMartinez) New features: diff --git a/bower.json b/bower.json index 2d1970d..5d0c03b 100644 --- a/bower.json +++ b/bower.json @@ -15,26 +15,26 @@ "package.json" ], "dependencies": { - "purescript-bifunctors": "^5.0.0", - "purescript-control": "^5.0.0", - "purescript-either": "^5.0.0", - "purescript-enums": "^5.0.0", - "purescript-foldable-traversable": "^5.0.0", - "purescript-functions": "^5.0.0", - "purescript-gen": "^3.0.0", - "purescript-integers": "^5.0.0", - "purescript-lists": "^6.0.0", - "purescript-math": "^3.0.0", - "purescript-maybe": "^5.0.0", - "purescript-newtype": "^4.0.0", - "purescript-ordered-collections": "^2.0.0", - "purescript-partial": "^3.0.0", - "purescript-prelude": "^5.0.0", - "purescript-tuples": "^6.0.0" + "purescript-bifunctors": "master", + "purescript-control": "master", + "purescript-either": "master", + "purescript-enums": "master", + "purescript-foldable-traversable": "master", + "purescript-functions": "master", + "purescript-gen": "master", + "purescript-integers": "master", + "purescript-lists": "master", + "purescript-math": "master", + "purescript-maybe": "master", + "purescript-newtype": "master", + "purescript-ordered-collections": "master", + "purescript-partial": "master", + "purescript-prelude": "master", + "purescript-tuples": "master" }, "devDependencies": { - "purescript-assert": "^5.0.0", - "purescript-console": "^5.0.0", - "purescript-strings": "^5.0.0" + "purescript-assert": "master", + "purescript-console": "master", + "purescript-strings": "master" } } diff --git a/package.json b/package.json index fd4391e..a1d6811 100644 --- a/package.json +++ b/package.json @@ -7,8 +7,8 @@ }, "devDependencies": { "eslint": "^7.15.0", - "pulp": "^15.0.0", - "purescript-psa": "^0.8.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 8125144..e7a7abc 100644 --- a/src/Data/Date.js +++ b/src/Data/Date.js @@ -1,5 +1,3 @@ -"use strict"; - var createDate = function (y, m, d) { var date = new Date(Date.UTC(y, m, d)); if (y >= 0 && y < 100) { @@ -8,17 +6,17 @@ var createDate = function (y, m, d) { return date; }; -exports.canonicalDateImpl = function (ctor, y, m, d) { +export function canonicalDateImpl(ctor, y, m, d) { var date = createDate(y, m - 1, d); return ctor(date.getUTCFullYear())(date.getUTCMonth() + 1)(date.getUTCDate()); -}; +} -exports.calcWeekday = function (y, m, d) { +export function calcWeekday(y, m, d) { return createDate(y, m - 1, d).getUTCDay(); -}; +} -exports.calcDiff = function (y1, m1, d1, y2, m2, d2) { +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/DateTime.js b/src/Data/DateTime.js index 7f172f0..86578b7 100644 --- a/src/Data/DateTime.js +++ b/src/Data/DateTime.js @@ -1,5 +1,3 @@ -"use strict"; - 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) { @@ -8,13 +6,13 @@ var createUTC = function (y, mo, d, h, m, s, ms) { return date.getTime(); }; -exports.calcDiff = function (rec1, rec2) { +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; -}; +} -exports.adjustImpl = function (just) { +export function adjustImpl(just) { return function (nothing) { return function (offset) { return function (rec) { @@ -32,4 +30,4 @@ exports.adjustImpl = function (just) { }; }; }; -}; +} diff --git a/src/Data/DateTime/Instant.js b/src/Data/DateTime/Instant.js index 9f883a9..c016c34 100644 --- a/src/Data/DateTime/Instant.js +++ b/src/Data/DateTime/Instant.js @@ -1,5 +1,3 @@ -"use strict"; - 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) { @@ -8,13 +6,13 @@ var createDateTime = function (y, m, d, h, mi, s, ms) { return dateTime; }; -exports.fromDateTimeImpl = function (y, mo, d, h, mi, s, ms) { +export function fromDateTimeImpl(y, mo, d, h, mi, s, ms) { return createDateTime(y, mo - 1, d, h, mi, s, ms).getTime(); -}; +} -exports.toDateTimeImpl = function (ctor) { +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()); }; -}; +} From ef5e4c867f59d78474ab838346d532727df5ead0 Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Mon, 28 Mar 2022 15:29:46 -0500 Subject: [PATCH 51/54] Drop math; update Math imports (#94) * Drop math; update Math imports * Add changelog entry * Fix test usage of math --- CHANGELOG.md | 1 + bower.json | 2 +- src/Data/Interval/Duration/Iso.purs | 6 +++--- src/Data/Time.purs | 10 +++++----- test/Test/Main.purs | 2 +- 5 files changed, 11 insertions(+), 10 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 3bb4f45..6c35ef3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ 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 diff --git a/bower.json b/bower.json index 5d0c03b..c710faa 100644 --- a/bower.json +++ b/bower.json @@ -24,9 +24,9 @@ "purescript-gen": "master", "purescript-integers": "master", "purescript-lists": "master", - "purescript-math": "master", "purescript-maybe": "master", "purescript-newtype": "master", + "purescript-numbers": "master", "purescript-ordered-collections": "master", "purescript-partial": "master", "purescript-prelude": "master", diff --git a/src/Data/Interval/Duration/Iso.purs b/src/Data/Interval/Duration/Iso.purs index 4b79068..19e42b1 100644 --- a/src/Data/Interval/Duration/Iso.purs +++ b/src/Data/Interval/Duration/Iso.purs @@ -17,11 +17,11 @@ 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) -import Math as Math newtype IsoDuration = IsoDuration Duration @@ -89,8 +89,8 @@ checkFractionalUse {asList} = case _.rest (span (snd >>> not isFractional) asLis Cons (Tuple c _) rest | checkRest rest -> pure (InvalidFractionalUse c) _ -> empty where - isFractional a = Math.floor a /= a - checkRest rest = unwrap (foldMap (snd >>> Math.abs >>> Additive) rest) > 0.0 + 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) -> diff --git a/src/Data/Time.purs b/src/Data/Time.purs index bf9a464..7224b32 100644 --- a/src/Data/Time.purs +++ b/src/Data/Time.purs @@ -14,11 +14,11 @@ import Prelude 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 Math as Math import Partial.Unsafe (unsafePartial) data Time = Time Hour Minute Second Millisecond @@ -77,7 +77,7 @@ adjust d t = d' = fromDuration d tLength = timeToMillis t dayLength = 86400000.0 - wholeDays = Days $ Math.floor (unwrap d' / dayLength) + 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 @@ -105,9 +105,9 @@ millisToTime (Milliseconds ms') = hourLength = 3600000.0 minuteLength = 60000.0 secondLength = 1000.0 - hours = Math.floor (ms' / hourLength) - minutes = Math.floor ((ms' - hours * hourLength) / minuteLength) - seconds = Math.floor ((ms' - (hours * hourLength + minutes * minuteLength)) / secondLength) + 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 $ diff --git a/test/Test/Main.purs b/test/Test/Main.purs index efeef62..2a33f63 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -14,10 +14,10 @@ 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 Math (floor) import Partial.Unsafe (unsafePartial) import Test.Assert (assert) import Type.Proxy (Proxy(..)) From a6a0cf1b0324964ad1854bc3377ed8766ba90e6f Mon Sep 17 00:00:00 2001 From: JordanMartinez Date: Wed, 27 Apr 2022 17:42:15 -0500 Subject: [PATCH 52/54] Prepare v6.0.0 release (1st PS 0.15.0-compatible release) (#95) * Update the bower dependencies * Update Node to 14 in CI * Update the changelog --- .github/workflows/ci.yml | 4 ++-- CHANGELOG.md | 10 ++++++++++ bower.json | 38 +++++++++++++++++++------------------- 3 files changed, 31 insertions(+), 21 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b6ebf3a..c69237a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -16,9 +16,9 @@ jobs: with: purescript: "unstable" - - uses: actions/setup-node@v1 + - uses: actions/setup-node@v2 with: - node-version: "12" + node-version: "14.x" - name: Install dependencies run: | diff --git a/CHANGELOG.md b/CHANGELOG.md index 6c35ef3..719baa9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,16 @@ Notable changes to this project are documented in this file. The format is based ## [Unreleased] +Breaking changes: + +New features: + +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) diff --git a/bower.json b/bower.json index c710faa..712032a 100644 --- a/bower.json +++ b/bower.json @@ -15,26 +15,26 @@ "package.json" ], "dependencies": { - "purescript-bifunctors": "master", - "purescript-control": "master", - "purescript-either": "master", - "purescript-enums": "master", - "purescript-foldable-traversable": "master", - "purescript-functions": "master", - "purescript-gen": "master", - "purescript-integers": "master", - "purescript-lists": "master", - "purescript-maybe": "master", - "purescript-newtype": "master", - "purescript-numbers": "master", - "purescript-ordered-collections": "master", - "purescript-partial": "master", - "purescript-prelude": "master", - "purescript-tuples": "master" + "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": "master", - "purescript-console": "master", - "purescript-strings": "master" + "purescript-assert": "^6.0.0", + "purescript-console": "^6.0.0", + "purescript-strings": "^6.0.0" } } From b17a455606df5d585d3bf01cebd747985690c47b Mon Sep 17 00:00:00 2001 From: Mark Eibes Date: Sun, 10 Jul 2022 23:51:03 +0200 Subject: [PATCH 53/54] Add helpers to go from Instants to a duration (#99) --- src/Data/DateTime/Instant.purs | 36 +++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/src/Data/DateTime/Instant.purs b/src/Data/DateTime/Instant.purs index d196249..6a04deb 100644 --- a/src/Data/DateTime/Instant.purs +++ b/src/Data/DateTime/Instant.purs @@ -1,5 +1,7 @@ module Data.DateTime.Instant - ( Instant + ( duration + , durationMillis + , Instant , instant , unInstant , fromDateTime @@ -13,8 +15,7 @@ import Data.DateTime (Millisecond, Second, Minute, Hour, Day, Year, DateTime(..) import Data.Enum (fromEnum, toEnum) import Data.Function.Uncurried (Fn7, runFn7) import Data.Maybe (Maybe(..), fromJust) -import Data.Time.Duration (Milliseconds(..)) - +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 @@ -74,3 +75,32 @@ toDateTime = toDateTimeImpl mkDateTime -- 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 + +-- | Get the amount of milliseconds between start and end +-- | for example: +-- | ``` +-- | do +-- | start <- Instant.now +-- | aLongRunningEffect +-- | end <- Instant.now +-- | let millis = duration end start +-- | log ("A long running effect took " <> show millis) +-- | ``` +durationMillis :: { start :: Instant, end :: Instant } → Milliseconds +durationMillis { start, end } = + unInstant end <> negateDuration (unInstant start) + +-- | Get the duration between start and end +-- | for example: +-- | ``` +-- | do +-- | start <- Instant.now # liftEffect +-- | aLongRunningAff +-- | end <- Instant.now # liftEffect +-- | let +-- | hours :: Hours +-- | hours = duration end start +-- | log ("A long running Aff took " <> show hours) +-- | ``` +duration :: forall d. Duration d => { start :: Instant, end :: Instant } → d +duration = durationMillis >>> toDuration From 7f6062346055e654942caed6c44612b59031f059 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 13 Jul 2022 11:56:56 +0100 Subject: [PATCH 54/54] Rename `duration` to `diff` for `Instant` (#100) * Rename `duration` to `diff` for `Instant` * Update CHANGELOG.md --- CHANGELOG.md | 11 +++++++++++ src/Data/DateTime/Instant.purs | 35 ++++++++++------------------------ test/Test/Main.purs | 26 +++++++++++++++++++------ 3 files changed, 41 insertions(+), 31 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 719baa9..cacc9ef 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,17 @@ 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: diff --git a/src/Data/DateTime/Instant.purs b/src/Data/DateTime/Instant.purs index 6a04deb..ad32d8c 100644 --- a/src/Data/DateTime/Instant.purs +++ b/src/Data/DateTime/Instant.purs @@ -1,12 +1,11 @@ module Data.DateTime.Instant - ( duration - , durationMillis - , Instant + ( Instant , instant , unInstant , fromDateTime , fromDate , toDateTime + , diff ) where import Prelude @@ -76,31 +75,17 @@ toDateTime = toDateTimeImpl mkDateTime 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 --- | Get the amount of milliseconds between start and end --- | for example: +-- | Calculates the difference between two instants, returning the result as a duration. +-- | For example: -- | ``` -- | do --- | start <- Instant.now --- | aLongRunningEffect --- | end <- Instant.now --- | let millis = duration end start --- | log ("A long running effect took " <> show millis) --- | ``` -durationMillis :: { start :: Instant, end :: Instant } → Milliseconds -durationMillis { start, end } = - unInstant end <> negateDuration (unInstant start) - --- | Get the duration between start and end --- | for example: --- | ``` --- | do --- | start <- Instant.now # liftEffect +-- | start <- liftEffect Now.now -- | aLongRunningAff --- | end <- Instant.now # liftEffect +-- | end <- liftEffect Now.now -- | let --- | hours :: Hours --- | hours = duration end start +-- | hours :: Duration.Hours +-- | hours = Instant.diff end start -- | log ("A long running Aff took " <> show hours) -- | ``` -duration :: forall d. Duration d => { start :: Instant, end :: Instant } → d -duration = durationMillis >>> toDuration +diff :: forall d. Duration d => Instant → Instant → d +diff dt1 dt2 = toDuration (unInstant dt1 <> negateDuration (unInstant dt2)) diff --git a/test/Test/Main.purs b/test/Test/Main.purs index 2a33f63..0388fcb 100644 --- a/test/Test/Main.purs +++ b/test/Test/Main.purs @@ -163,11 +163,16 @@ main = do 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 + 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) @@ -182,10 +187,19 @@ main = do 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 (Instant.fromDateTime dt1) == dt1 - assert $ Instant.toDateTime (Instant.fromDateTime dt2) == dt2 - assert $ Instant.toDateTime (Instant.fromDateTime dt3) == dt3 - assert $ Instant.toDateTime (Instant.fromDateTime dt4) == dt4 + 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"