Commit 8c1f0d14 authored by Cédric F.'s avatar Cédric F.

Refactor some long functions

parent 31ed43ed
Pipeline #5435950 passed with stage
in 1 minute and 6 seconds
......@@ -2,6 +2,7 @@ module Lifechart.Model exposing (..)
import Date exposing (Date)
import Color exposing (Color)
import Color.Convert
import Time exposing (Time)
import Navigation
import DateExtra
......@@ -83,7 +84,7 @@ mergeJsonModel jsonModel =
mergeModel : Model -> Model -> Model
mergeModel newModel baseModel =
mergeModel baseModel newModel =
{ newModel
| eventFormOpen = baseModel.eventFormOpen
, eventForm = baseModel.eventForm
......@@ -92,6 +93,26 @@ mergeModel newModel baseModel =
}
initialEventForm : Model -> EventForm
initialEventForm model =
{ from = DateExtra.toISOString <| Date.fromTime model.now
, to = DateExtra.toISOString <| Date.fromTime model.now
, color = Color.Convert.colorToHex fallbackColor
, label = ""
, overlay = False
}
createEvent : EventForm -> Event
createEvent form =
{ from = DateExtra.fromStringWithFallback form.from (Date.fromTime 0)
, to = DateExtra.fromStringWithFallback form.to (Date.fromTime 0)
, color = Color.Convert.hexToColor form.color |> Maybe.withDefault fallbackColor
, label = form.label
, overlay = form.overlay
}
fallbackColor : Color
fallbackColor =
Color.red
......
......@@ -14,9 +14,7 @@ init : Navigation.Location -> ( Model, Cmd Msg )
init location =
let
model =
decodeModel location
|> Result.toMaybe
|> Maybe.withDefault initialModel
decodeModel location |> Result.toMaybe |> Maybe.withDefault initialModel
in
( model, Task.perform Tick Time.now )
......@@ -29,50 +27,52 @@ update msg model =
NewUrl location ->
let
urlModel =
decodeModel location
|> Result.toMaybe
|> Maybe.withDefault model
newModel =
mergeModel urlModel model
case decodeModel location of
Ok urlModel ->
mergeModel model urlModel
Err _ ->
model
in
( newModel, Cmd.none )
NewBirthDate string ->
case Date.fromString string of
Ok date ->
let
newModel =
{ model
| birthDateString = string
, birthDate = date
}
in
( newModel, updateUrl newModel )
let
stringModel =
{ model | birthDateString = string }
in
case Date.fromString string of
Ok date ->
let
newModel =
{ stringModel | birthDate = date }
in
( newModel, updateUrl newModel )
Err _ ->
( { model | birthDateString = string }, Cmd.none )
Err _ ->
( stringModel, Cmd.none )
NewLifeExpectancy string ->
let
stringModel =
{ model | lifeExpectancyString = string }
int =
String.toInt string |> Result.toMaybe |> Maybe.withDefault 0
in
if int < minLifeExpectancy model || int > 500 then
( { model | lifeExpectancyString = string }, Cmd.none )
( stringModel, Cmd.none )
else
let
newModel =
{ model
| lifeExpectancyString = string
, lifeExpectancy = int
}
{ stringModel | lifeExpectancy = int }
in
( newModel, updateUrl newModel )
HideUnproductiveYears bool ->
let
-- TODO: fix this dirty hack somehow
tempModel =
{ model | hideUnproductiveYears = bool }
......@@ -98,12 +98,7 @@ update msg model =
eventForm =
case event of
Nothing ->
{ from = DateExtra.toISOString <| Date.fromTime model.now
, to = DateExtra.toISOString <| Date.fromTime model.now
, color = Color.Convert.colorToHex fallbackColor
, label = ""
, overlay = False
}
initialEventForm model
Just event ->
{ from = DateExtra.toISOString event.from
......@@ -149,28 +144,20 @@ update msg model =
SaveEvent ->
let
eventForm =
model.eventForm
existingEvent =
model.eventFormOpen /= 0
newEvent =
{ from =
DateExtra.fromStringWithFallback eventForm.from (Date.fromTime 0)
, to =
DateExtra.fromStringWithFallback eventForm.to (Date.fromTime 0)
, color =
Color.Convert.hexToColor eventForm.color |> Maybe.withDefault fallbackColor
, label = eventForm.label
, overlay = eventForm.overlay
}
currentEvent =
createEvent model.eventForm
newEvents =
if model.eventFormOpen == 0 then
model.events
otherEvents =
if existingEvent then
deleteItem (model.eventFormOpen - 1) model.events
else
deleteEvent model.eventFormOpen model.events
model.events
events =
(newEvent :: newEvents)
(currentEvent :: otherEvents)
|> List.sortBy (\event -> DateExtra.toISOString event.from)
newModel =
......@@ -181,7 +168,7 @@ update msg model =
DeleteEvent ->
let
events =
deleteEvent model.eventFormOpen model.events
deleteItem (model.eventFormOpen - 1) model.events
newModel =
{ model | events = events, eventFormOpen = -1 }
......@@ -190,13 +177,13 @@ update msg model =
NewConfig json ->
let
jsonModel =
Serializer.deserializeJson json
|> Result.toMaybe
|> Maybe.withDefault model
newModel =
mergeModel jsonModel model
case Serializer.deserializeJson json of
Ok jsonModel ->
mergeModel model jsonModel
Err _ ->
model
in
( newModel, updateUrl newModel )
......@@ -236,15 +223,15 @@ minLifeExpectancy model =
1
deleteEvent : Int -> List Event -> List Event
deleteEvent index events =
deleteItem : Int -> List a -> List a
deleteItem index list =
List.indexedMap
(\i ->
\event ->
if i + 1 == index then
\item ->
if i == index then
Nothing
else
Just event
Just item
)
events
list
|> List.filterMap identity
......@@ -203,59 +203,39 @@ week model year week =
yearWeekToTime model ( year, week )
match event =
(Date.toTime event.from <= time)
&& (Date.toTime event.to >= time)
(Date.toTime event.from <= time) && (Date.toTime event.to >= time)
( overlays, events ) =
List.filter match model.events |> List.partition .overlay
colors =
List.map .color events
weekColor =
List.head colors |> Maybe.andThen mixColors
mixColors firstColor =
Just <|
List.foldl
(\oldColor ->
\newColor ->
Color.Interpolate.interpolate
Color.Interpolate.HSL
oldColor
newColor
0.5
)
firstColor
(List.drop 1 colors)
List.map .color events |> mixColors
initial =
List.head overlays |> Maybe.andThen makeInitial
makeInitial event =
Just
(eventInitial event
|> Text.fromString
|> Text.monospace
|> Text.height weekWidth
|> Text.bold
|> Text.color Color.white
|> Collage.text
|> Collage.moveY 1
)
square color =
Collage.square weekWidth |> Collage.filled color
letter =
List.head overlays
|> Maybe.andThen
(\overlay ->
Just
(eventInitial overlay
|> Text.fromString
|> Text.monospace
|> Text.height weekWidth
|> Text.bold
|> Text.color Color.white
|> Collage.text
|> Collage.moveY 1
)
)
filled color =
Collage.group <|
case letter of
Nothing ->
[ square color ]
case initial of
Nothing ->
square color
Just letter ->
[ square color, letter ]
Just initial ->
Collage.group [ square color, initial ]
outlined =
Collage.square (weekWidth - weekBorder) |> Collage.outlined lineStyle
......@@ -278,6 +258,27 @@ week model year week =
filled color
mixColors : List Color -> Maybe Color
mixColors colors =
case colors of
[] ->
Nothing
firstColor :: otherColors ->
Just <|
List.foldl
(\oldColor ->
\newColor ->
Color.Interpolate.interpolate
Color.Interpolate.HSL
oldColor
newColor
0.5
)
firstColor
otherColors
outOfBounds : Model -> Time -> Bool
outOfBounds model time =
(time < Date.toTime (relativeBirthDate model))
......
......@@ -309,35 +309,7 @@ events model =
[ div
[ class "row" ]
[ div [ class "col-xs-3" ]
[ div
[ class "float-xs-left"
, style
[ ( "width", "1rem" )
, ( "height", "1rem" )
, ( "line-height", "1rem" )
, ( "font-weight", "bold" )
, ( "color", "#FFFFFF" )
, ( "margin", "3px 0.5rem 0 0" )
, ( "padding"
, if event.overlay then
"0 0 3px 3px"
else
"0"
)
, ( "background-color"
, if event.overlay then
"#000000"
else
Color.Convert.colorToHex event.color
)
]
]
[ text <|
if event.overlay then
eventInitial event
else
""
]
[ eventIcon event
, span [] [ text event.label ]
]
, div [ class "col-xs-7 text-xs-right text-muted" ]
......@@ -361,6 +333,37 @@ events model =
, eventForm model index
]
eventIcon event =
div
[ class "float-xs-left"
, style
[ ( "width", "1rem" )
, ( "height", "1rem" )
, ( "line-height", "1rem" )
, ( "font-weight", "bold" )
, ( "color", "#FFFFFF" )
, ( "margin", "3px 0.5rem 0 0" )
, ( "padding"
, if event.overlay then
"0 0 3px 3px"
else
"0"
)
, ( "background-color"
, if event.overlay then
"#000000"
else
Color.Convert.colorToHex event.color
)
]
]
[ text <|
if event.overlay then
eventInitial event
else
""
]
eventPercentage event model =
100
* (Date.toTime event.to - Date.toTime event.from)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment