From 071b07463ab3f6894928b13553e98cd47c9ccb18 Mon Sep 17 00:00:00 2001
From: Joris
Date: Tue, 28 Jun 2016 00:32:37 +0200
Subject: Add tooltips

---
 src/client/elm/Dialog/AddPaymentButton/View.elm |  22 +++--
 src/client/elm/Init.elm                         |   5 +-
 src/client/elm/LoggedIn/Home/Header/View.elm    |   1 +
 src/client/elm/LoggedIn/Home/View/Table.elm     |  16 ++--
 src/client/elm/Main.elm                         |   8 +-
 src/client/elm/Model.elm                        |   9 +-
 src/client/elm/Model/Size.elm                   |  17 ++++
 src/client/elm/Msg.elm                          |   4 +-
 src/client/elm/Tooltip.elm                      | 113 ++++++++++++++++++++++++
 src/client/elm/Update.elm                       |  15 +++-
 src/client/elm/View.elm                         |   2 +
 src/client/js/main.js                           |   3 +-
 src/server/Design/Global.hs                     |   2 +
 src/server/Design/Tooltip.hs                    |  16 ++++
 src/server/Model/Message/Key.hs                 |   3 +
 src/server/Model/Message/Translations.hs        |  15 ++++
 16 files changed, 229 insertions(+), 22 deletions(-)
 create mode 100644 src/client/elm/Model/Size.elm
 create mode 100644 src/client/elm/Tooltip.elm
 create mode 100644 src/server/Design/Tooltip.hs

(limited to 'src')

diff --git a/src/client/elm/Dialog/AddPaymentButton/View.elm b/src/client/elm/Dialog/AddPaymentButton/View.elm
index 5da380c..16616fe 100644
--- a/src/client/elm/Dialog/AddPaymentButton/View.elm
+++ b/src/client/elm/Dialog/AddPaymentButton/View.elm
@@ -13,6 +13,10 @@ import Form.Field as Field exposing (Field)
 import Utils.Form as Form
 
 import Dialog
+import Dialog.Model as DialogModel
+import Dialog.Msg as DialogMsg
+
+import Tooltip
 
 import View.Form as Form
 import View.Events exposing (onSubmitPrevDefault)
@@ -25,14 +29,11 @@ import Model.Translations exposing (getMessage)
 import Model.Payment as Payment exposing (Frequency(..))
 import Model.View exposing (View(LoggedInView))
 
-import Dialog.Model as DialogModel
-import Dialog.Msg as DialogMsg
-
 import LoggedData exposing (LoggedData)
 import LoggedIn.Home.Model as HomeModel
 
-view : LoggedData -> List (String, Field) -> String -> Html Msg -> Html Msg
-view loggedData initialForm title buttonContent =
+view : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg
+view loggedData initialForm title buttonContent tooltip =
   let dialogConfig =
         { className = "paymentDialog"
         , title = getMessage title loggedData.translations
@@ -42,9 +43,14 @@ view loggedData initialForm title buttonContent =
         , undo = getMessage "Undo" loggedData.translations
         }
   in  button
-        [ class "addPayment"
-        , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset initialForm))
-        ]
+        (  ( case tooltip of
+               Just message -> Tooltip.show Msg.Tooltip message
+               Nothing -> []
+           )
+        ++ [ class "addPayment"
+           , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset initialForm))
+           ]
+         )
         [ buttonContent ]
 
 addPaymentForm : LoggedData -> Form String DialogModel.AddPayment -> Html Msg
diff --git a/src/client/elm/Init.elm b/src/client/elm/Init.elm
index 8c148c0..9c6fc3b 100644
--- a/src/client/elm/Init.elm
+++ b/src/client/elm/Init.elm
@@ -10,18 +10,21 @@ import Json.Decode as Json exposing ((:=))
 import Model.Translations exposing (..)
 import Model.Conf exposing (..)
 import Model.InitResult exposing (..)
+import Model.Size exposing (..)
 
 type alias Init =
   { time : Time
   , translations : Translations
   , conf : Conf
   , result : InitResult
+  , windowSize : Size
   }
 
 decoder : Json.Decoder Init
 decoder =
-  Json.object4 Init
+  Json.object5 Init
     ("time" := Json.float)
     ("translations" := translationsDecoder)
     ("conf" := confDecoder)
     ("result" := initResultDecoder)
+    ("windowSize" := sizeDecoder)
diff --git a/src/client/elm/LoggedIn/Home/Header/View.elm b/src/client/elm/LoggedIn/Home/Header/View.elm
index b23e6fe..6ddd846 100644
--- a/src/client/elm/LoggedIn/Home/Header/View.elm
+++ b/src/client/elm/LoggedIn/Home/Header/View.elm
@@ -54,6 +54,7 @@ searchLine loggedData search frequency =
             (DialogModel.addPaymentInitial loggedData.translations currentDate frequency)
             "AddPayment"
             (text (getMessage "AddPayment" loggedData.translations))
