This is an alternative site for discovering Elm packages. You may be looking for the official Elm package site instead.

Html.Form.Input.Date

This module implements an input that includes a date picker

The input field

type alias DatePickerInput e = FormElement D.Date e () { displayMonth : D.Month -> String , displayDay : D.Day -> String , defaultDate : D.Date , encoder : D.Date -> String -- must match decoder! }

Spec for date picker input

datePickerInput : DatePickerInput e -> H.Html

An input field that shows a date picker below

Configuration helpers

displayDayGerman : D.Day -> String

Short german week days

displayMonthGerman : D.Month -> String

German month names

module Html.Form.Input.Date
  ( DatePickerInput, datePickerInput
  , displayDayGerman, displayMonthGerman
  ) where
{-| This module implements an input that includes a date picker

# The input field
@docs DatePickerInput, datePickerInput

# Configuration helpers
@docs displayDayGerman, displayMonthGerman
-}
import Date as D
import Date.Core as D
import Date.Field as D
import Html as H
import Html exposing (text)
import Html.Attributes as A
import Html.Events as E
import Html.Form.Input exposing (..)
import Json.Decode as Json
import List as L
import List.Split as L

{-| Spec for date picker input -}
type alias DatePickerInput e =
    FormElement D.Date e ()
    { displayMonth : D.Month -> String
    , displayDay : D.Day -> String
    , defaultDate : D.Date
    , encoder : D.Date -> String -- must match decoder!
    }

{-| Short german week days -}
displayDayGerman : D.Day -> String
displayDayGerman day =
    case day of
      D.Mon -> "Mo"
      D.Tue -> "Di"
      D.Wed -> "Mi"
      D.Thu -> "Do"
      D.Fri -> "Fr"
      D.Sat -> "Sa"
      D.Sun -> "So"

{-| German month names -}
displayMonthGerman : D.Month -> String
displayMonthGerman m =
    case m of
      D.Jan -> "Januar"
      D.Feb -> "Februar"
      D.Mar -> "März"
      D.Apr -> "April"
      D.May -> "Mai"
      D.Jun -> "Juni"
      D.Jul -> "Juli"
      D.Aug -> "August"
      D.Sep -> "September"
      D.Oct -> "Oktober"
      D.Nov -> "November"
      D.Dec -> "Dezember"

{-| An input field that shows a date picker below -}
datePickerInput : DatePickerInput e -> H.Html
datePickerInput dpi =
    formGroup dpi.element <|
    let el = dpi.element
        val = el.value
        apply unfocus d =
            el.onValue <| noFx <| \curVal ->
            { curVal
                | userInput = dpi.props.encoder d
                , value = Ok d
                , focused = not unfocus
            }
    in H.div []
         [ basicInputRaw
             { element = el
             , props = { type' = "text", extraClasses = ["ag-datepicker"] }
             , decoder = dpi.decoder
             , autoBlur = False
             }
         , if val.focused
           then monthTable apply dpi.props.displayDay dpi.props.displayMonth <|
                getFormValueDef dpi.props.defaultDate val
           else H.span [] []
         ]

monthGrid : D.Date -> List (List (Maybe Int))
monthGrid now =
    let first = D.toFirstOfMonth now
        dayOfWeekFirst = D.isoDayOfWeek (D.dayOfWeek first) - 1
        last = D.lastOfMonthDate now
        lastDay = D.day last
        dayOfWeekLast = D.isoDayOfWeek (D.dayOfWeek last) - 1
        lastRowTil = 6 - dayOfWeekLast
        firstRowTil = dayOfWeekFirst
        fullList =
            L.repeat firstRowTil Nothing
            ++ L.map Just [1..lastDay]
            ++ L.repeat lastRowTil Nothing
    in L.chunksOfLeft 7 fullList

monthTable : (Bool -> D.Date -> Signal.Message) -> (D.Day -> String) -> (D.Month -> String) -> D.Date -> H.Html
monthTable changeDate displayDay displayMonth now =
    let month = displayMonth (D.month now)
        day = D.day now
        totalDays = D.daysInMonthDate now
        dayOfWeak = D.isoDayOfWeek (D.dayOfWeek now) - 1
        dayHeaders =
          L.map (\x -> H.td [] [text x])
          [ displayDay D.Mon, displayDay D.Tue, displayDay D.Wed
          , displayDay D.Thu, displayDay D.Fri, displayDay D.Sat, displayDay D.Sun
          ]
        grid = monthGrid now
        calRows =
          flip L.map grid <| \dayRow ->
          H.tr [] (L.map dayCell dayRow)
        dayCell d =
          case d of
            Nothing -> H.td [] []
            Just i ->
              H.td
              [ A.class ("ag-cal-cell " ++ (if i == day then "info ag-cal-cell-active" else ""))
              , E.on "click" Json.value <| \_ -> changeDate True (D.fieldToDateClamp (D.DayOfMonth i) now)
              ]
              [ text (toString i)
              ]
        navButton side f =
           H.button
              [ A.class ("btn btn-default btn-xs ag-cal-nav-btn ag-cal-nav-btn-" ++ side)
              , E.on "click" Json.value <| \_ ->
                changeDate False (f now)
              ]
              [ H.span [ A.class ("glyphicon glyphicon-chevron-" ++ side) ] []
              ]
    in H.div [ A.class "ag-datepicker-table" ]
       [ H.div [ A.class "row" ]
           [ H.div [ A.class "col-xs-3" ]
               [ navButton "left" D.lastOfPrevMonthDate ]
           , H.div [ A.class "col-xs-6" ]
               [ H.h3 [] [ text month, text " ", text (toString <| D.year now) ] ]
           , H.div [ A.class "col-xs-3" ]
               [ navButton "right" D.firstOfNextMonthDate ]
           ]
       , H.table [ A.class "table table-bordered table-condensed"]
          [ H.tbody [] ( H.tr [] dayHeaders :: calRows ) ]
       ]