Calendar by elm-lang

Calendar.elm

module Calendar exposing (..)

import String
import Html exposing (div, span, node, text, button)
import Html.Attributes exposing (style)
import Html.Events exposing (onClick)

import Array
import Date exposing (Date)
import Date.Extra.Core exposing (daysInMonth, monthToInt, lastOfPrevMonthDate, firstOfNextMonthDate, toFirstOfMonth)
import Date.Extra.Compare exposing (is)
import Task

type alias Model =
  { today: Date
  , current: Date
  }

type Msg
  = CurrentDate Date
  | PrevMonth
  | NextMonth

createDate str =
  Date.fromString str
  |> Result.withDefault (Date.fromTime 0)

init : ( Model, Cmd Msg )
init =
  let
    initDate = createDate "2016/1/1"
  in
    ({ current = initDate, today = initDate }
    , Task.perform (always <| CurrentDate initDate) CurrentDate Date.now
    )
--
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case msg of
    CurrentDate date ->
      ({ model | today = date, current = date }, Cmd.none)
    PrevMonth ->
      ({ model | current = lastOfPrevMonthDate model.current }, Cmd.none)
    NextMonth ->
      ({ model | current = firstOfNextMonthDate model.current }, Cmd.none)

weekDays : List String
weekDays =
  [ "Sun"
  , "Mon"
  , "Tue"
  , "Wed"
  , "Thu"
  , "Fri"
  , "Sat"
  ]

view model =
  let
    currentYear = Date.year model.current
    currentMonth = Date.month model.current
    dates = datesInMonth currentYear currentMonth
    prevMonthDate = lastOfPrevMonthDate model.current
    nextMonthDate = firstOfNextMonthDate model.current
    leftPadding = datesInMonth (Date.year prevMonthDate) (Date.month prevMonthDate)
      |> List.reverse
      |> List.take (paddingLeft (toFirstOfMonth model.current))
      |> List.reverse
    rightPadding = datesInMonth (Date.year nextMonthDate) (Date.month nextMonthDate)
      |> List.take (7 - (paddingLeft nextMonthDate))
    cells = List.map renderCell (leftPadding ++ dates ++ rightPadding)
    title = [toString currentYear, " ", toString currentMonth] |> String.concat
    renderCell date =
      node "ui-calendar-cell" [ cellStyle model date ]
        [date |> Date.day |> toString |> text]
  in
    node "ui-calendar" [ rootStyle ]
      [ node "ui-calendar-header" [ headerStyle ]
        [ button [ onClick PrevMonth, leftIconStyle ] [ text "<" ]
        , div [ titleStyle ]
          [ text title
          , button [ onClick <| CurrentDate model.today ] [ text "Today"  ]
          ]
        , button [ onClick NextMonth, rightIconStyle ] [ text ">" ]
        ]
      , node "ui-calendar-caption" [ captionStyle ]
            (List.map (\item -> span [ captionSpanStyle ] [text item]) weekDays)
      , node "ui-calendar-table" [ tableStyle ] cells
      ]

-- printDate : Date -> String
-- printDate date =
--   [ toString (Date.year date)
--   , "/"
--   , toString (Date.Extra.Core.monthToInt (Date.month date))
--   , "/"
--   , toString (Date.day date)
--   ] |> String.concat

--
datesInMonth : Int -> Date.Month -> List Date
datesInMonth year month =
  let
    dates = daysInMonth year month
    create n =
      [ toString year, "/", toString (monthToInt month), "/", toString n ]
      |> String.concat
      |> createDate
  in
    Array.toList (Array.initialize dates (\n -> n + 1 |> create))
--
paddingLeft : Date -> Int
paddingLeft date =
  case Date.dayOfWeek date of
    Date.Sun -> 0
    Date.Mon -> 1
    Date.Tue -> 2
    Date.Wed -> 3
    Date.Thu -> 4
    Date.Fri -> 5
    Date.Sat -> 6
--

rootStyle =
  style
    [ ("transform", "translate3d(0, 0, 0)")
    , ("display", "inline-block")
    , ("padding", "15px")
    ]
--
headerStyle =
  style
    [ ("display", "flex")
    , ("border-bottom", "1px solid rgba(0,0,0,.1)")
    , ("border-bottom-style", "dashed")
    , ("height", "45px")
    , ("padding", "5px 5px 10px")
    , ("flex-direction", "row")
    ]

leftIconStyle =
  style
    [ ("justify-content", "flex-start")
    , ("display", "flex")
    , ("align-items", "center")
    , ("cursor", "pointer")
    ]

titleStyle =
  style
    [ ("display", "flex")
    , ("justify-content", "center")
    , ("align-items", "center")
    , ("flex", "1")
    ]

rightIconStyle =
  style
    [ ("justify-content", "flex-end")
    , ("display", "flex")
    , ("align-items", "center")
    , ("cursor", "pointer")
    ]

captionStyle =
  style
    [ ("border-bottom", "1px solid rgba(#000, 0.1)")
    , ("border-bottom-style", "dashed")
    , ("justify-content", "space-around")
    , ("margin-bottom", "5px")
    , ("display", "flex")
    , ("width", "300px")
    ]
--
captionSpanStyle =
  style
    [ (" text-align", "center")
    , ("font-weight", "600")
    , ("font-size", "14px")
    , ("margin", "5px 0")
    , ("opacity", "0.7")
    , ("width", "34px")
    ]
--
tableStyle =
  style
    [ ("justify-content", "space-around")
    , ("flex-wrap", "wrap")
    , ("display", "flex")
    , ("width", "300px")
    ]
--

compare : Date -> Date -> Bool
compare base diff =
  let
    baseYear = Date.year base
    baseMonth = Date.month base
    baseDay = Date.day base
    diffYear = Date.year diff
    diffMonth = Date.month diff
    diffDay = Date.day diff
  in
    (baseYear == diffYear)
    && (baseMonth == diffMonth)
    && (baseDay == diffDay)

-- cellStyle Bool ->
cellStyle model compareDay =
  let
    rules =
        [ ("justify-content", "center")
        , ("align-items", "center")
        , ("display", "flex")
        , ("height", "34px")
        , ("width", "34px")
        , ("margin", "4px")
        ] ++
      if (Date.month model.current) == (Date.month compareDay) then
        [ ("color", "black") ]
      else
        [ ("color", "#ccc") ]

  in
    if (compare model.today compareDay) then
      rules ++ [ ("border", "solid 1px #888") ] |> style
    else
      rules |> style