+            Nothing
         ]
 
 searchForm : LoggedData -> Form String Home.Search -> Html Msg
diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm
index ebffeb9..05c9e06 100644
--- a/src/client/elm/LoggedIn/Home/View/Table.elm
+++ b/src/client/elm/LoggedIn/Home/View/Table.elm
@@ -13,6 +13,12 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 
+import Dialog
+import Dialog.Model as DialogModel
+import Dialog.AddPaymentButton.View as AddPaymentButton
+
+import Tooltip
+
 import Msg exposing (Msg)
 
 import LoggedData exposing (LoggedData)
@@ -28,10 +34,6 @@ import Model.User exposing (getUserName)
 import Model.Payment as Payment exposing (..)
 import Model.Translations exposing (getMessage)
 
-import Dialog
-import Dialog.Model as DialogModel
-import Dialog.AddPaymentButton.View as AddPaymentButton
-
 view : LoggedData -> HomeModel.Model -> Payments -> Frequency -> Html Msg
 view loggedData homeModel payments frequency =
   let visiblePayments =
@@ -107,6 +109,7 @@ paymentLine loggedData homeModel frequency payment =
                 (DialogModel.clonePaymentInitial loggedData.translations currentDate payment)
                 "ClonePayment"
                 (FontAwesome.clone Color.chestnutRose 18)
+                (Just (getMessage "Clone" loggedData.translations))
         ]
     , div
         [ class "cell button" ]
@@ -119,6 +122,7 @@ paymentLine loggedData homeModel frequency payment =
                 (DialogModel.editPaymentInitial loggedData.translations payment)
                 "EditPayment"
                 (FontAwesome.edit Color.chestnutRose 18)
+                (Just (getMessage "Edit" loggedData.translations))
         ]
     , div
         [ class "cell button" ]
@@ -135,7 +139,9 @@ paymentLine loggedData homeModel frequency payment =
                     , undo = getMessage "Undo" loggedData.translations
                     }
               in  button
-                    [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ]
+                    (  Tooltip.show Msg.Tooltip (getMessage "Delete" loggedData.translations)
+                    ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ]
+                    )
                     [ FontAwesome.trash Color.chestnutRose 18 ]
         ]
     ]
diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm
index d15813d..fa1415d 100644
--- a/src/client/elm/Main.elm
+++ b/src/client/elm/Main.elm
@@ -10,6 +10,7 @@ import Model exposing (init)
 import Update exposing (update, urlUpdate)
 import View exposing (view)
 import Page
+import Tooltip
 
 main =
   Navigation.programWithFlags (Navigation.makeParser Page.fromHash)
@@ -17,5 +18,10 @@ main =
     , view = view
     , update = update
     , urlUpdate = urlUpdate
-    , subscriptions = \_ -> Time.every 1000 Msg.UpdateTime
+    , subscriptions = (\model ->
+        Sub.batch
+          [ Time.every 1000 Msg.UpdateTime
+          , Sub.map Msg.Tooltip Tooltip.subscription
+          ]
+      )
     }
diff --git a/src/client/elm/Model.elm b/src/client/elm/Model.elm
index 0cd714f..aa4b314 100644
--- a/src/client/elm/Model.elm
+++ b/src/client/elm/Model.elm
@@ -18,11 +18,13 @@ import Model.Conf exposing (..)
 import Model.InitResult exposing (..)
 import LoggedIn.Model as LoggedInModel
 import SignIn.Model as SignInModel
-import Dialog
 
+import Dialog
 import Dialog.Model as DialogModel
 import Dialog.Msg as DialogMsg
 
+import Tooltip
+
 import Utils.Maybe exposing (isJust)
 
 type alias Model =
@@ -32,6 +34,7 @@ type alias Model =
   , conf : Conf
   , page : Page
   , dialog : Dialog.Model DialogModel.Model DialogMsg.Msg Msg
+  , tooltip : Tooltip.Model
   }
 
 init : Json.Value -> Result String Page -> (Model, Cmd Msg)
@@ -42,7 +45,7 @@ init payload result =
           Ok page -> page
       model =
         case Json.decodeValue Init.decoder payload of
