├── .gitignore ├── package.json ├── src ├── Internal │ ├── Date.elm │ ├── TestHelper.elm │ └── Week.elm └── DatePicker.elm ├── examples ├── elm.json ├── Simple.elm ├── CloseOnEnter.elm ├── CustomDesign.elm └── Settings.elm ├── .github └── workflows │ ├── docs.yml │ └── ci.yml ├── elm.json ├── review ├── elm.json └── src │ └── ReviewConfig.elm ├── LICENSE ├── README.md ├── tests ├── WeekTests.elm └── DatePickerTests.elm └── docs.json /.gitignore: -------------------------------------------------------------------------------- 1 | #elm 2 | elm-stuff 3 | repl-temp-* 4 | .coverage 5 | .vscode 6 | examples/*.html 7 | examples/*.js 8 | 9 | #js 10 | node_modules -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "elm-ui-datepicker", 3 | "version": "5.0.0", 4 | "description": "see elm.json", 5 | "repository": "https://github.com/FabHof/elm-ui-datepicker.git", 6 | "author": "FabHof <35104465+FabHof@users.noreply.github.com>", 7 | "license": "BSD 3-Clause License" 8 | } 9 | -------------------------------------------------------------------------------- /src/Internal/Date.elm: -------------------------------------------------------------------------------- 1 | module Internal.Date exposing (formatMaybeLanguage) 2 | 3 | import Date exposing (Date, Language) 4 | 5 | 6 | formatMaybeLanguage : Maybe Language -> String -> Date -> String 7 | formatMaybeLanguage maybeLanguage string = 8 | case maybeLanguage of 9 | Just language -> 10 | Date.formatWithLanguage language string 11 | 12 | Nothing -> 13 | Date.format string -------------------------------------------------------------------------------- /examples/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": ["../src", "."], 4 | "elm-version": "0.19.1", 5 | "dependencies": { 6 | "direct": { 7 | "elm/browser": "1.0.2", 8 | "elm/core": "1.0.4", 9 | "elm/html": "1.0.0", 10 | "elm/json": "1.1.3", 11 | "elm/parser": "1.1.0", 12 | "elm/time": "1.0.0", 13 | "elm-community/maybe-extra": "5.1.0", 14 | "justinmimbs/date": "3.2.0", 15 | "mdgriffith/elm-ui": "1.1.5" 16 | }, 17 | "indirect": { 18 | "elm/url": "1.0.0", 19 | "elm/virtual-dom": "1.0.2" 20 | } 21 | }, 22 | "test-dependencies": { 23 | "direct": {}, 24 | "indirect": {} 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /.github/workflows/docs.yml: -------------------------------------------------------------------------------- 1 | name: Docs 2 | 3 | on: 4 | push: 5 | branches: 6 | - main 7 | 8 | jobs: 9 | build-docs: 10 | runs-on: ubuntu-latest 11 | steps: 12 | - uses: actions/checkout@v2.4.0 13 | 14 | - name: Setup Elm 15 | uses: JorelAli/setup-elm@v3 16 | 17 | - name: Build example 18 | run: elm make CloseOnEnter.elm --output=../docs/index.html 19 | working-directory: ./examples 20 | 21 | - name: GitHub Pages 22 | uses: crazy-max/ghaction-github-pages@v2.6.0 23 | with: 24 | target_branch: gh-pages 25 | allow_empty_commit: false 26 | build_dir: ./docs 27 | env: 28 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 29 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "fabhof/elm-ui-datepicker", 4 | "summary": "A reasonable date picker for the awesome elm-ui.", 5 | "license": "BSD-3-Clause", 6 | "version": "5.0.0", 7 | "exposed-modules": [ 8 | "DatePicker" 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/html": "1.0.0 <= v < 2.0.0", 14 | "elm/json": "1.0.0 <= v < 2.0.0", 15 | "elm/time": "1.0.0 <= v < 2.0.0", 16 | "justinmimbs/date": "3.2.0 <= v < 4.0.0", 17 | "mdgriffith/elm-ui": "1.0.0 <= v < 2.0.0" 18 | }, 19 | "test-dependencies": { 20 | "elm-explorations/test": "1.2.2 <= v < 2.0.0" 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build: 7 | runs-on: ubuntu-latest 8 | steps: 9 | - uses: actions/checkout@v2 10 | 11 | - name: Setup Elm 12 | uses: JorelAli/setup-elm@v3 13 | 14 | - name: Setup Node 15 | uses: actions/setup-node@v2.5.1 16 | 17 | - name: npm install 18 | run: npm install 19 | 20 | - name: Install elm-test 21 | run: npm install -g elm-test@0.19.1-revision7 22 | 23 | - name: Run elm-review 24 | run: npx elm-review 25 | 26 | - name: Run elm-coverage 27 | run: npx elm-coverage -r codecov 28 | 29 | - name: Upload to codecov 30 | uses: codecov/codecov-action@v2.1.0 31 | with: 32 | file: .coverage/codecov.json 33 | 34 | - name: Compile examples 35 | run: elm make *.elm 36 | working-directory: ./examples 37 | -------------------------------------------------------------------------------- /review/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/core": "1.0.5", 10 | "jfmengels/elm-review": "2.6.2", 11 | "jfmengels/elm-review-common": "1.2.0", 12 | "jfmengels/elm-review-simplify": "2.0.8", 13 | "jfmengels/elm-review-the-elm-architecture": "1.0.3", 14 | "jfmengels/elm-review-unused": "1.1.20", 15 | "sparksp/elm-review-camelcase": "1.1.0", 16 | "sparksp/elm-review-imports": "1.0.1", 17 | "stil4m/elm-syntax": "7.2.8" 18 | }, 19 | "indirect": { 20 | "elm/html": "1.0.0", 21 | "elm/json": "1.1.3", 22 | "elm/parser": "1.1.0", 23 | "elm/project-metadata-utils": "1.0.2", 24 | "elm/random": "1.0.0", 25 | "elm/time": "1.0.0", 26 | "elm/virtual-dom": "1.0.2", 27 | "elm-community/list-extra": "8.5.2", 28 | "elm-explorations/test": "1.2.2", 29 | "miniBill/elm-unicode": "1.0.2", 30 | "rtfeldman/elm-hex": "1.0.0", 31 | "stil4m/structured-writer": "1.0.3" 32 | } 33 | }, 34 | "test-dependencies": { 35 | "direct": { 36 | "elm-explorations/test": "1.2.2" 37 | }, 38 | "indirect": {} 39 | } 40 | } 41 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2020, Fabian Hoffmann 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /review/src/ReviewConfig.elm: -------------------------------------------------------------------------------- 1 | module ReviewConfig exposing (config) 2 | 3 | {-| Do not rename the ReviewConfig module or the config function, because 4 | `elm-review` will look for these. 5 | 6 | To add packages that contain rules, add them to this review project using 7 | 8 | `elm install author/packagename` 9 | 10 | when inside the directory containing this file. 11 | 12 | -} 13 | import NoDeprecated 14 | import NoMissingSubscriptionsCall 15 | import NoMissingTypeAnnotation 16 | import NoPrematureLetComputation 17 | import NoRecursiveUpdate 18 | import NoUnused.CustomTypeConstructorArgs 19 | import NoUnused.CustomTypeConstructors 20 | import NoUnused.Dependencies 21 | import NoUnused.Exports 22 | import NoUnused.Modules 23 | import NoUnused.Parameters 24 | import NoUnused.Patterns 25 | import NoUnused.Variables 26 | import NoUselessSubscriptions 27 | import Review.Rule exposing (Rule) 28 | import Simplify 29 | import UseCamelCase 30 | 31 | 32 | 33 | config : List Rule 34 | config = 35 | [ NoUnused.CustomTypeConstructorArgs.rule 36 | , NoUnused.CustomTypeConstructors.rule [] 37 | , NoUnused.Dependencies.rule 38 | , NoUnused.Exports.rule 39 | , NoUnused.Modules.rule 40 | , NoUnused.Parameters.rule 41 | , NoUnused.Patterns.rule 42 | , NoUnused.Variables.rule 43 | , Simplify.rule Simplify.defaults 44 | , NoDeprecated.rule NoDeprecated.defaults 45 | , NoMissingTypeAnnotation.rule 46 | , NoPrematureLetComputation.rule 47 | , UseCamelCase.rule UseCamelCase.default 48 | , NoMissingSubscriptionsCall.rule 49 | , NoRecursiveUpdate.rule 50 | , NoUselessSubscriptions.rule 51 | ] -------------------------------------------------------------------------------- /src/Internal/TestHelper.elm: -------------------------------------------------------------------------------- 1 | module Internal.TestHelper exposing 2 | ( calendarAttr 3 | , calendarAttrHtml 4 | , dayInMonthAttr 5 | , dayInMonthAttrHtml 6 | , inputAttr 7 | , inputAttrHtml 8 | , monthAttr 9 | , monthAttrHtml 10 | , nextMonthAttr 11 | , nextMonthAttrHtml 12 | , previousMonthAttr 13 | , previousMonthAttrHtml 14 | , selectedAttr 15 | , selectedAttrHtml 16 | , tableAttr 17 | , tableAttrHtml 18 | , todayAttr 19 | , todayAttrHtml 20 | , yearAttr 21 | , yearAttrHtml 22 | ) 23 | 24 | import Element exposing (Attribute) 25 | import Html 26 | import Html.Attributes 27 | 28 | 29 | inputAttr : Attribute msg 30 | inputAttr = 31 | inputAttrHtml 32 | |> Element.htmlAttribute 33 | 34 | 35 | inputAttrHtml : Html.Attribute msg 36 | inputAttrHtml = 37 | testAttribute "input" 38 | 39 | 40 | calendarAttr : Attribute msg 41 | calendarAttr = 42 | calendarAttrHtml 43 | |> Element.htmlAttribute 44 | 45 | 46 | calendarAttrHtml : Html.Attribute msg 47 | calendarAttrHtml = 48 | testAttribute "calendar" 49 | 50 | 51 | tableAttr : Attribute msg 52 | tableAttr = 53 | tableAttrHtml 54 | |> Element.htmlAttribute 55 | 56 | 57 | tableAttrHtml : Html.Attribute msg 58 | tableAttrHtml = 59 | testAttribute "table" 60 | 61 | 62 | nextMonthAttr : Attribute msg 63 | nextMonthAttr = 64 | nextMonthAttrHtml 65 | |> Element.htmlAttribute 66 | 67 | 68 | nextMonthAttrHtml : Html.Attribute msg 69 | nextMonthAttrHtml = 70 | testAttribute "nextMonth" 71 | 72 | 73 | previousMonthAttr : Attribute msg 74 | previousMonthAttr = 75 | previousMonthAttrHtml 76 | |> Element.htmlAttribute 77 | 78 | 79 | previousMonthAttrHtml : Html.Attribute msg 80 | previousMonthAttrHtml = 81 | testAttribute "previousMonth" 82 | 83 | 84 | dayInMonthAttr : Attribute msg 85 | dayInMonthAttr = 86 | dayInMonthAttrHtml 87 | |> Element.htmlAttribute 88 | 89 | 90 | dayInMonthAttrHtml : Html.Attribute msg 91 | dayInMonthAttrHtml = 92 | testAttribute "dayInMonth" 93 | 94 | 95 | todayAttr : Attribute msg 96 | todayAttr = 97 | todayAttrHtml 98 | |> Element.htmlAttribute 99 | 100 | 101 | todayAttrHtml : Html.Attribute msg 102 | todayAttrHtml = 103 | Html.Attributes.attribute "elm-test-alt" "today" 104 | 105 | 106 | selectedAttr : Attribute msg 107 | selectedAttr = 108 | selectedAttrHtml 109 | |> Element.htmlAttribute 110 | 111 | 112 | selectedAttrHtml : Html.Attribute msg 113 | selectedAttrHtml = 114 | testAttribute "selected" 115 | 116 | 117 | monthAttr : Attribute msg 118 | monthAttr = 119 | monthAttrHtml 120 | |> Element.htmlAttribute 121 | 122 | 123 | monthAttrHtml : Html.Attribute msg 124 | monthAttrHtml = 125 | testAttribute "month" 126 | 127 | 128 | yearAttr : Attribute msg 129 | yearAttr = 130 | yearAttrHtml 131 | |> Element.htmlAttribute 132 | 133 | 134 | yearAttrHtml : Html.Attribute msg 135 | yearAttrHtml = 136 | testAttribute "year" 137 | 138 | 139 | testAttribute : String -> Html.Attribute msg 140 | testAttribute name = 141 | Html.Attributes.attribute "elm-test" name 142 | -------------------------------------------------------------------------------- /examples/Simple.elm: -------------------------------------------------------------------------------- 1 | module Simple exposing (main) 2 | 3 | import Browser 4 | import Date exposing (Date) 5 | import DatePicker exposing (ChangeEvent(..)) 6 | import Element 7 | import Element.Input as Input 8 | import Html exposing (Html) 9 | import Maybe.Extra 10 | import Task 11 | 12 | 13 | type alias Model = 14 | { date : Maybe Date 15 | , dateText : String 16 | , pickerModel : DatePicker.Model 17 | } 18 | 19 | 20 | type Msg 21 | = ChangePicker ChangeEvent 22 | | SetToday Date 23 | 24 | 25 | init : ( Model, Cmd Msg ) 26 | init = 27 | ( { date = Nothing 28 | , dateText = "" 29 | , pickerModel = DatePicker.init 30 | |> DatePicker.open 31 | } 32 | , Task.perform SetToday Date.today 33 | ) 34 | 35 | 36 | view : Model -> Html Msg 37 | view model = 38 | Element.layout [ ] <| 39 | DatePicker.input [ Element.width Element.shrink, Element.centerX, Element.centerY ] 40 | { onChange = ChangePicker 41 | , selected = model.date 42 | , text = model.dateText 43 | , label = 44 | Input.labelAbove [] <| 45 | Element.text "Pick A Date" 46 | , placeholder = Just <| Input.placeholder [] <| Element.text "jjjj-MM-dd" 47 | , settings = DatePicker.defaultSettings 48 | , model = model.pickerModel 49 | } 50 | 51 | 52 | update : Msg -> Model -> ( Model, Cmd Msg ) 53 | update msg model = 54 | case msg of 55 | ChangePicker changeEvent -> 56 | case changeEvent of 57 | DateChanged date -> 58 | -- update both date and text 59 | ( { model 60 | | date = Just date 61 | , dateText = Date.toIsoString date 62 | } 63 | , Cmd.none 64 | ) 65 | 66 | TextChanged text -> 67 | ( { model 68 | | date = 69 | -- parse the text in any way you like 70 | Date.fromIsoString text 71 | |> Result.toMaybe 72 | |> Maybe.Extra.orElse model.date 73 | , dateText = text 74 | } 75 | , Cmd.none 76 | ) 77 | 78 | PickerChanged subMsg -> 79 | -- internal stuff changed 80 | -- call DatePicker.update 81 | ( { model 82 | | pickerModel = 83 | model.pickerModel 84 | |> DatePicker.update subMsg 85 | } 86 | , Cmd.none 87 | ) 88 | 89 | SetToday today -> 90 | ( { model 91 | | pickerModel = 92 | model.pickerModel 93 | |> DatePicker.setToday today 94 | } 95 | , Cmd.none 96 | ) 97 | 98 | 99 | main : Program () Model Msg 100 | main = 101 | Browser.element 102 | { init = \_ -> init 103 | , view = view 104 | , update = update 105 | , subscriptions = \_ -> Sub.none 106 | } 107 | -------------------------------------------------------------------------------- /examples/CloseOnEnter.elm: -------------------------------------------------------------------------------- 1 | module CloseOnEnter exposing (main) 2 | 3 | import Browser 4 | import Date exposing (Date) 5 | import DatePicker exposing (ChangeEvent(..)) 6 | import Element 7 | import Element.Input as Input 8 | import Html exposing (Html) 9 | import Maybe.Extra 10 | import Task 11 | 12 | 13 | type alias Model = 14 | { date : Maybe Date 15 | , dateText : String 16 | , pickerModel : DatePicker.Model 17 | } 18 | 19 | 20 | type Msg 21 | = ChangePicker ChangeEvent 22 | | SetToday Date 23 | 24 | 25 | init : ( Model, Cmd Msg ) 26 | init = 27 | ( { date = Nothing 28 | , dateText = "" 29 | , pickerModel = DatePicker.init 30 | } 31 | , Task.perform SetToday Date.today 32 | ) 33 | 34 | 35 | view : Model -> Html Msg 36 | view model = 37 | Element.layout [] <| 38 | DatePicker.input [ Element.width Element.shrink, Element.centerX, Element.centerY ] 39 | { onChange = ChangePicker 40 | , selected = model.date 41 | , text = model.dateText 42 | , label = Input.labelAbove [] <| Element.text "Pick A Date" 43 | , placeholder = Just <| Input.placeholder [] <| Element.text "jjjj-MM-dd" 44 | , settings = DatePicker.defaultSettings 45 | , model = model.pickerModel 46 | } 47 | 48 | 49 | update : Msg -> Model -> ( Model, Cmd Msg ) 50 | update msg model = 51 | case msg of 52 | ChangePicker changeEvent -> 53 | case changeEvent of 54 | DateChanged date -> 55 | -- update both date and text 56 | ( { model 57 | | date = Just date 58 | , dateText = Date.toIsoString date 59 | , pickerModel = 60 | model.pickerModel 61 | |> DatePicker.close 62 | } 63 | , Cmd.none 64 | ) 65 | 66 | TextChanged text -> 67 | ( { model 68 | | date = 69 | -- parse the text in any way you like 70 | Date.fromIsoString text 71 | |> Result.toMaybe 72 | |> Maybe.Extra.orElse model.date 73 | , dateText = text 74 | } 75 | , Cmd.none 76 | ) 77 | 78 | PickerChanged subMsg -> 79 | -- internal stuff changed 80 | -- call DatePicker.update 81 | ( { model 82 | | pickerModel = 83 | model.pickerModel 84 | |> DatePicker.update subMsg 85 | } 86 | , Cmd.none 87 | ) 88 | 89 | SetToday today -> 90 | ( { model 91 | | pickerModel = 92 | model.pickerModel 93 | |> DatePicker.setToday today 94 | } 95 | , Cmd.none 96 | ) 97 | 98 | 99 | main : Program () Model Msg 100 | main = 101 | Browser.element 102 | { init = \_ -> init 103 | , view = view 104 | , update = update 105 | , subscriptions = \_ -> Sub.none 106 | } 107 | -------------------------------------------------------------------------------- /src/Internal/Week.elm: -------------------------------------------------------------------------------- 1 | module Internal.Week exposing (Index(..), Week, calendarWeekDays, fromListWithDefault, getDay, indexedMap, toList, weeksInMonth) 2 | 3 | import Date exposing (Date, Language) 4 | import Internal.Date as Date 5 | import Time exposing (Month(..), Weekday(..)) 6 | 7 | 8 | type Week a 9 | = Week (WeekModel a) 10 | 11 | 12 | type alias WeekModel a = 13 | { day0 : a 14 | , day1 : a 15 | , day2 : a 16 | , day3 : a 17 | , day4 : a 18 | , day5 : a 19 | , day6 : a 20 | } 21 | 22 | 23 | getDay : Index -> Week a -> a 24 | getDay index (Week week) = 25 | case index of 26 | Day0 -> 27 | week.day0 28 | 29 | Day1 -> 30 | week.day1 31 | 32 | Day2 -> 33 | week.day2 34 | 35 | Day3 -> 36 | week.day3 37 | 38 | Day4 -> 39 | week.day4 40 | 41 | Day5 -> 42 | week.day5 43 | 44 | Day6 -> 45 | week.day6 46 | 47 | 48 | indexedMap : (Index -> a -> b) -> Week a -> Week b 49 | indexedMap fn (Week week) = 50 | Week 51 | { day0 = fn Day0 week.day0 52 | , day1 = fn Day1 week.day1 53 | , day2 = fn Day2 week.day2 54 | , day3 = fn Day3 week.day3 55 | , day4 = fn Day4 week.day4 56 | , day5 = fn Day5 week.day5 57 | , day6 = fn Day6 week.day6 58 | } 59 | 60 | 61 | addNextDay : ( a, List a, a -> b ) -> ( a, List a, b ) 62 | addNextDay ( default, days, fn ) = 63 | case days of 64 | day :: rest -> 65 | ( default, rest, fn day ) 66 | 67 | [] -> 68 | ( default, [], fn default ) 69 | 70 | 71 | fromListWithDefault : a -> List a -> Week a 72 | fromListWithDefault default items = 73 | let 74 | ( _, _, week ) = 75 | ( default, items, WeekModel ) 76 | |> addNextDay 77 | |> addNextDay 78 | |> addNextDay 79 | |> addNextDay 80 | |> addNextDay 81 | |> addNextDay 82 | |> addNextDay 83 | in 84 | Week week 85 | 86 | 87 | type Index 88 | = Day0 89 | | Day1 90 | | Day2 91 | | Day3 92 | | Day4 93 | | Day5 94 | | Day6 95 | 96 | 97 | toList : Week a -> List a 98 | toList (Week week) = 99 | [ week.day0 100 | , week.day1 101 | , week.day2 102 | , week.day3 103 | , week.day4 104 | , week.day5 105 | , week.day6 106 | ] 107 | 108 | 109 | calendarWeekDays : Weekday -> Maybe Language -> Week String 110 | calendarWeekDays firstDayOfWeek maybeLanguage = 111 | let 112 | startDay = 113 | Date.floor (weekdayToInterval firstDayOfWeek) (Date.fromCalendarDate 2020 Jan 1) 114 | 115 | days = 116 | Date.range Date.Day 1 startDay (Date.add Date.Days 7 startDay) 117 | in 118 | fromListWithDefault "X" (List.map (Date.formatMaybeLanguage maybeLanguage "EEEEEE") days) 119 | 120 | 121 | weekdayToInterval : Weekday -> Date.Interval 122 | weekdayToInterval weekday = 123 | case weekday of 124 | Mon -> 125 | Date.Monday 126 | 127 | Tue -> 128 | Date.Tuesday 129 | 130 | Wed -> 131 | Date.Wednesday 132 | 133 | Thu -> 134 | Date.Thursday 135 | 136 | Fri -> 137 | Date.Friday 138 | 139 | Sat -> 140 | Date.Saturday 141 | 142 | Sun -> 143 | Date.Sunday 144 | 145 | 146 | weeksInMonth : Date -> Weekday -> List (Week Date) 147 | weeksInMonth month firstDayOfWeek = 148 | let 149 | weekdayInterval = 150 | weekdayToInterval firstDayOfWeek 151 | 152 | firstOfMonth = 153 | Date.fromCalendarDate (Date.year month) (Date.month month) 1 154 | 155 | start = 156 | firstOfMonth 157 | |> Date.floor weekdayInterval 158 | 159 | end = 160 | Date.add Date.Months 1 firstOfMonth 161 | |> Date.ceiling weekdayInterval 162 | 163 | weekDays startDay = 164 | Date.range Date.Day 1 startDay (Date.add Date.Days 7 startDay) 165 | 166 | toWeek list = 167 | fromListWithDefault (Date.fromOrdinalDate 2020 1) list 168 | in 169 | Date.range Date.Day 7 start end 170 | |> List.map (weekDays >> toWeek) 171 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Date Picker [![release](https://github-basic-badges.herokuapp.com/release/FabHof/elm-ui-datepicker.svg)](https://package.elm-lang.org/packages/fabhof/elm-ui-datepicker/latest/) [![codecov](https://codecov.io/gh/FabHof/elm-ui-datepicker/branch/main/graph/badge.svg)](https://codecov.io/gh/FabHof/elm-ui-datepicker) ![CI](https://github.com/FabHof/elm-ui-datepicker/workflows/CI/badge.svg?branch=main) 2 | 3 | A reasonable date picker for the awesome [elm-ui](https://package.elm-lang.org/packages/mdgriffith/elm-ui/latest/). 4 | 5 | At it's core, this date picker is just a [Element.Input.text](https://package.elm-lang.org/packages/mdgriffith/elm-ui/latest/Element-Input#text) with a few more features. 6 | 7 | It also depends on [justinmimbs/date](https://package.elm-lang.org/packages/justinmimbs/date/latest/) to represent dates without time and timezones. 8 | 9 | [See it in action here.](https://fabhof.github.io/elm-ui-datepicker/) 10 | 11 | For a rough changelog please see the [release page on github](https://github.com/FabHof/elm-ui-datepicker/releases). 12 | 13 | ## Usage 14 | 15 | It makes the most sense if you look at the [simple example](https://github.com/FabHof/elm-ui-datepicker/blob/main/examples/Simple.elm) and the [other examples](https://github.com/FabHof/elm-ui-datepicker/tree/main/examples). 16 | 17 | The date picker *has* an internal Model, but it does hold neither the selected date, nor the text of the underlying `Element.Input.text`. Therefore your minimal working model looks like this: 18 | 19 | ```elm 20 | type alias Model = 21 | { date : Maybe Date 22 | , dateText : String 23 | , pickerModel : DatePicker.Model 24 | } 25 | ``` 26 | 27 | To get a `DatePicker.model` use the `DatePicker.init` function. If you want the current day to be highlighted, you have to set it using `DatePicker.setToday` or use `DatePicker.initWithToday` 28 | 29 | ```elm 30 | init : ( Model, Cmd Msg ) 31 | init = 32 | ( { date = Nothing 33 | , dateText = "" 34 | , pickerModel = DatePicker.init 35 | } 36 | , Task.perform SetToday Date.today 37 | ) 38 | 39 | 40 | update : Msg -> Model -> ( Model, Cmd Msg ) 41 | ... 42 | SetToday today -> 43 | ( { model 44 | | pickerModel = 45 | model.pickerModel 46 | |> DatePicker.setToday today 47 | } 48 | , Cmd.none 49 | ) 50 | ... 51 | ``` 52 | 53 | To display the date picker use the `DatePicker.input` function: 54 | 55 | ```elm 56 | view : Model -> Html Msg 57 | view model = 58 | Element.layout [ Element.width Element.shrink] <| 59 | DatePicker.input [Element.centerX, Element.centerY ] 60 | { onChange = ChangePicker 61 | , selected = model.date 62 | , text = model.dateText 63 | , label = 64 | Input.labelAbove [] <| 65 | Element.text "Pick A Date" 66 | , placeholder = Nothing 67 | , settings = DatePicker.defaultSettings 68 | , model = model.pickerModel 69 | } 70 | ``` 71 | You have to handle both changes to the text and selection of a date: 72 | 73 | ```elm 74 | update : Msg -> Model -> ( Model, Cmd Msg ) 75 | update msg model = 76 | case msg of 77 | ChangePicker changeEvent -> 78 | case changeEvent of 79 | DateChanged date -> 80 | -- update both date and text 81 | ( { model 82 | | date = Just date 83 | , dateText = Date.toIsoString date 84 | } 85 | , Cmd.none 86 | ) 87 | 88 | TextChanged text -> 89 | ( { model 90 | | date = 91 | -- parse the text in any way you like 92 | Date.fromIsoString text 93 | |> Result.toMaybe 94 | |> Maybe.Extra.orElse model.date 95 | , dateText = text 96 | } 97 | , Cmd.none 98 | ) 99 | 100 | PickerChanged subMsg -> 101 | -- internal stuff changed 102 | -- call DatePicker.update 103 | ( { model 104 | | pickerModel = 105 | model.pickerModel 106 | |> DatePicker.update subMsg 107 | } 108 | , Cmd.none 109 | ) 110 | ... 111 | ``` 112 | 113 | `DatePicker.defaultSettings` is a reasonable start, just change what you need. 114 | 115 | ```elm 116 | settings : DatePicker.Settings msg 117 | settings = 118 | let 119 | default = 120 | DatePicker.defaultSettings 121 | in 122 | { default 123 | | firstDayOfWeek = Sun 124 | , disabled = 125 | \day -> 126 | Date.weekday day == Sun 127 | } 128 | ``` -------------------------------------------------------------------------------- /examples/CustomDesign.elm: -------------------------------------------------------------------------------- 1 | module CustomDesign exposing (main) 2 | 3 | import Browser 4 | import Date exposing (Date) 5 | import DatePicker exposing (ChangeEvent(..)) 6 | import Element exposing (padding) 7 | import Element.Background as Background 8 | import Element.Border as Border 9 | import Element.Events as Events 10 | import Element.Font as Font 11 | import Element.Input as Input 12 | import Html exposing (Html) 13 | import Maybe.Extra 14 | import Task 15 | 16 | 17 | type alias Model = 18 | { date : Maybe Date 19 | , dateText : String 20 | , pickerModel : DatePicker.Model 21 | } 22 | 23 | 24 | type Msg 25 | = ChangePicker ChangeEvent 26 | | SetToday Date 27 | | OnFocus 28 | | OnLoseFocus 29 | | OnClick 30 | | OnDoubleClick 31 | | OnMouseDown 32 | | OnMouseUp 33 | | OnMouseEnter 34 | | OnMouseLeave 35 | | OnMouseMove 36 | 37 | 38 | init : ( Model, Cmd Msg ) 39 | init = 40 | ( { date = Nothing 41 | , dateText = "" 42 | , pickerModel = 43 | DatePicker.init 44 | } 45 | , Task.perform SetToday Date.today 46 | ) 47 | 48 | 49 | view : Model -> Html Msg 50 | view model = 51 | Element.layout [] <| 52 | DatePicker.input 53 | [ Element.width (Element.px 180) 54 | , Element.centerX 55 | , Element.centerY 56 | , Element.padding 42 57 | , Background.color (Element.rgb255 158 60 99) 58 | , Border.color (Element.rgb255 0 0 0) 59 | , Border.rounded 0 60 | , Element.below (Element.text "Some text below") 61 | , Events.onFocus OnFocus 62 | , Events.onLoseFocus OnLoseFocus 63 | , Events.onClick OnClick 64 | , Events.onDoubleClick OnDoubleClick 65 | , Events.onMouseDown OnMouseDown 66 | , Events.onMouseUp OnMouseUp 67 | , Events.onMouseEnter OnMouseEnter 68 | , Events.onMouseLeave OnMouseLeave 69 | , Events.onMouseMove OnMouseMove 70 | ] 71 | { onChange = ChangePicker 72 | , selected = model.date 73 | , text = model.dateText 74 | , label = Input.labelAbove [] <| Element.text "Pick A Date" 75 | , placeholder = Just <| Input.placeholder [] <| Element.text "jjjj-MM-dd" 76 | , settings = settings 77 | , model = model.pickerModel 78 | } 79 | 80 | 81 | update : Msg -> Model -> ( Model, Cmd Msg ) 82 | update msg model = 83 | case msg of 84 | ChangePicker changeEvent -> 85 | case changeEvent of 86 | DateChanged date -> 87 | -- update both date and text 88 | ( { model 89 | | date = Just date 90 | , dateText = Date.toIsoString date 91 | , pickerModel = 92 | model.pickerModel 93 | |> DatePicker.close 94 | } 95 | , Cmd.none 96 | ) 97 | 98 | TextChanged text -> 99 | ( { model 100 | | date = 101 | -- parse the text in any way you like 102 | Date.fromIsoString text 103 | |> Result.toMaybe 104 | |> Maybe.Extra.orElse model.date 105 | , dateText = text 106 | } 107 | , Cmd.none 108 | ) 109 | 110 | PickerChanged subMsg -> 111 | -- internal stuff changed 112 | -- call DatePicker.update 113 | ( { model 114 | | pickerModel = 115 | model.pickerModel 116 | |> DatePicker.update subMsg 117 | } 118 | , Cmd.none 119 | ) 120 | 121 | SetToday today -> 122 | ( { model 123 | | pickerModel = 124 | model.pickerModel 125 | |> DatePicker.setToday today 126 | } 127 | , Cmd.none 128 | ) 129 | 130 | _-> 131 | let 132 | _ = 133 | Debug.log "Will you see this?" msg 134 | in 135 | ( model, Cmd.none ) 136 | 137 | 138 | 139 | {-| If you want to have the date picker look crazy - you can do it! 140 | -} 141 | settings : DatePicker.Settings 142 | settings = 143 | let 144 | default = 145 | DatePicker.defaultSettings 146 | in 147 | { default 148 | | pickerAttributes = 149 | [ Border.width 1 150 | , Border.color (Element.rgb255 186 189 182) 151 | ] 152 | , headerAttributes = 153 | [ Element.width Element.fill 154 | , Font.bold 155 | , Background.color (Element.rgb255 187 60 99) 156 | ] 157 | , tableAttributes = 158 | [ padding 6, Background.color (Element.rgb255 190 210 150) ] 159 | , weekdayAttributes = [ Font.color (Element.rgb255 96 96 96) ] 160 | , dayAttributes = [] 161 | , wrongMonthDayAttributes = 162 | [ Font.light ] 163 | , selectedDayAttributes = 164 | [ Background.color (Element.rgb255 95 15 255) ] 165 | , previousMonthElement = 166 | Element.el 167 | [ Background.color (Element.rgb255 60 187 99) 168 | , padding 12 169 | ] 170 | <| 171 | Element.text 172 | "<" 173 | , nextMonthElement = 174 | Element.el 175 | [ Background.color (Element.rgb255 60 187 99) 176 | , padding 12 177 | ] 178 | <| 179 | Element.text 180 | ">" 181 | } 182 | 183 | 184 | main : Program () Model Msg 185 | main = 186 | Browser.element 187 | { init = \_ -> init 188 | , view = view 189 | , update = update 190 | , subscriptions = \_ -> Sub.none 191 | } 192 | -------------------------------------------------------------------------------- /tests/WeekTests.elm: -------------------------------------------------------------------------------- 1 | module WeekTests exposing (suite) 2 | 3 | import Date 4 | import Expect 5 | import Fuzz exposing (intRange, list, string) 6 | import Internal.Week as Week 7 | import Test exposing (..) 8 | import Time 9 | 10 | 11 | 12 | -- TESTS 13 | 14 | 15 | suite : Test 16 | suite = 17 | describe "Week" 18 | [ getDay 19 | , toList 20 | , indexedMap 21 | , calendarWeekDays 22 | , weeksInMonth 23 | ] 24 | 25 | 26 | getDay : Test 27 | getDay = 28 | describe "Week.getDay returns correct element" 29 | [ testGetDay 0 Week.Day0 30 | , testGetDay 1 Week.Day1 31 | , testGetDay 2 Week.Day2 32 | , testGetDay 3 Week.Day3 33 | , testGetDay 4 Week.Day4 34 | , testGetDay 5 Week.Day5 35 | , testGetDay 6 Week.Day6 36 | ] 37 | 38 | 39 | toList : Test 40 | toList = 41 | fuzz (list string) "Week.toList returns Week.fromListWithDefault" <| 42 | \fuzzlist -> 43 | let 44 | week = 45 | Week.fromListWithDefault "foo" fuzzlist 46 | in 47 | Week.toList week 48 | |> List.take (List.length fuzzlist) 49 | |> Expect.equal (List.take 7 fuzzlist) 50 | 51 | 52 | indexedMap : Test 53 | indexedMap = 54 | test "Week.indexedMap index and element match" <| 55 | \_ -> 56 | let 57 | week = 58 | List.range 0 6 59 | |> List.map 60 | intToIndex 61 | |> Week.fromListWithDefault Week.Day0 62 | in 63 | Week.indexedMap (\i el -> i == el) week 64 | |> Week.toList 65 | |> Expect.equalLists (List.range 0 6 |> List.map (always True)) 66 | 67 | 68 | calendarWeekDays : Test 69 | calendarWeekDays = 70 | describe "Week.calendarWeekDays" 71 | [ test "without language" <| 72 | \_ -> 73 | Week.calendarWeekDays Time.Wed Nothing 74 | |> Week.toList 75 | |> Expect.equalLists [ "We", "Th", "Fr", "Sa", "Su", "Mo", "Tu" ] 76 | , test "with Language" <| 77 | \_ -> 78 | let 79 | weekdayName = 80 | \weekday -> 81 | case weekday of 82 | Time.Mon -> 83 | "Montag" 84 | 85 | Time.Tue -> 86 | "Dienstag" 87 | 88 | Time.Wed -> 89 | "Mittwoch" 90 | 91 | Time.Thu -> 92 | "Donnerstag" 93 | 94 | Time.Fri -> 95 | "Freitag" 96 | 97 | Time.Sat -> 98 | "Samstag" 99 | 100 | Time.Sun -> 101 | "Sonntag" 102 | 103 | language = 104 | { monthName = always "xxx" 105 | , monthNameShort = always "xxx" 106 | , weekdayName = always "xxx" 107 | , weekdayNameShort = weekdayName 108 | , dayWithSuffix = always "xxx" 109 | } 110 | in 111 | Week.calendarWeekDays Time.Mon (Just language) 112 | |> Week.toList 113 | |> Expect.equalLists [ "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So" ] 114 | ] 115 | 116 | 117 | weeksInMonth : Test 118 | weeksInMonth = 119 | describe "Week.weeksInMonth" 120 | [ fuzz3 (intRange 1 31) (intRange 1000 3000) (intRange 1 7) "same result for every day in the month" <| 121 | \fuzzDay fuzzYear fuzzWeekDay -> 122 | let 123 | weekday = 124 | Date.numberToWeekday fuzzWeekDay 125 | 126 | weeks1 = 127 | Week.weeksInMonth (Date.fromCalendarDate fuzzYear Time.Mar 1) weekday 128 | 129 | weeksFuzzed = 130 | Week.weeksInMonth (Date.fromCalendarDate fuzzYear Time.Mar fuzzDay) weekday 131 | in 132 | Expect.equalLists weeks1 weeksFuzzed 133 | , test "expected length for long month" <| 134 | \_ -> 135 | Week.weeksInMonth (Date.fromCalendarDate 2019 Time.Sep 1) Time.Mon 136 | |> List.length 137 | |> Expect.equal 6 138 | , test "expected length for short month" <| 139 | \_ -> 140 | Week.weeksInMonth (Date.fromCalendarDate 2021 Time.Feb 1) Time.Mon 141 | |> List.length 142 | |> Expect.equal 4 143 | , test "expected length for middle month" <| 144 | \_ -> 145 | Week.weeksInMonth (Date.fromCalendarDate 2020 Time.Apr 1) Time.Mon 146 | |> List.length 147 | |> Expect.equal 5 148 | , fuzz (intRange 1600 2400) "contains range of days" <| 149 | \fuzzYear -> 150 | let 151 | normalizedDays = 152 | Week.weeksInMonth (Date.fromCalendarDate fuzzYear Time.Apr 1) Time.Mon 153 | |> List.map Week.toList 154 | |> List.concat 155 | |> List.indexedMap (\index day -> Date.add Date.Days (index * -1) day) 156 | in 157 | normalizedDays 158 | |> List.all (\day -> Just day == List.head normalizedDays) 159 | |> Expect.true "sequence of days" 160 | ] 161 | 162 | 163 | 164 | -- HELPERS 165 | 166 | 167 | testGetDay : Int -> Week.Index -> Test 168 | testGetDay intIndex dayIndex = 169 | fuzz2 (list string) string ("for element " ++ String.fromInt intIndex) <| 170 | \fuzzlist defaultString -> 171 | let 172 | week = 173 | Week.fromListWithDefault defaultString fuzzlist 174 | in 175 | case fuzzlist |> List.drop intIndex |> List.head of 176 | Just item -> 177 | Week.getDay dayIndex week 178 | |> Expect.equal item 179 | 180 | Nothing -> 181 | Week.getDay dayIndex week 182 | |> Expect.equal defaultString 183 | 184 | 185 | intToIndex : Int -> Week.Index 186 | intToIndex i = 187 | case i of 188 | 0 -> 189 | Week.Day0 190 | 191 | 1 -> 192 | Week.Day1 193 | 194 | 2 -> 195 | Week.Day2 196 | 197 | 3 -> 198 | Week.Day3 199 | 200 | 4 -> 201 | Week.Day4 202 | 203 | 5 -> 204 | Week.Day5 205 | 206 | 6 -> 207 | Week.Day6 208 | 209 | _ -> 210 | Week.Day0 211 | -------------------------------------------------------------------------------- /examples/Settings.elm: -------------------------------------------------------------------------------- 1 | module Settings exposing (main) 2 | 3 | import Browser 4 | import Date exposing (Date) 5 | import DatePicker exposing (ChangeEvent(..)) 6 | import Element 7 | import Element.Input as Input 8 | import Html exposing (Html) 9 | import Maybe.Extra 10 | import Parser exposing ((|.), (|=), Parser, chompWhile, getChompedString, problem, succeed, symbol) 11 | import Task 12 | import Time exposing (Month(..), Weekday(..)) 13 | 14 | 15 | type alias Model = 16 | { date : Maybe Date 17 | , dateText : String 18 | , pickerModel : DatePicker.Model 19 | } 20 | 21 | 22 | type Msg 23 | = ChangePicker ChangeEvent 24 | | SetToday Date 25 | 26 | 27 | init : ( Model, Cmd Msg ) 28 | init = 29 | ( { date = Nothing 30 | , dateText = "" 31 | , pickerModel = DatePicker.open DatePicker.init 32 | } 33 | , Task.perform SetToday Date.today 34 | ) 35 | 36 | 37 | settings : DatePicker.Settings 38 | settings = 39 | let 40 | default = 41 | DatePicker.defaultSettings 42 | in 43 | { default 44 | | firstDayOfWeek = Sun 45 | , language = Just language 46 | , disabled = 47 | \day -> 48 | Date.weekday day == Sun 49 | } 50 | 51 | 52 | language : Date.Language 53 | language = 54 | { monthName = monthName True 55 | , monthNameShort = monthName False 56 | , weekdayName = weekdayName True 57 | , weekdayNameShort = weekdayName False 58 | , dayWithSuffix = \x -> String.fromInt x ++ "." 59 | } 60 | 61 | 62 | weekdayName : Bool -> Weekday -> String 63 | weekdayName long weekday = 64 | let 65 | longName = 66 | case weekday of 67 | Mon -> 68 | "Montag" 69 | 70 | Tue -> 71 | "Dienstag" 72 | 73 | Wed -> 74 | "Mittwoch" 75 | 76 | Thu -> 77 | "Donnerstag" 78 | 79 | Fri -> 80 | "Freitag" 81 | 82 | Sat -> 83 | "Samstag" 84 | 85 | Sun -> 86 | "Sonntag" 87 | in 88 | if long then 89 | longName 90 | 91 | else 92 | String.left 3 longName 93 | 94 | 95 | monthName : Bool -> Month -> String 96 | monthName long month = 97 | let 98 | longName = 99 | case month of 100 | Jan -> 101 | "Januar" 102 | 103 | Feb -> 104 | "Februar" 105 | 106 | Mar -> 107 | "März" 108 | 109 | Apr -> 110 | "April" 111 | 112 | May -> 113 | "Mai" 114 | 115 | Jun -> 116 | "Juni" 117 | 118 | Jul -> 119 | "Juli" 120 | 121 | Aug -> 122 | "August" 123 | 124 | Sep -> 125 | "September" 126 | 127 | Oct -> 128 | "Oktober" 129 | 130 | Nov -> 131 | "November" 132 | 133 | Dec -> 134 | "Dezember" 135 | in 136 | if long then 137 | longName 138 | 139 | else 140 | String.left 3 longName 141 | 142 | 143 | view : Model -> Html Msg 144 | view model = 145 | Element.layout [] <| 146 | DatePicker.input [ Element.width Element.shrink, Element.centerX, Element.centerY ] 147 | { onChange = ChangePicker 148 | , selected = model.date 149 | , text = model.dateText 150 | , label = Input.labelAbove [] <| Element.text "Pick A Date" 151 | , placeholder = Nothing 152 | , settings = settings 153 | , model = model.pickerModel 154 | } 155 | 156 | 157 | update : Msg -> Model -> ( Model, Cmd Msg ) 158 | update msg model = 159 | case msg of 160 | ChangePicker changeEvent -> 161 | case changeEvent of 162 | DateChanged date -> 163 | ( { model 164 | | date = Just date 165 | , dateText = Date.formatWithLanguage language "EEEE, ddd MMMM y" date 166 | } 167 | , Cmd.none 168 | ) 169 | 170 | TextChanged text -> 171 | ( { model 172 | | date = 173 | Parser.run germanDateParser text 174 | -- Date.fromIsoString text 175 | |> Result.toMaybe 176 | |> Maybe.Extra.orElse model.date 177 | , dateText = text 178 | } 179 | , Cmd.none 180 | ) 181 | 182 | PickerChanged subMsg -> 183 | ( { model 184 | | pickerModel = 185 | model.pickerModel 186 | |> DatePicker.update subMsg 187 | } 188 | , Cmd.none 189 | ) 190 | 191 | SetToday today -> 192 | ( { model 193 | | pickerModel = 194 | model.pickerModel 195 | |> DatePicker.setToday today 196 | } 197 | , Cmd.none 198 | ) 199 | 200 | 201 | main : Program () Model Msg 202 | main = 203 | Browser.element 204 | { init = \_ -> init 205 | , view = view 206 | , update = update 207 | , subscriptions = \_ -> Sub.none 208 | } 209 | 210 | 211 | type alias MyDate = 212 | { day : Int 213 | , month : Month 214 | , year : Int 215 | } 216 | 217 | 218 | germanDateParser : Parser Date 219 | germanDateParser = 220 | (succeed MyDate 221 | |= (digits 222 | |> min 1 223 | |> max 31 224 | ) 225 | |. symbol "." 226 | |= (digits 227 | |> min 1 228 | |> max 12 229 | |> Parser.map Date.numberToMonth 230 | ) 231 | |. symbol "." 232 | |= digits 233 | ) 234 | |> Parser.map (\myDate -> Date.fromCalendarDate myDate.year myDate.month myDate.day) 235 | 236 | 237 | digits : Parser Int 238 | digits = 239 | getChompedString (chompWhile Char.isDigit) 240 | |> Parser.andThen 241 | (\str -> 242 | case String.toInt str of 243 | Just n -> 244 | succeed n 245 | 246 | Nothing -> 247 | problem "segment is not a number" 248 | ) 249 | 250 | 251 | min : Int -> Parser Int -> Parser Int 252 | min minVal = 253 | Parser.andThen 254 | (\val -> 255 | if val < minVal then 256 | problem "value is to small" 257 | 258 | else 259 | succeed val 260 | ) 261 | 262 | 263 | max : Int -> Parser Int -> Parser Int 264 | max maxVal = 265 | Parser.andThen 266 | (\val -> 267 | if val > maxVal then 268 | problem "value is to big" 269 | 270 | else 271 | succeed val 272 | ) 273 | -------------------------------------------------------------------------------- /docs.json: -------------------------------------------------------------------------------- 1 | [{"name":"DatePicker","comment":"\n\n\n# Basic Usage\n\n@docs input, Model, init, setToday, ChangeEvent, update, Settings, defaultSettings, initWithToday\n\n\n# Helpers\n\nFor when you want to be more in control\n\n@docs close, open, setVisibleMonth, SelectorLevel, setSelectorLevel, Language\n\n","unions":[{"name":"ChangeEvent","comment":" Use in your update function:\n\n update msg model =\n case msg of\n ChangePicker changeEvent ->\n case changeEvent of\n DateChanged date ->\n -- update both date and text\n ( { model\n | date = Just date\n , dateText = Date.toIsoString date\n }\n , Cmd.none\n )\n\n TextChanged text ->\n ( { model\n | date =\n -- parse the text in any way you like\n Date.fromIsoString text\n |> Result.toMaybe\n |> Maybe.Extra.orElse model.date\n , dateText = text\n }\n , Cmd.none\n )\n\n DateCleared ->\n ( { model\n | date =\n Nothing\n , dateText = \"\"\n }\n , Cmd.none\n )\n\n PickerChanged subMsg ->\n -- internal stuff changed\n -- call DatePicker.update\n ( { model\n | pickerModel =\n model.pickerModel\n |> DatePicker.update subMsg\n }\n , Cmd.none\n )\n\n","args":[],"cases":[["DateChanged",["Date.Date"]],["TextChanged",["String.String"]],["PickerChanged",["DatePicker.Msg"]]]},{"name":"Model","comment":" ","args":[],"cases":[]},{"name":"SelectorLevel","comment":" The different selector levels the date picker can show.\n","args":[],"cases":[["DaysLevel",[]],["MonthsLevel",[]],["YearsLevel",[]]]}],"aliases":[{"name":"Language","comment":" Alias of [`Language`][dateLanguage] from `justinmimbs/date`.\n[dateLanguage]: \n","args":[],"type":"Date.Language"},{"name":"Settings","comment":" All the possible configuration settings.\nYou probably want to start at the [defaultSettings](DatePicker#defaultSettings) and only change what you need.\nIt's probably easiest to look at the [`code`][githubCode] to see where each attribute list is used for.\n[githubCode]: \n","args":[],"type":"{ firstDayOfWeek : Time.Weekday, language : Maybe.Maybe DatePicker.Language, disabled : Date.Date -> Basics.Bool, pickerAttributes : List.List (Element.Attribute Basics.Never), headerAttributes : List.List (Element.Attribute Basics.Never), tableAttributes : List.List (Element.Attribute Basics.Never), weekdayAttributes : List.List (Element.Attribute Basics.Never), dayAttributes : List.List (Element.Attribute Basics.Never), monthYearAttribute : List.List (Element.Attribute Basics.Never), wrongMonthDayAttributes : List.List (Element.Attribute Basics.Never), todayDayAttributes : List.List (Element.Attribute Basics.Never), selectedDayAttributes : List.List (Element.Attribute Basics.Never), disabledDayAttributes : List.List (Element.Attribute Basics.Never), monthsTableAttributes : List.List (Element.Attribute Basics.Never), yearsTableAttributes : List.List (Element.Attribute Basics.Never), headerButtonsAttributes : List.List (Element.Attribute Basics.Never), previousMonthElement : Element.Element Basics.Never, nextMonthElement : Element.Element Basics.Never }"}],"values":[{"name":"close","comment":" Closes the date picker.\n\nExample: close date picker on date input:\n\n DateChanged date ->\n ( { model\n | date = Just date\n , dateText = Date.toIsoString date\n , pickerModel =\n model.pickerModel\n |> DatePicker.close\n }\n , Cmd.none\n )\n\n**Note**: the date picker will reopen on _focus_ and _click_.\nTo prevent this, close the date picker on every update:\n\n PickerChanged subMsg ->\n ( { model\n | pickerModel =\n model.pickerModel\n |> DatePicker.update subMsg\n --picker will never open\n |> DatePicker.close\n }\n , Cmd.none\n )\n\n","type":"DatePicker.Model -> DatePicker.Model"},{"name":"defaultSettings","comment":" Reasonable default settings.\n","type":"DatePicker.Settings"},{"name":"init","comment":" The initial model of the date picker.\nEasy to us in your own init function:\n\n(You probably want to get todays date to give it to the date picker using [DatePicker.setToday](DatePicker#setToday))\n\n init =\n ( { date = Nothing\n , dateText = \"\"\n , pickerModel = DatePicker.init\n }\n , Task.perform SetToday Date.today\n )\n\n","type":"DatePicker.Model"},{"name":"initWithToday","comment":" The initial model of the date picker and sets the given date as today.\n","type":"Date.Date -> DatePicker.Model"},{"name":"input","comment":" Use it like you would `Input.text`, the attributes, `text`, `placeholder` and `label` will behave\nexactly like for `Input.text`. It has however a more complex `onChange`, a `selected` date, the internal `model` and some `settings`.\n\n**Note**: `Events.onClick`, `Events.onFocus` and `Events.onLoseFocus` are used internally by the date picker.\nThis means, that **your own `Events.onClick`, `Events.onFocus` and `Events.onLoseFocus` attributes have no effect and will not fire**.\n\n","type":"List.List (Element.Attribute msg) -> { onChange : DatePicker.ChangeEvent -> msg, selected : Maybe.Maybe Date.Date, text : String.String, label : Element.Input.Label msg, placeholder : Maybe.Maybe (Element.Input.Placeholder msg), model : DatePicker.Model, settings : DatePicker.Settings } -> Element.Element msg"},{"name":"open","comment":" Opens the date picker.\n\nExample: start with open picker:\n\n init : ( Model, Cmd Msg )\n init =\n ( { date = Nothing\n , dateText = \"\"\n , pickerModel =\n DatePicker.init\n |> DatePicker.open\n }\n , Task.perform SetToday Date.today\n )\n\n","type":"DatePicker.Model -> DatePicker.Model"},{"name":"setSelectorLevel","comment":" Sets the selector level that is visible when date picker is open.\n\nExample: start on the year level:\n\n init : ( Model, Cmd Msg )\n init =\n ( { date = Nothing\n , dateText = \"\"\n , pickerModel =\n DatePicker.init\n |> DatePicker.setSelectorLevel DatePicker.YearsLevel\n }\n , Task.perform SetToday Date.today\n )\n\n","type":"DatePicker.SelectorLevel -> DatePicker.Model -> DatePicker.Model"},{"name":"setToday","comment":" Sets the day that should be marked as today.\n","type":"Date.Date -> DatePicker.Model -> DatePicker.Model"},{"name":"setVisibleMonth","comment":" Sets the current visible month of the date picker.\n","type":"Date.Date -> DatePicker.Model -> DatePicker.Model"},{"name":"update","comment":" ","type":"DatePicker.Msg -> DatePicker.Model -> DatePicker.Model"}],"binops":[]}] -------------------------------------------------------------------------------- /tests/DatePickerTests.elm: -------------------------------------------------------------------------------- 1 | module DatePickerTests exposing (suite) 2 | 3 | import Date exposing (Date) 4 | import DatePicker 5 | import Element exposing (Element) 6 | import Element.Input as Input 7 | import Expect exposing (Expectation) 8 | import Fuzz exposing (intRange) 9 | import Html exposing (Html) 10 | import Internal.TestHelper as TestHelper 11 | import Json.Encode exposing (Value) 12 | import Test exposing (..) 13 | import Test.Html.Event as Event 14 | import Test.Html.Query as Query 15 | import Test.Html.Selector as Selector 16 | 17 | 18 | 19 | -- TESTS 20 | 21 | 22 | suite : Test 23 | suite = 24 | describe "DatePicker" 25 | [ startsClosed 26 | , open 27 | , close 28 | , focusOpen 29 | , blurClose 30 | , initSetTodayIsInitWithToday 31 | , todayIsVisibleOnInit 32 | , setVisibleIsVisible 33 | , nextMonth 34 | , previousMonth 35 | , selectedDay 36 | , clickDay 37 | , clickDisabled 38 | , setTodayDoesNotOverrideVisibleMonthIfSet 39 | , clickOnHeaderShowsMonthSelection 40 | , clickOnMonth 41 | , clickOnMonthHeaderShowsYearSelection 42 | , clickOnYear 43 | ] 44 | 45 | 46 | startsClosed : Test 47 | startsClosed = 48 | test "DatePicker.init is closed" <| 49 | \_ -> 50 | DatePicker.init 51 | |> isClosed 52 | 53 | 54 | open : Test 55 | open = 56 | test "DatePicker.open is opens the date picker" <| 57 | \_ -> 58 | DatePicker.init 59 | |> DatePicker.open 60 | |> isOpen 61 | 62 | 63 | close : Test 64 | close = 65 | test "DatePicker.close closes again" <| 66 | \_ -> 67 | DatePicker.init 68 | |> DatePicker.open 69 | |> DatePicker.close 70 | |> isClosed 71 | 72 | 73 | focusOpen : Test 74 | focusOpen = 75 | test "Date picker opens on focus" <| 76 | \_ -> 77 | let 78 | model = 79 | DatePicker.init 80 | 81 | focusResult = 82 | eventOnInputField model Event.focus 83 | in 84 | case focusResult of 85 | Err err -> 86 | Expect.fail err 87 | 88 | Ok (DatePickerChanged changedEvent) -> 89 | case changedEvent of 90 | DatePicker.PickerChanged msg -> 91 | model 92 | |> DatePicker.update msg 93 | |> isOpen 94 | 95 | _ -> 96 | Expect.fail "focus resulted in wrong changedEvent" 97 | 98 | 99 | blurClose : Test 100 | blurClose = 101 | test "Date picker closes on blur" <| 102 | \_ -> 103 | let 104 | model = 105 | DatePicker.init 106 | |> DatePicker.open 107 | 108 | blurResult = 109 | eventOnInputField model Event.blur 110 | in 111 | case blurResult of 112 | Err err -> 113 | Expect.fail err 114 | 115 | Ok (DatePickerChanged changedEvent) -> 116 | case changedEvent of 117 | DatePicker.PickerChanged msg -> 118 | DatePicker.update msg model 119 | |> isClosed 120 | 121 | _ -> 122 | Expect.fail "focus resulted in wrong changedEvent" 123 | 124 | 125 | initSetTodayIsInitWithToday : Test 126 | initSetTodayIsInitWithToday = 127 | fuzz2 (intRange 1000 3000) (intRange 1 366) "init + setToday = initWithToday" <| 128 | \year day -> 129 | let 130 | date = 131 | Date.fromOrdinalDate year day 132 | 133 | setToday = 134 | DatePicker.init |> DatePicker.setToday date 135 | 136 | withToday = 137 | DatePicker.initWithToday date 138 | in 139 | Expect.equal setToday withToday 140 | 141 | 142 | setTodayDoesNotOverrideVisibleMonthIfSet : Test 143 | setTodayDoesNotOverrideVisibleMonthIfSet = 144 | fuzz2 (intRange 1000 3000) (intRange 1 334) "setToday does not override visibleMonth" <| 145 | \year day -> 146 | let 147 | date = 148 | Date.fromOrdinalDate year day 149 | 150 | visibleMonth = 151 | Date.fromOrdinalDate year 336 152 | 153 | model = 154 | DatePicker.init 155 | |> DatePicker.setVisibleMonth visibleMonth 156 | |> DatePicker.setToday date 157 | |> DatePicker.open 158 | in 159 | isVisibleMonth visibleMonth model 160 | 161 | 162 | todayIsVisibleOnInit : Test 163 | todayIsVisibleOnInit = 164 | fuzz2 (intRange 1000 3000) (intRange 1 366) "today is visible month" <| 165 | \year day -> 166 | let 167 | date = 168 | Date.fromOrdinalDate year day 169 | 170 | model = 171 | DatePicker.initWithToday date 172 | |> DatePicker.open 173 | in 174 | model 175 | |> Expect.all 176 | [ isVisibleMonth date 177 | , todayIsThere date 178 | ] 179 | 180 | 181 | setVisibleIsVisible : Test 182 | setVisibleIsVisible = 183 | fuzz2 (intRange 1000 3000) (intRange 1 366) "setVisibleMonth sets visible month" <| 184 | \year day -> 185 | let 186 | date = 187 | Date.fromOrdinalDate year day 188 | 189 | model = 190 | DatePicker.init 191 | |> DatePicker.open 192 | |> DatePicker.setVisibleMonth date 193 | in 194 | model 195 | |> isVisibleMonth date 196 | 197 | 198 | nextMonth : Test 199 | nextMonth = 200 | fuzz2 (intRange 1000 3000) (intRange 1 366) "Next month changes visible month" <| 201 | \year day -> 202 | let 203 | date = 204 | Date.fromOrdinalDate year day 205 | 206 | model = 207 | DatePicker.initWithToday date 208 | |> DatePicker.open 209 | 210 | clickResult = 211 | clickNextMonth model 212 | in 213 | case clickResult of 214 | Err err -> 215 | Expect.fail err 216 | 217 | Ok (DatePickerChanged (DatePicker.PickerChanged msg)) -> 218 | model 219 | |> DatePicker.update msg 220 | |> isVisibleMonth (date |> Date.add Date.Months 1) 221 | 222 | _ -> 223 | Expect.fail "focus resulted in wrong changedEvent" 224 | 225 | 226 | previousMonth : Test 227 | previousMonth = 228 | fuzz2 (intRange 1000 3000) (intRange 1 366) "Previous month changes visible month" <| 229 | \year day -> 230 | let 231 | date = 232 | Date.fromOrdinalDate year day 233 | 234 | model = 235 | DatePicker.initWithToday date 236 | |> DatePicker.open 237 | 238 | clickResult = 239 | clickPreviousMonth model 240 | in 241 | case clickResult of 242 | Err err -> 243 | Expect.fail err 244 | 245 | Ok (DatePickerChanged (DatePicker.PickerChanged msg)) -> 246 | model 247 | |> DatePicker.update msg 248 | |> isVisibleMonth (date |> Date.add Date.Months -1) 249 | 250 | _ -> 251 | Expect.fail "focus resulted in wrong changedEvent" 252 | 253 | 254 | clickDay : Test 255 | clickDay = 256 | fuzz3 (intRange 1000 3000) (intRange 1 366) (intRange 1 31) "Clicking a date has correct event" <| 257 | \year day select -> 258 | let 259 | date = 260 | Date.fromOrdinalDate year day 261 | 262 | lastDayInMonth = 263 | Date.fromCalendarDate (Date.year date) (Date.month date) 31 264 | 265 | model = 266 | DatePicker.initWithToday date 267 | |> DatePicker.open 268 | 269 | dayToSelect = 270 | min select (Date.day lastDayInMonth) 271 | in 272 | modelToSingle model 273 | |> findTable 274 | |> Query.find 275 | [ Selector.attribute TestHelper.dayInMonthAttrHtml 276 | , Selector.containing 277 | [ Selector.text <| 278 | intTo2DigitString dayToSelect 279 | ] 280 | ] 281 | |> Event.simulate Event.click 282 | |> Event.expect 283 | (DatePickerChanged <| 284 | DatePicker.DateChanged <| 285 | Date.fromCalendarDate (Date.year date) (Date.month date) dayToSelect 286 | ) 287 | 288 | 289 | clickDisabled : Test 290 | clickDisabled = 291 | fuzz3 (intRange 1000 3000) (intRange 1 366) (intRange 1 31) "Clicking a disabled date does not fire an event" <| 292 | \year day select -> 293 | let 294 | date = 295 | Date.fromOrdinalDate year day 296 | 297 | lastDayInMonth = 298 | Date.fromCalendarDate (Date.year date) (Date.month date) 31 299 | 300 | model = 301 | DatePicker.initWithToday date 302 | |> DatePicker.open 303 | 304 | dayToSelect = 305 | min select (Date.day lastDayInMonth) 306 | 307 | defaultSettings = 308 | DatePicker.defaultSettings 309 | 310 | settings = 311 | { defaultSettings | disabled = always True } 312 | 313 | simpleConfig = 314 | simplePickerConfig model 315 | 316 | config = 317 | { simpleConfig | settings = settings } 318 | in 319 | DatePicker.input [] config 320 | |> toHtml 321 | |> Query.fromHtml 322 | |> findTable 323 | |> Query.find 324 | [ Selector.attribute TestHelper.dayInMonthAttrHtml 325 | , Selector.containing 326 | [ Selector.text <| 327 | intTo2DigitString dayToSelect 328 | ] 329 | ] 330 | |> Event.simulate Event.click 331 | |> Event.toResult 332 | |> Expect.err 333 | 334 | 335 | intTo2DigitString : Int -> String 336 | intTo2DigitString num = 337 | if num < 10 then 338 | "0" ++ String.fromInt num 339 | 340 | else 341 | String.fromInt num 342 | 343 | 344 | selectedDay : Test 345 | selectedDay = 346 | fuzz2 (intRange 1000 3000) (intRange 1 365) "selected day is there" <| 347 | \year day -> 348 | let 349 | model = 350 | DatePicker.initWithToday (Date.fromOrdinalDate year day) 351 | |> DatePicker.open 352 | 353 | simpleConfig = 354 | simplePickerConfig model 355 | 356 | selectedConfig = 357 | { simpleConfig | selected = Just <| Date.fromOrdinalDate year day } 358 | in 359 | DatePicker.input [] selectedConfig 360 | |> toHtml 361 | |> Query.fromHtml 362 | |> Query.has [ Selector.attribute TestHelper.selectedAttrHtml ] 363 | 364 | 365 | clickOnHeaderShowsMonthSelection : Test 366 | clickOnHeaderShowsMonthSelection = 367 | fuzz2 (intRange 1000 3000) (intRange 1 365) "clicking header shows month selection" <| 368 | \year day -> 369 | let 370 | date = 371 | Date.fromOrdinalDate year day 372 | 373 | selectorText = 374 | Date.format "MMMM yyyy" date 375 | 376 | model = 377 | DatePicker.initWithToday date 378 | |> DatePicker.open 379 | 380 | clickResult = 381 | modelToSingle model 382 | |> findCalendar 383 | |> Query.findAll [ Selector.tag "div", Selector.containing [ Selector.text selectorText ] ] 384 | |> (Query.keep <| Selector.containing [ Selector.text selectorText ]) 385 | |> (Query.keep <| Selector.tag "div") 386 | |> Query.first 387 | |> Event.simulate Event.click 388 | |> Event.toResult 389 | in 390 | case clickResult of 391 | Err err -> 392 | Expect.fail err 393 | 394 | Ok (DatePickerChanged (DatePicker.PickerChanged msg)) -> 395 | model 396 | |> DatePicker.update msg 397 | |> isInMonthView year 398 | 399 | _ -> 400 | Expect.fail "focus resulted in wrong changedEvent" 401 | 402 | 403 | clickOnMonth : Test 404 | clickOnMonth = 405 | fuzz3 (intRange 1000 3000) (intRange 1 365) (intRange 1 12) "clicking a month selects it" <| 406 | \year day selectMonthNumber -> 407 | let 408 | date = 409 | Date.fromOrdinalDate year day 410 | 411 | selectMonth = 412 | selectMonthNumber 413 | |> Date.numberToMonth 414 | 415 | selectorText = 416 | selectMonth 417 | |> (\m -> 418 | Date.fromCalendarDate year m 1 419 | |> (\d -> Date.format "MMM" d) 420 | ) 421 | 422 | model = 423 | DatePicker.initWithToday date 424 | |> DatePicker.setSelectorLevel DatePicker.MonthsLevel 425 | |> DatePicker.open 426 | 427 | clickResult = 428 | modelToSingle model 429 | |> Query.find [ Selector.attribute TestHelper.monthAttrHtml, Selector.containing [ Selector.text selectorText ] ] 430 | |> Event.simulate Event.click 431 | |> Event.toResult 432 | in 433 | case clickResult of 434 | Err err -> 435 | Expect.fail err 436 | 437 | Ok (DatePickerChanged (DatePicker.PickerChanged msg)) -> 438 | model 439 | |> DatePicker.update msg 440 | |> isVisibleMonth (Date.fromCalendarDate year selectMonth 1) 441 | 442 | _ -> 443 | Expect.fail "click resulted in wrong changedEvent" 444 | 445 | 446 | clickOnMonthHeaderShowsYearSelection : Test 447 | clickOnMonthHeaderShowsYearSelection = 448 | fuzz2 (intRange 1000 3000) (intRange 1 365) "click on month header shows year selection" <| 449 | \year day -> 450 | let 451 | date = 452 | Date.fromOrdinalDate year day 453 | 454 | selectorText = 455 | Date.format "yyyy" date 456 | 457 | model = 458 | DatePicker.initWithToday date 459 | |> DatePicker.setSelectorLevel DatePicker.MonthsLevel 460 | |> DatePicker.open 461 | 462 | clickResult = 463 | modelToSingle model 464 | |> findCalendar 465 | |> Query.findAll [ Selector.tag "div", Selector.containing [ Selector.text selectorText ] ] 466 | |> (Query.keep <| Selector.containing [ Selector.text selectorText ]) 467 | |> (Query.keep <| Selector.tag "div") 468 | |> Query.first 469 | |> Event.simulate Event.click 470 | |> Event.toResult 471 | in 472 | case clickResult of 473 | Err err -> 474 | Expect.fail err 475 | 476 | Ok (DatePickerChanged (DatePicker.PickerChanged msg)) -> 477 | model 478 | |> DatePicker.update msg 479 | |> isInYearView year 480 | 481 | _ -> 482 | Expect.fail "focus resulted in wrong changedEvent" 483 | 484 | 485 | clickOnYear : Test 486 | clickOnYear = 487 | fuzz3 (intRange 1000 3000) (intRange 1 365) (intRange -1 10) "clicking a year selects it" <| 488 | \year day selectYearIndex -> 489 | let 490 | date = 491 | Date.fromOrdinalDate year day 492 | 493 | selectYear = 494 | year // 10 * 10 + selectYearIndex 495 | 496 | selectorText = 497 | String.fromInt selectYear 498 | 499 | model = 500 | DatePicker.initWithToday date 501 | |> DatePicker.setSelectorLevel DatePicker.YearsLevel 502 | |> DatePicker.open 503 | 504 | clickResult = 505 | modelToSingle model 506 | |> Query.find [ Selector.attribute TestHelper.yearAttrHtml, Selector.containing [ Selector.text selectorText ] ] 507 | |> Event.simulate Event.click 508 | |> Event.toResult 509 | in 510 | case clickResult of 511 | Err err -> 512 | Expect.fail err 513 | 514 | Ok (DatePickerChanged (DatePicker.PickerChanged msg)) -> 515 | model 516 | |> DatePicker.update msg 517 | |> isInMonthView selectYear 518 | 519 | _ -> 520 | Expect.fail "click resulted in wrong changedEvent" 521 | 522 | 523 | 524 | -- EXPECTATIONS 525 | 526 | 527 | isInMonthView : Int -> DatePicker.Model -> Expectation 528 | isInMonthView year model = 529 | let 530 | intToMothQuery value = 531 | value 532 | |> Date.numberToMonth 533 | |> (\m -> 534 | Date.fromCalendarDate 2000 m 1 535 | |> (\d -> 536 | Date.format "MMM" d 537 | |> (\ms -> Query.has [ Selector.text ms ]) 538 | ) 539 | ) 540 | in 541 | modelToSingle model 542 | |> Expect.all 543 | (Query.has [ year |> String.fromInt |> Selector.text ] 544 | :: (List.range 1 12 545 | |> List.map intToMothQuery 546 | ) 547 | ) 548 | 549 | 550 | isInYearView : Int -> DatePicker.Model -> Expectation 551 | isInYearView year model = 552 | let 553 | decade = 554 | year // 10 * 10 555 | 556 | decadeStr = 557 | decade 558 | |> String.fromInt 559 | |> String.slice 0 3 560 | |> String.padRight 4 'X' 561 | in 562 | modelToSingle model 563 | |> Expect.all 564 | (Query.has [ Selector.text decadeStr ] 565 | :: (List.range -1 10 566 | |> List.map ((+) decade) 567 | |> List.map 568 | (\y -> 569 | Query.has 570 | [ y 571 | |> String.fromInt 572 | |> Selector.text 573 | ] 574 | ) 575 | ) 576 | ) 577 | 578 | 579 | isVisibleMonth : Date -> DatePicker.Model -> Expectation 580 | isVisibleMonth date model = 581 | modelToSingle model 582 | |> findCalendar 583 | |> Query.has [ Selector.text <| Date.format "MMMM yyyy" date ] 584 | 585 | 586 | todayIsThere : Date -> DatePicker.Model -> Expectation 587 | todayIsThere today model = 588 | modelToSingle model 589 | |> Query.find [ Selector.attribute TestHelper.todayAttrHtml ] 590 | |> Query.has [ Selector.text (Date.day today |> String.fromInt) ] 591 | 592 | 593 | isClosed : DatePicker.Model -> Expectation 594 | isClosed model = 595 | modelToSingle model 596 | |> Query.hasNot [ Selector.attribute TestHelper.calendarAttrHtml ] 597 | 598 | 599 | isOpen : DatePicker.Model -> Expectation 600 | isOpen model = 601 | modelToSingle model 602 | |> Query.has [ Selector.attribute TestHelper.calendarAttrHtml ] 603 | 604 | 605 | 606 | -- HELPERS 607 | 608 | 609 | type Msg 610 | = DatePickerChanged DatePicker.ChangeEvent 611 | 612 | 613 | findCalendar : Query.Single Msg -> Query.Single Msg 614 | findCalendar = 615 | Query.find [ Selector.attribute TestHelper.calendarAttrHtml ] 616 | 617 | 618 | findTable : Query.Single Msg -> Query.Single Msg 619 | findTable = 620 | Query.find [ Selector.attribute TestHelper.tableAttrHtml ] 621 | 622 | 623 | findNextMonthButton : Query.Single Msg -> Query.Single Msg 624 | findNextMonthButton = 625 | Query.find [ Selector.attribute TestHelper.nextMonthAttrHtml ] 626 | 627 | 628 | findPreviousMonthButton : Query.Single Msg -> Query.Single Msg 629 | findPreviousMonthButton = 630 | Query.find [ Selector.attribute TestHelper.previousMonthAttrHtml ] 631 | 632 | 633 | modelToSingle : DatePicker.Model -> Query.Single Msg 634 | modelToSingle model = 635 | simplePicker model 636 | |> toHtml 637 | |> Query.fromHtml 638 | 639 | 640 | toHtml : Element msg -> Html msg 641 | toHtml = 642 | Element.layout [] 643 | 644 | 645 | simplePicker : DatePicker.Model -> Element Msg 646 | simplePicker model = 647 | DatePicker.input [] (simplePickerConfig model) 648 | 649 | 650 | simplePickerConfig : 651 | DatePicker.Model 652 | -> 653 | { onChange : DatePicker.ChangeEvent -> Msg 654 | , selected : Maybe Date 655 | , text : String 656 | , label : Input.Label msg 657 | , placeholder : Maybe (Input.Placeholder msg) 658 | , model : DatePicker.Model 659 | , settings : DatePicker.Settings 660 | } 661 | simplePickerConfig model = 662 | { onChange = DatePickerChanged 663 | , selected = Nothing 664 | , text = "" 665 | , label = Input.labelAbove [] (Element.text "date picker") 666 | , placeholder = Nothing 667 | , model = model 668 | , settings = DatePicker.defaultSettings 669 | } 670 | 671 | 672 | eventOnInputField : DatePicker.Model -> ( String, Value ) -> Result String Msg 673 | eventOnInputField model event = 674 | modelToSingle model 675 | |> Query.find [ Selector.attribute TestHelper.inputAttrHtml ] 676 | |> Event.simulate event 677 | |> Event.toResult 678 | 679 | 680 | clickNextMonth : DatePicker.Model -> Result String Msg 681 | clickNextMonth model = 682 | modelToSingle model 683 | |> findNextMonthButton 684 | |> Event.simulate Event.click 685 | |> Event.toResult 686 | 687 | 688 | clickPreviousMonth : DatePicker.Model -> Result String Msg 689 | clickPreviousMonth model = 690 | modelToSingle model 691 | |> findPreviousMonthButton 692 | |> Event.simulate Event.click 693 | |> Event.toResult 694 | -------------------------------------------------------------------------------- /src/DatePicker.elm: -------------------------------------------------------------------------------- 1 | module DatePicker exposing 2 | ( input, Model, init, setToday, ChangeEvent(..), update, Settings, defaultSettings, initWithToday 3 | , close, open, setVisibleMonth, SelectorLevel(..), setSelectorLevel, Language 4 | ) 5 | 6 | {-| 7 | 8 | 9 | # Basic Usage 10 | 11 | @docs input, Model, init, setToday, ChangeEvent, update, Settings, defaultSettings, initWithToday 12 | 13 | 14 | # Helpers 15 | 16 | For when you want to be more in control 17 | 18 | @docs close, open, setVisibleMonth, SelectorLevel, setSelectorLevel, Language 19 | 20 | -} 21 | 22 | import Date exposing (Date) 23 | import Element exposing (Attribute, Element, alignLeft, alignRight, centerX, mouseOver, padding, spacing) 24 | import Element.Background as Background 25 | import Element.Border as Border 26 | import Element.Events as Events 27 | import Element.Font as Font 28 | import Element.Input as Input 29 | import Html.Events 30 | import Internal.Date as Date 31 | import Internal.TestHelper as TestHelper 32 | import Internal.Week as Week exposing (Week) 33 | import Json.Decode as Decode 34 | import Time exposing (Month(..), Weekday(..)) 35 | 36 | 37 | 38 | -- MODEL 39 | 40 | 41 | {-| -} 42 | type Model 43 | = Model Picker 44 | 45 | 46 | type alias Picker = 47 | { open : Bool 48 | , today : Date 49 | , visibleMonth : Date 50 | , level : SelectorLevel 51 | } 52 | 53 | 54 | {-| The initial model of the date picker. 55 | Easy to us in your own init function: 56 | 57 | (You probably want to get todays date to give it to the date picker using [DatePicker.setToday](DatePicker#setToday)) 58 | 59 | init = 60 | ( { date = Nothing 61 | , dateText = "" 62 | , pickerModel = DatePicker.init 63 | } 64 | , Task.perform SetToday Date.today 65 | ) 66 | 67 | -} 68 | init : Model 69 | init = 70 | Model 71 | { open = False 72 | , today = Date.fromOrdinalDate 1 1 73 | , visibleMonth = Date.fromOrdinalDate 1 1 74 | , level = DaysLevel 75 | } 76 | 77 | 78 | {-| The initial model of the date picker and sets the given date as today. 79 | -} 80 | initWithToday : Date -> Model 81 | initWithToday today = 82 | Model 83 | { open = False 84 | , today = today 85 | , visibleMonth = today 86 | , level = DaysLevel 87 | } 88 | 89 | 90 | {-| Sets the day that should be marked as today. 91 | -} 92 | setToday : Date -> Model -> Model 93 | setToday today (Model picker) = 94 | Model 95 | { picker 96 | | today = today 97 | , visibleMonth = 98 | if picker.visibleMonth == Date.fromOrdinalDate 1 1 then 99 | today 100 | 101 | else 102 | picker.visibleMonth 103 | } 104 | 105 | 106 | {-| Closes the date picker. 107 | 108 | Example: close date picker on date input: 109 | 110 | DateChanged date -> 111 | ( { model 112 | | date = Just date 113 | , dateText = Date.toIsoString date 114 | , pickerModel = 115 | model.pickerModel 116 | |> DatePicker.close 117 | } 118 | , Cmd.none 119 | ) 120 | 121 | **Note**: the date picker will reopen on _focus_ and _click_. 122 | To prevent this, close the date picker on every update: 123 | 124 | PickerChanged subMsg -> 125 | ( { model 126 | | pickerModel = 127 | model.pickerModel 128 | |> DatePicker.update subMsg 129 | --picker will never open 130 | |> DatePicker.close 131 | } 132 | , Cmd.none 133 | ) 134 | 135 | -} 136 | close : Model -> Model 137 | close (Model picker) = 138 | Model 139 | { picker 140 | | open = False 141 | } 142 | 143 | 144 | {-| Opens the date picker. 145 | 146 | Example: start with open picker: 147 | 148 | init : ( Model, Cmd Msg ) 149 | init = 150 | ( { date = Nothing 151 | , dateText = "" 152 | , pickerModel = 153 | DatePicker.init 154 | |> DatePicker.open 155 | } 156 | , Task.perform SetToday Date.today 157 | ) 158 | 159 | -} 160 | open : Model -> Model 161 | open (Model picker) = 162 | Model { picker | open = True } 163 | 164 | 165 | {-| Sets the current visible month of the date picker. 166 | -} 167 | setVisibleMonth : Date -> Model -> Model 168 | setVisibleMonth date (Model picker) = 169 | Model { picker | visibleMonth = date } 170 | 171 | 172 | {-| Sets the selector level that is visible when date picker is open. 173 | 174 | Example: start on the year level: 175 | 176 | init : ( Model, Cmd Msg ) 177 | init = 178 | ( { date = Nothing 179 | , dateText = "" 180 | , pickerModel = 181 | DatePicker.init 182 | |> DatePicker.setSelectorLevel DatePicker.YearsLevel 183 | } 184 | , Task.perform SetToday Date.today 185 | ) 186 | 187 | -} 188 | setSelectorLevel : SelectorLevel -> Model -> Model 189 | setSelectorLevel level (Model picker) = 190 | Model { picker | level = level } 191 | 192 | 193 | 194 | -- UPDATE 195 | 196 | 197 | type Msg 198 | = ChangeMonth Date 199 | | ChangeMonthAndLevel Date SelectorLevel 200 | | ChangeYearAndLevel Int SelectorLevel 201 | | Open 202 | | Close 203 | | ChangeLevel SelectorLevel 204 | | NothingToDo 205 | 206 | 207 | {-| The different selector levels the date picker can show. 208 | -} 209 | type SelectorLevel 210 | = DaysLevel 211 | | MonthsLevel 212 | | YearsLevel 213 | 214 | 215 | {-| Use in your update function: 216 | 217 | update msg model = 218 | case msg of 219 | ChangePicker changeEvent -> 220 | case changeEvent of 221 | DateChanged date -> 222 | -- update both date and text 223 | ( { model 224 | | date = Just date 225 | , dateText = Date.toIsoString date 226 | } 227 | , Cmd.none 228 | ) 229 | 230 | TextChanged text -> 231 | ( { model 232 | | date = 233 | -- parse the text in any way you like 234 | Date.fromIsoString text 235 | |> Result.toMaybe 236 | |> Maybe.Extra.orElse model.date 237 | , dateText = text 238 | } 239 | , Cmd.none 240 | ) 241 | 242 | DateCleared -> 243 | ( { model 244 | | date = 245 | Nothing 246 | , dateText = "" 247 | } 248 | , Cmd.none 249 | ) 250 | 251 | PickerChanged subMsg -> 252 | -- internal stuff changed 253 | -- call DatePicker.update 254 | ( { model 255 | | pickerModel = 256 | model.pickerModel 257 | |> DatePicker.update subMsg 258 | } 259 | , Cmd.none 260 | ) 261 | 262 | -} 263 | type ChangeEvent 264 | = DateChanged Date 265 | | TextChanged String 266 | | PickerChanged Msg 267 | 268 | 269 | {-| -} 270 | update : Msg -> Model -> Model 271 | update msg model = 272 | case msg of 273 | ChangeMonth month -> 274 | setVisibleMonth month model 275 | 276 | ChangeMonthAndLevel month view -> 277 | model 278 | |> setVisibleMonth month 279 | |> setSelectorLevel view 280 | 281 | ChangeYearAndLevel year view -> 282 | model 283 | |> setVisibleMonth (Date.fromOrdinalDate year 1) 284 | |> setSelectorLevel view 285 | 286 | Open -> 287 | open model 288 | 289 | Close -> 290 | close model 291 | 292 | ChangeLevel view -> 293 | setSelectorLevel view model 294 | 295 | NothingToDo -> 296 | model 297 | 298 | 299 | 300 | -- VIEW 301 | 302 | 303 | {-| All the possible configuration settings. 304 | You probably want to start at the [defaultSettings](DatePicker#defaultSettings) and only change what you need. 305 | It's probably easiest to look at the [`code`][githubCode] to see where each attribute list is used for. 306 | [githubCode]: 307 | -} 308 | type alias Settings = 309 | { firstDayOfWeek : Weekday 310 | , language : Maybe Language 311 | , disabled : Date -> Bool 312 | , pickerAttributes : List (Attribute Never) 313 | , headerAttributes : List (Attribute Never) 314 | , tableAttributes : List (Attribute Never) 315 | , weekdayAttributes : List (Attribute Never) 316 | , dayAttributes : List (Attribute Never) 317 | , monthYearAttribute : List (Attribute Never) 318 | , wrongMonthDayAttributes : List (Attribute Never) 319 | , todayDayAttributes : List (Attribute Never) 320 | , selectedDayAttributes : List (Attribute Never) 321 | , disabledDayAttributes : List (Attribute Never) 322 | , monthsTableAttributes : List (Attribute Never) 323 | , yearsTableAttributes : List (Attribute Never) 324 | , headerButtonsAttributes : List (Attribute Never) 325 | , previousMonthElement : Element Never 326 | , nextMonthElement : Element Never 327 | } 328 | 329 | 330 | {-| Reasonable default settings. 331 | -} 332 | defaultSettings : Settings 333 | defaultSettings = 334 | { firstDayOfWeek = Mon 335 | , language = Nothing 336 | , disabled = always False 337 | , pickerAttributes = 338 | [ Border.width 1 339 | , Border.color (Element.rgb255 186 189 182) 340 | , Border.roundEach 341 | { topLeft = 0 342 | , topRight = 0 343 | , bottomLeft = 3 344 | , bottomRight = 3 345 | } 346 | , Element.moveDown 3 347 | , padding 8 348 | , spacing 4 349 | , Element.centerX 350 | , Element.centerY 351 | , Element.width Element.fill 352 | , Background.color <| Element.rgb255 255 255 255 353 | ] 354 | , headerAttributes = 355 | [ Element.width Element.fill 356 | , padding 2 357 | , Font.bold 358 | ] 359 | , tableAttributes = 360 | [ Element.height Element.fill 361 | , Element.centerY 362 | ] 363 | , weekdayAttributes = [ Font.bold ] 364 | , dayAttributes = 365 | [ Border.rounded 3 366 | , padding 3 367 | , Element.width Element.fill 368 | , Font.center 369 | , Element.centerY 370 | , Element.mouseOver [ Background.color (Element.rgb255 0x73 0xB6 0xFF) ] 371 | ] 372 | , monthYearAttribute = 373 | [ Border.rounded 3 374 | , padding 11 375 | , Element.width Element.fill 376 | , Font.center 377 | , Element.centerY 378 | , Element.mouseOver [ Background.color (Element.rgb255 0x73 0xB6 0xFF) ] 379 | ] 380 | , wrongMonthDayAttributes = 381 | [ Font.color (Element.rgb255 0x80 0x80 0x80) ] 382 | , todayDayAttributes = 383 | [ Background.color (Element.rgb255 0xFF 0xC1 0x9B) ] 384 | , selectedDayAttributes = 385 | [ Background.color (Element.rgb255 0x00 0x7B 0xFF) ] 386 | , disabledDayAttributes = 387 | [ Font.color (Element.rgb255 0x80 0x80 0x80) 388 | , Background.color (Element.rgb255 0xDD 0xDD 0xDD) 389 | ] 390 | , monthsTableAttributes = 391 | [ Element.spaceEvenly 392 | , Element.width Element.fill 393 | , Element.height Element.fill 394 | ] 395 | , yearsTableAttributes = 396 | [ Element.spaceEvenly 397 | , Element.width Element.fill 398 | , Element.height Element.fill 399 | ] 400 | , headerButtonsAttributes = 401 | [ Element.pointer 402 | , padding 6 403 | , Border.rounded 3 404 | , Border.shadow 405 | { offset = ( 1, 1 ) 406 | , size = 1 407 | , blur = 1 408 | , color = Element.rgb255 186 189 182 409 | } 410 | , mouseOver 411 | [ Border.shadow 412 | { offset = ( 1, 1 ) 413 | , size = 2 414 | , blur = 1 415 | , color = Element.rgb255 186 189 182 416 | } 417 | ] 418 | ] 419 | , previousMonthElement = 420 | Element.text "🢐" 421 | , nextMonthElement = 422 | Element.text "🢒" 423 | } 424 | 425 | 426 | {-| Alias of [`Language`][dateLanguage] from `justinmimbs/date`. 427 | [dateLanguage]: 428 | -} 429 | type alias Language = 430 | Date.Language 431 | 432 | 433 | type alias Config msg = 434 | { settings : Settings 435 | , label : Input.Label msg 436 | , placeholder : Maybe (Input.Placeholder msg) 437 | , picker : Picker 438 | , text : String 439 | , selected : Maybe Date 440 | , onChange : ChangeEvent -> msg 441 | } 442 | 443 | 444 | {-| Use it like you would `Input.text`, the attributes, `text`, `placeholder` and `label` will behave 445 | exactly like for `Input.text`. It has however a more complex `onChange`, a `selected` date, the internal `model` and some `settings`. 446 | 447 | **Note**: `Events.onClick`, `Events.onFocus` and `Events.onLoseFocus` are used internally by the date picker. 448 | This means, that **your own `Events.onClick`, `Events.onFocus` and `Events.onLoseFocus` attributes have no effect and will not fire**. 449 | 450 | -} 451 | input : 452 | List (Attribute msg) 453 | -> 454 | { onChange : ChangeEvent -> msg 455 | , selected : Maybe Date 456 | , text : String 457 | , label : Input.Label msg 458 | , placeholder : Maybe (Input.Placeholder msg) 459 | , model : Model 460 | , settings : Settings 461 | } 462 | -> Element msg 463 | input attributes ({ settings, model, label, placeholder, selected, onChange } as inputConfig) = 464 | let 465 | (Model picker) = 466 | model 467 | 468 | config = 469 | { settings = settings 470 | , picker = picker 471 | , text = inputConfig.text 472 | , label = label 473 | , placeholder = placeholder 474 | , selected = selected 475 | , onChange = onChange 476 | } 477 | 478 | pickerEl = 479 | if picker.open then 480 | pickerView config 481 | 482 | else 483 | [] 484 | 485 | inputAttributes = 486 | if picker.open then 487 | attributes 488 | 489 | else 490 | attributes 491 | ++ [ Events.onClick <| onChange <| PickerChanged Open ] 492 | in 493 | Input.text 494 | (inputAttributes 495 | ++ pickerEl 496 | ++ [ Events.onFocus <| onChange <| PickerChanged Open 497 | , Events.onLoseFocus <| onChange <| PickerChanged Close 498 | , TestHelper.inputAttr 499 | ] 500 | ) 501 | { onChange = onChange << TextChanged 502 | , text = config.text 503 | , placeholder = placeholder 504 | , label = label 505 | } 506 | 507 | 508 | pickerView : 509 | Config msg 510 | -> List (Attribute msg) 511 | pickerView ({ settings } as config) = 512 | [ Element.below <| 513 | Element.column 514 | (TestHelper.calendarAttr 515 | :: preventDefaultOnMouseDown config 516 | :: extAttrs settings.pickerAttributes 517 | ) 518 | [ pickerHeader config 519 | , pickerTable config 520 | ] 521 | ] 522 | 523 | 524 | pickerTable : Config msg -> Element msg 525 | pickerTable ({ settings, picker } as config) = 526 | case picker.level of 527 | DaysLevel -> 528 | Element.table (TestHelper.tableAttr :: extAttrs settings.tableAttributes) 529 | { data = Week.weeksInMonth picker.visibleMonth config.settings.firstDayOfWeek 530 | , columns = pickerColumns config 531 | } 532 | 533 | MonthsLevel -> 534 | monthTable config 535 | 536 | YearsLevel -> 537 | let 538 | decade = 539 | Date.year picker.visibleMonth // 10 * 10 540 | in 541 | Element.column (TestHelper.tableAttr :: extAttrs settings.yearsTableAttributes) 542 | (List.range 0 2 543 | |> List.map 544 | (\i -> 545 | Element.row (extAttrs settings.yearsTableAttributes) 546 | (List.range -1 2 547 | |> List.map 548 | (\j -> 549 | 4 550 | * i 551 | + j 552 | + decade 553 | |> selectYearElement config 554 | ) 555 | ) 556 | ) 557 | ) 558 | 559 | 560 | monthTable : Config msg -> Element msg 561 | monthTable ({ settings, picker } as config) = 562 | Element.column (TestHelper.tableAttr :: extAttrs settings.monthsTableAttributes) 563 | (List.range 0 2 564 | |> List.map 565 | (\i -> 566 | Element.row (extAttrs settings.monthsTableAttributes) 567 | (List.range 0 3 568 | |> List.map 569 | (\j -> 570 | Date.fromCalendarDate (Date.year picker.visibleMonth) Jan 1 571 | |> Date.add Date.Months (4 * i + j) 572 | |> selectMonthElement config 573 | ) 574 | ) 575 | ) 576 | ) 577 | 578 | 579 | selectYearElement : Config msg -> Int -> Element msg 580 | selectYearElement ({ settings, picker } as config) year = 581 | let 582 | attributesForThisYear = 583 | List.concat 584 | [ extAttrs settings.monthYearAttribute 585 | , [ Events.onClick <| config.onChange <| PickerChanged <| ChangeYearAndLevel year MonthsLevel 586 | , Element.pointer 587 | , TestHelper.yearAttr 588 | ] 589 | , if 590 | Date.year picker.today 591 | == year 592 | then 593 | TestHelper.todayAttr 594 | :: extAttrs settings.todayDayAttributes 595 | 596 | else 597 | [] 598 | , if 599 | Maybe.map Date.year config.selected 600 | == Just year 601 | then 602 | TestHelper.selectedAttr 603 | :: extAttrs settings.selectedDayAttributes 604 | 605 | else 606 | [] 607 | ] 608 | in 609 | Element.el attributesForThisYear 610 | (Element.text <| String.fromInt year) 611 | 612 | 613 | selectMonthElement : Config msg -> Date -> Element msg 614 | selectMonthElement ({ settings, picker } as config) month = 615 | let 616 | attributesForThisMonth = 617 | List.concat 618 | [ extAttrs settings.monthYearAttribute 619 | , [ Events.onClick <| config.onChange <| PickerChanged <| ChangeMonthAndLevel month DaysLevel 620 | , Element.pointer 621 | , TestHelper.monthAttr 622 | ] 623 | , if 624 | Date.month picker.today 625 | == Date.month month 626 | && Date.year picker.today 627 | == Date.year month 628 | then 629 | TestHelper.todayAttr 630 | :: extAttrs settings.todayDayAttributes 631 | 632 | else 633 | [] 634 | , if 635 | Maybe.map Date.month config.selected 636 | == Just (Date.month month) 637 | && Maybe.map Date.year config.selected 638 | == Just (Date.year month) 639 | then 640 | TestHelper.selectedAttr 641 | :: extAttrs settings.selectedDayAttributes 642 | 643 | else 644 | [] 645 | 646 | -- TODO All Days in Month are disabled => Disable Month? 647 | -- , if settings.disabled day then 648 | -- extAttrs settings.disabledDayAttributes 649 | -- else 650 | -- [ Events.onClick <| config.onChange <| DateChanged day, Element.pointer ] 651 | ] 652 | in 653 | Element.el attributesForThisMonth 654 | (Element.text <| Date.formatMaybeLanguage settings.language "MMM" month) 655 | 656 | 657 | pickerColumns : Config msg -> List (Element.Column (Week Date) msg) 658 | pickerColumns config = 659 | let 660 | weekdays = 661 | Week.calendarWeekDays config.settings.firstDayOfWeek config.settings.language 662 | 663 | toColumn index weekday = 664 | { header = Element.el (extAttrs config.settings.weekdayAttributes) (Element.text weekday) 665 | , width = Element.fill 666 | , view = 667 | \week -> 668 | Week.getDay index week 669 | |> dayView config 670 | } 671 | in 672 | Week.toList (Week.indexedMap toColumn weekdays) 673 | 674 | 675 | pickerHeader : Config msg -> Element msg 676 | pickerHeader { onChange, picker, settings } = 677 | let 678 | headerProperties = 679 | case picker.level of 680 | DaysLevel -> 681 | { stepUnit = Date.Months 682 | , stepSize = 1 683 | , title = 684 | Element.text <| 685 | Date.formatMaybeLanguage settings.language "MMMM yyyy" picker.visibleMonth 686 | , nextLevel = Just MonthsLevel 687 | } 688 | 689 | MonthsLevel -> 690 | { stepUnit = Date.Years 691 | , stepSize = 1 692 | , title = 693 | Element.text <| 694 | Date.formatMaybeLanguage settings.language "yyyy" picker.visibleMonth 695 | , nextLevel = Just YearsLevel 696 | } 697 | 698 | YearsLevel -> 699 | { stepUnit = Date.Years 700 | , stepSize = 10 701 | , title = 702 | Element.text <| 703 | (Date.formatMaybeLanguage settings.language "yyyy" picker.visibleMonth 704 | |> String.slice 0 3 705 | |> String.padRight 4 'X' 706 | ) 707 | , nextLevel = Nothing 708 | } 709 | in 710 | Element.row (extAttrs settings.headerAttributes) 711 | [ Input.button 712 | (alignLeft 713 | :: TestHelper.previousMonthAttr 714 | :: extAttrs settings.headerButtonsAttributes 715 | ) 716 | { onPress = 717 | Just <| 718 | onChange <| 719 | PickerChanged <| 720 | ChangeMonth (Date.add headerProperties.stepUnit (-1 * headerProperties.stepSize) picker.visibleMonth) 721 | , label = extEle settings.previousMonthElement 722 | } 723 | , Input.button 724 | (centerX 725 | :: extAttrs settings.headerButtonsAttributes 726 | ) 727 | { onPress = Maybe.map (\up -> onChange <| PickerChanged <| ChangeLevel up) headerProperties.nextLevel 728 | , label = headerProperties.title 729 | } 730 | , Input.button 731 | (alignRight 732 | :: TestHelper.nextMonthAttr 733 | :: extAttrs settings.headerButtonsAttributes 734 | ) 735 | { onPress = 736 | Just <| 737 | onChange <| 738 | PickerChanged <| 739 | ChangeMonth (Date.add headerProperties.stepUnit headerProperties.stepSize picker.visibleMonth) 740 | , label = extEle settings.nextMonthElement 741 | } 742 | ] 743 | 744 | 745 | dayView : Config msg -> Date -> Element msg 746 | dayView ({ picker, settings } as config) day = 747 | let 748 | attributesForThisDay = 749 | List.concat 750 | [ extAttrs settings.dayAttributes 751 | , if Date.month picker.visibleMonth /= Date.month day then 752 | extAttrs settings.wrongMonthDayAttributes 753 | 754 | else 755 | [ TestHelper.dayInMonthAttr ] 756 | , if picker.today == day then 757 | TestHelper.todayAttr 758 | :: extAttrs settings.todayDayAttributes 759 | 760 | else 761 | [] 762 | , if config.selected == Just day then 763 | TestHelper.selectedAttr 764 | :: extAttrs settings.selectedDayAttributes 765 | 766 | else 767 | [] 768 | , if settings.disabled day then 769 | extAttrs settings.disabledDayAttributes 770 | 771 | else 772 | [ Events.onClick <| config.onChange <| DateChanged day, Element.pointer ] 773 | ] 774 | in 775 | Element.el attributesForThisDay 776 | (Element.text <| Date.formatMaybeLanguage settings.language "dd" day) 777 | 778 | 779 | 780 | -- ADDITIONAL HELPERS 781 | 782 | 783 | extAttrs : List (Attribute Never) -> List (Attribute msg) 784 | extAttrs = 785 | List.map (Element.mapAttribute never) 786 | 787 | 788 | extEle : Element Never -> Element msg 789 | extEle = 790 | Element.map never 791 | 792 | 793 | {-| This is used, to prevent that the picker is closed unexpectedly. 794 | -} 795 | preventDefaultOnMouseDown : Config msg -> Attribute msg 796 | preventDefaultOnMouseDown config = 797 | Element.htmlAttribute <| 798 | Html.Events.preventDefaultOn "mousedown" <| 799 | Decode.succeed ( config.onChange <| PickerChanged NothingToDo, True ) 800 | --------------------------------------------------------------------------------