Skip to content

Instantly share code, notes, and snippets.

@yhsiang
Last active June 28, 2016 02:29
Show Gist options
  • Save yhsiang/2838c86acc392255b5bec71cfdfda927 to your computer and use it in GitHub Desktop.
Save yhsiang/2838c86acc392255b5bec71cfdfda927 to your computer and use it in GitHub Desktop.
Calendar by elm-lang
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment