Add better input for calendar events

modules/webapp/src/main/elm/Api.elm

@@ -1,6 +1,7 @@
 module Api exposing
     ( cancelJob
     , changePassword
+    , checkCalEvent
     , createMailSettings
     , deleteEquip
     , deleteItem
@@ -65,6 +66,8 @@ module Api exposing
 import Api.Model.AttachmentMeta exposing (AttachmentMeta)
 import Api.Model.AuthResult exposing (AuthResult)
 import Api.Model.BasicResult exposing (BasicResult)
+import Api.Model.CalEventCheck exposing (CalEventCheck)
+import Api.Model.CalEventCheckResult exposing (CalEventCheckResult)
 import Api.Model.Collective exposing (Collective)
 import Api.Model.CollectiveSettings exposing (CollectiveSettings)
 import Api.Model.ContactList exposing (ContactList)
@@ -114,6 +117,24 @@ import Util.Http as Http2
 
 
 
+--- CalEvent
+
+
+checkCalEvent :
+    Flags
+    -> CalEventCheck
+    -> (Result Http.Error CalEventCheckResult -> msg)
+    -> Cmd msg
+checkCalEvent flags input receive =
+    Http2.authPost
+        { url = flags.config.baseUrl ++ "/api/v1/sec/calevent/check"
+        , account = getAccount flags
+        , body = Http.jsonBody (Api.Model.CalEventCheck.encode input)
+        , expect = Http.expectJson receive Api.Model.CalEventCheckResult.decoder
+        }
+
+
+
 --- Attachment Metadata
 
 

modules/webapp/src/main/elm/Comp/CalEventInput.elm

@@ -0,0 +1,325 @@
+module Comp.CalEventInput exposing
+    ( Model
+    , Msg
+    , from
+    , init
+    , update
+    , view
+    )
+
+import Api
+import Api.Model.CalEventCheck exposing (CalEventCheck)
+import Api.Model.CalEventCheckResult exposing (CalEventCheckResult)
+import Data.Flags exposing (Flags)
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (onInput)
+import Http
+import Util.Http
+import Util.Maybe
+import Util.Time
+
+
+type alias Model =
+    { year : String
+    , month : String
+    , day : String
+    , hour : String
+    , minute : String
+    , weekday : Maybe String
+    , event : Maybe String
+    , checkResult : Maybe CalEventCheckResult
+    }
+
+
+type Msg
+    = SetYear String
+    | SetMonth String
+    | SetDay String
+    | SetHour String
+    | SetMinute String
+    | SetWeekday String
+    | CheckInputMsg (Result Http.Error CalEventCheckResult)
+
+
+init : Model
+init =
+    { year = "*"
+    , month = "*"
+    , day = "1"
+    , hour = "0"
+    , minute = "0"
+    , weekday = Nothing
+    , event = Nothing
+    , checkResult = Nothing
+    }
+
+
+from : String -> Maybe Model
+from event =
+    case String.split " " event of
+        date :: time :: [] ->
+            let
+                dateParts =
+                    String.split "-" date
+
+                timeParts =
+                    String.split ":" time
+
+                allParts =
+                    dateParts ++ timeParts
+            in
+            case allParts of
+                y :: m :: d :: h :: min :: [] ->
+                    Just
+                        { init
+                            | year = y
+                            , month = m
+                            , day = d
+                            , hour = h
+                            , minute = min
+                        }
+
+                _ ->
+                    Nothing
+
+        _ ->
+            Nothing
+
+
+toEvent : Model -> String
+toEvent model =
+    let
+        datetime =
+            model.year
+                ++ "-"
+                ++ model.month
+                ++ "-"
+                ++ model.day
+                ++ " "
+                ++ model.hour
+                ++ ":"
+                ++ model.minute
+    in
+    case model.weekday of
+        Just wd ->
+            wd ++ " " ++ datetime
+
+        Nothing ->
+            datetime
+
+
+checkInput : Flags -> Model -> Cmd Msg
+checkInput flags model =
+    let
+        event =
+            toEvent model
+
+        input =
+            CalEventCheck event
+    in
+    Api.checkCalEvent flags input CheckInputMsg
+
+
+withCheckInput : Flags -> Model -> ( Model, Cmd Msg, Maybe String )
+withCheckInput flags model =
+    ( model, checkInput flags model, Nothing )
+
+
+isCheckError : Model -> Bool
+isCheckError model =
+    Maybe.map .success model.checkResult
+        |> Maybe.withDefault True
+        |> not
+
+
+update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Maybe String )
+update flags msg model =
+    case msg of
+        SetYear str ->
+            withCheckInput flags { model | year = str }
+
+        SetMonth str ->
+            withCheckInput flags { model | month = str }
+
+        SetDay str ->
+            withCheckInput flags { model | day = str }
+
+        SetHour str ->
+            withCheckInput flags { model | hour = str }
+
+        SetMinute str ->
+            withCheckInput flags { model | minute = str }
+
+        SetWeekday str ->
+            withCheckInput flags { model | weekday = Util.Maybe.fromString str }
+
+        CheckInputMsg (Ok res) ->
+            let
+                m =
+                    { model
+                        | event = res.event
+                        , checkResult = Just res
+                    }
+            in
+            ( m, Cmd.none, res.event )
+
+        CheckInputMsg (Err err) ->
+            let
+                emptyResult =
+                    Api.Model.CalEventCheckResult.empty
+
+                m =
+                    { model
+                        | event = Nothing
+                        , checkResult =
+                            Just
+                                { emptyResult
+                                    | success = False
+                                    , message = Util.Http.errorToString err
+                                }
+                    }
+            in
+            ( m, Cmd.none, Nothing )
+
+
+view : String -> Model -> Html Msg
+view extraClasses model =
+    let
+        yearLen =
+            Basics.max 4 (String.length model.year)
+
+        otherLen str =
+            Basics.max 2 (String.length str)
+    in
+    div
+        [ classList
+            [ ( extraClasses, True )
+            ]
+        ]
+        [ div [ class "calevent-input" ]
+            [ div []
+                [ label [] [ text "Weekday" ]
+                , input
+                    [ type_ "text"
+                    , class "time-input"
+                    , size
+                        (Maybe.map otherLen model.weekday
+                            |> Maybe.withDefault 4
+                        )
+                    , Maybe.withDefault "" model.weekday
+                        |> value
+                    , onInput SetWeekday
+                    ]
+                    []
+                ]
+            , div []
+                [ label [] [ text "Year" ]
+                , input
+                    [ type_ "text"
+                    , class "time-input"
+                    , size yearLen
+                    , value model.year
+                    , onInput SetYear
+                    ]
+                    []
+                ]
+            , div [ class "date separator" ]
+                [ text "–"
+                ]
+            , div []
+                [ label [] [ text "Month" ]
+                , input
+                    [ type_ "text"
+                    , class "time-input"
+                    , size (otherLen model.month)
+                    , value model.month
+                    , onInput SetMonth
+                    ]
+                    []
+                ]
+            , div [ class "date separator" ]
+                [ text "–"
+                ]
+            , div []
+                [ label [] [ text "Day" ]
+                , input
+                    [ type_ "text"
+                    , class "time-input"
+                    , size (otherLen model.day)
+                    , value model.day
+                    , onInput SetDay
+                    ]
+                    []
+                ]
+            , div [ class "datetime separator" ]
+                [ text "  "
+                ]
+            , div []
+                [ label [] [ text "Hour" ]
+                , input
+                    [ type_ "text"
+                    , class "time-input"
+                    , size (otherLen model.hour)
+                    , value model.hour
+                    , onInput SetHour
+                    ]
+                    []
+                ]
+            , div [ class "time separator" ]
+                [ text ":"
+                ]
+            , div []
+                [ label [] [ text "Minute" ]
+                , input
+                    [ type_ "text"
+                    , class "time-input"
+                    , size (otherLen model.minute)
+                    , value model.minute
+                    , onInput SetMinute
+                    ]
+                    []
+                ]
+            ]
+        , div
+            [ classList
+                [ ( "ui basic red pointing label", True )
+                , ( "hidden invisible", not (isCheckError model) )
+                ]
+            ]
+            [ text "Error: "
+            , Maybe.map .message model.checkResult
+                |> Maybe.withDefault ""
+                |> text
+            ]
+        , div
+            [ classList
+                [ ( "ui  message", True )
+                , ( "hidden invisible"
+                  , model.checkResult == Nothing || isCheckError model
+                  )
+                ]
+            ]
+            [ dl []
+                [ dt []
+                    [ text "Schedule: "
+                    ]
+                , dd []
+                    [ code []
+                        [ Maybe.andThen .event model.checkResult
+                            |> Maybe.withDefault ""
+                            |> text
+                        ]
+                    ]
+                , dt []
+                    [ text "Next: "
+                    ]
+                , dd []
+                    [ Maybe.andThen .next model.checkResult
+                        |> Maybe.map Util.Time.formatDateTime
+                        |> Maybe.withDefault ""
+                        |> text
+                    ]
+                ]
+            ]
+        ]

