├── .gitignore
├── LICENSE
├── README.md
├── css
    ├── elm-datepicker.css
    └── elm-datepicker.scss
├── elm-package.json
├── examples
    ├── Makefile
    ├── bootstrap
    │   ├── .gitignore
    │   ├── Bootstrap.elm
    │   └── index.html
    ├── range
    │   ├── .gitignore
    │   ├── Range.elm
    │   └── index.html
    ├── simple-nightwatch
    │   ├── .gitignore
    │   ├── SimpleNightwatch.elm
    │   └── index.html
    └── simple
    │   ├── .gitignore
    │   ├── Simple.elm
    │   └── index.html
├── nightwatch-tests
    └── simple.js
├── nightwatch.json
├── package.json
├── run-acceptance-tests
└── src
    ├── DatePicker.elm
    └── DatePicker
        └── Date.elm


/.gitignore:
--------------------------------------------------------------------------------
1 | /elm-stuff
2 | /elm.js
3 | /.idea
4 | /node_modules
5 | 
6 | #nightwatch reports
7 | /reports
8 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright (c) 2016, Bogdan Paul Popa
 2 | All rights reserved.
 3 | 
 4 | Redistribution and use in source and binary forms, with or without
 5 | modification, are permitted provided that the following conditions are met:
 6 |     * Redistributions of source code must retain the above copyright
 7 |       notice, this list of conditions and the following disclaimer.
 8 |     * Redistributions in binary form must reproduce the above copyright
 9 |       notice, this list of conditions and the following disclaimer in the
10 |       documentation and/or other materials provided with the distribution.
11 |     * Neither the name of the <organization> nor the
12 |       names of its contributors may be used to endorse or promote products
13 |       derived from this software without specific prior written permission.
14 | 
15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
18 | DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # elm-datepicker
  2 | 
  3 | ``` shell
  4 | elm package install elm-community/elm-datepicker
  5 | ```
  6 | 
  7 | A reusable date picker component in Elm.
  8 | 
  9 | ## 0.19 Compatibility
 10 | 
 11 | As of 0.19, the Elm community is not hosting a central/default datepicker. It didn't seem like the kind of thing that would be in a standard library. Please use the [CurrySoftware](https://github.com/CurrySoftware/elm-datepicker) fork for 0.19+. Many thanks to them for taking it on!
 12 | 
 13 | 
 14 | ## Usage
 15 | 
 16 | The `DatePicker.init` function initialises the DatePicker. It returns the initialised DatePicker and associated `Cmds` so it must be done in your program's `init` or `update` functions:
 17 | 
 18 | **Note** Make sure you don't throw away the initial `Cmd`!
 19 | 
 20 | ```elm
 21 |    
 22 | init : (Model, Cmd Msg)
 23 | ...
 24 |     let
 25 |         ( datePicker, datePickerCmd ) =
 26 |             DatePicker.init 
 27 |     in
 28 |         (
 29 |             { model | datePicker = datePicker },
 30 |             Cmd.map SetDatePicker datePickerCmd
 31 |         )
 32 | ```
 33 | 
 34 | The `DatePicker` can be displayed in a view using the `DatePicker.view` function. It returns its own
 35 | message type so you should wrap it in one of your own messages using `Html.map`:
 36 | 
 37 | 
 38 | ```elm
 39 | type Msg
 40 |     = ...
 41 |     | SetDatePicker DatePicker.Msg
 42 |     | ...
 43 | 
 44 | 
 45 | view : Model -> Html Msg
 46 | view model =
 47 |     ...
 48 |     div [] [
 49 |         DatePicker.view
 50 |             model.date 
 51 |             someSettings
 52 |             model.startDatePicker 
 53 |          |> Html.map SetDatePicker
 54 |         ]
 55 | 
 56 | ```
 57 | 
 58 | To handle `Msg` in your update function, you should unwrap the `DatePicker.Msg` and pass it down to the `DatePicker.update` function. The `DatePicker.update` function returns:
 59 | 
 60 | * the new model
 61 | * any command 
 62 | * the new date as a `DateEvent (Maybe Date)`, where `DateEvent` is really just `Maybe` with different semantics, to avoid a potentially confusing `Maybe Maybe`.
 63 | 
 64 | To create the settings to pass to `update`, DatePicker.defaultSettings` is provided to make it easier to use. You only have to override the settings that you are interested in.
 65 | 
 66 | **Note** The datepicker does _not_ retain an internal idea of a picked date in its model. That is, it depends completely on you for an idea of what date is chosen, so that third tuple member is important! Evan Czaplicki has a compelling argument for why components should not necessarily have an their own state for the primary data they manage [here](https://github.com/evancz/elm-sortable-table#single-source-of-truth).
 67 | 
 68 | ```elm
 69 | someSettings : DatePicker.Settings
 70 | someSettings = 
 71 |     { defaultSettings
 72 |         | inputClassList = [ ( "form-control", True ) ]
 73 |         , inputId = Just "datepicker"
 74 |     }
 75 | 
 76 | update : Msg -> Model -> ( Model, Cmd Msg )
 77 | update msg model =
 78 |     case msg of
 79 |         ...
 80 | 
 81 |          SetDatePicker msg ->
 82 |             let
 83 |                 ( newDatePicker, datePickerCmd, dateEvent ) =
 84 |                     DatePicker.update someSettings msg model.startDatePicker
 85 | 
 86 |                 date =
 87 |                     case dateEvent of
 88 |                         NoChange ->
 89 |                             model.date
 90 | 
 91 |                         Changed newDate ->
 92 |                             newDate |> processDate
 93 |             in
 94 |                 { model
 95 |                     | date = date
 96 |                     , datePicker = newDatePicker
 97 |                 }
 98 |                     ! [ Cmd.map SetDatePicker datePickerCmd ]
 99 | 