-          Ok { time, translations, conf, result } ->
+          Ok { time, translations, conf, result, windowSize } ->
             { view =
                 case result of
                   InitEmpty ->
@@ -56,6 +59,7 @@ init payload result =
             , conf = conf
             , page = page
             , dialog = Dialog.init DialogModel.init Msg.Dialog
+            , tooltip = Tooltip.init windowSize.width windowSize.height
             }
           Err error ->
             { view = SignInView (SignInModel.init (Just error))
@@ -64,5 +68,6 @@ init payload result =
             , conf = { currency = "" }
             , page = page
             , dialog = Dialog.init DialogModel.init Msg.Dialog
+            , tooltip = Tooltip.init 0 0
             }
   in  (model, Cmd.none)
diff --git a/src/client/elm/Model/Size.elm b/src/client/elm/Model/Size.elm
new file mode 100644
index 0000000..b29e90b
--- /dev/null
+++ b/src/client/elm/Model/Size.elm
@@ -0,0 +1,17 @@
+module Model.Size exposing
+  ( Size
+  , sizeDecoder
+  )
+
+import Json.Decode as Json exposing ((:=))
+
+type alias Size =
+  { width: Int
+  , height: Int
+  }
+
+sizeDecoder : Json.Decoder Size
+sizeDecoder =
+  Json.object2 Size
+    ("width" := Json.int)
+    ("height" := Json.int)
diff --git a/src/client/elm/Msg.elm b/src/client/elm/Msg.elm
index a1da7e6..93e7f80 100644
--- a/src/client/elm/Msg.elm
+++ b/src/client/elm/Msg.elm
@@ -9,10 +9,11 @@ import Page exposing (Page)
 import Model.Init exposing (Init)
 
 import Dialog
-
 import Dialog.Model as DialogModel
 import Dialog.Msg as DialogMsg
 
+import Tooltip
+
 import SignIn.Msg as SignInMsg
 import LoggedIn.Msg as LoggedInMsg
 
@@ -26,3 +27,4 @@ type Msg =
   | GoSignInView
   | SignOut
   | Dialog (Dialog.Msg DialogModel.Model DialogMsg.Msg Msg)
+  | Tooltip Tooltip.Msg
diff --git a/src/client/elm/Tooltip.elm b/src/client/elm/Tooltip.elm
new file mode 100644
index 0000000..4f70cda
--- /dev/null
+++ b/src/client/elm/Tooltip.elm
@@ -0,0 +1,113 @@
+module Tooltip exposing
+  ( Msg(..)
+  , Model
+  , init
+  , subscription
+  , update
+  , view
+  , show
+  )
+
+import Platform.Cmd
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Mouse exposing (Position)
+import Window exposing (Size)
+
+type Msg =
+  UpdateMousePosition Position
+  | UpdateWindowSize Size
+  | ShowMessage String
+  | HideMessage
+
+type alias Model =
+  { mousePosition : Maybe Position
+  , windowSize : Size
+  , message : Maybe String
+  }
+
+init : Int -> Int -> Model
+init width height =
+  { mousePosition = Nothing
+  , windowSize =
+      { width = width
+      , height = height
+      }
+  , message = Nothing
+  }
+
+subscription : Sub Msg
+subscription =
+  Sub.batch
+    [ Mouse.moves UpdateMousePosition
+    , Window.resizes UpdateWindowSize
+    ]
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+  case msg of
+    UpdateMousePosition position ->
+      ( { model | mousePosition = Just position }
+      , Cmd.none
+      )
+
+    UpdateWindowSize size ->
+      ( { model | windowSize = size }
+      , Cmd.none
+      )
+
+    ShowMessage message ->
+      ( { model | message = Just message }
+      , Cmd.none
+      )
+
+    HideMessage ->
+      ( { model | message = Nothing }
+      , Cmd.none
+      )
+
+view : Model -> Html Msg
+view { mousePosition, windowSize, message } =
+  case (mousePosition, message) of
+    (Just pos, Just msg) ->
+      div
+        [ class "tooltip"
+        , style
+            [ ("position", "absolute")
+            , horizontalPosition windowSize pos
+            , ("top", px <| pos.y + 15)
+            ]
+        ]
+        [ text msg ]
+    _ ->
+      text ""
+
+horizontalPosition : Size -> Position -> (String, String)
+horizontalPosition size position =
+  if isLeft size position
+    then ("left", px <| position.x + 5)
+    else ("right", px <| size.width - position.x)
+
+verticalPosition : Size -> Position -> (String, String)
+verticalPosition size position =
+  if isTop size position
+    then ("top", px <| position.y + 20)
+    else ("bottom", px <| size.height - position.y + 15)
+
+px : Int -> String
+px n = (toString n) ++ "px"
+
+isLeft : Size -> Position -> Bool
+isLeft { width } { x } = x < width // 2
+
+isTop : Size -> Position -> Bool
+isTop { height } { y } = y < height // 2
+
+show : (Msg -> msg) -> String -> List (Attribute msg)
+show mapMsg message =
+  [ onMouseEnter <| mapMsg <| ShowMessage message
+  , onMouseLeave <| mapMsg <| HideMessage
+  ]
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index 23e0789..817a191 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -28,7 +28,11 @@ import SignIn.Update as SignInUpdate
 import Dialog
 import Dialog.Update as DialogUpdate
 