modules/webapp/src/main/elm/Comp/NotificationForm.elm

@@ -11,6 +11,7 @@ import Api.Model.EmailSettingsList exposing (EmailSettingsList)
 import Api.Model.NotificationSettings exposing (NotificationSettings)
 import Api.Model.Tag exposing (Tag)
 import Api.Model.TagList exposing (TagList)
+import Comp.CalEventInput
 import Comp.Dropdown
 import Comp.EmailInput
 import Comp.IntField
@@ -34,7 +35,8 @@ type alias Model =
     , remindDays : Maybe Int
     , remindDaysModel : Comp.IntField.Model
     , enabled : Bool
-    , timer : String
+    , schedule : String
+    , scheduleModel : Comp.CalEventInput.Model
     , formError : Maybe String
     }
 
@@ -49,7 +51,7 @@ type Msg
     | GetTagsResp (Result Http.Error TagList)
     | RemindDaysMsg Comp.IntField.Msg
     | ToggleEnabled
-    | SetSchedule String
+    | CalEventMsg Comp.CalEventInput.Msg
 
 
 initCmd : Flags -> Cmd Msg
@@ -60,6 +62,11 @@ initCmd flags =
         ]
 
 
+initialSchedule : String
+initialSchedule =
+    "*-*-1/7 12:00"
+
+
 init : Flags -> ( Model, Cmd Msg )
 init flags =
     ( { settings = Api.Model.NotificationSettings.empty
@@ -75,7 +82,10 @@ init flags =
       , remindDays = Just 1
       , remindDaysModel = Comp.IntField.init (Just 1) Nothing True "Remind Days"
       , enabled = False
-      , timer = "*-*-1/7 12:00"
+      , schedule = initialSchedule
+      , scheduleModel =
+            Comp.CalEventInput.from initialSchedule
+                |> Maybe.withDefault Comp.CalEventInput.init
       , formError = Nothing
       }
     , initCmd flags
@@ -85,8 +95,17 @@ init flags =
 update : Flags -> Msg -> Model -> ( Model, Cmd Msg )
 update flags msg model =
     case msg of
-        SetSchedule str ->
+        CalEventMsg lmsg ->
-            ( { model | timer = str }, Cmd.none )
+            let
+                ( cm, cc, cs ) =
+                    Comp.CalEventInput.update flags lmsg model.scheduleModel
+            in
+            ( { model
+                | schedule = Maybe.withDefault model.schedule cs
+                , scheduleModel = cm
+              }
+            , Cmd.map CalEventMsg cc
+            )
 
         RecipientMsg m ->
             let
@@ -229,13 +248,19 @@ view extraClasses model =
                 model.remindDaysModel
             )
         , div [ class "required field" ]