100 | ```
101 | 
102 | ## Examples
103 | 
104 | See the [examples][examples] folder or try it on ellie-app: [simple] example and [bootstrap] example.
105 | 
106 | [examples]: https://github.com/elm-community/elm-datepicker/tree/master/examples
107 | [simple]: https://ellie-app.com/5QFsDgQVva1/0
108 | [bootstrap]: https://ellie-app.com/pwGJj5T6TBa1/0
109 | 
110 | 
111 | ## CSS
112 | 
113 | The CSS for the date picker is distributed separately.  You can grab
114 | the compiled CSS from [here][compiled] or you can grab the SCSS source
115 | from [here][scss].
116 | 
117 | [compiled]: https://github.com/elm-community/elm-datepicker/blob/master/css/elm-datepicker.css
118 | [scss]: https://github.com/elm-community/elm-datepicker/blob/master/css/elm-datepicker.scss
119 | 
120 | 
121 | ## Running the acceptance tests
122 | ### Prerequisites
123 | 
124 | - elm reactor - this is most likely already installed if you're using Elm!
125 | - chromedriver (https://sites.google.com/a/chromium.org/chromedriver/).
126 |   Try `brew install chromedriver` if you're on OSX.
127 | 
128 | 
129 | ### Install the testing tools
130 | run `npm install`
131 | 
132 | ### build the examples
133 | cd examples && make && cd ..
134 | 
135 | ### Run the tests
136 | `./run-acceptance-tests`
137 | 
138 | Please file an issue if you have any difficulty running the tests.
139 | 


--------------------------------------------------------------------------------
/css/elm-datepicker.css:
--------------------------------------------------------------------------------
  1 | .elm-datepicker--container {
  2 |   position: relative; }
  3 | 
  4 | .elm-datepicker--input:focus {
  5 |   outline: 0; }
  6 | 
  7 | .elm-datepicker--picker {
  8 |   position: absolute;
  9 |   border: 1px solid #CCC;
 10 |   z-index: 10;
 11 |   background: #FFFFFF; }
 12 | 
 13 | .elm-datepicker--picker-header,
 14 | .elm-datepicker--weekdays {
 15 |   background: #F2F2F2; }
 16 | 
 17 | .elm-datepicker--picker-header {
 18 |   display: flex;
 19 |   align-items: center; }
 20 | 
 21 | .elm-datepicker--prev-container,
 22 | .elm-datepicker--next-container {
 23 |   flex: 0 1 auto; }
 24 | 
 25 | .elm-datepicker--month-container {
 26 |   flex: 1 1 auto;
 27 |   padding: 0.5em;
 28 |   display: flex;
 29 |   flex-direction: column; }
 30 | 
 31 | .elm-datepicker--month,
 32 | .elm-datepicker--year {
 33 |   flex: 1 1 auto;
 34 |   cursor: default;
 35 |   text-align: center; }
 36 | 
 37 | .elm-datepicker--year {
 38 |   font-size: 0.6em;
 39 |   font-weight: 700; }
 40 | 
 41 | .elm-datepicker--prev,
 42 | .elm-datepicker--next {
 43 |   border: 6px solid transparent;
 44 |   display: block;
 45 |   width: 0;
 46 |   height: 0;
 47 |   padding: 0 0.2em; }
 48 | 
 49 | .elm-datepicker--prev {
 50 |   border-right-color: #AAA; }
 51 |   .elm-datepicker--prev:hover {
 52 |     border-right-color: #BBB; }
 53 | 
 54 | .elm-datepicker--next {
 55 |   border-left-color: #AAA; }
 56 |   .elm-datepicker--next:hover {
 57 |     border-left-color: #BBB; }
 58 | 
 59 | .elm-datepicker--table {
 60 |   border-spacing: 0;
 61 |   border-collapse: collapse;
 62 |   font-size: 0.8em; }
 63 |   .elm-datepicker--table td {
 64 |     width: 2em;
 65 |     height: 2em;
 66 |     text-align: center; }
 67 | 
 68 | .elm-datepicker--row {
 69 |   border-top: 1px solid #F2F2F2; }
 70 | 
 71 | .elm-datepicker--dow {
 72 |   border-bottom: 1px solid #CCC;
 73 |   cursor: default; }
 74 | 
 75 | .elm-datepicker--day {
 76 |   cursor: pointer; }
 77 |   .elm-datepicker--day:hover {
 78 |     background: #F2F2F2; }
 79 | 
 80 | .elm-datepicker--disabled {
 81 |   cursor: default;
 82 |   color: #DDD; }
 83 |   .elm-datepicker--disabled:hover {
 84 |     background: inherit; }
 85 | 
 86 | .elm-datepicker--picked {
 87 |   color: white;
 88 |   background: darkblue; }
 89 |   .elm-datepicker--picked:hover {
 90 |     background: darkblue; }
 91 | 
 92 | .elm-datepicker--today {
 93 |   font-weight: bold; }
 94 | 
 95 | .elm-datepicker--other-month {
 96 |   color: #AAA; }
 97 |   .elm-datepicker--other-month.elm-datepicker--disabled {
 98 |     color: #EEE; }
 99 |   .elm-datepicker--other-month.elm-datepicker--picked {
100 |     color: white; }
101 | 


--------------------------------------------------------------------------------
/css/elm-datepicker.scss:
--------------------------------------------------------------------------------
  1 | $datepicker-ns: elm-datepicker-- !default;
  2 | $datepicker-hl: #F2F2F2;
  3 | $datepicker-arrow: #AAA;
  4 | $datepicker-arrow-hover: #BBB;
  5 | $datepicker-picked-fg: white;
  6 | $datepicker-picked-bg: darkblue;
  7 | $datepicker-border-color: #CCC;
  8 | $datepicker-row-border-color: #F2F2F2;
  9 | 
 10 | .#{$datepicker-ns}container {
 11 |   position: relative;
 12 | }
 13 | 
 14 | .#{$datepicker-ns}input:focus {
 15 |   outline: 0;
 16 | }
 17 | 
 18 | .#{$datepicker-ns}picker {
 19 |   position: absolute;
 20 |   border: 1px solid $datepicker-border-color;
 21 |   z-index: 10;
 22 |   background-color: white;
 23 | }
 24 | 
 25 | .#{$datepicker-ns}picker-header,
 26 | .#{$datepicker-ns}weekdays {
 27 |   background: $datepicker-hl;
 28 | }
 29 | 
 30 | .#{$datepicker-ns}picker-header {
 31 |   display: flex;
 32 |   align-items: center;
 33 | }
 34 | 
 35 | .#{$datepicker-ns}prev-container,
 36 | .#{$datepicker-ns}next-container {
 37 |   flex: 0 1 auto;
 38 | }
 39 | 
 40 | .#{$datepicker-ns}month-container {
 41 |   flex: 1 1 auto;
 42 | 
 43 |   padding: 0.5em;
 44 | 
 45 |   display: flex;
 46 |   flex-direction: column;
 47 | }
 48 | 
 49 | .#{$datepicker-ns}month,
 50 | .#{$datepicker-ns}year {
 51 |   flex: 1 1 auto;
 52 | 
 53 |   cursor: default;
 54 |   text-align: center;
 55 | }
 56 | 
 57 | .#{$datepicker-ns}year {
 58 |   font-size: 0.6em;
 59 |   font-weight: 700;
 60 | }
 61 | 
 62 | .#{$datepicker-ns}prev,
 63 | .#{$datepicker-ns}next {
 64 |   border: 6px solid transparent;
 65 | 
 66 |   display: block;
 67 |   width: 0;
 68 |   height: 0;
 69 | 
 70 |   padding: 0 0.2em;
 71 | }
 72 | 
 73 | .#{$datepicker-ns}prev {
 74 |   border-right-color: $datepicker-arrow;
 75 | 
 76 |   &:hover {
 77 |     border-right-color: $datepicker-arrow-hover;
 78 |   }
 79 | }
 80 | 
 81 | .#{$datepicker-ns}next {
 82 |   border-left-color: $datepicker-arrow;
 83 | 
 84 |   &:hover {
 85 |     border-left-color: $datepicker-arrow-hover;
 86 |   }
 87 | }
 88 | 
 89 | .#{$datepicker-ns}table {
 90 |   border-spacing: 0;
 91 |   border-collapse: collapse;
 92 | 
 93 |   font-size: 0.8em;
 94 | 
 95 |   td {
 96 |     width: 2em;
 97 |     height: 2em;
 98 | 
 99 |     text-align: center;
100 |   }
101 | }
102 | 
103 | .#{$datepicker-ns}row {
104 |   border-top: 1px solid $datepicker-row-border-color;
105 | }
106 | 
107 | .#{$datepicker-ns}dow {
108 |   border-bottom: 1px solid $datepicker-border-color;
109 | 
110 |   cursor: default;
111 | }
112 | 
113 | .#{$datepicker-ns}day {
114 |   cursor: pointer;
115 | 
116 |   &:hover {
117 |     background: $datepicker-hl;
118 |   }
119 | }
120 | 
121 | .#{$datepicker-ns}disabled {
122 |   cursor: default;
123 |   color: #DDD;
124 | 
125 |   &:hover {
126 |     background: inherit;
127 |   }
128 | }
129 | 
130 | .#{$datepicker-ns}picked {
131 |   color: $datepicker-picked-fg;
132 |   background: $datepicker-picked-bg;
133 | 
134 |   &:hover {
135 |     background: $datepicker-picked-bg;
136 |   }
137 | }
138 | 
139 | .#{$datepicker-ns}today {
140 |   font-weight: bold;
141 | }
142 | 
143 | .#{$datepicker-ns}other-month {
144 |   color: #AAA;
145 | 
146 |   &.#{$datepicker-ns}disabled {
147 |     color: #EEE;
148 |   }
149 | 
150 |   &.#{$datepicker-ns}picked {
151 |     color: $datepicker-picked-fg;
152 |   }
153 | }
154 | 


--------------------------------------------------------------------------------
/elm-package.json:
--------------------------------------------------------------------------------
 1 | {
 2 |     "version": "7.2.6",
 3 |     "summary": "A reusable date picker component",
 4 |     "repository": "https://github.com/elm-community/elm-datepicker.git",
 5 |     "license": "BSD3",
 6 |     "source-directories": [
 7 |         "examples/simple",
 8 |         "src"
 9 |     ],
10 |     "exposed-modules": [
11 |         "DatePicker"
12 |     ],
13 |     "dependencies": {
14 |         "elm-lang/core": "5.0.0 <= v < 6.0.0",
15 |         "elm-lang/html": "2.0.0 <= v < 3.0.0"
16 |     },
17 |     "elm-version": "0.18.0 <= v < 0.19.0"
18 | }
19 | 


--------------------------------------------------------------------------------
/examples/Makefile:
--------------------------------------------------------------------------------
 1 | all: simple-example bootstrap-example range-example simple-nightwatch-example
 2 | 
 3 | simple-example:
 4 | 	cd .. && elm make --warn examples/simple/Simple.elm --output=examples/simple/simple.js
 5 | 
 6 | bootstrap-example:
 7 | 	cd .. && elm make --warn examples/bootstrap/Bootstrap.elm --output=examples/bootstrap/bootstrap.js
 8 | 
 9 | range-example:
10 | 	cd .. && elm make --warn examples/range/Range.elm --output=examples/range/range.js
11 | 
12 | simple-nightwatch-example:
13 | 	cd .. && elm make --warn examples/simple-nightwatch/SimpleNightwatch.elm --output=examples/simple-nightwatch/simple-nightwatch.js
14 | 


--------------------------------------------------------------------------------
/examples/bootstrap/.gitignore:
--------------------------------------------------------------------------------
1 | bootstrap.js


--------------------------------------------------------------------------------
/examples/bootstrap/Bootstrap.elm:
--------------------------------------------------------------------------------
 1 | module Bootstrap exposing (main)
 2 | 
 3 | import Date exposing (Date, Day(..), day, dayOfWeek, month, year)
 4 | import DatePicker exposing (defaultSettings, DateEvent(..))
 5 | import Html exposing (Html, div, form, h1, input, label, text)
 6 | import Html.Attributes exposing (class, type_, value)
 7 | 
 8 | 
 9 | type Msg
10 |     = ToDatePicker DatePicker.Msg
11 | 
12 | 
13 | type alias Model =
14 |     { date : Maybe Date
15 |     , datePicker : DatePicker.DatePicker
16 |     }
17 | 
18 | 
19 | settings : DatePicker.Settings
20 | settings =
21 |     let
22 |         isDisabled date =
23 |             dayOfWeek date
24 |                 |> flip List.member [ Sat, Sun ]
25 |     in
26 |         { defaultSettings
27 |             | isDisabled = isDisabled
28 |             , inputClassList = [ ( "form-control", True ) ]
29 |             , inputName = Just "date"
30 |             , inputId = Just "date-field"
31 |         }
32 | 
33 | 
34 | init : ( Model, Cmd Msg )
35 | init =
36 |     let
37 |         ( datePicker, datePickerFx ) =
38 |             DatePicker.init
39 |     in
40 |         { date = Nothing
41 |         , datePicker = datePicker
42 |         }
43 |             ! [ Cmd.map ToDatePicker datePickerFx ]
44 | 
45 | 
46 | update : Msg -> Model -> ( Model, Cmd Msg )
47 | update msg ({ datePicker } as model) =
48 |     case msg of
49 |         ToDatePicker msg ->
50 |             let
51 |                 ( newDatePicker, datePickerFx, event ) =
52 |                     DatePicker.update settings msg datePicker
53 |             in
54 |                 { model
55 |                     | date =
56 |                         case event of
57 |                             Changed date ->
58 |                                 date
59 | 
60 |                             NoChange ->
61 |                                 model.date
62 |                     , datePicker = newDatePicker
63 |                 }
64 |                     ! [ Cmd.map ToDatePicker datePickerFx ]
65 | 
66 | 
67 | view : Model -> Html Msg
68 | view ({ date, datePicker } as model) =
69 |     div [ class "col-md-3" ]
70 |         [ form []
71 |             [ div [ class "form-group" ]
72 |                 [ label [] [ text "Pick a date" ]
73 |                 , DatePicker.view date settings datePicker
74 |                     |> Html.map ToDatePicker
75 |                 ]
76 |             , input
77 |                 [ type_ "submit"
78 |                 , class "btn btn-primary"
79 |                 , value "Submit"
80 |                 ]
81 |                 []
82 |             ]
83 |         ]
84 | 
85 | 
86 | formatDate : Date -> String
87 | formatDate d =
88 |     toString (month d) ++ " " ++ toString (day d) ++ ", " ++ toString (year d)
89 | 
90 | 
91 | main : Program Never Model Msg
92 | main =
93 |     Html.program
94 |         { init = init
95 |         , update = update
96 |         , view = view
97 |         , subscriptions = always Sub.none
98 |         }
99 | 


--------------------------------------------------------------------------------
/examples/bootstrap/index.html:
--------------------------------------------------------------------------------
 1 | <!doctype html>
 2 | <html lang="en-us">
 3 |   <head>
 4 |     <meta charset="utf-8">
 5 |     <title>elm-datepicker example</title>
 6 | 
 7 |     <link rel="stylesheet"
 8 |           href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.6/css/bootstrap.min.css"
 9 |           integrity="sha384-1q8mTJOASx8j1Au+a5WDVnPi2lkFfwwEAa8hDDdjZlpLegxhjVME1fgjWPGmkzs7"
10 |           crossorigin="anonymous" />
11 | 
12 |     <link rel="stylesheet"
13 |           type="text/css"
14 |           href="../../css/elm-datepicker.css" />
15 |   </head>
16 |   <body>
17 |     <div class="container">
18 |       <div id="app" class="row">
19 |       </div>
20 |     </div>
21 | 
22 |     <script src="bootstrap.js"></script>
23 |     <script>
24 |       Elm.Bootstrap.embed(document.getElementById("app"));
25 |     </script>
26 |   </body>
27 | </html>
28 | 


--------------------------------------------------------------------------------
/examples/range/.gitignore:
--------------------------------------------------------------------------------
1 | range.js
2 | 


--------------------------------------------------------------------------------
/examples/range/Range.elm:
--------------------------------------------------------------------------------
  1 | module Range exposing (main)
  2 | 
  3 | import Date exposing (Date, Day(..), day, dayOfWeek, month, year)
  4 | import DatePicker exposing (defaultSettings, DateEvent(..))
  5 | import Html exposing (Html, div, h1, text)
  6 | 
  7 | 
  8 | type Msg
  9 |     = ToStartDatePicker DatePicker.Msg
 10 |     | ToEndDatePicker DatePicker.Msg
 11 | 
 12 | 
 13 | type alias Model =
 14 |     { startDate : Maybe Date
 15 |     , endDate : Maybe Date
 16 |     , startDatePicker : DatePicker.DatePicker
 17 |     , endDatePicker : DatePicker.DatePicker
 18 |     }
 19 | 
 20 | 
 21 | 
 22 | -- Could be used to customize common settings for both date pickers. Like for
 23 | -- example disabling weekends from them.
 24 | 
 25 | 
 26 | commonSettings : DatePicker.Settings
 27 | commonSettings =
 28 |     defaultSettings
 29 | 
 30 | 
 31 | 
 32 | -- Extend commonSettings with isDisabled function which would disable dates
 33 | -- after already selected end date because range start should come before end.
 34 | 
 35 | 
 36 | startSettings : Maybe Date -> DatePicker.Settings
 37 | startSettings endDate =
 38 |     let
 39 |         isDisabled =
 40 |             case endDate of
 41 |                 Nothing ->
 42 |                     commonSettings.isDisabled
 43 | 
 44 |                 Just endDate ->
 45 |                     \d ->
 46 |                         Date.toTime d
 47 |                             > Date.toTime endDate
 48 |                             || (commonSettings.isDisabled d)
 49 |     in
 50 |         { commonSettings
 51 |             | placeholder = "Pick a start date"
 52 |             , isDisabled = isDisabled
 53 |         }
 54 | 
 55 | 
 56 | 
 57 | -- Extend commonSettings with isDisabled function which would disable dates
 58 | -- before already selected start date because range end should come after start.
 59 | 
 60 | 
 61 | endSettings : Maybe Date -> DatePicker.Settings
 62 | endSettings startDate =
 63 |     let
 64 |         isDisabled =
 65 |             case startDate of
 66 |                 Nothing ->
 67 |                     commonSettings.isDisabled
 68 | 
 69 |                 Just startDate ->
 70 |                     \d ->
 71 |                         Date.toTime d
 72 |                             < Date.toTime startDate
 73 |                             || (commonSettings.isDisabled d)
 74 |     in
 75 |         { commonSettings
 76 |             | placeholder = "Pick an end date"
 77 |             , isDisabled = isDisabled
 78 |         }
 79 | 
 80 | 
 81 | init : ( Model, Cmd Msg )
 82 | init =
 83 |     let
 84 |         ( startDatePicker, startDatePickerFx ) =
 85 |             DatePicker.init
 86 | 
 87 |         ( endDatePicker, endDatePickerFx ) =
 88 |             DatePicker.init
 89 |     in
 90 |         { startDate = Nothing
 91 |         , startDatePicker = startDatePicker
 92 |         , endDate = Nothing
 93 |         , endDatePicker = endDatePicker
 94 |         }
 95 |             ! ([ Cmd.map ToStartDatePicker startDatePickerFx ]
 96 |                 ++ [ Cmd.map
 97 |                         ToEndDatePicker
 98 |                         endDatePickerFx
 99 |                    ]
100 |               )
101 | 
102 | 
103 | update : Msg -> Model -> ( Model, Cmd Msg )
104 | update msg model =
105 |     case msg of
106 |         ToStartDatePicker msg ->
107 |             let
108 |                 ( newDatePicker, datePickerFx, dateEvent ) =
109 |                     DatePicker.update (startSettings model.endDate) msg model.startDatePicker
110 | 
111 |                 newDate =
112 |                     case dateEvent of
113 |                         Changed newDate ->
114 |                             newDate
115 | 
116 |                         _ ->
117 |                             model.startDate
118 |             in
119 |                 { model
120 |                     | startDate = newDate
121 |                     , startDatePicker = newDatePicker
122 |                 }
123 |                     ! [ Cmd.map ToStartDatePicker datePickerFx ]
124 | 
125 |         ToEndDatePicker msg ->
126 |             let
127 |                 ( newDatePicker, datePickerFx, dateEvent ) =
128 |                     DatePicker.update (endSettings model.startDate) msg model.endDatePicker
129 | 
130 |                 newDate =
131 |                     case dateEvent of
132 |                         Changed newDate ->
133 |                             newDate
134 | 
135 |                         _ ->
136 |                             model.endDate
137 |             in
138 |                 { model
139 |                     | endDate = newDate
140 |                     , endDatePicker = newDatePicker
141 |                 }
142 |                     ! [ Cmd.map ToEndDatePicker datePickerFx ]
143 | 
144 | 
145 | view : Model -> Html Msg
146 | view model =
147 |     div []
148 |         [ viewRange model.startDate model.endDate
149 |         , DatePicker.view model.startDate (startSettings model.endDate) model.startDatePicker
150 |             |> Html.map ToStartDatePicker
151 |         , DatePicker.view model.endDate (endSettings model.startDate) model.endDatePicker
152 |             |> Html.map ToEndDatePicker
153 |         ]
154 | 
155 | 
156 | viewRange : Maybe Date -> Maybe Date -> Html Msg
157 | viewRange start end =
158 |     case ( start, end ) of
159 |         ( Nothing, Nothing ) ->
160 |             h1 [] [ text "Pick dates" ]
161 | 
162 |         ( Just start, Nothing ) ->
163 |             h1 [] [ text <| formatDate start ++ " – Pick end date" ]
164 | 
165 |         ( Nothing, Just end ) ->
166 |             h1 [] [ text <| "Pick start date – " ++ formatDate end ]
167 | 
168 |         ( Just start, Just end ) ->
169 |             h1 [] [ text <| formatDate start ++ " – " ++ formatDate end ]
170 | 
171 | 
172 | formatDate : Date -> String
173 | formatDate d =
174 |     toString (month d) ++ " " ++ toString (day d) ++ ", " ++ toString (year d)
175 | 
176 | 
177 | main : Program Never Model Msg
178 | main =
179 |     Html.program
180 |         { init = init
181 |         , update = update
182 |         , view = view
183 |         , subscriptions = always Sub.none
184 |         }
185 | 


--------------------------------------------------------------------------------
/examples/range/index.html:
--------------------------------------------------------------------------------
 1 | <!doctype html>
 2 | <html lang="en-us">
 3 |   <head>
 4 |     <meta charset="utf-8">
 5 |     <title>elm-datepicker example</title>
 6 | 
 7 |     <link rel="stylesheet"
 8 |           type="text/css"
 9 |           href="https://necolas.github.io/normalize.css/4.1.1/normalize.css" />
10 | 
11 |     <link rel="stylesheet"
12 |           type="text/css"
13 |           href="https://fonts.googleapis.com/css?family=Roboto" />
14 | 
15 |     <link rel="stylesheet"
16 |           type="text/css"
17 |           href="../../css/elm-datepicker.css" />
18 | 
19 |     <style type="text/css">
20 |       body {
21 |           font-family: 'Roboto', sans-serif;
22 |       }
23 | 
24 |       .container {
25 |           width: 680px;
26 |           margin: 0 auto;
27 |       }
28 | 
29 |       #range > div {
30 |         display: flex;
31 |         flex-wrap: wrap;
32 |       }
33 | 
34 |       #range h1 {
35 |         min-width: 100%;
36 |       }
37 | 
38 |       #range > div > div:last-child::before {
39 |         content: "–";
40 |         padding: 0 1em;
41 |       }
42 |     </style>
43 |   </head>
44 |   <body>
45 |     <div class="container">
46 |       <div id="range">
47 |       </div>
48 |     </div>
49 | 
50 |     <script src="range.js"></script>
51 |     <script>
52 |       Elm.Range.embed(document.getElementById("range"));
53 |     </script>
54 |   </body>
55 | </html>
56 | 


--------------------------------------------------------------------------------
/examples/simple-nightwatch/.gitignore:
--------------------------------------------------------------------------------
1 | simple-nightwatch.js
2 | 


--------------------------------------------------------------------------------
/examples/simple-nightwatch/SimpleNightwatch.elm:
--------------------------------------------------------------------------------
  1 | module SimpleNightwatch exposing (main)
  2 | 
  3 | {-| This is a simple test suitable for automated browser testing (such as with nightwatch.js)
  4 | -}
  5 | 
  6 | import Date exposing (Date, Day(..), day, dayOfWeek, month, year)
  7 | import DatePicker exposing (defaultSettings, DateEvent(..))
  8 | import Html exposing (Html, div, h1, text, button)
  9 | import Process
 10 | import Task
 11 | import Time
 12 | 
 13 | type Msg
 14 |     = ToDatePicker DatePicker.Msg
 15 |     | NoOp
 16 | 
 17 | 
 18 | type alias Model =
 19 |     { date : Maybe Date
 20 |     , datePicker : DatePicker.DatePicker
 21 |     }
 22 | 
 23 | 
 24 | settings : DatePicker.Settings
 25 | settings =
 26 |     defaultSettings
 27 | 
 28 | 
 29 | init : ( Model, Cmd Msg )
 30 | init =
 31 |     let
 32 |         moonLandingDate =
 33 |             Date.fromString "1969-07-20"
 34 |                 |> Result.toMaybe
 35 |                 |> Maybe.withDefault (Date.fromTime 0)
 36 | 
 37 |         -- the fromTime 0 is just to keep the compiler happy - it will never be called
 38 |     in
 39 |         ( { date = Nothing
 40 |           , datePicker = DatePicker.initFromDate moonLandingDate
 41 |           }
 42 |           -- trigger a NoOp command after two seconds. This is used to test
 43 |           -- that re-renders of the app do not cause things to dissapear.
 44 |         , delayedNoOpCmd { seconds = 2 }
 45 |         )
 46 | 
 47 | 
 48 | update : Msg -> Model -> ( Model, Cmd Msg )
 49 | update msg ({ date, datePicker } as model) =
 50 |     case msg of
 51 |         ToDatePicker msg ->
 52 |             let
 53 |                 ( newDatePicker, datePickerFx, dateEvent ) =
 54 |                     DatePicker.update settings msg datePicker
 55 | 
 56 |                 newDate =
 57 |                     case dateEvent of
 58 |                         Changed newDate ->
 59 |                             newDate
 60 | 
 61 |                         _ ->
 62 |                             date
 63 |             in
 64 |                 { model
 65 |                     | date = newDate
 66 |                     , datePicker = newDatePicker
 67 |                 }
 68 |                     ! [ Cmd.map ToDatePicker datePickerFx ]
 69 | 
 70 |         NoOp ->
 71 |             model ! []
 72 | 
 73 | 
 74 | view : Model -> Html Msg
 75 | view ({ date, datePicker } as model) =
 76 |     div []
 77 |         [ case date of
 78 |             Nothing ->
 79 |                 h1 [] [ text "Pick a date" ]
 80 | 
 81 |             Just date ->
 82 |                 h1 [] [ text <| formatDate date ]
 83 |         , DatePicker.view date settings datePicker
 84 |             |> Html.map ToDatePicker
 85 |         ]
 86 | 
 87 | 
 88 | formatDate : Date -> String
 89 | formatDate d =
 90 |     toString (month d) ++ " " ++ toString (day d) ++ ", " ++ toString (year d)
 91 | 
 92 | 
 93 | delayedNoOpCmd : { seconds : Float } -> Cmd Msg
 94 | delayedNoOpCmd { seconds } =
 95 |         Process.sleep (seconds * Time.second)
 96 |         |> Task.perform (\_ -> NoOp)
 97 | 
 98 | 
 99 | main : Program Never Model Msg
100 | main =
101 |     Html.program
102 |         { init = init
103 |         , update = update
104 |         , view = view
105 |         , subscriptions = always Sub.none
106 |         }
107 | 


--------------------------------------------------------------------------------
/examples/simple-nightwatch/index.html:
--------------------------------------------------------------------------------
 1 | <!doctype html>
 2 | <html lang="en-us">
 3 |   <head>
 4 |     <meta charset="utf-8">
 5 |     <title>elm-datepicker example</title>
 6 | 
 7 |     <link rel="stylesheet"
 8 |           type="text/css"
 9 |           href="https://necolas.github.io/normalize.css/4.1.1/normalize.css" />
10 | 
11 |     <link rel="stylesheet"
12 |           type="text/css"
13 |           href="https://fonts.googleapis.com/css?family=Roboto" />
14 | 
15 |     <link rel="stylesheet"
16 |           type="text/css"
17 |           href="../../css/elm-datepicker.css" />
18 | 
19 |     <style type="text/css">
20 |       body {
21 |           font-family: 'Roboto', sans-serif;
22 |       }
23 | 
24 |       .container {
25 |           width: 680px;
26 |           margin: 0 auto;
27 |       }
28 |     </style>
29 |   </head>
30 |   <body>
31 |     <div class="container">
32 |       <div id="simple-nightwatch">
33 |       </div>
34 |     </div>
35 | 
36 |     <script src="simple-nightwatch.js"></script>
37 |     <script>
38 |       Elm.SimpleNightwatch.embed(document.getElementById("simple-nightwatch"));
39 |     </script>
40 |   </body>
41 | </html>
42 | 


--------------------------------------------------------------------------------
/examples/simple/.gitignore:
--------------------------------------------------------------------------------
1 | simple.js


--------------------------------------------------------------------------------
/examples/simple/Simple.elm:
--------------------------------------------------------------------------------
 1 | module Simple exposing (main)
 2 | 
 3 | import Date exposing (Date, Day(..), day, dayOfWeek, month, year)
 4 | import DatePicker exposing (defaultSettings, DateEvent(..))
 5 | import Html exposing (Html, div, h1, text)
 6 | 
 7 | 
 8 | type Msg
 9 |     = ToDatePicker DatePicker.Msg
10 | 
11 | 
12 | type alias Model =
13 |     { date : Maybe Date
14 |     , datePicker : DatePicker.DatePicker
15 |     }
16 | 
17 | 
18 | settings : DatePicker.Settings
19 | settings =
20 |     let
21 |         isDisabled date =
22 |             dayOfWeek date
23 |                 |> flip List.member [ Sat, Sun ]
24 |     in
25 |         { defaultSettings | isDisabled = isDisabled }
26 | 
27 | 
28 | init : ( Model, Cmd Msg )
29 | init =
30 |     let
31 |         ( datePicker, datePickerFx ) =
32 |             DatePicker.init
33 |     in
34 |         { date = Nothing
35 |         , datePicker = datePicker
36 |         }
37 |             ! [ Cmd.map ToDatePicker datePickerFx ]
38 | 
39 | 
40 | update : Msg -> Model -> ( Model, Cmd Msg )
41 | update msg ({ date, datePicker } as model) =
42 |     case msg of
43 |         ToDatePicker msg ->
44 |             let
45 |                 ( newDatePicker, datePickerFx, dateEvent ) =
46 |                     DatePicker.update settings msg datePicker
47 | 
48 |                 newDate =
49 |                     case dateEvent of
50 |                         Changed newDate ->
51 |                             newDate
52 | 
53 |                         _ ->
54 |                             date
55 |             in
56 |                 { model
57 |                     | date = newDate
58 |                     , datePicker = newDatePicker
59 |                 }
60 |                     ! [ Cmd.map ToDatePicker datePickerFx ]
61 | 
62 | 
63 | view : Model -> Html Msg
64 | view ({ date, datePicker } as model) =
65 |     div []
66 |         [ case date of
67 |             Nothing ->
68 |                 h1 [] [ text "Pick a date" ]
69 | 
70 |             Just date ->
71 |                 h1 [] [ text <| formatDate date ]
72 |         , DatePicker.view date settings datePicker
73 |             |> Html.map ToDatePicker
74 |         ]
75 | 
76 | 
77 | formatDate : Date -> String
78 | formatDate d =
79 |     toString (month d) ++ " " ++ toString (day d) ++ ", " ++ toString (year d)
80 | 
81 | 
82 | main : Program Never Model Msg
83 | main =
84 |     Html.program
85 |         { init = init
86 |         , update = update
87 |         , view = view
88 |         , subscriptions = always Sub.none
89 |         }
90 | 


--------------------------------------------------------------------------------
/examples/simple/index.html:
--------------------------------------------------------------------------------
 1 | <!doctype html>
 2 | <html lang="en-us">
 3 |   <head>
 4 |     <meta charset="utf-8">
 5 |     <title>elm-datepicker example</title>
 6 | 
 7 |     <link rel="stylesheet"
 8 |           type="text/css"
 9 |           href="https://necolas.github.io/normalize.css/4.1.1/normalize.css" />
10 | 
11 |     <link rel="stylesheet"
12 |           type="text/css"
13 |           href="https://fonts.googleapis.com/css?family=Roboto" />
14 | 
15 |     <link rel="stylesheet"
16 |           type="text/css"
17 |           href="../../css/elm-datepicker.css" />
18 | 
19 |     <style type="text/css">
20 |       body {
21 |           font-family: 'Roboto', sans-serif;
22 |       }
23 | 
24 |       .container {
25 |           width: 680px;
26 |           margin: 0 auto;
27 |       }
28 |     </style>
29 |   </head>
30 |   <body>
31 |     <div class="container">
32 |       <div id="simple">
33 |       </div>
34 |     </div>
35 | 
36 |     <script src="simple.js"></script>
37 |     <script>
38 |       Elm.Simple.embed(document.getElementById("simple"));
39 |     </script>
40 |   </body>
41 | </html>
42 | 


--------------------------------------------------------------------------------
/nightwatch-tests/simple.js:
--------------------------------------------------------------------------------
 1 | const url = "http://localhost:8000/examples/simple-nightwatch/index.html";
 2 | const textInputSelector = ".elm-datepicker--input";
 3 | const topLeftDaySelector = ".elm-datepicker--row:first-child .elm-datepicker--day:first-child";
 4 | 
 5 | 
 6 | const defaultWait = 1000;
 7 | 
 8 | module.exports = {
 9 | 
10 |   'When selecting a date with the mouse, it should appear in the text input' : function (client) {
11 |     client.url(url);
12 |     client.expect.element(textInputSelector).to.be.present.before(defaultWait);
13 |     client.click(textInputSelector);
14 |     client.expect.element(topLeftDaySelector).to.be.present.before(defaultWait);
15 |     client.click(topLeftDaySelector);
16 |     client.expect.element(textInputSelector).value.to.equal("1969/06/29").before(defaultWait);
17 |     client.end();
18 |   },
19 | 
20 |   'When entering text, and then selecting a date with the mouse, the selected date should appear in the text input' : function (client) {
21 |     client.url(url);
22 |     client.expect.element(textInputSelector).to.be.present.before(defaultWait);
23 |     client.click(textInputSelector);
24 |     slowlySendKeys(client, textInputSelector, "1 Jan 1980");
25 |     client.expect.element(topLeftDaySelector).to.be.present.before(defaultWait);
26 |     client.click(topLeftDaySelector);
27 |     client.expect.element(textInputSelector).value.to.equal("1969/06/29").before(defaultWait);
28 |     client.end();
29 |   },
30 | 
31 |   'When entering the text of a valid date, then pressing the ENTER key, the entered date should appear in the date picker' : function (client) {
32 |     client.url(url);
33 |     client.expect.element(textInputSelector).to.be.present.before(defaultWait);
34 |     client.click(textInputSelector);
35 |     slowlySendKeys(client, textInputSelector, "1 Jan 1980");
36 |     client.sendKeys(textInputSelector, client.Keys.ENTER);
37 |     client.expect.element(topLeftDaySelector).to.be.present.before(defaultWait);
38 |     client.expect.element(".elm-datepicker--row:first-child .elm-datepicker--day:nth-child(3)")
39 |       .to.have.attribute('class').which.contains('elm-datepicker--picked');
40 |     client.expect.element("h1").text.to.equal("Jan 1, 1980");
41 | 
42 |     // now we click on another value, to make sure the input is updated
43 |     client.click(topLeftDaySelector);
44 |     client.expect.element(textInputSelector).value.to.equal("1979/12/30").before(defaultWait);
45 |     client.expect.element("h1").text.to.equal("Dec 30, 1979");
46 |     client.end();
47 |   },
48 | 
49 |   // This test has been commented out, we are currently unable to find a
50 |   // satisfactory solution for https://github.com/elm-community/elm-datepicker/issues/63.
51 |   //
52 |   // 'Characters should not be dropped when entering text quickly' : function (client) {
53 |   //
54 |   //   const longTextExample = "The quick brown fox jumped over the lazy dog";
55 |   //
56 |   //   client.url(url);
57 |   //   client.expect.element(textInputSelector).to.be.present.before(defaultWait);
58 |   //   client.click(textInputSelector);
59 |   //   client.sendKeys(textInputSelector, longTextExample);
60 |   //   client.expect.element(textInputSelector).value.to.equal(longTextExample).before(defaultWait);
61 |   //   client.end();
62 |   // },
63 | 
64 |   'Manually entered text should not be cleared when the view re-renders' : function (client) {
65 | 
66 |     client.url(url);
67 |     client.expect.element(textInputSelector).to.be.present.before(defaultWait);
68 |     client.click(textInputSelector);
69 |     slowlySendKeys(client, textInputSelector, "testing");
70 | 
71 |     // the SimpleNightwatch.elm app has a NoOp message that is triggered after 2
72 |     // seconds. The NoOp causes a re-render of the app. This should not
73 |     // clear the manually entered text.
74 |     client.pause(3000);
75 |     client.expect.element(textInputSelector).value.to.equal("testing").before(defaultWait);
76 |     client.end();
77 |   },
78 | 
79 | 
80 | };
81 | 
82 | 
83 | function slowlySendKeys(client, selector, text) {
84 |   for (i in text) {
85 |     client.sendKeys(selector, text[i]);
86 |     client.pause(50);
87 |   }
88 | }
89 | 


--------------------------------------------------------------------------------
/nightwatch.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "src_folders" : ["nightwatch-tests"],
 3 |   "output_folder" : "reports",
 4 |   "custom_commands_path" : "",
 5 |   "custom_assertions_path" : "",
 6 |   "page_objects_path" : "",
 7 |   "globals_path" : "",
 8 | 
 9 |   "selenium" : {
10 |     "start_process" : false,
11 |     "server_path" : "",
12 |     "log_path" : "",
13 |     "port" : 4444,
14 |     "cli_args" : {
15 |       "webdriver.chrome.driver" : "",
16 |       "webdriver.gecko.driver" : "",
17 |       "webdriver.edge.driver" : ""
18 |     }
19 |   },
20 | 
21 |   "test_settings" : {
22 |     "default" : {
23 |       "launch_url" : "http://localhost",
24 |       "selenium_port"  : 9515,
25 |       "selenium_host"  : "localhost",
26 |       "default_path_prefix" : "",
27 |       "silent": true,
28 |       "screenshots" : {
29 |         "enabled" : false,
30 |         "path" : ""
31 |       },
32 |       "desiredCapabilities": {
33 |         "browserName": "firefox",
34 |         "marionette": true
35 |       }
36 |     },
37 | 
38 |     "chrome" : {
39 |       "desiredCapabilities": {
40 |         "browserName": "chrome"
41 |       }
42 |     },
43 | 
44 |     "edge" : {
45 |       "desiredCapabilities": {
46 |         "browserName": "MicrosoftEdge"
47 |       }
48 |     }
49 |   }
50 | }
51 | 


--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
 1 | {
 2 |   "name": "elm-datepicker",
 3 |   "version": "1.0.0",
 4 |   "description": "``` shell elm package install elm-community/elm-datepicker ```",
 5 |   "main": "index.js",
 6 |   "directories": {},
 7 |   "scripts": {
 8 |     "test": "echo \"Error: no test specified\" && exit 1"
 9 |   },
10 |   "repository": {
11 |     "type": "git",
12 |     "url": "git+https://github.com/elm-community/elm-datepicker.git"
13 |   },
14 |   "author": "",
15 |   "license": "ISC",
16 |   "bugs": {
17 |     "url": "https://github.com/elm-community/elm-datepicker/issues"
18 |   },
19 |   "homepage": "https://github.com/elm-community/elm-datepicker#readme",
20 |   "devDependencies": {
21 |     "nightwatch": "^0.9.16"
22 |   }
23 | }
24 | 


--------------------------------------------------------------------------------
/run-acceptance-tests:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env bash
 2 | 
 3 | 
 4 | # make sure latest build is being run
 5 | 
 6 | cd examples && make simple-nightwatch-example && cd ..
 7 | 
 8 | 
 9 | # start some required background processes
10 | 
11 | elm-reactor &
12 | ELM_REACTOR_PID=$!
13 | 
14 | chromedriver &
15 | CHROMEDRIVER_PID=$!
16 | 
17 | 
18 | # run nightwatch in the foreground
19 | 
20 | ./node_modules/.bin/nightwatch
21 | 
22 | 
23 | # after nightwatch exits, kill background processes
24 | 
25 | echo "shutting down Elm Reactor with pkill elm-reactor"
26 | pkill elm-reactor
27 | echo "shutting down Chromedriver with PID $CHROMEDRIVER_PID"
28 | kill "$CHROMEDRIVER_PID"
29 | 


--------------------------------------------------------------------------------
/src/DatePicker.elm:
--------------------------------------------------------------------------------
  1 | module DatePicker
  2 |     exposing
  3 |         ( Msg
  4 |         , Settings
  5 |         , DateEvent(..)
  6 |         , DatePicker
  7 |         , defaultSettings
  8 |         , init
  9 |         , initFromDate
 10 |         , initFromDates
 11 |         , update
 12 |         , view
 13 |         , pick
 14 |         , isOpen
 15 |         , between
 16 |         , moreOrLess
 17 |         , off
 18 |         , from
 19 |         , to
 20 |         , focusedDate
 21 |         )
 22 | 
 23 | {-| A customizable date picker component.
 24 | 
 25 | 
 26 | # Tea ☕
 27 | 
 28 | @docs Msg, DateEvent, DatePicker
 29 | @docs init, initFromDate, initFromDates, update, view, isOpen, focusedDate
 30 | 
 31 | 
 32 | # Settings
 33 | 
 34 | @docs Settings, defaultSettings, pick, between, moreOrLess, from, to, off
 35 | 
 36 | -}
 37 | 
 38 | import Date exposing (Date, Day(..), Month, day, month, year)
 39 | import DatePicker.Date exposing (..)
 40 | import Html exposing (..)
 41 | import Html.Attributes as Attrs exposing (href, placeholder, tabindex, type_, value, selected)
 42 | import Html.Events exposing (on, onBlur, onClick, onInput, onFocus, onWithOptions, targetValue)
 43 | import Html.Keyed
 44 | import Json.Decode as Json
 45 | import Task
 46 | 
 47 | 
 48 | {-| An opaque type representing messages that are passed inside the DatePicker.
 49 | -}
 50 | type Msg
 51 |     = CurrentDate Date
 52 |     | ChangeFocus Date
 53 |     | Pick (Maybe Date)
 54 |     | Text String
 55 |     | SubmitText
 56 |     | Focus
 57 |     | Blur
 58 |     | MouseDown
 59 |     | MouseUp
 60 | 
 61 | 
 62 | {-| The type of date picker settings.
 63 | -}
 64 | type alias Settings =
 65 |     { placeholder : String
 66 |     , classNamespace : String
 67 |     , containerClassList : List ( String, Bool )
 68 |     , inputClassList : List ( String, Bool )
 69 |     , inputName : Maybe String
 70 |     , inputId : Maybe String
 71 |     , inputAttributes : List (Html.Attribute Msg)
 72 |     , isDisabled : Date -> Bool
 73 |     , parser : String -> Result String Date
 74 |     , dateFormatter : Date -> String
 75 |     , dayFormatter : Day -> String
 76 |     , monthFormatter : Month -> String
 77 |     , yearFormatter : Int -> String
 78 |     , cellFormatter : String -> Html Msg
 79 |     , firstDayOfWeek : Day
 80 |     , changeYear : YearRange
 81 |     }
 82 | 
 83 | 
 84 | type alias Model =
 85 |     { open : Bool
 86 |     , forceOpen : Bool
 87 |     , focused :
 88 |         Maybe Date
 89 |         -- date currently center-focused by picker, but not necessarily chosen
 90 |     , inputText :
 91 |         Maybe String
 92 |     , today :
 93 |         Date
 94 |         -- actual, current day as far as we know
 95 |     }
 96 | 
 97 | 
 98 | {-| The DatePicker model. Opaque, hence no field docs.
 99 | -}
100 | type DatePicker
101 |     = DatePicker Model
102 | 
103 | 
104 | {-| A record of default settings for the date picker.  Extend this if
105 | you want to customize your date picker.
106 | 
107 | 
108 |     import DatePicker exposing (defaultSettings)
109 | 
110 |     DatePicker.init { defaultSettings | placeholder = "Pick a date" }
111 | 
112 | 
113 | To disable certain dates:
114 | 
115 | 
116 |     import Date exposing (Day(..), dayOfWeek)
117 |     import DatePicker exposing (defaultSettings)
118 | 
119 |     DatePicker.init { defaultSettings | isDisabled = \d -> dayOfWeek d `List.member` [ Sat, Sun ] }
120 | 
121 | -}
122 | defaultSettings : Settings
123 | defaultSettings =
124 |     { placeholder = "Please pick a date..."
125 |     , classNamespace = "elm-datepicker--"
126 |     , containerClassList = []
127 |     , inputClassList = []
128 |     , inputName = Nothing
129 |     , inputId = Nothing
130 |     , inputAttributes =
131 |         [ Attrs.required False
132 |         ]
133 |     , isDisabled = always False
134 |     , parser = Date.fromString
135 |     , dateFormatter = formatDate
136 |     , dayFormatter = formatDay
137 |     , monthFormatter = formatMonth
138 |     , yearFormatter = toString
139 |     , cellFormatter = formatCell
140 |     , firstDayOfWeek = Sun
141 |     , changeYear = off
142 |     }
143 | 
144 | 
145 | yearRangeActive : YearRange -> Bool
146 | yearRangeActive yearRange =
147 |     yearRange /= Off
148 | 
149 | 
150 | {-| Select a range of date to display
151 | 
152 | 
153 |     DatePicker.init { defaultSettings | changeYear = between 1555 2018 }
154 | 
155 | -}
156 | between : Int -> Int -> YearRange
157 | between start end =
158 |     if start > end then
159 |         Between end start
160 |     else
161 |         Between start end
162 | 
163 | 
164 | {-| Select a symmetric range of date to display
165 | 
166 | 
167 |     DatePicker.init { defaultSettings | changeYear = moreOrLess 10 }
168 | 
169 | -}
170 | moreOrLess : Int -> YearRange
171 | moreOrLess range =
172 |     MoreOrLess range
173 | 
174 | 
175 | {-| Select a range from a given year to this year
176 | 
177 | 
178 |     DatePicker.init { defaultSettings | changeYear = from 1995 }
179 | 
180 | -}
181 | from : Int -> YearRange
182 | from year =
183 |     From year
184 | 
185 | 
186 | {-| Select a range from this year to a given year
187 | 
188 | 
189 |     DatePicker.init { defaultSettings | changeYear = to 2020 }
190 | 
191 | -}
192 | to : Int -> YearRange
193 | to year =
194 |     To year
195 | 
196 | 
197 | {-| Turn off the date range
198 | 
199 | 
200 |     DatePicker.init { defaultSettings | changeYear = off }
201 | 
202 | -}
203 | off : YearRange
204 | off =
205 |     Off
206 | 
207 | 
208 | formatCell : String -> Html Msg
209 | formatCell day =
210 |     text day
211 | 
212 | 
213 | {-| The default initial state of the Datepicker.  You must execute
214 | the returned command (which, for the curious, sets the current date)
215 | for the date picker to behave correctly.
216 | 
217 |     init =
218 |       let
219 |          (datePicker, datePickerFx) =
220 |            DatePicker.init
221 |       in
222 |          { picker = datePicker } ! [ Cmd.map ToDatePicker datePickerfx ]
223 | 
224 | -}
225 | init : ( DatePicker, Cmd Msg )
226 | init =
227 |     ( DatePicker <|
228 |         { open = False
229 |         , forceOpen = False
230 |         , focused = Just initDate
231 |         , inputText = Nothing
232 |         , today = initDate
233 |         }
234 |     , Task.perform CurrentDate Date.now
235 |     )
236 | 
237 | 
238 | {-| Initialize a DatePicker with a given Date
239 | 
240 |     init date =
241 |       { picker = DatePicker.initFromDate date } ! [ ]
242 | 
243 | -}
244 | initFromDate : Date -> DatePicker
245 | initFromDate date =
246 |     DatePicker <|
247 |         { open = False
248 |         , forceOpen = False
249 |         , focused = Just date
250 |         , inputText = Nothing
251 |         , today = date
252 |         }
253 | 
254 | 
255 | {-| Initialize a DatePicker with a date for today and Maybe a date picked
256 | 
257 |     init today date =
258 |       { picker = DatePicker.initFromDates today date } ! []
259 | 
260 | -}
261 | initFromDates : Date -> Maybe Date -> DatePicker
262 | initFromDates today date =
263 |     DatePicker <|
264 |         { open = False
265 |         , forceOpen = False
266 |         , focused = date
267 |         , inputText = Nothing
268 |         , today = today
269 |         }
270 | 
271 | 
272 | prepareDates : Date -> Day -> { currentMonth : Date, currentDates : List Date }
273 | prepareDates date firstDayOfWeek =
274 |     let
275 |         start =
276 |             firstOfMonth date |> subDays 6
277 | 
278 |         end =
279 |             nextMonth date |> addDays 6
280 |     in
281 |         { currentMonth = date
282 |         , currentDates = datesInRange firstDayOfWeek start end
283 |         }
284 | 
285 | 
286 | {-|
287 | Expose if the datepicker is open
288 | -}
289 | isOpen : DatePicker -> Bool
290 | isOpen (DatePicker model) =
291 |     model.open
292 | 
293 | 
294 | {-| Expose the currently focused date
295 | -}
296 | focusedDate : DatePicker -> Maybe Date
297 | focusedDate (DatePicker model) =
298 |     model.focused
299 | 
300 | 
301 | {-| A sugaring of `Maybe` to explicitly tell you how to interpret `Changed Nothing`, because `Just Nothing` seems somehow wrong.
302 |     Used to represent a request, by the datepicker, to change the selected date.
303 | -}
304 | type DateEvent
305 |     = NoChange
306 |     | Changed (Maybe Date)
307 | 
308 | 
309 | {-| The date picker update function. The third tuple member represents a user action to change the
310 |     date.
311 | -}
312 | update : Settings -> Msg -> DatePicker -> ( DatePicker, Cmd Msg, DateEvent )
313 | update settings msg (DatePicker ({ forceOpen, focused } as model)) =
314 |     case msg of
315 |         CurrentDate date ->
316 |             { model | focused = Just date, today = date } ! []
317 | 
318 |         ChangeFocus date ->
319 |             { model | focused = Just date } ! []
320 | 
321 |         Pick date ->
322 |             ( DatePicker <|
323 |                 { model
324 |                     | open = False
325 |                     , inputText = Nothing
326 |                     , focused = Nothing
327 |                 }
328 |             , Cmd.none
329 |             , Changed date
330 |             )
331 | 
332 |         Text text ->
333 |             { model | inputText = Just text } ! []
334 | 
335 |         SubmitText ->
336 |             let
337 |                 isWhitespace =
338 |                     String.trim >> String.isEmpty
339 | 
340 |                 dateEvent =
341 |                     let
342 |                         text =
343 |                             model.inputText ?> ""
344 |                     in
345 |                         if isWhitespace text then
346 |                             Changed Nothing
347 |                         else
348 |                             text
349 |                                 |> settings.parser
350 |                                 |> Result.map
351 |                                     (Changed
352 |                                         << (\date ->
353 |                                                 if settings.isDisabled date then
354 |                                                     Nothing
355 |                                                 else
356 |                                                     Just date
357 |                                            )
358 |                                     )
359 |                                 |> Result.withDefault NoChange
360 |             in
361 |                 ( DatePicker <|
362 |                     { model
363 |                         | inputText =
364 |                             case dateEvent of
365 |                                 Changed change ->
366 |                                     Nothing
367 | 
368 |                                 NoChange ->
369 |                                     model.inputText
370 |                         , focused =
371 |                             case dateEvent of
372 |                                 Changed change ->
373 |                                     case change of
374 |                                         Just date ->
375 |                                             Just date
376 | 
377 |                                         Nothing ->
378 |                                             Nothing
379 | 
380 |                                 NoChange ->
381 |                                     model.focused
382 |                     }
383 |                 , Cmd.none
384 |                 , dateEvent
385 |                 )
386 | 
387 |         Focus ->
388 |             { model | open = True, forceOpen = False } ! []
389 | 
390 |         Blur ->
391 |             { model | open = forceOpen } ! []
392 | 
393 |         MouseDown ->
394 |             { model | forceOpen = True } ! []
395 | 
396 |         MouseUp ->
397 |             { model | forceOpen = False } ! []
398 | 
399 | 
400 | {-| Generate a message that will act as if the user has chosen a certain date,
401 |     so you can call `update` on the model yourself.
402 |     Note that this is different from just changing the "current chosen" date,
403 |     since the picker doesn't actually have internal state for that.
404 |     Rather, it will:
405 |         * change the calendar focus
406 |         * replace the input text with the new value
407 |         * close the picker
408 | 
409 |     update datepickerSettings (pick (Just someDate)) datepicker
410 | -}
411 | pick : Maybe Date -> Msg
412 | pick =
413 |     Pick
414 | 
415 | 
416 | {-| The date picker view. The Date passed is whatever date it should treat as selected.
417 | -}
418 | view : Maybe Date -> Settings -> DatePicker -> Html Msg
419 | view pickedDate settings (DatePicker ({ open } as model)) =
420 |     let
421 |         class =
422 |             mkClass settings
423 | 
424 |         potentialInputId =
425 |             settings.inputId
426 |                 |> Maybe.map Attrs.id
427 |                 |> (List.singleton >> List.filterMap identity)
428 | 
429 |         inputClasses =
430 |             [ ( settings.classNamespace ++ "input", True ) ]
431 |                 ++ settings.inputClassList
432 | 
433 |         inputCommon xs =
434 |             input
435 |                 ([ Attrs.classList inputClasses
436 |                  , Attrs.name (settings.inputName ?> "")
437 |                  , type_ "text"
438 |                  , on "change" (Json.succeed SubmitText)
439 |                  , onInput Text
440 |                  , onBlur Blur
441 |                  , onClick Focus
442 |                  , onFocus Focus
443 |                  ]
444 |                     ++ settings.inputAttributes
445 |                     ++ potentialInputId
446 |                     ++ xs
447 |                 )
448 |                 []
449 | 
450 |         dateInput =
451 |             inputCommon
452 |                 [ placeholder settings.placeholder
453 |                 , model.inputText
454 |                     |> Maybe.withDefault
455 |                         (Maybe.map settings.dateFormatter pickedDate
456 |                             |> Maybe.withDefault ""
457 |                         )
458 |                     |> value
459 |                 ]
460 | 
461 |         containerClassList =
462 |             ( "container", True ) :: settings.containerClassList
463 |     in
464 |         div
465 |             [ Attrs.classList containerClassList ]
466 |             [ dateInput
467 |             , if open then
468 |                 datePicker pickedDate settings model
469 |               else
470 |                 text ""
471 |             ]
472 | 
473 | 
474 | datePicker : Maybe Date -> Settings -> Model -> Html Msg
475 | datePicker pickedDate settings ({ focused, today } as model) =
476 |     let
477 |         currentDate =
478 |             focused ??> pickedDate ?> today
479 | 
480 |         { currentMonth, currentDates } =
481 |             prepareDates currentDate settings.firstDayOfWeek
482 | 
483 |         class =
484 |             mkClass settings
485 | 
486 |         classList =
487 |             mkClassList settings
488 | 
489 |         firstDay =
490 |             settings.firstDayOfWeek
491 | 
492 |         arrow className message =
493 |             a
494 |                 [ class className
495 |                 , href "javascript:;"
496 |                 , onClick message
497 |                 , tabindex -1
498 |                 ]
499 |                 []
500 | 
501 |         dow d =
502 |             td [ class "dow" ] [ text <| settings.dayFormatter d ]
503 | 
504 |         picked d =
505 |             pickedDate
506 |                 |> Maybe.map
507 |                     (dateTuple >> (==) (dateTuple d))
508 |                 |> Maybe.withDefault False
509 | 
510 |         day d =
511 |             let
512 |                 disabled =
513 |                     settings.isDisabled d
514 | 
515 |                 props =
516 |                     if not disabled then
517 |                         [ onClick (Pick (Just d)) ]
518 |                     else
519 |                         []
520 |             in
521 |                 td
522 |                     ([ classList
523 |                         [ ( "day", True )
524 |                         , ( "disabled", disabled )
525 |                         , ( "picked", picked d )
526 |                         , ( "today", dateTuple d == dateTuple currentDate )
527 |                         , ( "other-month", month currentMonth /= month d )
528 |                         ]
529 |                      ]
530 |                         ++ props
531 |                     )
532 |                     [ settings.cellFormatter <| toString <| Date.day d ]
533 | 
534 |         row days =
535 |             tr [ class "row" ] (List.map day days)
536 | 
537 |         days =
538 |             List.map row (groupDates currentDates)
539 | 
540 |         onPicker ev =
541 |             Json.succeed
542 |                 >> onWithOptions ev
543 |                     { preventDefault = False
544 |                     , stopPropagation = True
545 |                     }
546 | 
547 |         onChange handler =
548 |             on "change" <| Json.map handler targetValue
549 | 
550 |         isCurrentYear selectedYear =
551 |             year currentMonth == selectedYear
552 | 
553 |         yearOption index selectedYear =
554 |             ( toString index
555 |             , option [ value (toString selectedYear), selected (isCurrentYear selectedYear) ]
556 |                 [ text <| toString selectedYear ]
557 |             )
558 | 
559 |         dropdownYear =
560 |             Html.Keyed.node "select"
561 |                 [ onChange (newYear currentDate >> ChangeFocus), class "year-menu" ]
562 |                 (List.indexedMap yearOption
563 |                     (yearRange { currentMonth = currentMonth, today = today } settings.changeYear)
564 |                 )
565 |     in
566 |         div
567 |             [ class "picker"
568 |             , onPicker "mousedown" MouseDown
569 |             , onPicker "mouseup" MouseUp
570 |             ]
571 |             [ div [ class "picker-header" ]
572 |                 [ div [ class "prev-container" ]
573 |                     [ arrow "prev" (ChangeFocus (prevMonth currentDate)) ]
574 |                 , div [ class "month-container" ]
575 |                     [ span [ class "month" ]
576 |                         [ text <| settings.monthFormatter <| month currentMonth ]
577 |                     , span [ class "year" ]
578 |                         [ if not (yearRangeActive settings.changeYear) then
579 |                             text <| settings.yearFormatter <| year currentMonth
580 |                           else
581 |                             Html.Keyed.node "span" [] [ ( toString (year currentMonth), dropdownYear ) ]
582 |                         ]
583 |                     ]
584 |                 , div [ class "next-container" ]
585 |                     [ arrow "next" (ChangeFocus (nextMonth currentDate)) ]
586 |                 ]
587 |             , table [ class "table" ]
588 |                 [ thead [ class "weekdays" ]
589 |                     [ tr []
590 |                         [ dow <| firstDay
591 |                         , dow <| addDows 1 firstDay
592 |                         , dow <| addDows 2 firstDay
593 |                         , dow <| addDows 3 firstDay
594 |                         , dow <| addDows 4 firstDay
595 |                         , dow <| addDows 5 firstDay
596 |                         , dow <| addDows 6 firstDay
597 |                         ]
598 |                     ]
599 |                 , tbody [ class "days" ] days
600 |                 ]
601 |             ]
602 | 
603 | 
604 | {-| Turn a list of dates into a list of date rows with 7 columns per
605 | row representing each day of the week.
606 | -}
607 | groupDates : List Date -> List (List Date)
608 | groupDates dates =
609 |     let
610 |         go i xs racc acc =
611 |             case xs of
612 |                 [] ->
613 |                     List.reverse acc
614 | 
615 |                 x :: xs ->
616 |                     if i == 6 then
617 |                         go 0 xs [] (List.reverse (x :: racc) :: acc)
618 |                     else
619 |                         go (i + 1) xs (x :: racc) acc
620 |     in
621 |         go 0 dates [] []
622 | 
623 | 
624 | mkClass : Settings -> String -> Html.Attribute msg
625 | mkClass { classNamespace } c =
626 |     Attrs.class (classNamespace ++ c)
627 | 
628 | 
629 | mkClassList : Settings -> List ( String, Bool ) -> Html.Attribute msg
630 | mkClassList { classNamespace } cs =
631 |     List.map (\( c, b ) -> ( classNamespace ++ c, b )) cs
632 |         |> Attrs.classList
633 | 
634 | 
635 | (!) : Model -> List (Cmd Msg) -> ( DatePicker, Cmd Msg, DateEvent )
636 | (!) m cs =
637 |     ( DatePicker m, Cmd.batch cs, NoChange )
638 | 
639 | 
640 | (?>) : Maybe a -> a -> a
641 | (?>) =
642 |     flip Maybe.withDefault
643 | 
644 | 
645 | (??>) : Maybe a -> Maybe a -> Maybe a
646 | (??>) first default =
647 |     case first of
648 |         Just val ->
649 |             Just val
650 | 
651 |         Nothing ->
652 |             default
653 | 


--------------------------------------------------------------------------------
/src/DatePicker/Date.elm:
--------------------------------------------------------------------------------
  1 | module DatePicker.Date
  2 |     exposing
  3 |         ( YearRange(..)
  4 |         , initDate
  5 |         , formatDate
  6 |         , formatDay
  7 |         , formatMonth
  8 |         , addDays
  9 |         , addDows
 10 |         , subDays
 11 |         , dateTuple
 12 |         , datesInRange
 13 |         , firstOfMonth
 14 |         , prevMonth
 15 |         , nextMonth
 16 |         , newYear
 17 |         , yearRange
 18 |         )
 19 | 
 20 | import Date exposing (Date, Day(..), Month(..), year, month, day)
 21 | 
 22 | 
 23 | type alias Year =
 24 |     Int
 25 | 
 26 | 
 27 | type alias Day =
 28 |     Int
 29 | 
 30 | 
 31 | type YearRange
 32 |     = Off
 33 |     | MoreOrLess Int
 34 |     | Between Year Year
 35 |     | From Year
 36 |     | To Year
 37 | 
 38 | 
 39 | initDate : Date
 40 | initDate =
 41 |     mkDate 1992 May 29
 42 | 
 43 | 
 44 | formatDate : Date -> String
 45 | formatDate date =
 46 |     toString (year date) ++ "/" ++ monthToString (month date) ++ "/" ++ dayToString (day date)
 47 | 
 48 | 
 49 | formatDay : Date.Day -> String
 50 | formatDay day =
 51 |     case day of
 52 |         Mon ->
 53 |             "Mo"
 54 | 
 55 |         Tue ->
 56 |             "Tu"
 57 | 
 58 |         Wed ->
 59 |             "We"
 60 | 
 61 |         Thu ->
 62 |             "Th"
 63 | 
 64 |         Fri ->
 65 |             "Fr"
 66 | 
 67 |         Sat ->
 68 |             "Sa"
 69 | 
 70 |         Sun ->
 71 |             "Su"
 72 | 
 73 | 
 74 | formatMonth : Month -> String
 75 | formatMonth month =
 76 |     case month of
 77 |         Jan ->
 78 |             "January"
 79 | 
 80 |         Feb ->
 81 |             "February"
 82 | 
 83 |         Mar ->
 84 |             "March"
 85 | 
 86 |         Apr ->
 87 |             "April"
 88 | 
 89 |         May ->
 90 |             "May"
 91 | 
 92 |         Jun ->
 93 |             "June"
 94 | 
 95 |         Jul ->
 96 |             "July"
 97 | 
 98 |         Aug ->
 99 |             "August"
100 | 
101 |         Sep ->
102 |             "September"
103 | 
104 |         Oct ->
105 |             "October"
106 | 
107 |         Nov ->
108 |             "November"
109 | 
110 |         Dec ->
111 |             "December"
112 | 
113 | 
114 | trimDates : Date.Day -> List Date -> List Date
115 | trimDates firstDay dates =
116 |     let
117 |         lastDay =
118 |             predDow firstDay
119 | 
120 |         dl dates =
121 |             case dates of
122 |                 [] ->
123 |                     []
124 | 
125 |                 x :: xs ->
126 |                     if Date.dayOfWeek x == firstDay then
127 |                         dates
128 |                     else
129 |                         dl xs
130 | 
131 |         dr dates =
132 |             case dates of
133 |                 [] ->
134 |                     []
135 | 
136 |                 x :: xs ->
137 |                     if Date.dayOfWeek x == lastDay then
138 |                         dates
139 |                     else
140 |                         dr xs
141 |     in
142 |         dl dates
143 |             |> List.reverse
144 |             |> dr
145 |             |> List.reverse
146 | 
147 | 
148 | datesInRange : Date.Day -> Date -> Date -> List Date
149 | datesInRange firstDay min max =
150 |     let
151 |         go x acc =
152 |             let
153 |                 y =
154 |                     subDay x
155 |             in
156 |                 if dateTuple y == dateTuple min then
157 |                     y :: acc
158 |                 else
159 |                     go y (y :: acc)
160 |     in
161 |         go max []
162 |             |> trimDates firstDay
163 | 
164 | 
165 | dateTuple : Date -> ( Int, Int, Int )
166 | dateTuple date =
167 |     ( year date, monthToInt <| month date, day date )
168 | 
169 | 
170 | repeat : (a -> a) -> Int -> a -> a
171 | repeat f =
172 |     let
173 |         go n x =
174 |             if n == 0 then
175 |                 x
176 |             else
177 |                 go (n - 1) (f x)
178 |     in
179 |         go
180 | 
181 | 
182 | firstOfMonth : Date -> Date
183 | firstOfMonth date =
184 |     mkDate (year date) (month date) 1
185 | 
186 | 
187 | nextMonth : Date -> Date
188 | nextMonth date =
189 |     let
190 |         nextMonth =
191 |             succMonth (month date)
192 | 
193 |         nextYear =
194 |             if nextMonth == Jan then
195 |                 year date + 1
196 |             else
197 |                 year date
198 |     in
199 |         mkDate nextYear nextMonth 1
200 | 
201 | 
202 | prevMonth : Date -> Date
203 | prevMonth date =
204 |     let
205 |         prevMonth =
206 |             predMonth (month date)
207 | 
208 |         prevYear =
209 |             if prevMonth == Dec then
210 |                 year date - 1
211 |             else
212 |                 year date
213 |     in
214 |         mkDate prevYear prevMonth 1
215 | 
216 | 
217 | addDays : Int -> Date -> Date
218 | addDays =
219 |     repeat addDay
220 | 
221 | 
222 | addDay : Date -> Date
223 | addDay date =
224 |     let
225 |         month =
226 |             Date.month date
227 | 
228 |         year =
229 |             Date.year date
230 | 
231 |         dim =
232 |             daysInMonth year month
233 | 
234 |         day =
235 |             Date.day date + 1
236 | 
237 |         succ =
238 |             succMonth month
239 | 
240 |         succYear =
241 |             if succ == Jan then
242 |                 year + 1
243 |             else
244 |                 year
245 |     in
246 |         if day > dim then
247 |             mkDate succYear succ 1
248 |         else
249 |             mkDate year month day
250 | 
251 | 
252 | subDays : Int -> Date -> Date
253 | subDays =
254 |     repeat subDay
255 | 
256 | 
257 | subDay : Date -> Date
258 | subDay date =
259 |     let
260 |         month =
261 |             Date.month date
262 | 
263 |         year =
264 |             Date.year date
265 | 
266 |         day =
267 |             Date.day date - 1
268 | 
269 |         pred =
270 |             predMonth month
271 | 
272 |         predYear =
273 |             if pred == Dec then
274 |                 year - 1
275 |             else
276 |                 year
277 |     in
278 |         if day < 1 then
279 |             mkDate predYear pred (daysInMonth predYear pred)
280 |         else
281 |             mkDate year month day
282 | 
283 | 
284 | addDows : Int -> Date.Day -> Date.Day
285 | addDows =
286 |     repeat succDow
287 | 
288 | 
289 | succDow : Date.Day -> Date.Day
290 | succDow day =
291 |     dayToInt day
292 |         |> flip rem 7
293 |         |> (+) 1
294 |         |> dayFromInt
295 | 
296 | 
297 | subDows : Int -> Date.Day -> Date.Day
298 | subDows =
299 |     repeat succDow
300 | 
301 | 
302 | predDow : Date.Day -> Date.Day
303 | predDow day =
304 |     let
305 |         prev =
306 |             (dayToInt day - 1)
307 |                 |> flip rem 7
308 |     in
309 |         if prev == 0 then
310 |             Sun
311 |         else
312 |             dayFromInt prev
313 | 
314 | 
315 | dayToString : Int -> String
316 | dayToString day =
317 |     if day < 10 then
318 |         "0" ++ toString day
319 |     else
320 |         toString day
321 | 
322 | 
323 | dayToInt : Date.Day -> Int
324 | dayToInt day =
325 |     case day of
326 |         Mon ->
327 |             1
328 | 
329 |         Tue ->
330 |             2
331 | 
332 |         Wed ->
333 |             3
334 | 
335 |         Thu ->
336 |             4
337 | 
338 |         Fri ->
339 |             5
340 | 
341 |         Sat ->
342 |             6
343 | 
344 |         Sun ->
345 |             7
346 | 
347 | 
348 | dayFromInt : Int -> Date.Day
349 | dayFromInt day =
350 |     case day of
351 |         1 ->
352 |             Mon
353 | 
354 |         2 ->
355 |             Tue
356 | 
357 |         3 ->
358 |             Wed
359 | 
360 |         4 ->
361 |             Thu
362 | 
363 |         5 ->
364 |             Fri
365 | 
366 |         6 ->
367 |             Sat
368 | 
369 |         7 ->
370 |             Sun
371 | 
372 |         _ ->
373 |             Debug.crash ("dayFromInt: invalid day: " ++ toString day)
374 | 
375 | 
376 | monthToString : Month -> String
377 | monthToString month =
378 |     let
379 |         int =
380 |             monthToInt month
381 |     in
382 |         if int < 10 then
383 |             "0" ++ toString int
384 |         else
385 |             toString int
386 | 
387 | 
388 | predMonth : Month -> Month
389 | predMonth month =
390 |     let
391 |         prev =
392 |             (monthToInt month - 1)
393 |                 |> flip rem 12
394 |     in
395 |         if prev == 0 then
396 |             Dec
397 |         else
398 |             monthFromInt prev
399 | 
400 | 
401 | succMonth : Month -> Month
402 | succMonth month =
403 |     monthToInt month
404 |         |> flip rem 12
405 |         |> (+) 1
406 |         |> monthFromInt
407 | 
408 | 
409 | monthToInt : Month -> Int
410 | monthToInt month =
411 |     case month of
412 |         Jan ->
413 |             1
414 | 
415 |         Feb ->
416 |             2
417 | 
418 |         Mar ->
419 |             3
420 | 
421 |         Apr ->
422 |             4
423 | 
424 |         May ->
425 |             5
426 | 
427 |         Jun ->
428 |             6
429 | 
430 |         Jul ->
431 |             7
432 | 
433 |         Aug ->
434 |             8
435 | 
436 |         Sep ->
437 |             9
438 | 
439 |         Oct ->
440 |             10
441 | 
442 |         Nov ->
443 |             11
444 | 
445 |         Dec ->
446 |             12
447 | 
448 | 
449 | monthFromInt : Int -> Month
450 | monthFromInt month =
451 |     case month of
452 |         1 ->
453 |             Jan
454 | 
455 |         2 ->
456 |             Feb
457 | 
458 |         3 ->
459 |             Mar
460 | 
461 |         4 ->
462 |             Apr
463 | 
464 |         5 ->
465 |             May
466 | 
467 |         6 ->
468 |             Jun
469 | 
470 |         7 ->
471 |             Jul
472 | 
473 |         8 ->
474 |             Aug
475 | 
476 |         9 ->
477 |             Sep
478 | 
479 |         10 ->
480 |             Oct
481 | 
482 |         11 ->
483 |             Nov
484 | 
485 |         12 ->
486 |             Dec
487 | 
488 |         x ->
489 |             Debug.crash ("monthFromInt: invalid month: " ++ toString x)
490 | 
491 | 
492 | daysInMonth : Year -> Month -> Int
493 | daysInMonth year month =
494 |     case month of
495 |         Jan ->
496 |             31
497 | 
498 |         Feb ->
499 |             if isLeapYear year then
500 |                 29
501 |             else
502 |                 28
503 | 
504 |         Mar ->
505 |             31
506 | 
507 |         Apr ->
508 |             30
509 | 
510 |         May ->
511 |             31
512 | 
513 |         Jun ->
514 |             30
515 | 
516 |         Jul ->
517 |             31
518 | 
519 |         Aug ->
520 |             31
521 | 
522 |         Sep ->
523 |             30
524 | 
525 |         Oct ->
526 |             31
527 | 
528 |         Nov ->
529 |             30
530 | 
531 |         Dec ->
532 |             31
533 | 
534 | 
535 | isLeapYear : Year -> Bool
536 | isLeapYear y =
537 |     y % 400 == 0 || y % 100 /= 0 && y % 4 == 0
538 | 
539 | 
540 | mkDate : Year -> Month -> Day -> Date
541 | mkDate year month day =
542 |     toString year
543 |         ++ "/"
544 |         ++ monthToString month
545 |         ++ "/"
546 |         ++ dayToString day
547 |         |> unsafeDate
548 | 
549 | 
550 | unsafeDate : String -> Date
551 | unsafeDate date =
552 |     case Date.fromString date of
553 |         Err e ->
554 |             Debug.crash ("unsafeDate: failed to parse date:" ++ e)
555 | 
556 |         Ok date ->
557 |             date
558 | 
559 | 
560 | newYear : Date -> String -> Date
561 | newYear currentMonth newYear =
562 |     case String.toInt newYear of
563 |         Ok year ->
564 |             mkDate year (month currentMonth) (day currentMonth)
565 | 
566 |         Err _ ->
567 |             Debug.crash ("Unknown Month " ++ (toString currentMonth))
568 | 
569 | 
570 | yearRange : { currentMonth : Date, today : Date } -> YearRange -> List Int
571 | yearRange { currentMonth, today } range =
572 |     case range of
573 |         MoreOrLess num ->
574 |             List.range ((year currentMonth) - num) ((year currentMonth) + num)
575 | 
576 |         Between start end ->
577 |             List.range start end
578 | 
579 |         From year_ ->
580 |             List.range year_ (year today)
581 | 
582 |         To year_ ->
583 |             List.range (year today) year_
584 | 
585 |         Off ->
586 |             []
587 | 


--------------------------------------------------------------------------------