diff --git a/css/elm-range-datepicker.css b/css/elm-range-datepicker.css new file mode 100644 index 0000000..70356cb --- /dev/null +++ b/css/elm-range-datepicker.css @@ -0,0 +1,112 @@ +.elm-datepicker--container { + position: relative; } + +.elm-datepicker--pickers-container { + position: absolute; + border: 1px solid #CCC; + max-width: 420px; + outline: 0; } + +.elm-datepicker--input { + display: block; } + +.elm-datepicker--input:focus { + outline: 0; } + +.elm-datepicker--picker { + position: relative; + max-width: 190px; + display: inline-block; + margin: 10px; + z-index: 10; + outline: 0;} + +.elm-datepicker--picker-header { + display: flex; + align-items: center; } + +.elm-datepicker--prev-container, +.elm-datepicker--next-container { + flex: 0 1 auto; } + +.elm-datepicker--month-container { + flex: 1 1 auto; + padding: 0.5em; + display: flex; + flex-direction: column; } + +.elm-datepicker--month, +.elm-datepicker--year { + flex: 1 1 auto; + cursor: default; + text-align: center; } + +.elm-datepicker--year { + font-size: 0.6em; + font-weight: 700; } + +.elm-datepicker--prev, +.elm-datepicker--next { + border: 6px solid transparent; + display: block; + width: 0; + height: 0; + padding: 0 0.2em; } + +.elm-datepicker--prev { + border-right-color: #AAA; } + .elm-datepicker--prev:hover { + border-right-color: #BBB; } + +.elm-datepicker--next { + border-left-color: #AAA; } + .elm-datepicker--next:hover { + border-left-color: #BBB; } + +.elm-datepicker--table { + border-spacing: 0; + border-collapse: collapse; + font-size: 0.8em; } + .elm-datepicker--table td { + width: 2em; + height: 2em; + text-align: center; } + +.elm-datepicker--row { + border-top: 1px solid #F2F2F2; } + +.elm-datepicker--dow { + border-bottom: 1px solid #CCC; + cursor: default; } + +.elm-datepicker--day { + cursor: pointer; } + .elm-datepicker--day:hover { + background: #F2F2F2; } + +.elm-datepicker--range { + background: #F2F2F2; } + +.elm-datepicker--disabled { + cursor: default; + color: #DDD; } + .elm-datepicker--disabled:hover { + background: inherit; } + +.elm-datepicker--picked { + color: white; + background: darkblue; } + .elm-datepicker--picked:hover { + background: darkblue; } + +.elm-datepicker--today { + font-weight: bold; } + +.elm-datepicker--other-month { + color: #AAA; + cursor: default; + visibility: hidden; } + .elm-datepicker--other-month.elm-datepicker--disabled { + color: #EEE; } + .elm-datepicker--other-month.elm-datepicker--picked { + color: white; } diff --git a/elm-package.json b/elm-package.json index 420ea29..fdb730b 100644 --- a/elm-package.json +++ b/elm-package.json @@ -8,7 +8,8 @@ "src" ], "exposed-modules": [ - "DatePicker" + "DatePicker", + "RangeDatePicker" ], "dependencies": { "elm-lang/core": "5.0.0 <= v < 6.0.0", diff --git a/examples/Makefile b/examples/Makefile index 4098649..06cd1e2 100644 --- a/examples/Makefile +++ b/examples/Makefile @@ -1,4 +1,4 @@ -all: simple-example bootstrap-example range-example simple-nightwatch-example +all: simple-example bootstrap-example range-example range2-example simple-nightwatch-example simple-example: cd .. && elm make --warn examples/simple/Simple.elm --output=examples/simple/simple.js @@ -9,5 +9,8 @@ bootstrap-example: range-example: cd .. && elm make --warn examples/range/Range.elm --output=examples/range/range.js +range2-example: + cd .. && elm make --warn examples/range2/Range2.elm --output=examples/range2/range2.js + simple-nightwatch-example: cd .. && elm make --warn examples/simple-nightwatch/SimpleNightwatch.elm --output=examples/simple-nightwatch/simple-nightwatch.js diff --git a/examples/range2/.gitignore b/examples/range2/.gitignore new file mode 100644 index 0000000..14ade9f --- /dev/null +++ b/examples/range2/.gitignore @@ -0,0 +1 @@ +range2.js \ No newline at end of file diff --git a/examples/range2/Range2.elm b/examples/range2/Range2.elm new file mode 100644 index 0000000..21cf48a --- /dev/null +++ b/examples/range2/Range2.elm @@ -0,0 +1,93 @@ +module Range2 exposing (main) + +import Date exposing (Date, Day(..), day, dayOfWeek, month, year) +import Html exposing (Html, div, h1, text) +import RangeDatePicker as DatePicker exposing (DateEvent(..), defaultSettings) + + +type Msg + = ToDatePicker DatePicker.Msg + + +type alias Model = + { startDate : Maybe Date + , finishDate : Maybe Date + , datePicker : DatePicker.DatePicker + } + + +settings : DatePicker.Settings +settings = + defaultSettings + + +init : ( Model, Cmd Msg ) +init = + let + ( datePicker, datePickerFx ) = + DatePicker.init + in + { startDate = Nothing + , finishDate = Nothing + , datePicker = datePicker + } + ! [ Cmd.map ToDatePicker datePickerFx ] + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg ({ startDate, finishDate, datePicker } as model) = + case msg of + ToDatePicker msg -> + let + ( newDatePicker, datePickerFx, dateEvent ) = + DatePicker.update settings msg datePicker + in + case dateEvent of + Changed startDate finishDate -> + { model + | startDate = startDate + , finishDate = finishDate + , datePicker = newDatePicker + } + ! [ Cmd.map ToDatePicker datePickerFx ] + + _ -> + { model + | datePicker = newDatePicker + } + ! [ Cmd.map ToDatePicker datePickerFx ] + + +view : Model -> Html Msg +view ({ startDate, finishDate, datePicker } as model) = + div [] + [ case startDate of + Nothing -> + h1 [] [ text "Pick a date" ] + + Just date -> + h1 [] [ text <| formatDate date ] + , case finishDate of + Nothing -> + h1 [] [ text "Pick a date" ] + + Just date -> + h1 [] [ text <| formatDate date ] + , DatePicker.view startDate finishDate settings datePicker + |> Html.map ToDatePicker + ] + + +formatDate : Date -> String +formatDate d = + toString (month d) ++ " " ++ toString (day d) ++ ", " ++ toString (year d) + + +main : Program Never Model Msg +main = + Html.program + { init = init + , update = update + , view = view + , subscriptions = always Sub.none + } diff --git a/examples/range2/index.html b/examples/range2/index.html new file mode 100644 index 0000000..6b724d6 --- /dev/null +++ b/examples/range2/index.html @@ -0,0 +1,41 @@ + + + + + elm-datepicker example + + + + + + + + + + +
+
+
+
+ + + + + diff --git a/src/DatePicker.elm b/src/DatePicker.elm index b0454ec..7efd8e8 100644 --- a/src/DatePicker.elm +++ b/src/DatePicker.elm @@ -1,23 +1,23 @@ module DatePicker exposing - ( Msg - , Settings - , DateEvent(..) + ( DateEvent(..) , DatePicker + , Msg + , Settings + , between , defaultSettings + , focusedDate + , from , init , initFromDate , initFromDates - , update - , view - , pick , isOpen - , between , moreOrLess , off - , from + , pick , to - , focusedDate + , update + , view ) {-| A customizable date picker component. @@ -38,8 +38,8 @@ module DatePicker import Date exposing (Date, Day(..), Month, day, month, year) import DatePicker.Date exposing (..) import Html exposing (..) -import Html.Attributes as Attrs exposing (href, placeholder, tabindex, type_, value, selected) -import Html.Events exposing (on, onBlur, onClick, onInput, onFocus, onWithOptions, targetValue) +import Html.Attributes as Attrs exposing (href, placeholder, selected, tabindex, type_, value) +import Html.Events exposing (on, onBlur, onClick, onFocus, onInput, onWithOptions, targetValue) import Html.Keyed import Json.Decode as Json import Task @@ -84,10 +84,12 @@ type alias Model = , forceOpen : Bool , focused : Maybe Date - -- date currently center-focused by picker, but not necessarily chosen + + -- date currently center-focused by picker, but not necessarily chosen , today : Date - -- actual, current day as far as we know + + -- actual, current day as far as we know } @@ -97,18 +99,15 @@ type DatePicker = DatePicker Model -{-| A record of default settings for the date picker. Extend this if +{-| A record of default settings for the date picker. Extend this if you want to customize your date picker. - import DatePicker exposing (defaultSettings) DatePicker.init { defaultSettings | placeholder = "Pick a date" } - To disable certain dates: - import Date exposing (Day(..), dayOfWeek) import DatePicker exposing (defaultSettings) @@ -144,7 +143,6 @@ yearRangeActive yearRange = {-| Select a range of date to display - DatePicker.init { defaultSettings | changeYear = between 1555 2018 } -} @@ -158,7 +156,6 @@ between start end = {-| Select a symmetric range of date to display - DatePicker.init { defaultSettings | changeYear = moreOrLess 10 } -} @@ -169,7 +166,6 @@ moreOrLess range = {-| Select a range from a given year to this year - DatePicker.init { defaultSettings | changeYear = from 1995 } -} @@ -180,7 +176,6 @@ from year = {-| Select a range from this year to a given year - DatePicker.init { defaultSettings | changeYear = to 2020 } -} @@ -191,7 +186,6 @@ to year = {-| Turn off the date range - DatePicker.init { defaultSettings | changeYear = off } -} @@ -205,16 +199,16 @@ formatCell day = text day -{-| The default initial state of the Datepicker. You must execute +{-| The default initial state of the Datepicker. You must execute the returned command (which, for the curious, sets the current date) for the date picker to behave correctly. init = - let - (datePicker, datePickerFx) = - DatePicker.init - in - { picker = datePicker } ! [ Cmd.map ToDatePicker datePickerfx ] + let + ( datePicker, datePickerFx ) = + DatePicker.init + in + { picker = datePicker } ! [ Cmd.map ToDatePicker datePickerfx ] -} init : ( DatePicker, Cmd Msg ) @@ -232,7 +226,7 @@ init = {-| Initialize a DatePicker with a given Date init date = - { picker = DatePicker.initFromDate date } ! [ ] + { picker = DatePicker.initFromDate date } ! [] -} initFromDate : Date -> DatePicker @@ -248,7 +242,7 @@ initFromDate date = {-| Initialize a DatePicker with a date for today and Maybe a date picked init today date = - { picker = DatePicker.initFromDates today date } ! [] + { picker = DatePicker.initFromDates today date } ! [] -} initFromDates : Date -> Maybe Date -> DatePicker @@ -270,13 +264,12 @@ prepareDates date firstDayOfWeek = end = nextMonth date |> addDays 6 in - { currentMonth = date - , currentDates = datesInRange firstDayOfWeek start end - } + { currentMonth = date + , currentDates = datesInRange firstDayOfWeek start end + } -{-| -Expose if the datepicker is open +{-| Expose if the datepicker is open -} isOpen : DatePicker -> Bool isOpen (DatePicker model) = @@ -291,7 +284,7 @@ focusedDate (DatePicker model) = {-| A sugaring of `Maybe` to explicitly tell you how to interpret `Changed Nothing`, because `Just Nothing` seems somehow wrong. - Used to represent a request, by the datepicker, to change the selected date. +Used to represent a request, by the datepicker, to change the selected date. -} type DateEvent = NoChange @@ -299,7 +292,7 @@ type DateEvent {-| The date picker update function. The third tuple member represents a user action to change the - date. +date. -} update : Settings -> Msg -> DatePicker -> ( DatePicker, Cmd Msg, DateEvent ) update settings msg (DatePicker ({ forceOpen, focused } as model)) = @@ -342,19 +335,19 @@ update settings msg (DatePicker ({ forceOpen, focused } as model)) = ) |> Result.withDefault NoChange in - ( DatePicker <| - { model - | focused = - case dateEvent of - Changed _ -> - Nothing - - NoChange -> - model.focused - } - , Cmd.none - , dateEvent - ) + ( DatePicker <| + { model + | focused = + case dateEvent of + Changed _ -> + Nothing + + NoChange -> + model.focused + } + , Cmd.none + , dateEvent + ) Focus -> { model | open = True, forceOpen = False } ! [] @@ -370,15 +363,16 @@ update settings msg (DatePicker ({ forceOpen, focused } as model)) = {-| Generate a message that will act as if the user has chosen a certain date, - so you can call `update` on the model yourself. - Note that this is different from just changing the "current chosen" date, - since the picker doesn't actually have internal state for that. - Rather, it will: - * change the calendar focus - * replace the input text with the new value - * close the picker +so you can call `update` on the model yourself. +Note that this is different from just changing the "current chosen" date, +since the picker doesn't actually have internal state for that. +Rather, it will: +* change the calendar focus +* replace the input text with the new value +* close the picker update datepickerSettings (pick (Just someDate)) datepicker + -} pick : Maybe Date -> Msg pick = @@ -427,13 +421,13 @@ view pickedDate settings (DatePicker ({ open } as model)) = |> value ] in - div [ class "container" ] - [ dateInput - , if open then - datePicker pickedDate settings model - else - text "" - ] + div [ class "container" ] + [ dateInput + , if open then + datePicker pickedDate settings model + else + text "" + ] datePicker : Maybe Date -> Settings -> Model -> Html Msg @@ -483,18 +477,18 @@ datePicker pickedDate settings ({ focused, today } as model) = else [] in - td - ([ classList - [ ( "day", True ) - , ( "disabled", disabled ) - , ( "picked", picked d ) - , ( "today", dateTuple d == dateTuple currentDate ) - , ( "other-month", month currentMonth /= month d ) - ] - ] - ++ props - ) - [ settings.cellFormatter <| toString <| Date.day d ] + td + ([ classList + [ ( "day", True ) + , ( "disabled", disabled ) + , ( "picked", picked d ) + , ( "today", dateTuple d == dateTuple currentDate ) + , ( "other-month", month currentMonth /= month d ) + ] + ] + ++ props + ) + [ settings.cellFormatter <| toString <| Date.day d ] row days = tr [ class "row" ] (List.map day days) @@ -528,42 +522,42 @@ datePicker pickedDate settings ({ focused, today } as model) = (yearRange { focused = currentDate, currentMonth = currentMonth } settings.changeYear) ) in - div - [ class "picker" - , onPicker "mousedown" MouseDown - , onPicker "mouseup" MouseUp - ] - [ div [ class "picker-header" ] - [ div [ class "prev-container" ] - [ arrow "prev" (ChangeFocus (prevMonth currentDate)) ] - , div [ class "month-container" ] - [ span [ class "month" ] - [ text <| settings.monthFormatter <| month currentMonth ] - , span [ class "year" ] - [ if not (yearRangeActive settings.changeYear) then - text <| settings.yearFormatter <| year currentMonth - else - Html.Keyed.node "span" [] [ ( toString (year currentMonth), dropdownYear ) ] - ] + div + [ class "picker" + , onPicker "mousedown" MouseDown + , onPicker "mouseup" MouseUp + ] + [ div [ class "picker-header" ] + [ div [ class "prev-container" ] + [ arrow "prev" (ChangeFocus (prevMonth currentDate)) ] + , div [ class "month-container" ] + [ span [ class "month" ] + [ text <| settings.monthFormatter <| month currentMonth ] + , span [ class "year" ] + [ if not (yearRangeActive settings.changeYear) then + text <| settings.yearFormatter <| year currentMonth + else + Html.Keyed.node "span" [] [ ( toString (year currentMonth), dropdownYear ) ] ] - , div [ class "next-container" ] - [ arrow "next" (ChangeFocus (nextMonth currentDate)) ] ] - , table [ class "table" ] - [ thead [ class "weekdays" ] - [ tr [] - [ dow <| firstDay - , dow <| addDows 1 firstDay - , dow <| addDows 2 firstDay - , dow <| addDows 3 firstDay - , dow <| addDows 4 firstDay - , dow <| addDows 5 firstDay - , dow <| addDows 6 firstDay - ] + , div [ class "next-container" ] + [ arrow "next" (ChangeFocus (nextMonth currentDate)) ] + ] + , table [ class "table" ] + [ thead [ class "weekdays" ] + [ tr [] + [ dow <| firstDay + , dow <| addDows 1 firstDay + , dow <| addDows 2 firstDay + , dow <| addDows 3 firstDay + , dow <| addDows 4 firstDay + , dow <| addDows 5 firstDay + , dow <| addDows 6 firstDay ] - , tbody [ class "days" ] days ] + , tbody [ class "days" ] days ] + ] {-| Turn a list of dates into a list of date rows with 7 columns per @@ -583,7 +577,7 @@ groupDates dates = else go (i + 1) xs (x :: racc) acc in - go 0 dates [] [] + go 0 dates [] [] mkClass : Settings -> String -> Html.Attribute msg diff --git a/src/DatePicker/Date.elm b/src/DatePicker/Date.elm index ad7e253..9b07c91 100644 --- a/src/DatePicker/Date.elm +++ b/src/DatePicker/Date.elm @@ -1,23 +1,23 @@ module DatePicker.Date exposing ( YearRange(..) - , initDate - , formatDate - , formatDay - , formatMonth , addDays , addDows - , subDays , dateTuple , datesInRange , firstOfMonth - , prevMonth - , nextMonth + , formatDate + , formatDay + , formatMonth + , initDate , newYear + , nextMonth + , prevMonth + , subDays , yearRange ) -import Date exposing (Date, Day(..), Month(..), year, month, day) +import Date exposing (Date, Day(..), Month(..), day, month, year) type alias Year = @@ -139,10 +139,10 @@ trimDates firstDay dates = else dr xs in - dl dates - |> List.reverse - |> dr - |> List.reverse + dl dates + |> List.reverse + |> dr + |> List.reverse datesInRange : Date.Day -> Date -> Date -> List Date @@ -153,13 +153,13 @@ datesInRange firstDay min max = y = subDay x in - if dateTuple y == dateTuple min then - y :: acc - else - go y (y :: acc) + if dateTuple y == dateTuple min then + y :: acc + else + go y (y :: acc) in - go max [] - |> trimDates firstDay + go max [] + |> trimDates firstDay dateTuple : Date -> ( Int, Int, Int ) @@ -176,7 +176,7 @@ repeat f = else go (n - 1) (f x) in - go + go firstOfMonth : Date -> Date @@ -196,7 +196,7 @@ nextMonth date = else year date in - mkDate nextYear nextMonth 1 + mkDate nextYear nextMonth 1 prevMonth : Date -> Date @@ -211,7 +211,7 @@ prevMonth date = else year date in - mkDate prevYear prevMonth 1 + mkDate prevYear prevMonth 1 addDays : Int -> Date -> Date @@ -243,10 +243,10 @@ addDay date = else year in - if day > dim then - mkDate succYear succ 1 - else - mkDate year month day + if day > dim then + mkDate succYear succ 1 + else + mkDate year month day subDays : Int -> Date -> Date @@ -275,10 +275,10 @@ subDay date = else year in - if day < 1 then - mkDate predYear pred (daysInMonth predYear pred) - else - mkDate year month day + if day < 1 then + mkDate predYear pred (daysInMonth predYear pred) + else + mkDate year month day addDows : Int -> Date.Day -> Date.Day @@ -306,10 +306,10 @@ predDow day = (dayToInt day - 1) |> flip rem 7 in - if prev == 0 then - Sun - else - dayFromInt prev + if prev == 0 then + Sun + else + dayFromInt prev dayToString : Int -> String @@ -379,10 +379,10 @@ monthToString month = int = monthToInt month in - if int < 10 then - "0" ++ toString int - else - toString int + if int < 10 then + "0" ++ toString int + else + toString int predMonth : Month -> Month @@ -392,10 +392,10 @@ predMonth month = (monthToInt month - 1) |> flip rem 12 in - if prev == 0 then - Dec - else - monthFromInt prev + if prev == 0 then + Dec + else + monthFromInt prev succMonth : Month -> Month @@ -564,14 +564,14 @@ newYear currentMonth newYear = mkDate year (month currentMonth) (day currentMonth) Err _ -> - Debug.crash ("Unknown Month " ++ (toString currentMonth)) + Debug.crash ("Unknown Month " ++ toString currentMonth) yearRange : { focused : Date, currentMonth : Date } -> YearRange -> List Int yearRange { focused, currentMonth } range = case range of MoreOrLess num -> - List.range ((year currentMonth) - num) ((year currentMonth) + num) + List.range (year currentMonth - num) (year currentMonth + num) Between start end -> List.range start end diff --git a/src/RangeDatePicker.elm b/src/RangeDatePicker.elm new file mode 100644 index 0000000..eaf0068 --- /dev/null +++ b/src/RangeDatePicker.elm @@ -0,0 +1,775 @@ +module RangeDatePicker + exposing + ( DateEvent(..) + , DatePicker + , Msg + , Settings + , between + , defaultSettings + , focusedDate + , from + , init + , initFromDate + , initFromDates + , isOpen + , moreOrLess + , off + , pick + , to + , update + , view + ) + +{-| A customizable date picker component. + + +# Tea ☕ + +@docs Msg, DateEvent, DatePicker +@docs init, initFromDate, initFromDates, update, view, isOpen, focusedDate + + +# Settings + +@docs Settings, defaultSettings, pick, between, moreOrLess, from, to, off + +-} + +import Date exposing (Date, Day(..), Month, day, month, year) +import DatePicker.Date exposing (..) +import Html exposing (..) +import Html.Attributes as Attrs exposing (defaultValue, href, placeholder, selected, tabindex, type_, value) +import Html.Events exposing (on, onBlur, onClick, onFocus, onInput, onMouseOver, onWithOptions, targetValue) +import Html.Keyed +import Json.Decode as Json +import Task + + +{-| An opaque type representing messages that are passed inside the DatePicker. +-} +type Msg + = CurrentDate Date + | ChangeFirstFocus Date + | ChangeSecondFocus Date + | Pick (Maybe Date) (Maybe Date) (Maybe Date) WhichPicker + | Text String + | SubmitText + | Focus + | Blur + | MouseDown + | MouseUp + | Over (Maybe Date) + + +{-| The type of date picker settings. +-} +type alias Settings = + { placeholder : String + , classNamespace : String + , inputClassList : List ( String, Bool ) + , inputName : Maybe String + , inputId : Maybe String + , inputAttributes : List (Html.Attribute Msg) + , isDisabled : Date -> Bool + , parser : String -> Result String Date + , dateFormatter : Date -> String + , dayFormatter : Day -> String + , monthFormatter : Month -> String + , yearFormatter : Int -> String + , cellFormatter : String -> Html Msg + , firstDayOfWeek : Day + , changeYear : YearRange + } + + +type alias Model = + { open : Bool + , forceOpen : Bool + , firstFocused : + Maybe Date + + -- date currently center-focused by first picker, but not necessarily chosen + , secondFocused : + Maybe Date + + -- date currently center-focused by second picker, but not necessarily chosen + , inputText : + Maybe String + + -- for user input that hasn't yet been submitted + , today : + Date + + -- actual, current day as far as we know + , hoverDate : Maybe Date + + -- date currently hovered by mouse, but not necessarily chosen + } + + +{-| The DatePicker model. Opaque, hence no field docs. +-} +type DatePicker + = DatePicker Model + + +type WhichPicker + = FirstPicker + | SecondPicker + + +{-| A record of default settings for the date picker. Extend this if +you want to customize your date picker. + + import DatePicker exposing (defaultSettings) + + DatePicker.init { defaultSettings | placeholder = "Pick a date" } + +To disable certain dates: + + import Date exposing (Day(..), dayOfWeek) + import DatePicker exposing (defaultSettings) + + DatePicker.init { defaultSettings | isDisabled = \d -> dayOfWeek d `List.member` [ Sat, Sun ] } + +-} +defaultSettings : Settings +defaultSettings = + { placeholder = "Please pick a date..." + , classNamespace = "elm-datepicker--" + , inputClassList = [] + , inputName = Nothing + , inputId = Nothing + , inputAttributes = + [ Attrs.required False + ] + , isDisabled = always False + , parser = Date.fromString + , dateFormatter = formatDate + , dayFormatter = formatDay + , monthFormatter = formatMonth + , yearFormatter = toString + , cellFormatter = formatCell + , firstDayOfWeek = Sun + , changeYear = off + } + + +yearRangeActive : YearRange -> Bool +yearRangeActive yearRange = + yearRange /= Off + + +{-| Select a range of date to display + + DatePicker.init { defaultSettings | changeYear = between 1555 2018 } + +-} +between : Int -> Int -> YearRange +between start end = + if start > end then + Between end start + else + Between start end + + +{-| Select a symmetric range of date to display + + DatePicker.init { defaultSettings | changeYear = moreOrLess 10 } + +-} +moreOrLess : Int -> YearRange +moreOrLess range = + MoreOrLess range + + +{-| Select a range from a given year to this year + + DatePicker.init { defaultSettings | changeYear = from 1995 } + +-} +from : Int -> YearRange +from year = + From year + + +{-| Select a range from this year to a given year + + DatePicker.init { defaultSettings | changeYear = to 2020 } + +-} +to : Int -> YearRange +to year = + To year + + +{-| Turn off the date range + + DatePicker.init { defaultSettings | changeYear = off } + +-} +off : YearRange +off = + Off + + +formatCell : String -> Html Msg +formatCell day = + text day + + +{-| The default initial state of the Datepicker. You must execute +the returned command (which, for the curious, sets the current date) +for the date picker to behave correctly. + + init = + let + ( datePicker, datePickerFx ) = + DatePicker.init + in + { picker = datePicker } ! [ Cmd.map ToDatePicker datePickerfx ] + +-} +init : ( DatePicker, Cmd Msg ) +init = + ( DatePicker <| + { open = False + , forceOpen = False + , secondFocused = Just initDate + , firstFocused = Just initDate + , inputText = Nothing + , today = initDate + , hoverDate = Nothing + } + , Task.perform CurrentDate Date.now + ) + + +{-| Initialize a DatePicker with a given Date + + init date = + { picker = DatePicker.initFromDate date } ! [] + +-} +initFromDate : Date -> DatePicker +initFromDate date = + DatePicker <| + { open = False + , forceOpen = False + , secondFocused = Just date + , firstFocused = Just date + , inputText = Nothing + , today = date + , hoverDate = Nothing + } + + +{-| Initialize a DatePicker with a date for today and Maybe a date picked + + init today date = + { picker = DatePicker.initFromDates today date } ! [] + +-} +initFromDates : Date -> Maybe Date -> DatePicker +initFromDates today date = + DatePicker <| + { open = False + , forceOpen = False + , secondFocused = date + , firstFocused = date + , inputText = Nothing + , today = today + , hoverDate = Nothing + } + + +prepareDates : Date -> Day -> { currentMonth : Date, currentDates : List Date } +prepareDates date firstDayOfWeek = + let + start = + firstOfMonth date |> subDays 6 + + end = + nextMonth date |> addDays 6 + in + { currentMonth = date + , currentDates = datesInRange firstDayOfWeek start end + } + + +{-| Expose if the datepicker is open +-} +isOpen : DatePicker -> Bool +isOpen (DatePicker model) = + model.open + + +{-| Expose the currently focused dates +-} +focusedDate : DatePicker -> ( Maybe Date, Maybe Date ) +focusedDate (DatePicker model) = + (,) model.firstFocused model.secondFocused + + +{-| A sugaring of `Maybe` to explicitly tell you how to interpret `Changed Nothing`, because `Just Nothing` seems somehow wrong. +Used to represent a request, by the datepicker, to change the selected date. +-} +type DateEvent + = NoChange + | Changed (Maybe Date) (Maybe Date) + + +inDirection : Maybe Date -> Maybe Date -> ( Maybe Date, Maybe Date, Bool ) +inDirection firstDate secondDate = + if + Maybe.map2 (<) (Maybe.map dateTuple firstDate) (Maybe.map dateTuple secondDate) + |> Maybe.withDefault True + then + ( firstDate, secondDate, True ) + else + ( secondDate, firstDate, False ) + + +{-| The date picker update function. The third tuple member represents a user action to change the +date. +-} +update : Settings -> Msg -> DatePicker -> ( DatePicker, Cmd Msg, DateEvent ) +update settings msg (DatePicker ({ forceOpen, firstFocused, secondFocused } as model)) = + case msg of + CurrentDate date -> + { model + | firstFocused = Just date + , secondFocused = Just (nextMonth date) + , today = date + } + ! [] + + ChangeFirstFocus date -> + { model | firstFocused = Just date } ! [] + + ChangeSecondFocus date -> + { model | secondFocused = Just date } ! [] + + Pick firstDate secondDate date whichPicker -> + let + ( startDate, finishDate, _ ) = + inDirection firstDate secondDate + + dateEvent = + case startDate of + Nothing -> + Changed date Nothing + + _ -> + case finishDate of + Nothing -> + let + ( earlierDate, laterDate, _ ) = + inDirection startDate date + in + Changed earlierDate laterDate + + _ -> + Changed date Nothing + in + ( DatePicker <| + { model + | inputText = Nothing + } + , Cmd.none + , dateEvent + ) + + Text text -> + { model | inputText = Just text } ! [] + + SubmitText -> + let + isWhitespace = + String.trim >> String.isEmpty + + dateEvent = + let + text = + model.inputText ?> "" + in + if isWhitespace text then + Changed Nothing Nothing + else + let + startDate = + settings.parser (Maybe.withDefault "" (List.head (String.words text))) + + finishDate = + settings.parser (Maybe.withDefault "" (List.head (List.reverse (String.words text)))) + in + Result.map2 + (\firstDate secondDate -> + if settings.isDisabled firstDate then + Changed Nothing Nothing + else + let + ( startDate, finishDate, _ ) = + inDirection (Just firstDate) (Just secondDate) + in + Changed startDate finishDate + ) + startDate + finishDate + |> Result.withDefault NoChange + in + ( DatePicker <| + { model + | inputText = + Nothing + , firstFocused = + case dateEvent of + Changed a _ -> + a + + NoChange -> + model.firstFocused + , secondFocused = + case dateEvent of + Changed _ b -> + b + + NoChange -> + model.secondFocused + } + , Cmd.none + , dateEvent + ) + + Focus -> + { model | open = True, forceOpen = False } ! [] + + Blur -> + { model | open = forceOpen } ! [] + + MouseDown -> + { model | forceOpen = True } ! [] + + MouseUp -> + { model | forceOpen = False } ! [] + + Over date -> + { model | hoverDate = date } ! [] + + +{-| Generate a message that will act as if the user has chosen a certain date, +so you can call `update` on the model yourself. +Note that this is different from just changing the "current chosen" date, +since the picker doesn't actually have internal state for that. +Rather, it will: + + - change the calendar focus + + - replace the input text with the new value + + - close the picker + + update datepickerSettings (pick firstPickedDate secondPickedDate (Just someDate)) datepicker + +-} +pick : Maybe Date -> Maybe Date -> Maybe Date -> WhichPicker -> Msg +pick = + Pick + + +{-| The date picker view. The Date passed is whatever date it should treat as selected. +-} +view : Maybe Date -> Maybe Date -> Settings -> DatePicker -> Html Msg +view firstDate secondDate settings (DatePicker ({ open } as model)) = + let + class = + mkClass settings + + potentialInputId = + settings.inputId + |> Maybe.map Attrs.id + |> (List.singleton >> List.filterMap identity) + + inputClasses = + [ ( settings.classNamespace ++ "input", True ) ] + ++ settings.inputClassList + + inputCommon xs = + input + ([ Attrs.classList inputClasses + , Attrs.name (settings.inputName ?> "") + , type_ "text" + , on "change" (Json.succeed SubmitText) + , onInput Text + , onBlur Blur + , onClick Focus + , onFocus Focus + ] + ++ settings.inputAttributes + ++ potentialInputId + ++ xs + ) + [] + + dateInput = + inputCommon + [ placeholder settings.placeholder + , model.inputText + |> Maybe.withDefault + ((Maybe.map settings.dateFormatter firstDate + |> Maybe.withDefault "..." + ) + ++ " to " + ++ (Maybe.map settings.dateFormatter secondDate + |> Maybe.withDefault "..." + ) + ) + |> value + ] + in + Html.Keyed.node "div" + [ class "container" ] + [ ( "dateInput", dateInput ) + , if open then + ( "doublePicker" + , div + [ class "pickers-container" ] + [ datePicker firstDate secondDate settings model model.firstFocused ChangeFirstFocus FirstPicker + , datePicker firstDate secondDate settings model model.secondFocused ChangeSecondFocus SecondPicker + ] + ) + else + ( "text", text "" ) + ] + + +datePicker : Maybe Date -> Maybe Date -> Settings -> Model -> Maybe Date -> (Date -> Msg) -> WhichPicker -> Html Msg +datePicker firstDate secondDate settings ({ today, hoverDate } as model) focused changeFocusMsg whichPicker = + let + currentDate = + focused ??> firstDate ?> today + + { currentMonth, currentDates } = + prepareDates currentDate settings.firstDayOfWeek + + class = + mkClass settings + + classList = + mkClassList settings + + firstDay = + settings.firstDayOfWeek + + arrow className message = + a + [ class className + , href "javascript:;" + , onClick message + , tabindex -1 + ] + [] + + dow d = + td [ class "dow" ] [ text <| settings.dayFormatter d ] + + inRange d = + let + ( startDate, finishDate, _ ) = + inDirection firstDate secondDate + in + case startDate of + Nothing -> + False + + _ -> + case finishDate of + Nothing -> + let + ( _, _, isLaterThenStart ) = + inDirection startDate d + + ( _, _, isEarlierThenHover ) = + inDirection d hoverDate + in + if + (isLaterThenStart && isEarlierThenHover) + || (not isLaterThenStart && not isEarlierThenHover) + then + True + else + False + + _ -> + let + ( _, _, isLaterThenStart ) = + inDirection startDate d + + ( _, _, isEarlierThenFinish ) = + inDirection d finishDate + in + if isLaterThenStart && isEarlierThenFinish then + True + else + False + + picked d = + (firstDate + |> Maybe.map + (dateTuple >> (==) (dateTuple d)) + |> Maybe.withDefault False + ) + || (secondDate + |> Maybe.map + (dateTuple >> (==) (dateTuple d)) + |> Maybe.withDefault False + ) + + day d = + let + disabled = + settings.isDisabled d + + props = + if not disabled && (month currentMonth == month d) then + [ onClick (Pick firstDate secondDate (Just d) whichPicker) + , onMouseOver (Over (Just d)) + ] + else + [] + in + td + ([ classList + [ ( "day", True ) + , ( "disabled", disabled ) + , ( "picked", picked d ) + , ( "today", dateTuple d == dateTuple today ) + , ( "other-month", month currentMonth /= month d ) + , ( "range", inRange (Just d) ) + ] + ] + ++ props + ) + [ settings.cellFormatter <| toString <| Date.day d ] + + row days = + tr [ class "row" ] (List.map day days) + + days = + List.map row (groupDates currentDates) + + onPicker ev = + Json.succeed + >> onWithOptions ev + { preventDefault = False + , stopPropagation = True + } + + onChange handler = + on "change" <| Json.map handler targetValue + + isCurrentYear selectedYear = + year currentMonth == selectedYear + + yearOption index selectedYear = + ( toString index + , option [ value (toString selectedYear), selected (isCurrentYear selectedYear) ] + [ text <| toString selectedYear ] + ) + + dropdownYear = + Html.Keyed.node "select" + [ onChange (newYear currentDate >> changeFocusMsg), class "year-menu" ] + (List.indexedMap yearOption + (yearRange { focused = currentDate, currentMonth = currentMonth } settings.changeYear) + ) + in + div + [ class "picker" + , onPicker "mousedown" MouseDown + , onPicker "mouseup" MouseUp + , tabindex 2 + , onBlur Blur + ] + [ div [ class "picker-header" ] + [ div [ class "prev-container" ] + [ arrow "prev" (changeFocusMsg (prevMonth currentDate)) ] + , div [ class "month-container" ] + [ span [ class "month" ] + [ text <| settings.monthFormatter <| month currentMonth ] + , span [ class "year" ] + [ if not (yearRangeActive settings.changeYear) then + text <| settings.yearFormatter <| year currentMonth + else + Html.Keyed.node "span" [] [ ( toString (year currentMonth), dropdownYear ) ] + ] + ] + , div [ class "next-container" ] + [ arrow "next" (changeFocusMsg (nextMonth currentDate)) ] + ] + , table [ class "table" ] + [ thead [ class "weekdays" ] + [ tr [] + [ dow <| firstDay + , dow <| addDows 1 firstDay + , dow <| addDows 2 firstDay + , dow <| addDows 3 firstDay + , dow <| addDows 4 firstDay + , dow <| addDows 5 firstDay + , dow <| addDows 6 firstDay + ] + ] + , tbody [ class "days" ] days + ] + ] + + +{-| Turn a list of dates into a list of date rows with 7 columns per +row representing each day of the week. +-} +groupDates : List Date -> List (List Date) +groupDates dates = + let + go i xs racc acc = + case xs of + [] -> + List.reverse acc + + x :: xs -> + if i == 6 then + go 0 xs [] (List.reverse (x :: racc) :: acc) + else + go (i + 1) xs (x :: racc) acc + in + go 0 dates [] [] + + +mkClass : Settings -> String -> Html.Attribute msg +mkClass { classNamespace } c = + Attrs.class (classNamespace ++ c) + + +mkClassList : Settings -> List ( String, Bool ) -> Html.Attribute msg +mkClassList { classNamespace } cs = + List.map (\( c, b ) -> ( classNamespace ++ c, b )) cs + |> Attrs.classList + + +(!) : Model -> List (Cmd Msg) -> ( DatePicker, Cmd Msg, DateEvent ) +(!) m cs = + ( DatePicker m, Cmd.batch cs, NoChange ) + + +(?>) : Maybe a -> a -> a +(?>) = + flip Maybe.withDefault + + +(??>) : Maybe a -> Maybe a -> Maybe a +(??>) first default = + case first of + Just val -> + Just val + + Nothing -> + default