-            [ label [] [ text "Schedule" ]
+            [ label []
-            , input
+                [ text "Schedule"
-                [ type_ "text"
+                , a
-                , onInput SetSchedule
+                    [ class "right-float"
-                , value model.timer
+                    , href "https://github.com/eikek/calev#what-are-calendar-events"
+                    , target "_blank"
                     ]
-                []
+                    [ i [ class "help icon" ] []
+                    , text "Click here for help"
+                    ]
+                ]
+            , Html.map CalEventMsg
+                (Comp.CalEventInput.view "" model.scheduleModel)
             ]
         , div [ class "ui divider" ] []
         , button

modules/webapp/src/main/webjar/docspell.css

@@ -3,6 +3,33 @@
  * https://www.color-hex.com/color-palette/1637
  */
 
+.calevent-input {
+    border: 1px solid rgba(34,36,38,.15);
+    display: flex;
+    flex-direction: row;
+    margin: 0 0 1em;
+}
+.calevent-input input.time-input {
+    border: 0 !important;
+    text-align: center;
+}
+.calevent-input .separator {
+    margin-top: auto;
+    margin-bottom: auto;
+    padding-top: 2%;
+}
+.calevent-input label {
+    display: block;
+    margin: 0;
+    padding: 0;
+    font-size: small;
+    font-weight: 600;
+    text-align: center;
+}
+
+.default-layout .right-float {
+    float: right;
+}
 .default-layout {
     background: #fff;
 /*    height: 100vh; */