-
Notifications
You must be signed in to change notification settings - Fork 0
/
DatePicker.elm
192 lines (156 loc) · 5.5 KB
/
DatePicker.elm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
module DatePicker where
import Html exposing (Html, table, td, tr, th, div, text, thead, tbody, input)
import Html.Lazy exposing (lazy2)
import Html.Events exposing (onClick, onFocus)
import Html.Attributes exposing (class, colspan, style, value, type', placeholder)
import Date exposing (Date, Day, day, year, month, fromTime)
import Signal exposing (Address)
import Time exposing (Time, timestamp)
import Date.Format exposing (format)
import Localized
import Arithmetic exposing ( dayToInt
, daysOfWeek
, comparableByDay
, groupByWeek
, daysOfTheMonth
, padByStartOfWeek
, getNextMonth
, getPreviousMonth )
--- VIEW ---
renderDay : Address Action -> Model -> Maybe Date -> Html
renderDay address model date =
case date of
Nothing
-> td [] []
Just d
->
let currentDay = model.currentDate |> comparableByDay
selectedDay = model.selectedDate |> Maybe.withDefault model.currentDate |> comparableByDay
renderedDay = d |> day
classes = if | selectedDay == (comparableByDay d) -> "day active"
| otherwise -> "day"
in
td [ onClick address (SelectDate d)
, class classes
]
[renderedDay |> toString |> text]
renderRow : Address Action -> Model -> List (Maybe Date) -> Html
renderRow address model dayList =
tr [] (List.map (renderDay address model) dayList)
renderHeaderRow : Day -> Html
renderHeaderRow startOfWeek =
let days = daysOfWeek ++ daysOfWeek
startIndex = dayToInt startOfWeek
adjustedDays = days |> (List.drop (startIndex - 1)) |> (List.take 7)
localizedDays = List.map (Localized.weekday "en_US") adjustedDays
renderDay d = th [class "dow"] [text d]
in
tr []
(List.map renderDay localizedDays)
renderTable : Address Action -> Model -> List (Maybe Date) -> Html
renderTable address model dayList =
let daysByWeek = groupByWeek dayList []
in
tbody []
([renderHeaderRow model.firstDayOfWeek] ++
(List.map (renderRow address model) daysByWeek))
renderBody : Address Action -> Model -> Html
renderBody address model =
let allDays = daysOfTheMonth model.browseDate
paddedList = padByStartOfWeek model.firstDayOfWeek allDays
in
renderTable address model paddedList
renderCurrentDate : Model -> Html
renderCurrentDate model =
let y = (year model.browseDate)
m = (Localized.month "en_US" (month model.browseDate))
in
text (m ++ " " ++ (toString y))
renderHeader : Address Action -> Model -> Html
renderHeader address model =
thead []
[
tr []
[ th [class "prev", onClick address PreviousMonth] [text "«"]
, th [class "datepicker-switch", colspan 5]
[renderCurrentDate model]
, th [class "next", onClick address NextMonth] [text "»"]
]
]
renderCalendar : Address Action -> Model -> Html
renderCalendar address model =
let disp = if model.showPicker then "block" else "none"
in
div [ class "datepicker datepicker-dropdown dropdown-menu datepicker-orient-left datepicker-orient-top"
, style [ ("display", disp)
, ("top", "25px")
-- , ("left", "120px")
]
]
[ table [class "table-condensed"]
[ renderHeader address model
, renderBody address model
]
]
renderInput : Address Action -> Model -> Html
renderInput address model =
let val = case model.selectedDate of
Nothing
-> []
Just d
-> [value (format "%m/%d/%Y" d)]
in
div [class "hero-unit"]
[
input ([ type' "text"
, placeholder "click to pick a date"
, onFocus address ShowPicker
] ++ val)
[]
]
renderWidget : Address Action -> Model -> Html
renderWidget address model =
div [class "container", style [("position", "relative")]]
[ renderInput address model
, renderCalendar address model
]
view : Address Action -> Model -> Html
view address model = lazy2 renderWidget address model
--- MODEL ---
type alias Model =
{ currentDate : Date
, browseDate : Date
, selectedDate : Maybe Date
, firstDayOfWeek : Date.Day
, showPicker : Bool
}
model : Model
model =
let curDate = (Date.fromTime 0)
in
Model curDate curDate Nothing Date.Mon False
--- UPDATE ---
type Action = PreviousMonth | NextMonth | SelectDate Date | ShowPicker | HidePicker | SampleAndDelegate (Time, Action) | NoOp
update : Action -> Model -> Model
update action model =
case action of
PreviousMonth
-> { model | browseDate <- getPreviousMonth model.browseDate}
NextMonth
-> { model | browseDate <- getNextMonth model.browseDate}
SelectDate date
-> { model | selectedDate <- Just date, showPicker <- False}
ShowPicker
-> { model | showPicker <- True, browseDate <- (Maybe.withDefault model.currentDate model.selectedDate) }
HidePicker
-> { model | showPicker <- False }
SampleAndDelegate (time, act)
-> update act { model | currentDate <- (fromTime time)} -- sample current time and do the action
NoOp
-> model
picker : Signal.Mailbox Action
picker = Signal.mailbox NoOp
signals : Signal Action
signals = Signal.map SampleAndDelegate (timestamp picker.signal)
main : Signal Html
main = Signal.map (view picker.address) (Signal.foldp update model signals)