+import Tooltip
+
 import Utils.Http exposing (errorKey)
+import Utils.Cmd exposing ((:>))
+import Utils.Tuple as Tuple
 
 update : Msg -> Model -> (Model, Cmd Msg)
 update msg model =
@@ -69,9 +73,14 @@ update msg model =
       )
 
     Dialog dialogMsg ->
-      let (newDialog, command) = Dialog.update DialogUpdate.update dialogMsg model.dialog.model model.dialog
-      in  ( { model | dialog = newDialog }
-          , command
+      Dialog.update DialogUpdate.update dialogMsg model.dialog.model model.dialog
+        |> Tuple.mapFst (\dialog -> { model | dialog = dialog })
+        :> update (Tooltip Tooltip.HideMessage)
+
+    Tooltip tooltipMsg ->
+      let (newTooltip, command) = Tooltip.update tooltipMsg model.tooltip
+      in  ( { model | tooltip = newTooltip }
+          , Cmd.map Tooltip command
           )
 
 applySignIn : Model -> SignInMsg.Msg -> Model
diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm
index 6953816..00833cb 100644
--- a/src/client/elm/View.elm
+++ b/src/client/elm/View.elm
@@ -11,6 +11,7 @@ import Msg exposing (Msg)
 import Model.View exposing (..)
 import LoggedData
 import Dialog
+import Tooltip
 
 import View.Header as Header
 
@@ -26,6 +27,7 @@ view model =
     [ Header.view model
     , mainView model
     , Dialog.view model.dialog
+    , Html.map Msg.Tooltip <| Tooltip.view model.tooltip
     ]
 
 mainView : Model -> Html Msg
diff --git a/src/client/js/main.js b/src/client/js/main.js
index 04ccfd0..3c3d797 100644
--- a/src/client/js/main.js
+++ b/src/client/js/main.js
@@ -12,5 +12,6 @@ var app = Elm.Main.fullscreen({
   time: new Date().getTime(),
   translations: JSON.parse(document.getElementById('translations').innerHTML),
   conf: JSON.parse(document.getElementById('conf').innerHTML),
-  result: JSON.parse(document.getElementById('result').innerHTML)
+  result: JSON.parse(document.getElementById('result').innerHTML),
+  windowSize: { width: window.innerWidth, height: window.innerHeight }
 });
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 68d0196..dfe19b0 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -13,6 +13,7 @@ import qualified Design.SignIn as SignIn
 import qualified Design.LoggedIn as LoggedIn
 import qualified Design.Form as Form
 import qualified Design.Dialog as Dialog
+import qualified Design.Tooltip as Tooltip
 
 import Design.Color as Color
 import Design.Helper as Helper
@@ -28,6 +29,7 @@ global = do
   ".signIn" ? SignIn.design
   ".loggedIn" ? LoggedIn.design
   ".dialog" ? Dialog.design
+  ".tooltip" ? Tooltip.design
   Form.design
 
   body ? do
diff --git a/src/server/Design/Tooltip.hs b/src/server/Design/Tooltip.hs
new file mode 100644
index 0000000..1da8764
--- /dev/null
+++ b/src/server/Design/Tooltip.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Design.Tooltip
+  ( design
+  ) where
+
+import Clay
+
+import Design.Color as Color
+
+design :: Css
+design = do
+  backgroundColor Color.mossGreen
+  borderRadius (px 5) (px 5) (px 5) (px 5)
+  padding (px 5) (px 5) (px 5) (px 5)
+  color Color.white
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index b60067c..2723dd5 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -81,6 +81,9 @@ data Key =
   | PaymentPunctual
   | PaymentMonthly
 
+  | Clone
+  | Edit
+  | Delete
   | ConfirmPaymentDelete
 
   -- Statistics
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 3c92601..9b018f6 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -342,6 +342,21 @@ m l ConfirmPaymentDelete =
     English -> "Are you sure to delete this payment ?"
     French  -> "Voulez-vous vraiment supprimer ce paiement ?"
 
+m l Edit =
+  case l of
+    English -> "Edit"
+    French  -> "Modifier"
+
+m l Clone =
+  case l of
+    English -> "Clone"
+    French  -> "Cloner"
+
+m l Delete =
+  case l of
+    English -> "Delete"
+    French  -> "Supprimer"
+
 -- Income
 
 m l CumulativeIncomesSince =
-- 
cgit v1.2.3