├── .gitignore ├── elm.json ├── tests ├── elm.json ├── PatternTests.elm ├── Shim.elm ├── Language.elm └── Tests.elm ├── examples ├── elm.json └── Calendar.elm ├── LICENSE ├── CHANGELOG.md ├── src ├── Pattern.elm └── Date.elm └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "justinmimbs/date", 4 | "summary": "Work with dates without times or zones", 5 | "license": "BSD-3-Clause", 6 | "version": "4.1.0", 7 | "exposed-modules": [ 8 | "Date" 9 | ], 10 | "elm-version": "0.19.0 <= v < 0.20.0", 11 | "dependencies": { 12 | "elm/core": "1.0.0 <= v < 2.0.0", 13 | "elm/parser": "1.0.0 <= v < 2.0.0", 14 | "elm/time": "1.0.0 <= v < 2.0.0" 15 | }, 16 | "test-dependencies": {} 17 | } 18 | -------------------------------------------------------------------------------- /tests/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "../src", 5 | "." 6 | ], 7 | "elm-version": "0.19.1", 8 | "dependencies": { 9 | "direct": { 10 | "elm/core": "1.0.0", 11 | "elm/json": "1.0.0", 12 | "elm/parser": "1.0.0", 13 | "elm/time": "1.0.0" 14 | }, 15 | "indirect": {} 16 | }, 17 | "test-dependencies": { 18 | "direct": {}, 19 | "indirect": {} 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "../src", 5 | "." 6 | ], 7 | "elm-version": "0.19.0", 8 | "dependencies": { 9 | "direct": { 10 | "elm/browser": "1.0.0", 11 | "elm/core": "1.0.0", 12 | "elm/html": "1.0.0", 13 | "elm/parser": "1.1.0", 14 | "elm/time": "1.0.0" 15 | }, 16 | "indirect": { 17 | "elm/json": "1.0.0", 18 | "elm/url": "1.0.0", 19 | "elm/virtual-dom": "1.0.0" 20 | } 21 | }, 22 | "test-dependencies": { 23 | "direct": {}, 24 | "indirect": {} 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /tests/PatternTests.elm: -------------------------------------------------------------------------------- 1 | module PatternTests exposing (test_fromString) 2 | 3 | import Pattern exposing (Pattern, Token) 4 | import Shim exposing (Test, describe, equal, test) 5 | 6 | 7 | f : Char -> Int -> Token 8 | f = 9 | Pattern.Field 10 | 11 | 12 | l : String -> Token 13 | l = 14 | Pattern.Literal 15 | 16 | 17 | test_fromString : Test 18 | test_fromString = 19 | let 20 | toTest : ( String, Pattern ) -> Test 21 | toTest ( input, expected ) = 22 | test input <| \() -> Pattern.fromString input |> equal expected 23 | in 24 | describe "fromString" <| 25 | List.map 26 | toTest 27 | [ ( "aaa", [ f 'a' 3 ] ) 28 | , ( "abbccc", [ f 'a' 1, f 'b' 2, f 'c' 3 ] ) 29 | , ( "''dddd''eeeee", [ l "'", f 'd' 4, l "'", f 'e' 5 ] ) 30 | , ( "aa-bb-cc//#!0.dd", [ f 'a' 2, l "-", f 'b' 2, l "-", f 'c' 2, l "//#!0.", f 'd' 2 ] ) 31 | , ( "a'''bbb'", [ f 'a' 1, l "'bbb" ] ) 32 | , ( "a'''bbb", [ f 'a' 1, l "'bbb" ] ) 33 | , ( "'o''clock'", [ l "o'clock" ] ) 34 | , ( "'''aaa ' '' - ''' '' '' '..' a '", [ l "'aaa ' - ' ' ' .. a " ] ) 35 | ] 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause 2 | 3 | Copyright (c) 2018, Justin Mimbs. All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | 1. Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 23 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 24 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 25 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /tests/Shim.elm: -------------------------------------------------------------------------------- 1 | module Shim exposing (Expectation, Test, describe, equal, run, test) 2 | 3 | -- temporary shim for elm-test 4 | 5 | 6 | type Test 7 | = One String (() -> Expectation) 8 | | Many String (List Test) 9 | 10 | 11 | type Expectation 12 | = Pass 13 | | NotEqual ( String, String ) 14 | 15 | 16 | equal : a -> a -> Expectation 17 | equal x y = 18 | if x == y then 19 | Pass 20 | 21 | else 22 | NotEqual ( Debug.toString x, Debug.toString y ) 23 | 24 | 25 | test : String -> (() -> Expectation) -> Test 26 | test = 27 | One 28 | 29 | 30 | describe : String -> List Test -> Test 31 | describe = 32 | Many 33 | 34 | 35 | {-| test -> ( count of tests run, [ ( failing test context, not-equal pair ) ] ) 36 | -} 37 | run : Test -> ( Int, List ( List String, ( String, String ) ) ) 38 | run t = 39 | case t of 40 | One desc thunk -> 41 | ( 1 42 | , case thunk () of 43 | Pass -> 44 | [] 45 | 46 | NotEqual pair -> 47 | [ ( [ desc ], pair ) ] 48 | ) 49 | 50 | Many desc tests -> 51 | List.foldl 52 | (\t1 result -> 53 | run t1 54 | |> Tuple.mapSecond (List.map (Tuple.mapFirst ((::) desc))) 55 | |> append result 56 | ) 57 | empty 58 | tests 59 | 60 | 61 | empty : ( Int, List a ) 62 | empty = 63 | ( 0, [] ) 64 | 65 | 66 | append : ( Int, List a ) -> ( Int, List a ) -> ( Int, List a ) 67 | append ( n2, list2 ) ( n1, list1 ) = 68 | ( n1 + n2, list1 ++ list2 ) 69 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## 4.1.0 - 2024-03-09 4 | 5 | #### Added 6 | - Formatting helper function (thanks, @kutyel) 7 | - `withOrdinalSuffix` 8 | 9 | 10 | ## 4.0.1 - 2022-02-27 11 | 12 | #### Fixed 13 | - `fromIsoString` function now provides detailed error messages when given out-of-range date parts (fixes #31) 14 | 15 | 16 | ## 4.0.0 - 2021-09-09 17 | 18 | #### Changed 19 | - `today` type signature relaxed from `Task Never Date` to `Task x Date` (thank you, [@kofigumbs](https://github.com/kofigumbs)) 20 | 21 | 22 | ## 3.2.1 - 2020-06-08 23 | 24 | #### Fixed 25 | - `fromIsoString` function no longer gives redundant error messages 26 | 27 | 28 | ## 3.2.0 - 2019-09-11 29 | 30 | #### Added 31 | - Helper functions (thank you, [@2mol](https://github.com/2mol)) 32 | - `min` 33 | - `max` 34 | 35 | 36 | ## 3.1.2 - 2018-10-04 37 | 38 | #### Fixed 39 | - `fromIsoString` function now has better error messages 40 | 41 | 42 | ## 3.1.1 - 2018-09-16 43 | 44 | _Updated documentation_ 45 | 46 | 47 | ## 3.1.0 - 2018-09-12 48 | 49 | #### Added 50 | - Language support 51 | - `formatWithLanguage` function 52 | - `Language` type 53 | - Ordering helper functions 54 | - `compare` 55 | - `isBetween` 56 | - `clamp` 57 | 58 | 59 | ## 3.0.0 - 2018-09-10 60 | 61 | #### Added 62 | - `fromPosix` function 63 | 64 | #### Removed 65 | - `Date.RataDie` module 66 | 67 | 68 | ## 2.0.2 - 2018-09-06 69 | 70 | #### Fixed 71 | - Dates before year 1 are now handled correctly 72 | 73 | 74 | ## 2.0.1 - 2018-09-02 75 | 76 | _Updated documentation_ 77 | 78 | 79 | ## 2.0.0 - 2018-09-02 80 | 81 | #### Changed 82 | - `Month` and `Weekday` types were replaced by those from `elm/time` 83 | - `toFormattedString` function was renamed to `format` 84 | 85 | #### Removed 86 | - Record helper functions 87 | - `toCalendarDate` 88 | - `toOrdinalDate` 89 | - `toWeekDate` 90 | 91 | 92 | ## 1.1.0 - 2018-08-31 93 | 94 | #### Added 95 | - `today` task 96 | 97 | 98 | ## 1.0.0 - 2018-08-21 99 | -------------------------------------------------------------------------------- /tests/Language.elm: -------------------------------------------------------------------------------- 1 | module Language exposing (fr) 2 | 3 | import Date 4 | import Time exposing (Month(..), Weekday(..)) 5 | 6 | 7 | fr : Date.Language 8 | fr = 9 | { monthName = fr_monthName 10 | , monthNameShort = fr_monthNameShort 11 | , weekdayName = fr_weekdayName 12 | , weekdayNameShort = fr_weekdayName >> String.left 3 13 | , dayWithSuffix = fr_dayWithSuffix 14 | } 15 | 16 | 17 | fr_monthName : Month -> String 18 | fr_monthName month = 19 | case month of 20 | Jan -> 21 | "janvier" 22 | 23 | Feb -> 24 | "février" 25 | 26 | Mar -> 27 | "mars" 28 | 29 | Apr -> 30 | "avril" 31 | 32 | May -> 33 | "mai" 34 | 35 | Jun -> 36 | "juin" 37 | 38 | Jul -> 39 | "juillet" 40 | 41 | Aug -> 42 | "août" 43 | 44 | Sep -> 45 | "septembre" 46 | 47 | Oct -> 48 | "octobre" 49 | 50 | Nov -> 51 | "novembre" 52 | 53 | Dec -> 54 | "décembre" 55 | 56 | 57 | fr_monthNameShort : Month -> String 58 | fr_monthNameShort month = 59 | case month of 60 | Jan -> 61 | "janv." 62 | 63 | Feb -> 64 | "févr." 65 | 66 | Mar -> 67 | "mars" 68 | 69 | Apr -> 70 | "avr." 71 | 72 | May -> 73 | "mai" 74 | 75 | Jun -> 76 | "juin" 77 | 78 | Jul -> 79 | "juill." 80 | 81 | Aug -> 82 | "août" 83 | 84 | Sep -> 85 | "sept." 86 | 87 | Oct -> 88 | "oct." 89 | 90 | Nov -> 91 | "nov." 92 | 93 | Dec -> 94 | "déc." 95 | 96 | 97 | fr_weekdayName : Weekday -> String 98 | fr_weekdayName weekday = 99 | case weekday of 100 | Mon -> 101 | "lundi" 102 | 103 | Tue -> 104 | "mardi" 105 | 106 | Wed -> 107 | "mercredi" 108 | 109 | Thu -> 110 | "jeudi" 111 | 112 | Fri -> 113 | "vendredi" 114 | 115 | Sat -> 116 | "samedi" 117 | 118 | Sun -> 119 | "dimanche" 120 | 121 | 122 | fr_dayWithSuffix : Int -> String 123 | fr_dayWithSuffix day = 124 | if day == 1 then 125 | "1er" 126 | 127 | else 128 | String.fromInt day 129 | -------------------------------------------------------------------------------- /src/Pattern.elm: -------------------------------------------------------------------------------- 1 | module Pattern exposing (Pattern, Token(..), fromString) 2 | 3 | import Char 4 | import Parser exposing ((|.), (|=), Parser) 5 | 6 | 7 | 8 | -- date formatting pattern 9 | 10 | 11 | type alias Pattern = 12 | List Token 13 | 14 | 15 | type Token 16 | = Field Char Int 17 | | Literal String 18 | 19 | 20 | fromString : String -> Pattern 21 | fromString str = 22 | Parser.run (patternHelp []) str 23 | |> Result.withDefault [ Literal str ] 24 | 25 | 26 | 27 | -- parser 28 | 29 | 30 | field : Parser Token 31 | field = 32 | Parser.chompIf Char.isAlpha 33 | |> Parser.getChompedString 34 | |> Parser.andThen fieldRepeats 35 | 36 | 37 | fieldRepeats : String -> Parser Token 38 | fieldRepeats str = 39 | case String.toList str of 40 | [ char ] -> 41 | Parser.succeed (\x y -> Field char (1 + (y - x))) 42 | |= Parser.getOffset 43 | |. Parser.chompWhile ((==) char) 44 | |= Parser.getOffset 45 | 46 | _ -> 47 | Parser.problem "expected exactly one char" 48 | 49 | 50 | escapedQuote : Parser Token 51 | escapedQuote = 52 | Parser.succeed (Literal "'") 53 | |. Parser.token "''" 54 | 55 | 56 | literal : Parser Token 57 | literal = 58 | Parser.succeed () 59 | |. Parser.chompIf isLiteralChar 60 | |. Parser.chompWhile isLiteralChar 61 | |> Parser.getChompedString 62 | |> Parser.map Literal 63 | 64 | 65 | isLiteralChar : Char -> Bool 66 | isLiteralChar char = 67 | char /= '\'' && not (Char.isAlpha char) 68 | 69 | 70 | quoted : Parser Token 71 | quoted = 72 | Parser.succeed Literal 73 | |. Parser.chompIf ((==) '\'') 74 | |= quotedHelp "" 75 | |. Parser.oneOf 76 | [ Parser.chompIf ((==) '\'') 77 | , Parser.end -- lenient parse for unclosed quotes 78 | ] 79 | 80 | 81 | quotedHelp : String -> Parser String 82 | quotedHelp result = 83 | Parser.oneOf 84 | [ Parser.succeed () 85 | |. Parser.chompIf ((/=) '\'') 86 | |. Parser.chompWhile ((/=) '\'') 87 | |> Parser.getChompedString 88 | |> Parser.andThen (\str -> quotedHelp (result ++ str)) 89 | , Parser.token "''" 90 | |> Parser.andThen (\_ -> quotedHelp (result ++ "'")) 91 | , Parser.succeed result 92 | ] 93 | 94 | 95 | patternHelp : List Token -> Parser (List Token) 96 | patternHelp tokens = 97 | Parser.oneOf 98 | [ Parser.oneOf 99 | [ field 100 | , literal 101 | , escapedQuote 102 | , quoted 103 | ] 104 | |> Parser.andThen (\token -> patternHelp (token :: tokens)) 105 | , Parser.lazy 106 | (\_ -> Parser.succeed (finalize tokens)) 107 | ] 108 | 109 | 110 | {-| Reverse list and combine consecutive Literals. 111 | -} 112 | finalize : List Token -> List Token 113 | finalize = 114 | List.foldl 115 | (\token tokens -> 116 | case ( token, tokens ) of 117 | ( Literal x, (Literal y) :: rest ) -> 118 | Literal (x ++ y) :: rest 119 | 120 | _ -> 121 | token :: tokens 122 | ) 123 | [] 124 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # date 2 | 3 | This Elm package provides a simple `Date` type for working with dates without times or zones. 4 | 5 | 6 | ## Installation 7 | 8 | ```sh 9 | elm install justinmimbs/date 10 | ``` 11 | 12 | 13 | ## Overview 14 | 15 | - Get the current local date: [`today`][today] 16 | - Get dates from `Posix` times: [`fromPosix`][fromPosix] 17 | - Convert `Date` values both to and from: 18 | - [Calendar dates][fromCalendarDate] (`2018 Sep 26`) 19 | - [ISO week dates][fromWeekDate] (`2018 39 Wed`) 20 | - [Ordinal dates][fromOrdinalDate] (`2018 269`) 21 | - [ISO 8601 strings][fromIsoString] (`"2018-09-26"`) 22 | - [Rata Die][fromRataDie] (`736963`) 23 | - Format dates for display: [`format`][format], [`formatWithLanguage`][formatWithLanguage] 24 | - Manipulate dates: [`add`][add], [`floor`][floor], [`ceiling`][ceiling] 25 | - Diff dates: [`diff`][diff] 26 | - Create lists of dates: [`range`][range] 27 | - Helpers: [`compare`][compare], [`isBetween`][isBetween], [`min`][min], [`max`][max], [`clamp`][clamp] 28 | 29 | [today]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#today 30 | [fromPosix]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#fromPosix 31 | [fromCalendarDate]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#fromCalendarDate 32 | [fromWeekDate]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#fromWeekDate 33 | [fromOrdinalDate]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#fromOrdinalDate 34 | [fromIsoString]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#fromIsoString 35 | [fromRataDie]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#fromRataDie 36 | [format]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#format 37 | [formatWithLanguage]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#formatWithLanguage 38 | [add]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#add 39 | [floor]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#floor 40 | [ceiling]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#ceiling 41 | [diff]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#diff 42 | [range]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#range 43 | [compare]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#compare 44 | [isBetween]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#isBetween 45 | [min]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#min 46 | [max]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#max 47 | [clamp]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date#clamp 48 | 49 | 50 | ## Examples 51 | 52 | These examples are only meant to give a feel for the library; see [the docs][docs] for the full API. 53 | 54 | [docs]: https://package.elm-lang.org/packages/justinmimbs/date/latest/Date 55 | 56 | 57 | ### Create a date and format it 58 | 59 | ```elm 60 | import Date 61 | import Time exposing (Month(..)) 62 | 63 | Date.fromCalendarDate 2018 Sep 26 64 | |> Date.format "EEEE, MMMM ddd, yyyy" 65 | == "Wednesday, September 26th, 2018" 66 | ``` 67 | 68 | 69 | ### Find the next Saturday after a date 70 | 71 | ```elm 72 | import Date exposing (Interval(..), Unit(..)) 73 | import Time exposing (Month(..)) 74 | 75 | Date.fromCalendarDate 2018 Sep 26 76 | |> Date.floor Saturday 77 | |> Date.add Weeks 1 78 | |> Date.toIsoString 79 | == "2018-09-29" 80 | ``` 81 | 82 | 83 | ### List the third Thursday of the month for six months of a year 84 | 85 | ```elm 86 | import Date exposing (Date, Interval(..), Unit(..)) 87 | 88 | start : Date 89 | start = 90 | Date.fromOrdinalDate 2019 1 91 | 92 | thirdThursday : Date -> Date 93 | thirdThursday date = 94 | date |> Date.add Weeks 2 |> Date.ceiling Thursday 95 | 96 | Date.range Month 1 start (start |> Date.add Months 6) 97 | |> List.map thirdThursday 98 | |> List.map Date.toIsoString 99 | == [ "2019-01-17" 100 | , "2019-02-21" 101 | , "2019-03-21" 102 | , "2019-04-18" 103 | , "2019-05-16" 104 | , "2019-06-20" 105 | ] 106 | ``` 107 | -------------------------------------------------------------------------------- /examples/Calendar.elm: -------------------------------------------------------------------------------- 1 | module Calendar exposing (main) 2 | 3 | import Browser 4 | import Date exposing (Date, Interval(..), Unit(..)) 5 | import Html exposing (Html) 6 | import Html.Attributes 7 | import Task exposing (Task) 8 | import Time exposing (Month(..)) 9 | 10 | 11 | main : Program () Model Msg 12 | main = 13 | Browser.document 14 | { init = always init 15 | , view = view 16 | , update = update 17 | , subscriptions = always Sub.none 18 | } 19 | 20 | 21 | type alias Model = 22 | Date 23 | 24 | 25 | type Msg 26 | = ReceiveDate Date 27 | 28 | 29 | init : ( Model, Cmd Msg ) 30 | init = 31 | ( Date.fromCalendarDate 2019 Jan 1 32 | , Date.today |> Task.perform ReceiveDate 33 | ) 34 | 35 | 36 | 37 | -- update 38 | 39 | 40 | update : Msg -> Model -> ( Model, Cmd Msg ) 41 | update (ReceiveDate today) _ = 42 | ( today 43 | , Cmd.none 44 | ) 45 | 46 | 47 | 48 | -- helpers 49 | 50 | 51 | monthDates : Int -> Month -> List Date 52 | monthDates year month = 53 | let 54 | start = 55 | Date.fromCalendarDate year month 1 56 | |> Date.floor Monday 57 | 58 | until = 59 | start |> Date.add Days 42 60 | in 61 | Date.range Day 1 start until 62 | 63 | 64 | groupsOf : Int -> List a -> List (List a) 65 | groupsOf n list = 66 | if List.isEmpty list then 67 | [] 68 | 69 | else 70 | List.take n list :: groupsOf n (List.drop n list) 71 | 72 | 73 | 74 | -- view 75 | 76 | 77 | view : Model -> Browser.Document Msg 78 | view date = 79 | Browser.Document 80 | "Calendar" 81 | [ Html.div 82 | [ Html.Attributes.style "padding" "2em" 83 | , Html.Attributes.style "font-family" "Helvetica, Arial, san-serif" 84 | , Html.Attributes.style "font-size" "16px" 85 | ] 86 | [ Html.h2 87 | [ Html.Attributes.style "font-size" "16px" 88 | , Html.Attributes.style "margin" "0" 89 | , Html.Attributes.style "padding" "0 0.5em 2em" 90 | ] 91 | [ Html.text (date |> Date.format "MMMM yyyy") 92 | ] 93 | , viewMonthTable date 94 | ] 95 | ] 96 | 97 | 98 | weekdayHeader : Html a 99 | weekdayHeader = 100 | Html.thead 101 | [] 102 | [ Html.tr 103 | [] 104 | ([ "Mo", "Tu", "We", "Th", "Fr", "Sa", "Su" ] 105 | |> List.map 106 | (\str -> 107 | Html.th 108 | [ Html.Attributes.style "padding" "0.5em" 109 | , Html.Attributes.style "font-weight" "normal" 110 | , Html.Attributes.style "font-style" "italic" 111 | , Html.Attributes.style "color" "gray" 112 | ] 113 | [ Html.text str 114 | ] 115 | ) 116 | ) 117 | ] 118 | 119 | 120 | viewMonthTable : Date -> Html a 121 | viewMonthTable target = 122 | let 123 | weeks = 124 | monthDates (Date.year target) (Date.month target) 125 | |> groupsOf 7 126 | in 127 | Html.table 128 | [ Html.Attributes.style "border-collapse" "collapse" 129 | , Html.Attributes.style "text-align" "right" 130 | ] 131 | [ weekdayHeader 132 | , Html.tbody 133 | [] 134 | (weeks 135 | |> List.map 136 | (\weekdates -> 137 | Html.tr 138 | [] 139 | (weekdates 140 | |> List.map 141 | (\date -> 142 | let 143 | color = 144 | if Date.month date == Date.month target then 145 | "black" 146 | 147 | else 148 | "lightgray" 149 | 150 | background = 151 | if date == target then 152 | "lightskyblue" 153 | 154 | else 155 | "transparent" 156 | in 157 | Html.td 158 | [ Html.Attributes.style "padding" "0.5em" 159 | , Html.Attributes.style "background" background 160 | , Html.Attributes.style "color" color 161 | ] 162 | [ Html.text (Date.day date |> String.fromInt) 163 | ] 164 | ) 165 | ) 166 | ) 167 | ) 168 | ] 169 | -------------------------------------------------------------------------------- /src/Date.elm: -------------------------------------------------------------------------------- 1 | module Date exposing 2 | ( Date 3 | , Month, Weekday 4 | , today, fromPosix, fromCalendarDate, fromWeekDate, fromOrdinalDate, fromIsoString, fromRataDie 5 | , toIsoString, toRataDie 6 | , year, month, day, weekYear, weekNumber, weekday, ordinalDay, quarter, monthNumber, weekdayNumber 7 | , format, withOrdinalSuffix 8 | , Language, formatWithLanguage 9 | , Unit(..), add, diff 10 | , Interval(..), ceiling, floor 11 | , range 12 | , compare, isBetween, min, max, clamp 13 | , monthToNumber, numberToMonth, weekdayToNumber, numberToWeekday 14 | ) 15 | 16 | {-| 17 | 18 | @docs Date 19 | 20 | @docs Month, Weekday 21 | 22 | 23 | # Create 24 | 25 | @docs today, fromPosix, fromCalendarDate, fromWeekDate, fromOrdinalDate, fromIsoString, fromRataDie 26 | 27 | 28 | # Convert 29 | 30 | @docs toIsoString, toRataDie 31 | 32 | 33 | # Extract 34 | 35 | @docs year, month, day, weekYear, weekNumber, weekday, ordinalDay, quarter, monthNumber, weekdayNumber 36 | 37 | 38 | # Format 39 | 40 | @docs format, withOrdinalSuffix 41 | 42 | 43 | ## Custom Languages 44 | 45 | @docs Language, formatWithLanguage 46 | 47 | 48 | # Arithmetic 49 | 50 | @docs Unit, add, diff 51 | 52 | 53 | # Rounding 54 | 55 | @docs Interval, ceiling, floor 56 | 57 | 58 | # Lists 59 | 60 | @docs range 61 | 62 | 63 | # Ordering 64 | 65 | @docs compare, isBetween, min, max, clamp 66 | 67 | 68 | # Month and Weekday helpers 69 | 70 | @docs monthToNumber, numberToMonth, weekdayToNumber, numberToWeekday 71 | 72 | -} 73 | 74 | import Parser exposing ((|.), (|=), Parser) 75 | import Pattern exposing (Token(..)) 76 | import Task exposing (Task) 77 | import Time exposing (Month(..), Posix, Weekday(..)) 78 | 79 | 80 | {-| The `Month` type used in this package is an alias of [`Month`][timemonth] 81 | from `elm/time`. To express literal values, like `Jan`, you must import them 82 | from `Time`. 83 | 84 | import Date 85 | import Time exposing (Month(..)) 86 | 87 | Date.fromCalendarDate 2020 Jan 1 88 | 89 | [timemonth]: https://package.elm-lang.org/packages/elm/time/latest/Time#Month 90 | 91 | -} 92 | type alias Month = 93 | Time.Month 94 | 95 | 96 | {-| The `Weekday` type used in this package is an alias of [`Weekday`][timeweekday] 97 | from `elm/time`. To express literal values, like `Mon`, you must import them 98 | from `Time`. 99 | 100 | import Date 101 | import Time exposing (Weekday(..)) 102 | 103 | Date.fromWeekDate 2020 1 Mon 104 | 105 | [timeweekday]: https://package.elm-lang.org/packages/elm/time/latest/Time#Weekday 106 | 107 | -} 108 | type alias Weekday = 109 | Time.Weekday 110 | 111 | 112 | type alias RataDie = 113 | Int 114 | 115 | 116 | {-| Represents a date. 117 | -} 118 | type Date 119 | = RD RataDie 120 | 121 | 122 | {-| [Rata Die][ratadie] is a system for assigning numbers to calendar days, 123 | where the number 1 represents the date _1 January 0001_. 124 | 125 | You can losslessly convert a `Date` to and from an `Int` representing the date 126 | in Rata Die. This makes it a convenient representation for transporting dates 127 | or using them as comparables. For all date values: 128 | 129 | (date |> toRataDie |> fromRataDie) 130 | == date 131 | 132 | [ratadie]: https://en.wikipedia.org/wiki/Rata_Die 133 | 134 | -} 135 | fromRataDie : Int -> Date 136 | fromRataDie rd = 137 | RD rd 138 | 139 | 140 | {-| Convert a date to its number representation in Rata Die (see 141 | [`fromRataDie`](#fromRataDie)). For all date values: 142 | 143 | (date |> toRataDie |> fromRataDie) 144 | == date 145 | 146 | -} 147 | toRataDie : Date -> Int 148 | toRataDie (RD rd) = 149 | rd 150 | 151 | 152 | 153 | -- CALCULATIONS 154 | 155 | 156 | isLeapYear : Int -> Bool 157 | isLeapYear y = 158 | modBy 4 y == 0 && modBy 100 y /= 0 || modBy 400 y == 0 159 | 160 | 161 | daysBeforeYear : Int -> Int 162 | daysBeforeYear y1 = 163 | let 164 | y = 165 | y1 - 1 166 | 167 | leapYears = 168 | floorDiv y 4 - floorDiv y 100 + floorDiv y 400 169 | in 170 | 365 * y + leapYears 171 | 172 | 173 | {-| The weekday number (1–7), beginning with Monday. 174 | -} 175 | weekdayNumber : Date -> Int 176 | weekdayNumber (RD rd) = 177 | case rd |> modBy 7 of 178 | 0 -> 179 | 7 180 | 181 | n -> 182 | n 183 | 184 | 185 | daysBeforeWeekYear : Int -> Int 186 | daysBeforeWeekYear y = 187 | let 188 | jan4 = 189 | daysBeforeYear y + 4 190 | in 191 | jan4 - weekdayNumber (RD jan4) 192 | 193 | 194 | is53WeekYear : Int -> Bool 195 | is53WeekYear y = 196 | let 197 | wdnJan1 = 198 | weekdayNumber (firstOfYear y) 199 | in 200 | -- any year starting on Thursday and any leap year starting on Wednesday 201 | wdnJan1 == 4 || (wdnJan1 == 3 && isLeapYear y) 202 | 203 | 204 | {-| The calendar year. 205 | -} 206 | year : Date -> Int 207 | year (RD rd) = 208 | let 209 | ( n400, r400 ) = 210 | -- 400 * 365 + 97 211 | divWithRemainder rd 146097 212 | 213 | ( n100, r100 ) = 214 | -- 100 * 365 + 24 215 | divWithRemainder r400 36524 216 | 217 | ( n4, r4 ) = 218 | -- 4 * 365 + 1 219 | divWithRemainder r100 1461 220 | 221 | ( n1, r1 ) = 222 | divWithRemainder r4 365 223 | 224 | n = 225 | if r1 == 0 then 226 | 0 227 | 228 | else 229 | 1 230 | in 231 | n400 * 400 + n100 * 100 + n4 * 4 + n1 + n 232 | 233 | 234 | firstOfYear : Int -> Date 235 | firstOfYear y = 236 | RD <| daysBeforeYear y + 1 237 | 238 | 239 | firstOfMonth : Int -> Month -> Date 240 | firstOfMonth y m = 241 | RD <| daysBeforeYear y + daysBeforeMonth y m + 1 242 | 243 | 244 | 245 | -- FROM PARTS (clamps out-of-range values) 246 | 247 | 248 | {-| Create a date from an [ordinal date][ordinaldate]: a year and day of the 249 | year. Out-of-range day values will be clamped. 250 | 251 | import Date exposing (fromOrdinalDate) 252 | 253 | fromOrdinalDate 2018 269 254 | 255 | [ordinaldate]: https://en.wikipedia.org/wiki/Ordinal_date 256 | 257 | -} 258 | fromOrdinalDate : Int -> Int -> Date 259 | fromOrdinalDate y od = 260 | let 261 | daysInYear = 262 | if isLeapYear y then 263 | 366 264 | 265 | else 266 | 365 267 | in 268 | RD <| daysBeforeYear y + (od |> Basics.clamp 1 daysInYear) 269 | 270 | 271 | {-| Create a date from a [calendar date][gregorian]: a year, month, and day of 272 | the month. Out-of-range day values will be clamped. 273 | 274 | import Date exposing (fromCalendarDate) 275 | import Time exposing (Month(..)) 276 | 277 | fromCalendarDate 2018 Sep 26 278 | 279 | [gregorian]: https://en.wikipedia.org/wiki/Proleptic_Gregorian_calendar 280 | 281 | -} 282 | fromCalendarDate : Int -> Month -> Int -> Date 283 | fromCalendarDate y m d = 284 | RD <| daysBeforeYear y + daysBeforeMonth y m + (d |> Basics.clamp 1 (daysInMonth y m)) 285 | 286 | 287 | {-| Create a date from an [ISO week date][weekdate]: a week-numbering year, 288 | week number, and weekday. Out-of-range week number values will be clamped. 289 | 290 | import Date exposing (fromWeekDate) 291 | import Time exposing (Weekday(..)) 292 | 293 | fromWeekDate 2018 39 Wed 294 | 295 | [weekdate]: https://en.wikipedia.org/wiki/ISO_week_date 296 | 297 | -} 298 | fromWeekDate : Int -> Int -> Weekday -> Date 299 | fromWeekDate wy wn wd = 300 | let 301 | weeksInYear = 302 | if is53WeekYear wy then 303 | 53 304 | 305 | else 306 | 52 307 | in 308 | RD <| daysBeforeWeekYear wy + ((wn |> Basics.clamp 1 weeksInYear) - 1) * 7 + (wd |> weekdayToNumber) 309 | 310 | 311 | 312 | -- FROM NUMBERS (fails on out-of-range values) 313 | 314 | 315 | fromOrdinalParts : Int -> Int -> Result String Date 316 | fromOrdinalParts y od = 317 | let 318 | daysInYear = 319 | if isLeapYear y then 320 | 366 321 | 322 | else 323 | 365 324 | in 325 | if not (od |> isBetweenInt 1 daysInYear) then 326 | Err <| 327 | "Invalid ordinal date: " 328 | ++ ("ordinal-day " ++ String.fromInt od ++ " is out of range") 329 | ++ (" (1 to " ++ String.fromInt daysInYear ++ ")") 330 | ++ (" for " ++ String.fromInt y) 331 | ++ ("; received (year " ++ String.fromInt y ++ ", ordinal-day " ++ String.fromInt od ++ ")") 332 | 333 | else 334 | Ok <| RD <| daysBeforeYear y + od 335 | 336 | 337 | fromCalendarParts : Int -> Int -> Int -> Result String Date 338 | fromCalendarParts y mn d = 339 | if not (mn |> isBetweenInt 1 12) then 340 | Err <| 341 | "Invalid date: " 342 | ++ ("month " ++ String.fromInt mn ++ " is out of range") 343 | ++ " (1 to 12)" 344 | ++ ("; received (year " ++ String.fromInt y ++ ", month " ++ String.fromInt mn ++ ", day " ++ String.fromInt d ++ ")") 345 | 346 | else if not (d |> isBetweenInt 1 (daysInMonth y (mn |> numberToMonth))) then 347 | Err <| 348 | "Invalid date: " 349 | ++ ("day " ++ String.fromInt d ++ " is out of range") 350 | ++ (" (1 to " ++ String.fromInt (daysInMonth y (mn |> numberToMonth)) ++ ")") 351 | ++ (" for " ++ (mn |> numberToMonth |> monthToName)) 352 | ++ (if mn == 2 && d == 29 then 353 | " (" ++ String.fromInt y ++ " is not a leap year)" 354 | 355 | else 356 | "" 357 | ) 358 | ++ ("; received (year " ++ String.fromInt y ++ ", month " ++ String.fromInt mn ++ ", day " ++ String.fromInt d ++ ")") 359 | 360 | else 361 | Ok <| RD <| daysBeforeYear y + daysBeforeMonth y (mn |> numberToMonth) + d 362 | 363 | 364 | fromWeekParts : Int -> Int -> Int -> Result String Date 365 | fromWeekParts wy wn wdn = 366 | let 367 | weeksInYear = 368 | if is53WeekYear wy then 369 | 53 370 | 371 | else 372 | 52 373 | in 374 | if not (wn |> isBetweenInt 1 weeksInYear) then 375 | Err <| 376 | "Invalid week date: " 377 | ++ ("week " ++ String.fromInt wn ++ " is out of range") 378 | ++ (" (1 to " ++ String.fromInt weeksInYear ++ ")") 379 | ++ (" for " ++ String.fromInt wy) 380 | ++ ("; received (year " ++ String.fromInt wy ++ ", week " ++ String.fromInt wn ++ ", weekday " ++ String.fromInt wdn ++ ")") 381 | 382 | else if not (wdn |> isBetweenInt 1 7) then 383 | Err <| 384 | "Invalid week date: " 385 | ++ ("weekday " ++ String.fromInt wdn ++ " is out of range") 386 | ++ " (1 to 7)" 387 | ++ ("; received (year " ++ String.fromInt wy ++ ", week " ++ String.fromInt wn ++ ", weekday " ++ String.fromInt wdn ++ ")") 388 | 389 | else 390 | Ok <| RD <| daysBeforeWeekYear wy + (wn - 1) * 7 + wdn 391 | 392 | 393 | 394 | -- TO RECORDS 395 | 396 | 397 | {-| -} 398 | toOrdinalDate : Date -> { year : Int, ordinalDay : Int } 399 | toOrdinalDate (RD rd) = 400 | let 401 | y = 402 | year (RD rd) 403 | in 404 | { year = y 405 | , ordinalDay = rd - daysBeforeYear y 406 | } 407 | 408 | 409 | {-| -} 410 | toCalendarDate : Date -> { year : Int, month : Month, day : Int } 411 | toCalendarDate (RD rd) = 412 | let 413 | date = 414 | RD rd |> toOrdinalDate 415 | in 416 | toCalendarDateHelp date.year Jan date.ordinalDay 417 | 418 | 419 | toCalendarDateHelp : Int -> Month -> Int -> { year : Int, month : Month, day : Int } 420 | toCalendarDateHelp y m d = 421 | let 422 | monthDays = 423 | daysInMonth y m 424 | 425 | mn = 426 | m |> monthToNumber 427 | in 428 | if mn < 12 && d > monthDays then 429 | toCalendarDateHelp y (mn + 1 |> numberToMonth) (d - monthDays) 430 | 431 | else 432 | { year = y 433 | , month = m 434 | , day = d 435 | } 436 | 437 | 438 | {-| -} 439 | toWeekDate : Date -> { weekYear : Int, weekNumber : Int, weekday : Weekday } 440 | toWeekDate (RD rd) = 441 | let 442 | wdn = 443 | weekdayNumber (RD rd) 444 | 445 | wy = 446 | -- `year ` 447 | year (RD (rd + (4 - wdn))) 448 | 449 | week1Day1 = 450 | daysBeforeWeekYear wy + 1 451 | in 452 | { weekYear = wy 453 | , weekNumber = 1 + (rd - week1Day1) // 7 454 | , weekday = wdn |> numberToWeekday 455 | } 456 | 457 | 458 | 459 | -- TO PARTS 460 | 461 | 462 | {-| The day of the year (1–366). 463 | -} 464 | ordinalDay : Date -> Int 465 | ordinalDay = 466 | toOrdinalDate >> .ordinalDay 467 | 468 | 469 | {-| The month as a [`Month`](https://package.elm-lang.org/packages/elm/time/latest/Time#Month) 470 | value (`Jan`–`Dec`). 471 | -} 472 | month : Date -> Month 473 | month = 474 | toCalendarDate >> .month 475 | 476 | 477 | {-| The month number (1–12). 478 | -} 479 | monthNumber : Date -> Int 480 | monthNumber = 481 | month >> monthToNumber 482 | 483 | 484 | {-| The quarter of the year (1–4). 485 | -} 486 | quarter : Date -> Int 487 | quarter = 488 | month >> monthToQuarter 489 | 490 | 491 | {-| The day of the month (1–31). 492 | -} 493 | day : Date -> Int 494 | day = 495 | toCalendarDate >> .day 496 | 497 | 498 | {-| The ISO week-numbering year. This is not always the same as the 499 | calendar year. 500 | -} 501 | weekYear : Date -> Int 502 | weekYear = 503 | toWeekDate >> .weekYear 504 | 505 | 506 | {-| The ISO week number of the year (1–53). 507 | -} 508 | weekNumber : Date -> Int 509 | weekNumber = 510 | toWeekDate >> .weekNumber 511 | 512 | 513 | {-| The weekday as a [`Weekday`](https://package.elm-lang.org/packages/elm/time/latest/Time#Weekday) 514 | value (`Mon`–`Sun`). 515 | -} 516 | weekday : Date -> Weekday 517 | weekday = 518 | weekdayNumber >> numberToWeekday 519 | 520 | 521 | 522 | -- quarters 523 | 524 | 525 | monthToQuarter : Month -> Int 526 | monthToQuarter m = 527 | (monthToNumber m + 2) // 3 528 | 529 | 530 | quarterToMonth : Int -> Month 531 | quarterToMonth q = 532 | q * 3 - 2 |> numberToMonth 533 | 534 | 535 | 536 | -- TO FORMATTED STRINGS 537 | 538 | 539 | {-| Functions to convert date information to strings in a custom language. 540 | -} 541 | type alias Language = 542 | { monthName : Month -> String 543 | , monthNameShort : Month -> String 544 | , weekdayName : Weekday -> String 545 | , weekdayNameShort : Weekday -> String 546 | , dayWithSuffix : Int -> String 547 | } 548 | 549 | 550 | formatField : Language -> Char -> Int -> Date -> String 551 | formatField language char length date = 552 | case char of 553 | 'y' -> 554 | case length of 555 | 2 -> 556 | date |> year |> String.fromInt |> String.padLeft 2 '0' |> String.right 2 557 | 558 | _ -> 559 | date |> year |> padSignedInt length 560 | 561 | 'Y' -> 562 | case length of 563 | 2 -> 564 | date |> weekYear |> String.fromInt |> String.padLeft 2 '0' |> String.right 2 565 | 566 | _ -> 567 | date |> weekYear |> padSignedInt length 568 | 569 | 'Q' -> 570 | case length of 571 | 1 -> 572 | date |> quarter |> String.fromInt 573 | 574 | 2 -> 575 | date |> quarter |> String.fromInt 576 | 577 | 3 -> 578 | date |> quarter |> String.fromInt |> (++) "Q" 579 | 580 | 4 -> 581 | date |> quarter |> withOrdinalSuffix 582 | 583 | 5 -> 584 | date |> quarter |> String.fromInt 585 | 586 | _ -> 587 | "" 588 | 589 | 'M' -> 590 | case length of 591 | 1 -> 592 | date |> monthNumber |> String.fromInt 593 | 594 | 2 -> 595 | date |> monthNumber |> String.fromInt |> String.padLeft 2 '0' 596 | 597 | 3 -> 598 | date |> month |> language.monthNameShort 599 | 600 | 4 -> 601 | date |> month |> language.monthName 602 | 603 | 5 -> 604 | date |> month |> language.monthNameShort |> String.left 1 605 | 606 | _ -> 607 | "" 608 | 609 | 'w' -> 610 | case length of 611 | 1 -> 612 | date |> weekNumber |> String.fromInt 613 | 614 | 2 -> 615 | date |> weekNumber |> String.fromInt |> String.padLeft 2 '0' 616 | 617 | _ -> 618 | "" 619 | 620 | 'd' -> 621 | case length of 622 | 1 -> 623 | date |> day |> String.fromInt 624 | 625 | 2 -> 626 | date |> day |> String.fromInt |> String.padLeft 2 '0' 627 | 628 | -- non-standard 629 | 3 -> 630 | date |> day |> language.dayWithSuffix 631 | 632 | _ -> 633 | "" 634 | 635 | 'D' -> 636 | case length of 637 | 1 -> 638 | date |> ordinalDay |> String.fromInt 639 | 640 | 2 -> 641 | date |> ordinalDay |> String.fromInt |> String.padLeft 2 '0' 642 | 643 | 3 -> 644 | date |> ordinalDay |> String.fromInt |> String.padLeft 3 '0' 645 | 646 | _ -> 647 | "" 648 | 649 | 'E' -> 650 | case length of 651 | -- abbreviated 652 | 1 -> 653 | date |> weekday |> language.weekdayNameShort 654 | 655 | 2 -> 656 | date |> weekday |> language.weekdayNameShort 657 | 658 | 3 -> 659 | date |> weekday |> language.weekdayNameShort 660 | 661 | -- full 662 | 4 -> 663 | date |> weekday |> language.weekdayName 664 | 665 | -- narrow 666 | 5 -> 667 | date |> weekday |> language.weekdayNameShort |> String.left 1 668 | 669 | -- short 670 | 6 -> 671 | date |> weekday |> language.weekdayNameShort |> String.left 2 672 | 673 | _ -> 674 | "" 675 | 676 | 'e' -> 677 | case length of 678 | 1 -> 679 | date |> weekdayNumber |> String.fromInt 680 | 681 | 2 -> 682 | date |> weekdayNumber |> String.fromInt 683 | 684 | _ -> 685 | date |> formatField language 'E' length 686 | 687 | _ -> 688 | "" 689 | 690 | 691 | {-| Expects `tokens` list reversed for foldl. 692 | -} 693 | formatWithTokens : Language -> List Token -> Date -> String 694 | formatWithTokens language tokens date = 695 | List.foldl 696 | (\token formatted -> 697 | case token of 698 | Field char length -> 699 | formatField language char length date ++ formatted 700 | 701 | Literal str -> 702 | str ++ formatted 703 | ) 704 | "" 705 | tokens 706 | 707 | 708 | {-| Format a date in a custom language using a string as a template. 709 | 710 | import Date exposing (fromOrdinalDate, formatWithLanguage) 711 | 712 | formatWithLanguage fr "EEEE, ddd MMMM y" (fromOrdinalDate 1970 1) 713 | == "jeudi, 1er janvier 1970" 714 | 715 | -- assuming `fr` is a custom `Date.Language` 716 | 717 | -} 718 | formatWithLanguage : Language -> String -> Date -> String 719 | formatWithLanguage language pattern = 720 | let 721 | tokens = 722 | pattern |> Pattern.fromString |> List.reverse 723 | in 724 | formatWithTokens language tokens 725 | 726 | 727 | 728 | -- default language 729 | 730 | 731 | monthToName : Month -> String 732 | monthToName m = 733 | case m of 734 | Jan -> 735 | "January" 736 | 737 | Feb -> 738 | "February" 739 | 740 | Mar -> 741 | "March" 742 | 743 | Apr -> 744 | "April" 745 | 746 | May -> 747 | "May" 748 | 749 | Jun -> 750 | "June" 751 | 752 | Jul -> 753 | "July" 754 | 755 | Aug -> 756 | "August" 757 | 758 | Sep -> 759 | "September" 760 | 761 | Oct -> 762 | "October" 763 | 764 | Nov -> 765 | "November" 766 | 767 | Dec -> 768 | "December" 769 | 770 | 771 | weekdayToName : Weekday -> String 772 | weekdayToName wd = 773 | case wd of 774 | Mon -> 775 | "Monday" 776 | 777 | Tue -> 778 | "Tuesday" 779 | 780 | Wed -> 781 | "Wednesday" 782 | 783 | Thu -> 784 | "Thursday" 785 | 786 | Fri -> 787 | "Friday" 788 | 789 | Sat -> 790 | "Saturday" 791 | 792 | Sun -> 793 | "Sunday" 794 | 795 | 796 | ordinalSuffix : Int -> String 797 | ordinalSuffix n = 798 | let 799 | -- use 2-digit number 800 | nn = 801 | n |> modBy 100 802 | in 803 | case 804 | Basics.min 805 | (if nn < 20 then 806 | nn 807 | 808 | else 809 | nn |> modBy 10 810 | ) 811 | 4 812 | of 813 | 1 -> 814 | "st" 815 | 816 | 2 -> 817 | "nd" 818 | 819 | 3 -> 820 | "rd" 821 | 822 | _ -> 823 | "th" 824 | 825 | 826 | {-| Convert an integer into an English ordinal number string (like `"4th"`). 827 | 828 | import Date exposing (withOrdinalSuffix) 829 | 830 | withOrdinalSuffix 21 == "21st" 831 | withOrdinalSuffix 42 == "42nd" 832 | withOrdinalSuffix 0 == "0th" 833 | withOrdinalSuffix 23 == "23rd" 834 | withOrdinalSuffix -1 == "-1st" 835 | 836 | -} 837 | withOrdinalSuffix : Int -> String 838 | withOrdinalSuffix n = 839 | String.fromInt n ++ ordinalSuffix n 840 | 841 | 842 | language_en : Language 843 | language_en = 844 | { monthName = monthToName 845 | , monthNameShort = monthToName >> String.left 3 846 | , weekdayName = weekdayToName 847 | , weekdayNameShort = weekdayToName >> String.left 3 848 | , dayWithSuffix = withOrdinalSuffix 849 | } 850 | 851 | 852 | {-| Format a date using a string as a template. 853 | 854 | import Date exposing (fromOrdinalDate, format) 855 | 856 | format "EEEE, d MMMM y" (fromOrdinalDate 1970 1) 857 | == "Thursday, 1 January 1970" 858 | 859 | Alphabetic characters in the template represent date information; the number of 860 | times a character is repeated specifies the form of a name (e.g. `"Tue"`, 861 | `"Tuesday"`) or the padding of a number (e.g. `"1"`, `"01"`). 862 | 863 | Alphabetic characters can be escaped within single-quotes; a single-quote can 864 | be escaped as a sequence of two single-quotes, whether appearing inside or 865 | outside an escaped sequence. 866 | 867 | Templates are based on Date Format Patterns in [Unicode Technical 868 | Standard #35][uts35]. Only the following subset of formatting characters 869 | are available: 870 | 871 | "y" -- year 872 | 873 | "Y" -- week-numbering year 874 | 875 | "Q" -- quarter 876 | 877 | "M" -- month (number or name) 878 | 879 | "w" -- week number 880 | 881 | "d" -- day 882 | 883 | "D" -- ordinal day 884 | 885 | "E" -- weekday name 886 | 887 | "e" -- weekday number 888 | 889 | [uts35]: http://www.unicode.org/reports/tr35/tr35-43/tr35-dates.html#Date_Format_Patterns 890 | 891 | The non-standard pattern field "ddd" is available to indicate the day of the 892 | month with an ordinal suffix (e.g. `"1st"`, `"15th"`), as the current standard 893 | does not include such a field. 894 | 895 | format "MMMM ddd, y" (fromOrdinalDate 1970 1) 896 | == "January 1st, 1970" 897 | 898 | -} 899 | format : String -> Date -> String 900 | format pattern = 901 | formatWithLanguage language_en pattern 902 | 903 | 904 | {-| Convert a date to a string in ISO 8601 extended format. 905 | 906 | import Date exposing (fromOrdinalDate, toIsoString) 907 | 908 | toIsoString (fromOrdinalDate 2001 1) 909 | == "2001-01-01" 910 | 911 | -} 912 | toIsoString : Date -> String 913 | toIsoString = 914 | format "yyyy-MM-dd" 915 | 916 | 917 | 918 | -- FROM ISO 8601 STRINGS 919 | 920 | 921 | {-| Attempt to create a date from a string in [ISO 8601][iso8601] format. 922 | Calendar dates, week dates, and ordinal dates are all supported in extended 923 | and basic format. 924 | 925 | import Date exposing (fromIsoString, fromCalendarDate, fromWeekDate, fromOrdinalDate) 926 | import Time exposing (Month(..), Weekday(..)) 927 | 928 | -- calendar date 929 | fromIsoString "2018-09-26" 930 | == Ok (fromCalendarDate 2018 Sep 26) 931 | 932 | 933 | -- week date 934 | fromIsoString "2018-W39-3" 935 | == Ok (fromWeekDate 2018 39 Wed) 936 | 937 | 938 | -- ordinal date 939 | fromIsoString "2018-269" 940 | == Ok (fromOrdinalDate 2018 269) 941 | 942 | The string must represent a valid date; unlike `fromCalendarDate` and 943 | friends, any out-of-range values will fail to produce a date. 944 | 945 | fromIsoString "2018-02-29" 946 | == Err "Invalid calendar date (2018, 2, 29)" 947 | 948 | [iso8601]: https://en.wikipedia.org/wiki/ISO_8601 949 | 950 | -} 951 | fromIsoString : String -> Result String Date 952 | fromIsoString = 953 | Parser.run 954 | (Parser.succeed identity 955 | |= parser 956 | |. (Parser.oneOf 957 | [ Parser.map Ok 958 | Parser.end 959 | , Parser.map (always (Err "Expected a date only, not a date and time")) 960 | (Parser.chompIf ((==) 'T')) 961 | , Parser.succeed (Err "Expected a date only") 962 | ] 963 | |> Parser.andThen resultToParser 964 | ) 965 | ) 966 | >> Result.mapError (List.head >> Maybe.map deadEndToString >> Maybe.withDefault "") 967 | 968 | 969 | deadEndToString : Parser.DeadEnd -> String 970 | deadEndToString { problem } = 971 | case problem of 972 | Parser.Problem message -> 973 | message 974 | 975 | _ -> 976 | "Expected a date in ISO 8601 format" 977 | 978 | 979 | resultToParser : Result String a -> Parser a 980 | resultToParser result = 981 | case result of 982 | Ok x -> 983 | Parser.succeed x 984 | 985 | Err message -> 986 | Parser.problem message 987 | 988 | 989 | 990 | -- day of year 991 | 992 | 993 | type DayOfYear 994 | = MonthAndDay Int Int 995 | | WeekAndWeekday Int Int 996 | | OrdinalDay Int 997 | 998 | 999 | fromYearAndDayOfYear : ( Int, DayOfYear ) -> Result String Date 1000 | fromYearAndDayOfYear ( y, doy ) = 1001 | case doy of 1002 | MonthAndDay mn d -> 1003 | fromCalendarParts y mn d 1004 | 1005 | WeekAndWeekday wn wdn -> 1006 | fromWeekParts y wn wdn 1007 | 1008 | OrdinalDay od -> 1009 | fromOrdinalParts y od 1010 | 1011 | 1012 | 1013 | -- parser 1014 | 1015 | 1016 | parser : Parser Date 1017 | parser = 1018 | Parser.succeed Tuple.pair 1019 | |= int4 1020 | |= dayOfYear 1021 | |> Parser.andThen 1022 | (fromYearAndDayOfYear >> resultToParser) 1023 | 1024 | 1025 | dayOfYear : Parser DayOfYear 1026 | dayOfYear = 1027 | Parser.oneOf 1028 | [ Parser.succeed identity 1029 | -- extended format 1030 | |. Parser.token "-" 1031 | |= Parser.oneOf 1032 | [ Parser.backtrackable 1033 | (Parser.map OrdinalDay 1034 | int3 1035 | |> Parser.andThen Parser.commit 1036 | ) 1037 | , Parser.succeed MonthAndDay 1038 | |= int2 1039 | |= Parser.oneOf 1040 | [ Parser.succeed identity 1041 | |. Parser.token "-" 1042 | |= int2 1043 | , Parser.succeed 1 1044 | ] 1045 | , Parser.succeed WeekAndWeekday 1046 | |. Parser.token "W" 1047 | |= int2 1048 | |= Parser.oneOf 1049 | [ Parser.succeed identity 1050 | |. Parser.token "-" 1051 | |= int1 1052 | , Parser.succeed 1 1053 | ] 1054 | ] 1055 | 1056 | -- basic format 1057 | , Parser.backtrackable 1058 | (Parser.succeed MonthAndDay 1059 | |= int2 1060 | |= Parser.oneOf 1061 | [ int2 1062 | , Parser.succeed 1 1063 | ] 1064 | |> Parser.andThen Parser.commit 1065 | ) 1066 | , Parser.map OrdinalDay 1067 | int3 1068 | , Parser.succeed WeekAndWeekday 1069 | |. Parser.token "W" 1070 | |= int2 1071 | |= Parser.oneOf 1072 | [ int1 1073 | , Parser.succeed 1 1074 | ] 1075 | , Parser.succeed 1076 | (OrdinalDay 1) 1077 | ] 1078 | 1079 | 1080 | int4 : Parser Int 1081 | int4 = 1082 | Parser.succeed () 1083 | |. Parser.oneOf 1084 | [ Parser.chompIf (\c -> c == '-') 1085 | , Parser.succeed () 1086 | ] 1087 | |. Parser.chompIf Char.isDigit 1088 | |. Parser.chompIf Char.isDigit 1089 | |. Parser.chompIf Char.isDigit 1090 | |. Parser.chompIf Char.isDigit 1091 | |> Parser.mapChompedString 1092 | (\str _ -> String.toInt str |> Maybe.withDefault 0) 1093 | 1094 | 1095 | int3 : Parser Int 1096 | int3 = 1097 | Parser.succeed () 1098 | |. Parser.chompIf Char.isDigit 1099 | |. Parser.chompIf Char.isDigit 1100 | |. Parser.chompIf Char.isDigit 1101 | |> Parser.mapChompedString 1102 | (\str _ -> String.toInt str |> Maybe.withDefault 0) 1103 | 1104 | 1105 | int2 : Parser Int 1106 | int2 = 1107 | Parser.succeed () 1108 | |. Parser.chompIf Char.isDigit 1109 | |. Parser.chompIf Char.isDigit 1110 | |> Parser.mapChompedString 1111 | (\str _ -> String.toInt str |> Maybe.withDefault 0) 1112 | 1113 | 1114 | int1 : Parser Int 1115 | int1 = 1116 | Parser.chompIf Char.isDigit 1117 | |> Parser.mapChompedString 1118 | (\str _ -> String.toInt str |> Maybe.withDefault 0) 1119 | 1120 | 1121 | 1122 | -- ARITHMETIC 1123 | 1124 | 1125 | {-| -} 1126 | type Unit 1127 | = Years 1128 | | Months 1129 | | Weeks 1130 | | Days 1131 | 1132 | 1133 | {-| Get a past or future date by adding a number of units to a date. 1134 | 1135 | import Date exposing (Unit(..), add, fromCalendarDate) 1136 | import Time exposing (Month(..)) 1137 | 1138 | add Weeks -2 (fromCalendarDate 2018 Sep 26) 1139 | == fromCalendarDate 2018 Sep 12 1140 | 1141 | When adding `Years` or `Months`, day values are clamped to the end of the 1142 | month if necessary. 1143 | 1144 | add Months 1 (fromCalendarDate 2000 Jan 31) 1145 | == fromCalendarDate 2000 Feb 29 1146 | 1147 | -} 1148 | add : Unit -> Int -> Date -> Date 1149 | add unit n (RD rd) = 1150 | case unit of 1151 | Years -> 1152 | RD rd |> add Months (12 * n) 1153 | 1154 | Months -> 1155 | let 1156 | date = 1157 | RD rd |> toCalendarDate 1158 | 1159 | wholeMonths = 1160 | 12 * (date.year - 1) + (monthToNumber date.month - 1) + n 1161 | 1162 | y = 1163 | floorDiv wholeMonths 12 + 1 1164 | 1165 | m = 1166 | (wholeMonths |> modBy 12) + 1 |> numberToMonth 1167 | in 1168 | RD <| daysBeforeYear y + daysBeforeMonth y m + Basics.min date.day (daysInMonth y m) 1169 | 1170 | Weeks -> 1171 | RD <| rd + 7 * n 1172 | 1173 | Days -> 1174 | RD <| rd + n 1175 | 1176 | 1177 | {-| The number of whole months between date and 0001-01-01 plus fraction 1178 | representing the current month. Only used for diffing months. 1179 | -} 1180 | toMonths : RataDie -> Float 1181 | toMonths rd = 1182 | let 1183 | date = 1184 | RD rd |> toCalendarDate 1185 | 1186 | wholeMonths = 1187 | 12 * (date.year - 1) + (monthToNumber date.month - 1) 1188 | in 1189 | toFloat wholeMonths + toFloat date.day / 100 1190 | 1191 | 1192 | {-| Get the difference, as a number of whole units, between two dates. 1193 | 1194 | import Date exposing (Unit(..), diff, fromCalendarDate) 1195 | import Time exposing (Month(..)) 1196 | 1197 | diff Months 1198 | (fromCalendarDate 2020 Jan 2) 1199 | (fromCalendarDate 2020 Apr 1) 1200 | == 2 1201 | 1202 | -} 1203 | diff : Unit -> Date -> Date -> Int 1204 | diff unit (RD rd1) (RD rd2) = 1205 | case unit of 1206 | Years -> 1207 | (toMonths rd2 - toMonths rd1 |> truncate) // 12 1208 | 1209 | Months -> 1210 | toMonths rd2 - toMonths rd1 |> truncate 1211 | 1212 | Weeks -> 1213 | (rd2 - rd1) // 7 1214 | 1215 | Days -> 1216 | rd2 - rd1 1217 | 1218 | 1219 | 1220 | -- ROUNDING 1221 | 1222 | 1223 | {-| -} 1224 | type Interval 1225 | = Year 1226 | | Quarter 1227 | | Month 1228 | | Week 1229 | | Monday 1230 | | Tuesday 1231 | | Wednesday 1232 | | Thursday 1233 | | Friday 1234 | | Saturday 1235 | | Sunday 1236 | | Day 1237 | 1238 | 1239 | daysSincePreviousWeekday : Weekday -> Date -> Int 1240 | daysSincePreviousWeekday wd date = 1241 | (weekdayNumber date + 7 - weekdayToNumber wd) |> modBy 7 1242 | 1243 | 1244 | {-| Round down a date to the beginning of the closest interval. The resulting 1245 | date will be less than or equal to the one provided. 1246 | 1247 | import Date exposing (Interval(..), floor, fromCalendarDate) 1248 | import Time exposing (Month(..)) 1249 | 1250 | floor Tuesday (fromCalendarDate 2018 May 11) 1251 | == fromCalendarDate 2018 May 8 1252 | 1253 | -} 1254 | floor : Interval -> Date -> Date 1255 | floor interval ((RD rd) as date) = 1256 | case interval of 1257 | Year -> 1258 | firstOfYear (year date) 1259 | 1260 | Quarter -> 1261 | firstOfMonth (year date) (quarter date |> quarterToMonth) 1262 | 1263 | Month -> 1264 | firstOfMonth (year date) (month date) 1265 | 1266 | Week -> 1267 | RD <| rd - daysSincePreviousWeekday Mon date 1268 | 1269 | Monday -> 1270 | RD <| rd - daysSincePreviousWeekday Mon date 1271 | 1272 | Tuesday -> 1273 | RD <| rd - daysSincePreviousWeekday Tue date 1274 | 1275 | Wednesday -> 1276 | RD <| rd - daysSincePreviousWeekday Wed date 1277 | 1278 | Thursday -> 1279 | RD <| rd - daysSincePreviousWeekday Thu date 1280 | 1281 | Friday -> 1282 | RD <| rd - daysSincePreviousWeekday Fri date 1283 | 1284 | Saturday -> 1285 | RD <| rd - daysSincePreviousWeekday Sat date 1286 | 1287 | Sunday -> 1288 | RD <| rd - daysSincePreviousWeekday Sun date 1289 | 1290 | Day -> 1291 | date 1292 | 1293 | 1294 | intervalToUnits : Interval -> ( Int, Unit ) 1295 | intervalToUnits interval = 1296 | case interval of 1297 | Year -> 1298 | ( 1, Years ) 1299 | 1300 | Quarter -> 1301 | ( 3, Months ) 1302 | 1303 | Month -> 1304 | ( 1, Months ) 1305 | 1306 | Day -> 1307 | ( 1, Days ) 1308 | 1309 | _ -> 1310 | ( 1, Weeks ) 1311 | 1312 | 1313 | {-| Round up a date to the beginning of the closest interval. The resulting 1314 | date will be greater than or equal to the one provided. 1315 | 1316 | import Date exposing (Interval(..), ceiling, fromCalendarDate) 1317 | import Time exposing (Month(..)) 1318 | 1319 | ceiling Tuesday (fromCalendarDate 2018 May 11) 1320 | == fromCalendarDate 2018 May 15 1321 | 1322 | -} 1323 | ceiling : Interval -> Date -> Date 1324 | ceiling interval date = 1325 | let 1326 | floored = 1327 | date |> floor interval 1328 | in 1329 | if date == floored then 1330 | date 1331 | 1332 | else 1333 | let 1334 | ( n, unit ) = 1335 | interval |> intervalToUnits 1336 | in 1337 | floored |> add unit n 1338 | 1339 | 1340 | 1341 | -- LISTS 1342 | 1343 | 1344 | {-| Create a list of dates, at rounded intervals, increasing by a step value, 1345 | between two dates. The list will start on or after the first date, and end 1346 | before the second date. 1347 | 1348 | import Date exposing (Interval(..), range, fromCalendarDate) 1349 | import Time exposing (Month(..)) 1350 | 1351 | start = fromCalendarDate 2018 May 8 1352 | until = fromCalendarDate 2018 May 14 1353 | 1354 | range Day 2 start until 1355 | == [ fromCalendarDate 2018 May 8 1356 | , fromCalendarDate 2018 May 10 1357 | , fromCalendarDate 2018 May 12 1358 | ] 1359 | 1360 | -} 1361 | range : Interval -> Int -> Date -> Date -> List Date 1362 | range interval step (RD start) (RD until) = 1363 | let 1364 | ( n, unit ) = 1365 | interval |> intervalToUnits 1366 | 1367 | (RD first) = 1368 | RD start |> ceiling interval 1369 | in 1370 | if first < until then 1371 | rangeHelp unit (Basics.max 1 step * n) until [] first 1372 | 1373 | else 1374 | [] 1375 | 1376 | 1377 | rangeHelp : Unit -> Int -> RataDie -> List Date -> RataDie -> List Date 1378 | rangeHelp unit step until revList current = 1379 | if current < until then 1380 | let 1381 | (RD next) = 1382 | RD current |> add unit step 1383 | in 1384 | rangeHelp unit step until (RD current :: revList) next 1385 | 1386 | else 1387 | List.reverse revList 1388 | 1389 | 1390 | 1391 | -- POSIX 1392 | 1393 | 1394 | {-| Create a date from a time [`Zone`][zone] and a [`Posix`][posix] time. This 1395 | conversion loses the time information associated with the `Posix` value. 1396 | 1397 | import Date exposing (fromCalendarDate, fromPosix) 1398 | import Time exposing (millisToPosix, utc, Month(..)) 1399 | 1400 | fromPosix utc (millisToPosix 0) 1401 | == fromCalendarDate 1970 Jan 1 1402 | 1403 | [zone]: https://package.elm-lang.org/packages/elm/time/latest/Time#Zone 1404 | [posix]: https://package.elm-lang.org/packages/elm/time/latest/Time#Posix 1405 | 1406 | -} 1407 | fromPosix : Time.Zone -> Posix -> Date 1408 | fromPosix zone posix = 1409 | fromCalendarDate 1410 | (posix |> Time.toYear zone) 1411 | (posix |> Time.toMonth zone) 1412 | (posix |> Time.toDay zone) 1413 | 1414 | 1415 | {-| Get the current local date. See [this page][calendarexample] for a full example. 1416 | 1417 | [calendarexample]: https://github.com/justinmimbs/date/blob/master/examples/Calendar.elm 1418 | 1419 | -} 1420 | today : Task x Date 1421 | today = 1422 | Task.map2 fromPosix Time.here Time.now 1423 | 1424 | 1425 | 1426 | -- ORDERING 1427 | 1428 | 1429 | {-| Compare two dates. This can be used as the compare function for 1430 | `List.sortWith`. 1431 | 1432 | import Date exposing (fromOrdinalDate, compare) 1433 | 1434 | compare (fromOrdinalDate 1970 1) (fromOrdinalDate 2038 1) 1435 | == LT 1436 | 1437 | -} 1438 | compare : Date -> Date -> Order 1439 | compare (RD a) (RD b) = 1440 | Basics.compare a b 1441 | 1442 | 1443 | {-| Test if a date is within a range, inclusive of the range values. 1444 | 1445 | import Date exposing (fromOrdinalDate, isBetween) 1446 | 1447 | minimum = fromOrdinalDate 1970 1 1448 | maximum = fromOrdinalDate 2038 1 1449 | 1450 | isBetween minimum maximum (fromOrdinalDate 1969 201) 1451 | == False 1452 | 1453 | -} 1454 | isBetween : Date -> Date -> Date -> Bool 1455 | isBetween (RD a) (RD b) (RD x) = 1456 | isBetweenInt a b x 1457 | 1458 | 1459 | {-| Find the lesser of two dates. 1460 | 1461 | import Date exposing (fromOrdinalDate, min) 1462 | 1463 | min (fromOrdinalDate 1970 1) (fromOrdinalDate 2038 1) 1464 | == (fromOrdinalDate 1970 1) 1465 | 1466 | -} 1467 | min : Date -> Date -> Date 1468 | min ((RD a) as dateA) ((RD b) as dateB) = 1469 | if a < b then 1470 | dateA 1471 | 1472 | else 1473 | dateB 1474 | 1475 | 1476 | {-| Find the greater of two dates. 1477 | 1478 | import Date exposing (fromOrdinalDate, max) 1479 | 1480 | max (fromOrdinalDate 1970 1) (fromOrdinalDate 2038 1) 1481 | == (fromOrdinalDate 2038 1) 1482 | 1483 | -} 1484 | max : Date -> Date -> Date 1485 | max ((RD a) as dateA) ((RD b) as dateB) = 1486 | if a < b then 1487 | dateB 1488 | 1489 | else 1490 | dateA 1491 | 1492 | 1493 | {-| Clamp a date within a range. 1494 | 1495 | import Date exposing (fromOrdinalDate, clamp) 1496 | 1497 | minimum = fromOrdinalDate 1970 1 1498 | maximum = fromOrdinalDate 2038 1 1499 | 1500 | clamp minimum maximum (fromOrdinalDate 1969 201) 1501 | == fromOrdinalDate 1970 1 1502 | 1503 | -} 1504 | clamp : Date -> Date -> Date -> Date 1505 | clamp ((RD a) as dateA) ((RD b) as dateB) ((RD x) as dateX) = 1506 | if x < a then 1507 | dateA 1508 | 1509 | else if b < x then 1510 | dateB 1511 | 1512 | else 1513 | dateX 1514 | 1515 | 1516 | 1517 | -- NUMBERS OF DAYS 1518 | 1519 | 1520 | daysInMonth : Int -> Month -> Int 1521 | daysInMonth y m = 1522 | case m of 1523 | Jan -> 1524 | 31 1525 | 1526 | Feb -> 1527 | if isLeapYear y then 1528 | 29 1529 | 1530 | else 1531 | 28 1532 | 1533 | Mar -> 1534 | 31 1535 | 1536 | Apr -> 1537 | 30 1538 | 1539 | May -> 1540 | 31 1541 | 1542 | Jun -> 1543 | 30 1544 | 1545 | Jul -> 1546 | 31 1547 | 1548 | Aug -> 1549 | 31 1550 | 1551 | Sep -> 1552 | 30 1553 | 1554 | Oct -> 1555 | 31 1556 | 1557 | Nov -> 1558 | 30 1559 | 1560 | Dec -> 1561 | 31 1562 | 1563 | 1564 | daysBeforeMonth : Int -> Month -> Int 1565 | daysBeforeMonth y m = 1566 | let 1567 | leapDays = 1568 | if isLeapYear y then 1569 | 1 1570 | 1571 | else 1572 | 0 1573 | in 1574 | case m of 1575 | Jan -> 1576 | 0 1577 | 1578 | Feb -> 1579 | 31 1580 | 1581 | Mar -> 1582 | 59 + leapDays 1583 | 1584 | Apr -> 1585 | 90 + leapDays 1586 | 1587 | May -> 1588 | 120 + leapDays 1589 | 1590 | Jun -> 1591 | 151 + leapDays 1592 | 1593 | Jul -> 1594 | 181 + leapDays 1595 | 1596 | Aug -> 1597 | 212 + leapDays 1598 | 1599 | Sep -> 1600 | 243 + leapDays 1601 | 1602 | Oct -> 1603 | 273 + leapDays 1604 | 1605 | Nov -> 1606 | 304 + leapDays 1607 | 1608 | Dec -> 1609 | 334 + leapDays 1610 | 1611 | 1612 | 1613 | -- MONTH AND WEEKDAY NUMBERS 1614 | 1615 | 1616 | {-| Maps `Jan`–`Dec` to 1–12. 1617 | -} 1618 | monthToNumber : Month -> Int 1619 | monthToNumber m = 1620 | case m of 1621 | Jan -> 1622 | 1 1623 | 1624 | Feb -> 1625 | 2 1626 | 1627 | Mar -> 1628 | 3 1629 | 1630 | Apr -> 1631 | 4 1632 | 1633 | May -> 1634 | 5 1635 | 1636 | Jun -> 1637 | 6 1638 | 1639 | Jul -> 1640 | 7 1641 | 1642 | Aug -> 1643 | 8 1644 | 1645 | Sep -> 1646 | 9 1647 | 1648 | Oct -> 1649 | 10 1650 | 1651 | Nov -> 1652 | 11 1653 | 1654 | Dec -> 1655 | 12 1656 | 1657 | 1658 | {-| Maps 1–12 to `Jan`–`Dec`. 1659 | -} 1660 | numberToMonth : Int -> Month 1661 | numberToMonth mn = 1662 | case Basics.max 1 mn of 1663 | 1 -> 1664 | Jan 1665 | 1666 | 2 -> 1667 | Feb 1668 | 1669 | 3 -> 1670 | Mar 1671 | 1672 | 4 -> 1673 | Apr 1674 | 1675 | 5 -> 1676 | May 1677 | 1678 | 6 -> 1679 | Jun 1680 | 1681 | 7 -> 1682 | Jul 1683 | 1684 | 8 -> 1685 | Aug 1686 | 1687 | 9 -> 1688 | Sep 1689 | 1690 | 10 -> 1691 | Oct 1692 | 1693 | 11 -> 1694 | Nov 1695 | 1696 | _ -> 1697 | Dec 1698 | 1699 | 1700 | {-| Maps `Mon`–`Sun` to 1-7. 1701 | -} 1702 | weekdayToNumber : Weekday -> Int 1703 | weekdayToNumber wd = 1704 | case wd of 1705 | Mon -> 1706 | 1 1707 | 1708 | Tue -> 1709 | 2 1710 | 1711 | Wed -> 1712 | 3 1713 | 1714 | Thu -> 1715 | 4 1716 | 1717 | Fri -> 1718 | 5 1719 | 1720 | Sat -> 1721 | 6 1722 | 1723 | Sun -> 1724 | 7 1725 | 1726 | 1727 | {-| Maps 1-7 to `Mon`–`Sun`. 1728 | -} 1729 | numberToWeekday : Int -> Weekday 1730 | numberToWeekday wdn = 1731 | case Basics.max 1 wdn of 1732 | 1 -> 1733 | Mon 1734 | 1735 | 2 -> 1736 | Tue 1737 | 1738 | 3 -> 1739 | Wed 1740 | 1741 | 4 -> 1742 | Thu 1743 | 1744 | 5 -> 1745 | Fri 1746 | 1747 | 6 -> 1748 | Sat 1749 | 1750 | _ -> 1751 | Sun 1752 | 1753 | 1754 | 1755 | -- HELPERS 1756 | 1757 | 1758 | padSignedInt : Int -> Int -> String 1759 | padSignedInt length int = 1760 | (if int < 0 then 1761 | "-" 1762 | 1763 | else 1764 | "" 1765 | ) 1766 | ++ (abs int |> String.fromInt |> String.padLeft length '0') 1767 | 1768 | 1769 | floorDiv : Int -> Int -> Int 1770 | floorDiv a b = 1771 | Basics.floor (toFloat a / toFloat b) 1772 | 1773 | 1774 | {-| integer division, returning (Quotient, Remainder) 1775 | -} 1776 | divWithRemainder : Int -> Int -> ( Int, Int ) 1777 | divWithRemainder a b = 1778 | ( floorDiv a b, a |> modBy b ) 1779 | 1780 | 1781 | isBetweenInt : Int -> Int -> Int -> Bool 1782 | isBetweenInt a b x = 1783 | a <= x && x <= b 1784 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (suite) 2 | 3 | import Date exposing (Date, Interval(..), Unit(..)) 4 | import Language 5 | import Shim exposing (Expectation, Test, describe, equal, test) 6 | import Time exposing (Month(..), Weekday(..)) 7 | 8 | 9 | 10 | -- import Expect exposing (Expectation) 11 | -- import Test exposing (Test, describe, test) 12 | ------------------------------------------------------------------------------- 13 | 14 | 15 | {-| temporary collection of all tests 16 | 17 | run suite 18 | 19 | -} 20 | suite : Test 21 | suite = 22 | describe "Date" 23 | [ test_CalendarDate 24 | , test_RataDie 25 | , test_WeekDate 26 | , test_format 27 | , test_formatWithLanguage 28 | , test_add 29 | , test_diff 30 | , test_floor 31 | , test_ceiling 32 | , test_range 33 | , test_fromIsoString 34 | , test_fromOrdinalDate 35 | , test_fromCalendarDate 36 | , test_fromWeekDate 37 | , test_numberToMonth 38 | , test_numberToWeekday 39 | , test_compare 40 | , test_isBetween 41 | , test_min 42 | , test_max 43 | , test_clamp 44 | ] 45 | 46 | 47 | 48 | ------------------------------------------------------------------------------- 49 | 50 | 51 | test_CalendarDate : Test 52 | test_CalendarDate = 53 | describe "CalendarDate" 54 | [ describe "CalendarDate and Date are are isomorphic" 55 | (List.concat 56 | [ List.range 1897 1905 57 | , List.range 1997 2025 58 | , List.range -5 5 59 | , List.range -105 -95 60 | , List.range -405 -395 61 | ] 62 | |> List.concatMap calendarDatesInYear 63 | |> List.map 64 | (\calendarDate -> 65 | test (Debug.toString calendarDate) <| 66 | \() -> expectIsomorphism fromCalendarDate toCalendarDate calendarDate 67 | ) 68 | ) 69 | ] 70 | 71 | 72 | test_RataDie : Test 73 | test_RataDie = 74 | describe "RataDie" 75 | [ test "a list of contiguous CalendarDates, converted to RataDie, is equivalent to a list of contiguous integers" <| 76 | \() -> 77 | List.range 1997 2025 78 | |> List.concatMap (calendarDatesInYear >> List.map (fromCalendarDate >> Date.toRataDie)) 79 | |> equal 80 | (List.range 81 | (Date.fromCalendarDate 1997 Jan 1 |> Date.toRataDie) 82 | (Date.fromCalendarDate 2025 Dec 31 |> Date.toRataDie) 83 | ) 84 | ] 85 | 86 | 87 | test_WeekDate : Test 88 | test_WeekDate = 89 | describe "WeekDate" 90 | [ describe "WeekDate and Date are isomorphic" 91 | (List.concat 92 | [ List.range 1997 2025 93 | , List.range -5 5 94 | ] 95 | |> List.concatMap calendarDatesInYear 96 | |> List.map 97 | (\calendarDate -> 98 | test (Debug.toString calendarDate) <| 99 | \() -> expectIsomorphism toWeekDate fromWeekDate (fromCalendarDate calendarDate) 100 | ) 101 | ) 102 | , describe "toWeekDate produces results that match samples" 103 | ([ ( CalendarDate 2005 Jan 1, WeekDate 2004 53 Sat ) 104 | , ( CalendarDate 2005 Jan 2, WeekDate 2004 53 Sun ) 105 | , ( CalendarDate 2005 Dec 31, WeekDate 2005 52 Sat ) 106 | , ( CalendarDate 2007 Jan 1, WeekDate 2007 1 Mon ) 107 | , ( CalendarDate 2007 Dec 30, WeekDate 2007 52 Sun ) 108 | , ( CalendarDate 2007 Dec 31, WeekDate 2008 1 Mon ) 109 | , ( CalendarDate 2008 Jan 1, WeekDate 2008 1 Tue ) 110 | , ( CalendarDate 2008 Dec 28, WeekDate 2008 52 Sun ) 111 | , ( CalendarDate 2008 Dec 29, WeekDate 2009 1 Mon ) 112 | , ( CalendarDate 2008 Dec 30, WeekDate 2009 1 Tue ) 113 | , ( CalendarDate 2008 Dec 31, WeekDate 2009 1 Wed ) 114 | , ( CalendarDate 2009 Jan 1, WeekDate 2009 1 Thu ) 115 | , ( CalendarDate 2009 Dec 31, WeekDate 2009 53 Thu ) 116 | , ( CalendarDate 2010 Jan 1, WeekDate 2009 53 Fri ) 117 | , ( CalendarDate 2010 Jan 2, WeekDate 2009 53 Sat ) 118 | , ( CalendarDate 2010 Jan 3, WeekDate 2009 53 Sun ) 119 | ] 120 | |> List.map 121 | (\( calendarDate, weekDate ) -> 122 | test (Debug.toString calendarDate) <| 123 | \() -> fromCalendarDate calendarDate |> toWeekDate |> equal weekDate 124 | ) 125 | ) 126 | ] 127 | 128 | 129 | test_format : Test 130 | test_format = 131 | let 132 | toTest : Date -> ( String, String ) -> Test 133 | toTest date ( pattern, expected ) = 134 | test ("\"" ++ pattern ++ "\" " ++ Debug.toString date) <| 135 | \() -> date |> Date.format pattern |> equal expected 136 | in 137 | describe "format" 138 | [ describe "replaces supported character patterns" <| 139 | List.map 140 | (toTest (Date.fromCalendarDate 2001 Jan 2)) 141 | [ ( "y", "2001" ) 142 | , ( "yy", "01" ) 143 | , ( "yyy", "2001" ) 144 | , ( "yyyy", "2001" ) 145 | , ( "yyyyy", "02001" ) 146 | , ( "Y", "2001" ) 147 | , ( "YY", "01" ) 148 | , ( "YYY", "2001" ) 149 | , ( "YYYY", "2001" ) 150 | , ( "YYYYY", "02001" ) 151 | , ( "Q", "1" ) 152 | , ( "QQ", "1" ) 153 | , ( "QQQ", "Q1" ) 154 | , ( "QQQQ", "1st" ) 155 | , ( "QQQQQ", "1" ) 156 | , ( "QQQQQQ", "" ) 157 | , ( "M", "1" ) 158 | , ( "MM", "01" ) 159 | , ( "MMM", "Jan" ) 160 | , ( "MMMM", "January" ) 161 | , ( "MMMMM", "J" ) 162 | , ( "MMMMMM", "" ) 163 | , ( "w", "1" ) 164 | , ( "ww", "01" ) 165 | , ( "www", "" ) 166 | , ( "d", "2" ) 167 | , ( "dd", "02" ) 168 | , ( "ddd", "2nd" ) 169 | , ( "dddd", "" ) 170 | , ( "D", "2" ) 171 | , ( "DD", "02" ) 172 | , ( "DDD", "002" ) 173 | , ( "DDDD", "" ) 174 | , ( "E", "Tue" ) 175 | , ( "EE", "Tue" ) 176 | , ( "EEE", "Tue" ) 177 | , ( "EEEE", "Tuesday" ) 178 | , ( "EEEEE", "T" ) 179 | , ( "EEEEEE", "Tu" ) 180 | , ( "EEEEEEE", "" ) 181 | , ( "e", "2" ) 182 | , ( "ee", "2" ) 183 | , ( "eee", "Tue" ) 184 | , ( "eeee", "Tuesday" ) 185 | , ( "eeeee", "T" ) 186 | , ( "eeeeee", "Tu" ) 187 | , ( "eeeeeee", "" ) 188 | ] 189 | , describe "removes unsupported pattern characters" <| 190 | List.map 191 | (toTest (Date.fromCalendarDate 2008 Dec 31)) 192 | [ ( "ABCFGHIJKLNOPRSTUVWXZabcfghijklmnopqrstuvxz", "" ) 193 | ] 194 | , describe "ignores non-alpha characters" <| 195 | List.map 196 | (toTest (Date.fromCalendarDate 2008 Dec 31)) 197 | [ ( "0123456789 .,\\//:-%", "0123456789 .,\\//:-%" ) 198 | ] 199 | , describe "handles escaped characters and escaped escape characters" <| 200 | List.map 201 | (toTest (Date.fromCalendarDate 2001 Jan 2)) 202 | [ ( "'yYQMwdDEe'", "yYQMwdDEe" ) 203 | , ( "''' '' ''' ''", "' ' ' '" ) 204 | , ( "'yyyy:' yyyy", "yyyy: 2001" ) 205 | ] 206 | , describe "is lenient on unclosed quotes" <| 207 | List.map 208 | (toTest (Date.fromCalendarDate 2001 Jan 2)) 209 | [ ( "yyyy 'yyyy", "2001 yyyy" ) 210 | ] 211 | , describe "formats day ordinals" <| 212 | List.map 213 | (\( n, string ) -> 214 | toTest (Date.fromCalendarDate 2001 Jan n) ( "ddd", string ) 215 | ) 216 | [ ( 1, "1st" ) 217 | , ( 2, "2nd" ) 218 | , ( 3, "3rd" ) 219 | , ( 4, "4th" ) 220 | , ( 5, "5th" ) 221 | , ( 6, "6th" ) 222 | , ( 7, "7th" ) 223 | , ( 8, "8th" ) 224 | , ( 9, "9th" ) 225 | , ( 10, "10th" ) 226 | , ( 11, "11th" ) 227 | , ( 12, "12th" ) 228 | , ( 13, "13th" ) 229 | , ( 14, "14th" ) 230 | , ( 15, "15th" ) 231 | , ( 16, "16th" ) 232 | , ( 17, "17th" ) 233 | , ( 18, "18th" ) 234 | , ( 19, "19th" ) 235 | , ( 20, "20th" ) 236 | , ( 21, "21st" ) 237 | , ( 22, "22nd" ) 238 | , ( 23, "23rd" ) 239 | , ( 24, "24th" ) 240 | , ( 25, "25th" ) 241 | , ( 26, "26th" ) 242 | , ( 27, "27th" ) 243 | , ( 28, "28th" ) 244 | , ( 29, "29th" ) 245 | , ( 30, "30th" ) 246 | , ( 31, "31st" ) 247 | ] 248 | , describe "formats with sample patterns as expected" <| 249 | List.map 250 | (toTest (Date.fromCalendarDate 2008 Dec 31)) 251 | [ ( "yyyy-MM-dd", "2008-12-31" ) 252 | , ( "yyyy-DDD", "2008-366" ) 253 | , ( "YYYY-'W'ww-e", "2009-W01-3" ) 254 | , ( "M/d/y", "12/31/2008" ) 255 | , ( "''yy", "'08" ) 256 | ] 257 | ] 258 | 259 | 260 | test_formatWithLanguage : Test 261 | test_formatWithLanguage = 262 | let 263 | toTest : Date -> ( String, String ) -> Test 264 | toTest date ( pattern, expected ) = 265 | test ("\"" ++ pattern ++ "\" " ++ Debug.toString date) <| 266 | \() -> date |> Date.formatWithLanguage Language.fr pattern |> equal expected 267 | in 268 | describe "formatWithLanguage" 269 | [ describe "replaces names as expected" <| 270 | List.map 271 | (toTest (Date.fromCalendarDate 2001 Jan 1)) 272 | [ ( "MMM", "janv." ) 273 | , ( "MMMM", "janvier" ) 274 | , ( "MMMMM", "j" ) 275 | , ( "MMMMMM", "" ) 276 | , ( "d", "1" ) 277 | , ( "dd", "01" ) 278 | , ( "ddd", "1er" ) 279 | , ( "dddd", "" ) 280 | , ( "E", "lun" ) 281 | , ( "EE", "lun" ) 282 | , ( "EEE", "lun" ) 283 | , ( "EEEE", "lundi" ) 284 | , ( "EEEEE", "l" ) 285 | , ( "EEEEEE", "lu" ) 286 | , ( "EEEEEEE", "" ) 287 | ] 288 | ] 289 | 290 | 291 | test_add : Test 292 | test_add = 293 | let 294 | toTest : ( Int, Month, Int ) -> Int -> Unit -> ( Int, Month, Int ) -> Test 295 | toTest ( y1, m1, d1 ) n unit (( y2, m2, d2 ) as expected) = 296 | test (Debug.toString ( y1, m1, d1 ) ++ " + " ++ Debug.toString n ++ " " ++ Debug.toString unit ++ " => " ++ Debug.toString expected) <| 297 | \() -> 298 | Date.fromCalendarDate y1 m1 d1 |> Date.add unit n |> equal (Date.fromCalendarDate y2 m2 d2) 299 | in 300 | describe "add" 301 | [ describe "add 0 x == x" <| 302 | List.map 303 | (\unit -> toTest ( 2000, Jan, 1 ) 0 unit ( 2000, Jan, 1 )) 304 | [ Years, Months, Weeks, Days ] 305 | , describe "adding positive numbers works as expected" 306 | [ toTest ( 2000, Jan, 1 ) 2 Years ( 2002, Jan, 1 ) 307 | , toTest ( 2000, Jan, 1 ) 2 Months ( 2000, Mar, 1 ) 308 | , toTest ( 2000, Jan, 1 ) 2 Weeks ( 2000, Jan, 15 ) 309 | , toTest ( 2000, Jan, 1 ) 2 Days ( 2000, Jan, 3 ) 310 | , toTest ( 2000, Jan, 1 ) 18 Years ( 2018, Jan, 1 ) 311 | , toTest ( 2000, Jan, 1 ) 18 Months ( 2001, Jul, 1 ) 312 | , toTest ( 2000, Jan, 1 ) 18 Weeks ( 2000, May, 6 ) 313 | , toTest ( 2000, Jan, 1 ) 36 Days ( 2000, Feb, 6 ) 314 | ] 315 | , describe "adding negative numbers works as expected" 316 | [ toTest ( 2000, Jan, 1 ) -2 Years ( 1998, Jan, 1 ) 317 | , toTest ( 2000, Jan, 1 ) -2 Months ( 1999, Nov, 1 ) 318 | , toTest ( 2000, Jan, 1 ) -2 Weeks ( 1999, Dec, 18 ) 319 | , toTest ( 2000, Jan, 1 ) -2 Days ( 1999, Dec, 30 ) 320 | , toTest ( 2000, Jan, 1 ) -18 Years ( 1982, Jan, 1 ) 321 | , toTest ( 2000, Jan, 1 ) -18 Months ( 1998, Jul, 1 ) 322 | , toTest ( 2000, Jan, 1 ) -18 Weeks ( 1999, Aug, 28 ) 323 | , toTest ( 2000, Jan, 1 ) -18 Days ( 1999, Dec, 14 ) 324 | ] 325 | , describe "adding Years from a leap day clamps overflow to the end of February" 326 | [ toTest ( 2000, Feb, 29 ) 1 Years ( 2001, Feb, 28 ) 327 | , toTest ( 2000, Feb, 29 ) 4 Years ( 2004, Feb, 29 ) 328 | ] 329 | , describe "adding Months clamps overflow to the end of a short month" 330 | [ toTest ( 2000, Jan, 31 ) 1 Months ( 2000, Feb, 29 ) 331 | , toTest ( 2000, Jan, 31 ) 2 Months ( 2000, Mar, 31 ) 332 | , toTest ( 2000, Jan, 31 ) 3 Months ( 2000, Apr, 30 ) 333 | , toTest ( 2000, Jan, 31 ) 13 Months ( 2001, Feb, 28 ) 334 | ] 335 | ] 336 | 337 | 338 | test_diff : Test 339 | test_diff = 340 | let 341 | toTest : ( Int, Month, Int ) -> ( Int, Month, Int ) -> Int -> Unit -> Test 342 | toTest ( y1, m1, d1 ) ( y2, m2, d2 ) expected unit = 343 | test (Debug.toString ( y2, m2, d2 ) ++ " - " ++ Debug.toString ( y1, m1, d1 ) ++ " => " ++ Debug.toString expected ++ " " ++ Debug.toString unit) <| 344 | \() -> 345 | Date.diff unit (Date.fromCalendarDate y1 m1 d1) (Date.fromCalendarDate y2 m2 d2) |> equal expected 346 | in 347 | describe "diff" 348 | [ describe "diff x x == 0" <| 349 | List.map 350 | (\unit -> toTest ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 0 unit) 351 | [ Years, Months, Weeks, Days ] 352 | , describe "diff x y == -(diff y x)" <| 353 | let 354 | ( x, y ) = 355 | ( Date.fromCalendarDate 2000 Jan 1, Date.fromCalendarDate 2017 Sep 28 ) 356 | in 357 | List.map 358 | (\unit -> test (Debug.toString unit) <| \() -> Date.diff unit x y |> equal (negate (Date.diff unit y x))) 359 | [ Years, Months, Weeks, Days ] 360 | , describe "`diff earlier later` results in positive numbers" 361 | [ toTest ( 2000, Jan, 1 ) ( 2002, Jan, 1 ) 2 Years 362 | , toTest ( 2000, Jan, 1 ) ( 2000, Mar, 1 ) 2 Months 363 | , toTest ( 2000, Jan, 1 ) ( 2000, Jan, 15 ) 2 Weeks 364 | , toTest ( 2000, Jan, 1 ) ( 2000, Jan, 3 ) 2 Days 365 | , toTest ( 2000, Jan, 1 ) ( 2018, Jan, 1 ) 18 Years 366 | , toTest ( 2000, Jan, 1 ) ( 2001, Jul, 1 ) 18 Months 367 | , toTest ( 2000, Jan, 1 ) ( 2000, May, 6 ) 18 Weeks 368 | , toTest ( 2000, Jan, 1 ) ( 2000, Feb, 6 ) 36 Days 369 | ] 370 | , describe "`diff later earlier` results in negative numbers" 371 | [ toTest ( 2000, Jan, 1 ) ( 1998, Jan, 1 ) -2 Years 372 | , toTest ( 2000, Jan, 1 ) ( 1999, Nov, 1 ) -2 Months 373 | , toTest ( 2000, Jan, 1 ) ( 1999, Dec, 18 ) -2 Weeks 374 | , toTest ( 2000, Jan, 1 ) ( 1999, Dec, 30 ) -2 Days 375 | , toTest ( 2000, Jan, 1 ) ( 1982, Jan, 1 ) -18 Years 376 | , toTest ( 2000, Jan, 1 ) ( 1998, Jul, 1 ) -18 Months 377 | , toTest ( 2000, Jan, 1 ) ( 1999, Aug, 28 ) -18 Weeks 378 | , toTest ( 2000, Jan, 1 ) ( 1999, Dec, 14 ) -18 Days 379 | ] 380 | , describe "diffing Years returns a number of whole years as determined by calendar date (anniversary)" 381 | [ toTest ( 2000, Feb, 29 ) ( 2001, Feb, 28 ) 0 Years 382 | , toTest ( 2000, Feb, 29 ) ( 2004, Feb, 29 ) 4 Years 383 | ] 384 | , describe "diffing Months returns a number of whole months as determined by calendar date" 385 | [ toTest ( 2000, Jan, 31 ) ( 2000, Feb, 29 ) 0 Months 386 | , toTest ( 2000, Jan, 31 ) ( 2000, Mar, 31 ) 2 Months 387 | , toTest ( 2000, Jan, 31 ) ( 2000, Apr, 30 ) 2 Months 388 | , toTest ( 2000, Jan, 31 ) ( 2001, Feb, 28 ) 12 Months 389 | ] 390 | ] 391 | 392 | 393 | test_floor : Test 394 | test_floor = 395 | let 396 | toTest : Interval -> ( Int, Month, Int ) -> ( Int, Month, Int ) -> Test 397 | toTest interval ( y1, m1, d1 ) (( y2, m2, d2 ) as expected) = 398 | describe (Debug.toString interval ++ " " ++ Debug.toString ( y1, m1, d1 )) 399 | [ test ("=> " ++ Debug.toString expected) <| 400 | \() -> Date.fromCalendarDate y1 m1 d1 |> Date.floor interval |> equal (Date.fromCalendarDate y2 m2 d2) 401 | , test "is idempotent" <| 402 | \() -> Date.fromCalendarDate y1 m1 d1 |> expectIdempotence (Date.floor interval) 403 | ] 404 | in 405 | describe "floor" 406 | [ describe "doesn't affect a date that is already at a rounded interval" 407 | [ toTest Year ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 408 | , toTest Quarter ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 409 | , toTest Month ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 410 | , toTest Week ( 2000, Jan, 3 ) ( 2000, Jan, 3 ) 411 | , toTest Monday ( 2000, Jan, 3 ) ( 2000, Jan, 3 ) 412 | , toTest Tuesday ( 2000, Jan, 4 ) ( 2000, Jan, 4 ) 413 | , toTest Wednesday ( 2000, Jan, 5 ) ( 2000, Jan, 5 ) 414 | , toTest Thursday ( 2000, Jan, 6 ) ( 2000, Jan, 6 ) 415 | , toTest Friday ( 2000, Jan, 7 ) ( 2000, Jan, 7 ) 416 | , toTest Saturday ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 417 | , toTest Sunday ( 2000, Jan, 2 ) ( 2000, Jan, 2 ) 418 | , toTest Day ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 419 | ] 420 | , describe "returns the previous rounded interval" 421 | [ toTest Year ( 2000, May, 21 ) ( 2000, Jan, 1 ) 422 | , toTest Quarter ( 2000, May, 21 ) ( 2000, Apr, 1 ) 423 | , toTest Month ( 2000, May, 21 ) ( 2000, May, 1 ) 424 | , toTest Week ( 2000, May, 21 ) ( 2000, May, 15 ) 425 | , toTest Monday ( 2000, May, 21 ) ( 2000, May, 15 ) 426 | , toTest Tuesday ( 2000, May, 21 ) ( 2000, May, 16 ) 427 | , toTest Wednesday ( 2000, May, 21 ) ( 2000, May, 17 ) 428 | , toTest Thursday ( 2000, May, 21 ) ( 2000, May, 18 ) 429 | , toTest Friday ( 2000, May, 21 ) ( 2000, May, 19 ) 430 | , toTest Saturday ( 2000, May, 21 ) ( 2000, May, 20 ) 431 | , toTest Sunday ( 2000, May, 22 ) ( 2000, May, 21 ) 432 | , toTest Day ( 2000, May, 21 ) ( 2000, May, 21 ) 433 | ] 434 | , describe "rounds to Quarter as expected" <| 435 | List.concatMap 436 | (\( ms, expected ) -> ms |> List.map (\m -> toTest Quarter ( 2000, m, 15 ) expected)) 437 | [ ( [ Jan, Feb, Mar ], ( 2000, Jan, 1 ) ) 438 | , ( [ Apr, May, Jun ], ( 2000, Apr, 1 ) ) 439 | , ( [ Jul, Aug, Sep ], ( 2000, Jul, 1 ) ) 440 | , ( [ Oct, Nov, Dec ], ( 2000, Oct, 1 ) ) 441 | ] 442 | ] 443 | 444 | 445 | test_ceiling : Test 446 | test_ceiling = 447 | let 448 | toTest : Interval -> ( Int, Month, Int ) -> ( Int, Month, Int ) -> Test 449 | toTest interval ( y1, m1, d1 ) (( y2, m2, d2 ) as expected) = 450 | describe (Debug.toString interval ++ " " ++ Debug.toString ( y1, m1, d1 )) 451 | [ test ("=> " ++ Debug.toString expected) <| 452 | \() -> Date.fromCalendarDate y1 m1 d1 |> Date.ceiling interval |> equal (Date.fromCalendarDate y2 m2 d2) 453 | , test "is idempotent" <| 454 | \() -> Date.fromCalendarDate y1 m1 d1 |> expectIdempotence (Date.ceiling interval) 455 | ] 456 | in 457 | describe "ceiling" 458 | [ describe "doesn't affect a date that is already at a rounded interval" 459 | [ toTest Year ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 460 | , toTest Quarter ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 461 | , toTest Month ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 462 | , toTest Week ( 2000, Jan, 3 ) ( 2000, Jan, 3 ) 463 | , toTest Monday ( 2000, Jan, 3 ) ( 2000, Jan, 3 ) 464 | , toTest Tuesday ( 2000, Jan, 4 ) ( 2000, Jan, 4 ) 465 | , toTest Wednesday ( 2000, Jan, 5 ) ( 2000, Jan, 5 ) 466 | , toTest Thursday ( 2000, Jan, 6 ) ( 2000, Jan, 6 ) 467 | , toTest Friday ( 2000, Jan, 7 ) ( 2000, Jan, 7 ) 468 | , toTest Saturday ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 469 | , toTest Sunday ( 2000, Jan, 2 ) ( 2000, Jan, 2 ) 470 | , toTest Day ( 2000, Jan, 1 ) ( 2000, Jan, 1 ) 471 | ] 472 | , describe "returns the next rounded interval" 473 | [ toTest Year ( 2000, May, 21 ) ( 2001, Jan, 1 ) 474 | , toTest Quarter ( 2000, May, 21 ) ( 2000, Jul, 1 ) 475 | , toTest Month ( 2000, May, 21 ) ( 2000, Jun, 1 ) 476 | , toTest Week ( 2000, May, 21 ) ( 2000, May, 22 ) 477 | , toTest Monday ( 2000, May, 21 ) ( 2000, May, 22 ) 478 | , toTest Tuesday ( 2000, May, 21 ) ( 2000, May, 23 ) 479 | , toTest Wednesday ( 2000, May, 21 ) ( 2000, May, 24 ) 480 | , toTest Thursday ( 2000, May, 21 ) ( 2000, May, 25 ) 481 | , toTest Friday ( 2000, May, 21 ) ( 2000, May, 26 ) 482 | , toTest Saturday ( 2000, May, 21 ) ( 2000, May, 27 ) 483 | , toTest Sunday ( 2000, May, 22 ) ( 2000, May, 28 ) 484 | , toTest Day ( 2000, May, 21 ) ( 2000, May, 21 ) 485 | ] 486 | , describe "rounds to Quarter as expected" <| 487 | List.concatMap 488 | (\( ms, expected ) -> ms |> List.map (\m -> toTest Quarter ( 2000, m, 15 ) expected)) 489 | [ ( [ Jan, Feb, Mar ], ( 2000, Apr, 1 ) ) 490 | , ( [ Apr, May, Jun ], ( 2000, Jul, 1 ) ) 491 | , ( [ Jul, Aug, Sep ], ( 2000, Oct, 1 ) ) 492 | , ( [ Oct, Nov, Dec ], ( 2001, Jan, 1 ) ) 493 | ] 494 | ] 495 | 496 | 497 | test_range : Test 498 | test_range = 499 | let 500 | toTest : Interval -> Int -> CalendarDate -> CalendarDate -> List CalendarDate -> Test 501 | toTest interval step start end expected = 502 | test ([ Debug.toString interval, Debug.toString step, Debug.toString start, Debug.toString end ] |> String.join " ") <| 503 | \() -> 504 | Date.range interval step (fromCalendarDate start) (fromCalendarDate end) 505 | |> equal (expected |> List.map fromCalendarDate) 506 | in 507 | describe "range" 508 | [ describe "returns a list of dates at rounded intervals which may include start and must exclude end" 509 | [ toTest Year 10 (CalendarDate 2000 Jan 1) (CalendarDate 2030 Jan 1) <| 510 | [ CalendarDate 2000 Jan 1 511 | , CalendarDate 2010 Jan 1 512 | , CalendarDate 2020 Jan 1 513 | ] 514 | , toTest Quarter 1 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Sep 1) <| 515 | [ CalendarDate 2000 Jan 1 516 | , CalendarDate 2000 Apr 1 517 | , CalendarDate 2000 Jul 1 518 | ] 519 | , toTest Month 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Jul 1) <| 520 | [ CalendarDate 2000 Jan 1 521 | , CalendarDate 2000 Mar 1 522 | , CalendarDate 2000 May 1 523 | ] 524 | , toTest Week 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 14) <| 525 | [ CalendarDate 2000 Jan 3 526 | , CalendarDate 2000 Jan 17 527 | , CalendarDate 2000 Jan 31 528 | ] 529 | , toTest Monday 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 14) <| 530 | [ CalendarDate 2000 Jan 3 531 | , CalendarDate 2000 Jan 17 532 | , CalendarDate 2000 Jan 31 533 | ] 534 | , toTest Tuesday 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 15) <| 535 | [ CalendarDate 2000 Jan 4 536 | , CalendarDate 2000 Jan 18 537 | , CalendarDate 2000 Feb 1 538 | ] 539 | , toTest Wednesday 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 16) <| 540 | [ CalendarDate 2000 Jan 5 541 | , CalendarDate 2000 Jan 19 542 | , CalendarDate 2000 Feb 2 543 | ] 544 | , toTest Thursday 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 17) <| 545 | [ CalendarDate 2000 Jan 6 546 | , CalendarDate 2000 Jan 20 547 | , CalendarDate 2000 Feb 3 548 | ] 549 | , toTest Friday 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 18) <| 550 | [ CalendarDate 2000 Jan 7 551 | , CalendarDate 2000 Jan 21 552 | , CalendarDate 2000 Feb 4 553 | ] 554 | , toTest Saturday 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 12) <| 555 | [ CalendarDate 2000 Jan 1 556 | , CalendarDate 2000 Jan 15 557 | , CalendarDate 2000 Jan 29 558 | ] 559 | , toTest Sunday 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 13) <| 560 | [ CalendarDate 2000 Jan 2 561 | , CalendarDate 2000 Jan 16 562 | , CalendarDate 2000 Jan 30 563 | ] 564 | , toTest Day 2 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Jan 7) <| 565 | [ CalendarDate 2000 Jan 1 566 | , CalendarDate 2000 Jan 3 567 | , CalendarDate 2000 Jan 5 568 | ] 569 | ] 570 | , describe "begins at interval nearest to start date" 571 | [ toTest Day 10 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Jan 30) <| 572 | [ CalendarDate 2000 Jan 1 573 | , CalendarDate 2000 Jan 11 574 | , CalendarDate 2000 Jan 21 575 | ] 576 | , toTest Day 10 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Jan 31) <| 577 | [ CalendarDate 2000 Jan 1 578 | , CalendarDate 2000 Jan 11 579 | , CalendarDate 2000 Jan 21 580 | ] 581 | , toTest Day 10 (CalendarDate 2000 Jan 1) (CalendarDate 2000 Feb 1) <| 582 | [ CalendarDate 2000 Jan 1 583 | , CalendarDate 2000 Jan 11 584 | , CalendarDate 2000 Jan 21 585 | , CalendarDate 2000 Jan 31 586 | ] 587 | ] 588 | , test "returns a list of days as expected" <| 589 | \() -> 590 | Date.range Day 1 (Date.fromCalendarDate 2000 Jan 1) (Date.fromCalendarDate 2001 Jan 1) 591 | |> equal (calendarDatesInYear 2000 |> List.map fromCalendarDate) 592 | , test "can return the empty list" <| 593 | \() -> 594 | Date.range Day 1 (Date.fromCalendarDate 2000 Jan 1) (Date.fromCalendarDate 2000 Jan 1) 595 | |> equal [] 596 | , describe "can return a large list (tail recursion)" 597 | [ let 598 | start = 599 | Date.fromCalendarDate 1950 Jan 1 600 | 601 | end = 602 | Date.fromCalendarDate 2050 Jan 1 603 | 604 | expectedLength = 605 | Date.diff Days start end 606 | in 607 | test ("length: " ++ Debug.toString expectedLength) <| 608 | \() -> Date.range Day 1 start end |> List.length |> equal expectedLength 609 | ] 610 | ] 611 | 612 | 613 | test_fromIsoString : Test 614 | test_fromIsoString = 615 | let 616 | toTest : ( String, ( Int, Month, Int ) ) -> Test 617 | toTest ( string, ( y, m, d ) as expected ) = 618 | test (string ++ " => " ++ Debug.toString expected) <| 619 | \() -> Date.fromIsoString string |> equal (Ok (Date.fromCalendarDate y m d)) 620 | in 621 | describe "fromIsoString" 622 | [ describe "converts ISO 8601 date strings in basic format" <| 623 | List.map toTest 624 | [ ( "2008", ( 2008, Jan, 1 ) ) 625 | , ( "200812", ( 2008, Dec, 1 ) ) 626 | , ( "20081231", ( 2008, Dec, 31 ) ) 627 | , ( "2009W01", ( 2008, Dec, 29 ) ) 628 | , ( "2009W014", ( 2009, Jan, 1 ) ) 629 | , ( "2008061", ( 2008, Mar, 1 ) ) 630 | ] 631 | , describe "converts ISO 8601 date strings in extended format" <| 632 | List.map toTest 633 | [ ( "2008-12", ( 2008, Dec, 1 ) ) 634 | , ( "2008-12-31", ( 2008, Dec, 31 ) ) 635 | , ( "2009-W01", ( 2008, Dec, 29 ) ) 636 | , ( "2009-W01-4", ( 2009, Jan, 1 ) ) 637 | , ( "2008-061", ( 2008, Mar, 1 ) ) 638 | ] 639 | , describe "returns Err for malformed date strings" <| 640 | List.map 641 | (\s -> test s <| \() -> Date.fromIsoString s |> extractErr "" |> String.startsWith "Expected a date" |> equal True) 642 | [ "200812-31" 643 | , "2008-1231" 644 | , "2009W01-4" 645 | , "2009-W014" 646 | , "2008-012-31" 647 | , "2008-12-031" 648 | , "2008-0061" 649 | , "2018-05-1" 650 | , "2018-5" 651 | , "20180" 652 | ] 653 | , describe "returns Err for invalid dates" <| 654 | List.map 655 | (\( s, message ) -> test s <| \() -> Date.fromIsoString s |> equal (Err message)) 656 | -- ordinal-day 657 | [ ( "2007-000", "Invalid ordinal date: ordinal-day 0 is out of range (1 to 365) for 2007; received (year 2007, ordinal-day 0)" ) 658 | , ( "2007-366", "Invalid ordinal date: ordinal-day 366 is out of range (1 to 365) for 2007; received (year 2007, ordinal-day 366)" ) 659 | , ( "2008-367", "Invalid ordinal date: ordinal-day 367 is out of range (1 to 366) for 2008; received (year 2008, ordinal-day 367)" ) 660 | 661 | -- month 662 | , ( "2008-00", "Invalid date: month 0 is out of range (1 to 12); received (year 2008, month 0, day 1)" ) 663 | , ( "2008-13", "Invalid date: month 13 is out of range (1 to 12); received (year 2008, month 13, day 1)" ) 664 | , ( "2008-00-01", "Invalid date: month 0 is out of range (1 to 12); received (year 2008, month 0, day 1)" ) 665 | , ( "2008-13-01", "Invalid date: month 13 is out of range (1 to 12); received (year 2008, month 13, day 1)" ) 666 | 667 | -- day 668 | , ( "2008-01-00", "Invalid date: day 0 is out of range (1 to 31) for January; received (year 2008, month 1, day 0)" ) 669 | , ( "2008-01-32", "Invalid date: day 32 is out of range (1 to 31) for January; received (year 2008, month 1, day 32)" ) 670 | , ( "2006-02-29", "Invalid date: day 29 is out of range (1 to 28) for February (2006 is not a leap year); received (year 2006, month 2, day 29)" ) 671 | , ( "2008-02-30", "Invalid date: day 30 is out of range (1 to 29) for February; received (year 2008, month 2, day 30)" ) 672 | 673 | -- week 674 | , ( "2008-W00-1", "Invalid week date: week 0 is out of range (1 to 52) for 2008; received (year 2008, week 0, weekday 1)" ) 675 | , ( "2008-W53-1", "Invalid week date: week 53 is out of range (1 to 52) for 2008; received (year 2008, week 53, weekday 1)" ) 676 | , ( "2009-W54-1", "Invalid week date: week 54 is out of range (1 to 53) for 2009; received (year 2009, week 54, weekday 1)" ) 677 | 678 | -- weekday 679 | , ( "2008-W01-0", "Invalid week date: weekday 0 is out of range (1 to 7); received (year 2008, week 1, weekday 0)" ) 680 | , ( "2008-W01-8", "Invalid week date: weekday 8 is out of range (1 to 7); received (year 2008, week 1, weekday 8)" ) 681 | ] 682 | , describe "returns Err for a valid date followed by a 'T'" <| 683 | List.map 684 | (\s -> test s <| \() -> Date.fromIsoString s |> equal (Err "Expected a date only, not a date and time")) 685 | [ "2018-09-26T00:00:00.000Z" 686 | , "2018-W39-3T00:00:00.000Z" 687 | , "2018-269T00:00:00.000Z" 688 | ] 689 | , describe "returns Err for a valid date followed by anything else" <| 690 | List.map 691 | (\s -> test s <| \() -> Date.fromIsoString s |> equal (Err "Expected a date only")) 692 | [ "2018-09-26 " 693 | , "2018-W39-3 " 694 | , "2018-269 " 695 | ] 696 | , describe "returns error messages describing only one parser dead end" <| 697 | List.map 698 | (\s -> test s <| \() -> Date.fromIsoString s |> equal (Err "Expected a date in ISO 8601 format")) 699 | [ "2018-" 700 | ] 701 | , describe "can form an isomorphism with toIsoString" 702 | (List.concat 703 | [ List.range 1897 1905 704 | , List.range 1997 2025 705 | , List.range -5 5 706 | ] 707 | |> List.concatMap calendarDatesInYear 708 | |> List.map 709 | (\calendarDate -> 710 | test (Debug.toString calendarDate) <| 711 | \() -> 712 | expectIsomorphism 713 | (Result.map Date.toIsoString) 714 | (Result.andThen Date.fromIsoString) 715 | (Ok <| fromCalendarDate calendarDate) 716 | ) 717 | ) 718 | , describe "can form an isomorphism with `format \"yyyy-DDD\"`" 719 | (List.concat 720 | [ List.range 1997 2005 721 | , List.range -5 5 722 | ] 723 | |> List.concatMap calendarDatesInYear 724 | |> List.map 725 | (\calendarDate -> 726 | test (Debug.toString calendarDate) <| 727 | \() -> 728 | expectIsomorphism 729 | (Result.map (Date.format "yyyy-DDD")) 730 | (Result.andThen Date.fromIsoString) 731 | (Ok <| fromCalendarDate calendarDate) 732 | ) 733 | ) 734 | , describe "can form an isomorphism with `format \"YYYY-'W'ww-e\"`" 735 | (List.concat 736 | [ List.range 1997 2005 737 | , List.range -5 5 738 | ] 739 | |> List.concatMap calendarDatesInYear 740 | |> List.map 741 | (\calendarDate -> 742 | test (Debug.toString calendarDate) <| 743 | \() -> 744 | expectIsomorphism 745 | (Result.map (Date.format "YYYY-'W'ww-e")) 746 | (Result.andThen Date.fromIsoString) 747 | (Ok <| fromCalendarDate calendarDate) 748 | ) 749 | ) 750 | ] 751 | 752 | 753 | test_fromOrdinalDate : Test 754 | test_fromOrdinalDate = 755 | describe "fromOrdinalDate" 756 | [ describe "clamps days that are out of range for the given year" 757 | (List.map 758 | (\( ( y, od ), expected ) -> 759 | test (Debug.toString ( y, od ) ++ " " ++ Debug.toString expected) <| 760 | \() -> 761 | Date.fromOrdinalDate y od |> toOrdinalDate |> equal expected 762 | ) 763 | [ ( ( 2000, -1 ), OrdinalDate 2000 1 ) 764 | , ( ( 2000, 0 ), OrdinalDate 2000 1 ) 765 | , ( ( 2001, 366 ), OrdinalDate 2001 365 ) 766 | , ( ( 2000, 367 ), OrdinalDate 2000 366 ) 767 | ] 768 | ) 769 | ] 770 | 771 | 772 | test_fromCalendarDate : Test 773 | test_fromCalendarDate = 774 | describe "fromCalendarDate" 775 | [ describe "clamps days that are out of range for the given year and month" 776 | (List.map 777 | (\( ( y, m, d ), expected ) -> 778 | test (Debug.toString ( y, m, d ) ++ " " ++ Debug.toString expected) <| 779 | \() -> 780 | Date.fromCalendarDate y m d |> toCalendarDate |> equal expected 781 | ) 782 | [ ( ( 2000, Jan, -1 ), CalendarDate 2000 Jan 1 ) 783 | , ( ( 2000, Jan, 0 ), CalendarDate 2000 Jan 1 ) 784 | , ( ( 2000, Jan, 32 ), CalendarDate 2000 Jan 31 ) 785 | , ( ( 2000, Feb, 0 ), CalendarDate 2000 Feb 1 ) 786 | , ( ( 2001, Feb, 29 ), CalendarDate 2001 Feb 28 ) 787 | , ( ( 2000, Feb, 30 ), CalendarDate 2000 Feb 29 ) 788 | , ( ( 2000, Mar, 32 ), CalendarDate 2000 Mar 31 ) 789 | , ( ( 2000, Apr, 31 ), CalendarDate 2000 Apr 30 ) 790 | , ( ( 2000, May, 32 ), CalendarDate 2000 May 31 ) 791 | , ( ( 2000, Jun, 31 ), CalendarDate 2000 Jun 30 ) 792 | , ( ( 2000, Jul, 32 ), CalendarDate 2000 Jul 31 ) 793 | , ( ( 2000, Aug, 32 ), CalendarDate 2000 Aug 31 ) 794 | , ( ( 2000, Sep, 31 ), CalendarDate 2000 Sep 30 ) 795 | , ( ( 2000, Oct, 32 ), CalendarDate 2000 Oct 31 ) 796 | , ( ( 2000, Nov, 31 ), CalendarDate 2000 Nov 30 ) 797 | , ( ( 2000, Dec, 32 ), CalendarDate 2000 Dec 31 ) 798 | ] 799 | ) 800 | ] 801 | 802 | 803 | test_fromWeekDate : Test 804 | test_fromWeekDate = 805 | describe "fromWeekDate" 806 | [ describe "clamps weeks that are out of range for the given week-year" 807 | (List.map 808 | (\( ( wy, wn, wd ), expected ) -> 809 | test (Debug.toString ( wy, wn, wd ) ++ " " ++ Debug.toString expected) <| 810 | \() -> 811 | Date.fromWeekDate wy wn wd |> toWeekDate |> equal expected 812 | ) 813 | [ ( ( 2000, -1, Mon ), WeekDate 2000 1 Mon ) 814 | , ( ( 2000, 0, Mon ), WeekDate 2000 1 Mon ) 815 | , ( ( 2000, 53, Mon ), WeekDate 2000 52 Mon ) 816 | , ( ( 2004, 54, Mon ), WeekDate 2004 53 Mon ) 817 | ] 818 | ) 819 | ] 820 | 821 | 822 | test_numberToMonth : Test 823 | test_numberToMonth = 824 | describe "numberToMonth" 825 | [ describe "clamps numbers that are out of range" 826 | (List.map 827 | (\( n, month ) -> 828 | test (Debug.toString ( n, month )) <| \() -> n |> Date.numberToMonth |> equal month 829 | ) 830 | [ ( -1, Jan ) 831 | , ( 0, Jan ) 832 | , ( 13, Dec ) 833 | ] 834 | ) 835 | ] 836 | 837 | 838 | test_numberToWeekday : Test 839 | test_numberToWeekday = 840 | describe "numberToWeekday" 841 | [ describe "clamps numbers that are out of range" 842 | (List.map 843 | (\( n, weekday ) -> 844 | test (Debug.toString ( n, weekday )) <| \() -> n |> Date.numberToWeekday |> equal weekday 845 | ) 846 | [ ( -1, Mon ) 847 | , ( 0, Mon ) 848 | , ( 8, Sun ) 849 | ] 850 | ) 851 | ] 852 | 853 | 854 | 855 | {- 856 | test_is53WeekYear : Test 857 | test_is53WeekYear = 858 | test "is53WeekYear" <| 859 | \() -> 860 | List.range 1970 2040 861 | |> List.filter Date.is53WeekYear 862 | |> equal [ 1970, 1976, 1981, 1987, 1992, 1998, 2004, 2009, 2015, 2020, 2026, 2032, 2037 ] 863 | -} 864 | 865 | 866 | test_compare : Test 867 | test_compare = 868 | describe "compare" 869 | [ describe "returns an Order" <| 870 | List.map 871 | (\( a, b, expected ) -> 872 | test (Debug.toString a ++ " " ++ Debug.toString b) <| 873 | \() -> Date.compare a b |> equal expected 874 | ) 875 | [ ( Date.fromOrdinalDate 1970 1, Date.fromOrdinalDate 2038 1, LT ) 876 | , ( Date.fromOrdinalDate 1970 1, Date.fromOrdinalDate 1970 1, EQ ) 877 | , ( Date.fromOrdinalDate 2038 1, Date.fromOrdinalDate 1970 1, GT ) 878 | ] 879 | , test "can be used with List.sortWith" <| 880 | \() -> 881 | [ Date.fromOrdinalDate 2038 1 882 | , Date.fromOrdinalDate 2038 19 883 | , Date.fromOrdinalDate 1970 1 884 | , Date.fromOrdinalDate 1969 201 885 | , Date.fromOrdinalDate 2001 1 886 | ] 887 | |> List.sortWith Date.compare 888 | |> equal 889 | [ Date.fromOrdinalDate 1969 201 890 | , Date.fromOrdinalDate 1970 1 891 | , Date.fromOrdinalDate 2001 1 892 | , Date.fromOrdinalDate 2038 1 893 | , Date.fromOrdinalDate 2038 19 894 | ] 895 | ] 896 | 897 | 898 | test_isBetween : Test 899 | test_isBetween = 900 | let 901 | ( a, b, c ) = 902 | ( Date.fromOrdinalDate 1969 201 903 | , Date.fromOrdinalDate 1970 1 904 | , Date.fromOrdinalDate 2038 19 905 | ) 906 | 907 | toTest : ( String, ( Date, Date, Date ), Bool ) -> Test 908 | toTest ( desc, ( minimum, maximum, x ), expected ) = 909 | test desc <| 910 | \() -> 911 | Date.isBetween minimum maximum x |> equal expected 912 | in 913 | describe "isBetween" 914 | [ describe "when min < max, works as expected" <| 915 | List.map toTest 916 | [ ( "before", ( b, c, a ), False ) 917 | , ( "min", ( b, c, b ), True ) 918 | , ( "middle", ( a, c, b ), True ) 919 | , ( "max", ( a, b, b ), True ) 920 | , ( "after", ( a, b, c ), False ) 921 | ] 922 | , describe "when min == max, works as expected" <| 923 | List.map toTest 924 | [ ( "before", ( b, b, a ), False ) 925 | , ( "equal", ( b, b, b ), True ) 926 | , ( "after", ( b, b, c ), False ) 927 | ] 928 | , describe "when min > max, always returns False" <| 929 | List.map toTest 930 | [ ( "before", ( c, b, a ), False ) 931 | , ( "min", ( c, b, b ), False ) 932 | , ( "middle", ( c, a, b ), False ) 933 | , ( "max", ( b, a, b ), False ) 934 | , ( "after", ( b, a, c ), False ) 935 | ] 936 | ] 937 | 938 | 939 | test_min : Test 940 | test_min = 941 | let 942 | ( a, b ) = 943 | ( Date.fromOrdinalDate 1969 201 944 | , Date.fromOrdinalDate 1970 1 945 | ) 946 | in 947 | describe "min" 948 | [ test "a b" <| \() -> Date.min a b |> equal a 949 | , test "b a" <| \() -> Date.min b a |> equal a 950 | ] 951 | 952 | 953 | test_max : Test 954 | test_max = 955 | let 956 | ( a, b ) = 957 | ( Date.fromOrdinalDate 1969 201 958 | , Date.fromOrdinalDate 1970 1 959 | ) 960 | in 961 | describe "max" 962 | [ test "a b" <| \() -> Date.max a b |> equal b 963 | , test "b a" <| \() -> Date.max b a |> equal b 964 | ] 965 | 966 | 967 | test_clamp : Test 968 | test_clamp = 969 | let 970 | ( a, b, c ) = 971 | ( Date.fromOrdinalDate 1969 201 972 | , Date.fromOrdinalDate 1970 1 973 | , Date.fromOrdinalDate 2038 19 974 | ) 975 | 976 | toTest : ( String, ( Date, Date, Date ), Date ) -> Test 977 | toTest ( desc, ( minimum, maximum, x ), expected ) = 978 | test desc <| 979 | \() -> 980 | Date.clamp minimum maximum x |> equal expected 981 | in 982 | describe "clamp" 983 | [ describe "when min < max, works as expected" <| 984 | List.map toTest 985 | [ ( "before", ( b, c, a ), b ) 986 | , ( "min", ( b, c, b ), b ) 987 | , ( "middle", ( a, c, b ), b ) 988 | , ( "max", ( a, b, b ), b ) 989 | , ( "after", ( a, b, c ), b ) 990 | ] 991 | , describe "when min == max, works as expected" <| 992 | List.map toTest 993 | [ ( "before", ( b, b, a ), b ) 994 | , ( "equal", ( b, b, b ), b ) 995 | , ( "after", ( b, b, c ), b ) 996 | ] 997 | ] 998 | 999 | 1000 | 1001 | -- records 1002 | 1003 | 1004 | type alias OrdinalDate = 1005 | { year : Int, ordinalDay : Int } 1006 | 1007 | 1008 | toOrdinalDate : Date -> OrdinalDate 1009 | toOrdinalDate date = 1010 | OrdinalDate 1011 | (date |> Date.year) 1012 | (date |> Date.ordinalDay) 1013 | 1014 | 1015 | type alias CalendarDate = 1016 | { year : Int, month : Month, day : Int } 1017 | 1018 | 1019 | fromCalendarDate : CalendarDate -> Date 1020 | fromCalendarDate { year, month, day } = 1021 | Date.fromCalendarDate year month day 1022 | 1023 | 1024 | toCalendarDate : Date -> CalendarDate 1025 | toCalendarDate date = 1026 | CalendarDate 1027 | (date |> Date.year) 1028 | (date |> Date.month) 1029 | (date |> Date.day) 1030 | 1031 | 1032 | type alias WeekDate = 1033 | { weekYear : Int, weekNumber : Int, weekday : Weekday } 1034 | 1035 | 1036 | fromWeekDate : WeekDate -> Date 1037 | fromWeekDate { weekYear, weekNumber, weekday } = 1038 | Date.fromWeekDate weekYear weekNumber weekday 1039 | 1040 | 1041 | toWeekDate : Date -> WeekDate 1042 | toWeekDate date = 1043 | WeekDate 1044 | (date |> Date.weekYear) 1045 | (date |> Date.weekNumber) 1046 | (date |> Date.weekday) 1047 | 1048 | 1049 | 1050 | -- dates 1051 | 1052 | 1053 | calendarDatesInYear : Int -> List CalendarDate 1054 | calendarDatesInYear y = 1055 | [ Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec ] 1056 | |> List.concatMap 1057 | (\m -> List.range 1 (daysInMonth y m) |> List.map (CalendarDate y m)) 1058 | 1059 | 1060 | isLeapYear : Int -> Bool 1061 | isLeapYear y = 1062 | modBy 4 y == 0 && modBy 100 y /= 0 || modBy 400 y == 0 1063 | 1064 | 1065 | daysInMonth : Int -> Month -> Int 1066 | daysInMonth y m = 1067 | case m of 1068 | Jan -> 1069 | 31 1070 | 1071 | Feb -> 1072 | if isLeapYear y then 1073 | 29 1074 | 1075 | else 1076 | 28 1077 | 1078 | Mar -> 1079 | 31 1080 | 1081 | Apr -> 1082 | 30 1083 | 1084 | May -> 1085 | 31 1086 | 1087 | Jun -> 1088 | 30 1089 | 1090 | Jul -> 1091 | 31 1092 | 1093 | Aug -> 1094 | 31 1095 | 1096 | Sep -> 1097 | 30 1098 | 1099 | Oct -> 1100 | 31 1101 | 1102 | Nov -> 1103 | 30 1104 | 1105 | Dec -> 1106 | 31 1107 | 1108 | 1109 | 1110 | -- result 1111 | 1112 | 1113 | extractErr : x -> Result x a -> x 1114 | extractErr default result = 1115 | case result of 1116 | Err x -> 1117 | x 1118 | 1119 | Ok _ -> 1120 | default 1121 | 1122 | 1123 | 1124 | -- expectation 1125 | 1126 | 1127 | expectIsomorphism : (x -> y) -> (y -> x) -> x -> Expectation 1128 | expectIsomorphism xToY yToX x = 1129 | x |> xToY |> yToX |> equal x 1130 | 1131 | 1132 | expectIdempotence : (x -> x) -> x -> Expectation 1133 | expectIdempotence f x = 1134 | f (f x) |> equal (f x) 1135 | --------------------------------------------------------------------------------