Migrate to elm 0.17

13 files changed, 86 insertions, 94 deletions

diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index 1e1f942..abb3b17 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -18,7 +18,7 @@ import Conf (Conf(..))
 import qualified LoginSession
 import Secure (getUserFromToken)
 
-import Model.Database
+import Model.Database hiding (Key)
 import qualified Model.Json.Conf as M
 import Model.User (getUser)
 import Model.Message.Key
diff --git a/src/server/Cookie.hs b/src/server/Cookie.hs
index 1495fc1..96d45da 100644
--- a/src/server/Cookie.hs
+++ b/src/server/Cookie.hs
@@ -38,10 +38,10 @@ makeSimpleCookie conf name value =
     , setCookieSecure = Conf.https conf
     }
 
-setCookie :: (Monad m, ScottyError e) => SetCookie -> ActionT e m ()
+setCookie :: (Monad m) => SetCookie -> ActionT e m ()
 setCookie name = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie name)
 
-setSimpleCookie :: (Monad m, ScottyError e) => Conf -> TS.Text -> TS.Text -> ActionT e m ()
+setSimpleCookie :: (Monad m) => Conf -> TS.Text -> TS.Text -> ActionT e m ()
 setSimpleCookie conf name value = setCookie $ makeSimpleCookie conf name value
 
 getCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m (Maybe TS.Text)
@@ -52,5 +52,5 @@ getCookies =
   liftM (Map.fromList . maybe [] parse) $ header "Cookie"
   where parse = parseCookiesText . BSL.toStrict . TL.encodeUtf8
 
-deleteCookie :: (Monad m, ScottyError e) => Conf -> TS.Text -> ActionT e m ()
+deleteCookie :: (Monad m) => Conf -> TS.Text -> ActionT e m ()
 deleteCookie conf name = setCookie $ (makeSimpleCookie conf name "") { setCookieExpires = Just $ posixSecondsToUTCTime 0 }
diff --git a/src/server/Design/Color.hs b/src/server/Design/Color.hs
index b59f738..7520e4e 100644
--- a/src/server/Design/Color.hs
+++ b/src/server/Design/Color.hs
@@ -2,29 +2,28 @@ module Design.Color where
 
 import qualified Clay.Color as C
 
+-- http://chir.ag/projects/name-that-color/#969696
+
 white :: C.Color
 white = C.white
 
-redError :: C.Color
-redError = C.red
-
-red :: C.Color
-red = C.rgb 207 92 86
+chestnutRose :: C.Color
+chestnutRose = C.rgb 207 92 86
 
-green :: C.Color
-green = C.rgb 159 210 165
+mossGreen :: C.Color
+mossGreen = C.rgb 159 210 165
 
-blue :: C.Color
-blue = C.rgb 108 162 164
+gothic :: C.Color
+gothic = C.rgb 108 162 164
 
-paymentFocus :: C.Color
-paymentFocus = C.rgb 255 223 196
+negroni :: C.Color
+negroni = C.rgb 255 223 196
 
-mercury :: C.Color
-mercury = C.rgb 245 245 245
+wildSand :: C.Color
+wildSand = C.rgb 245 245 245
 
-pumice :: C.Color
-pumice = C.rgb 200 200 200
+silver :: C.Color
+silver = C.rgb 200 200 200
 
-mountainMist :: C.Color
-mountainMist = C.rgb 150 150 150
+dustyGray :: C.Color
+dustyGray = C.rgb 150 150 150
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index f27859b..12e20b9 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -36,7 +36,7 @@ global = do
 
   h1 ? do
     fontSize (px 24)
-    color Color.red
+    color Color.chestnutRose
     "margin-bottom" -: "3vh"
 
   ul ? do
@@ -46,7 +46,7 @@ global = do
       "margin-bottom" -: "2vh"
       before & do
         content (stringContent "• ")
-        color Color.red
+        color Color.chestnutRose
         "margin-right" -: "0.3vw"
       ul <? do
         "margin-left" -: "3vh"
diff --git a/src/server/Design/Header.hs b/src/server/Design/Header.hs
index 94334c6..6f0f48e 100644
--- a/src/server/Design/Header.hs
+++ b/src/server/Design/Header.hs
@@ -20,7 +20,7 @@ design = do
   lineHeightMedia
   marginBottom blockMarginBottom
   position relative
-  backgroundColor Color.red
+  backgroundColor Color.chestnutRose
   color Color.white
 
   ".title" <> ".item" ? headerPadding
@@ -38,11 +38,11 @@ design = do
   ".item" ? do
     display inlineBlock
     transition "background-color" (ms 50) easeIn (sec 0)
-    ".current" & backgroundColor (Color.red -. 20)
+    ".current" & backgroundColor (Color.chestnutRose -. 20)
     Media.mobile $ fontSize (px 13)
 
-  (".item" # hover) <> (".item" # focus) ? backgroundColor (Color.red +. 10)
-  (".item.current" # hover) <> (".item.current" # focus) ? backgroundColor (Color.red -. 10)
+  (".item" # hover) <> (".item" # focus) ? backgroundColor (Color.chestnutRose +. 10)
+  (".item.current" # hover) <> (".item.current" # focus) ? backgroundColor (Color.chestnutRose -. 10)
 
   ".nameSignOut" ? do
     display flex
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index 2f0aceb..766fbdb 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -58,8 +58,8 @@ defaultInput h = do
   height (px h)
   padding (px 10) (px 10) (px 10) (px 10)
   borderRadius radius radius radius radius
-  border solid (px 1) Color.mountainMist
-  focus & borderColor Color.pumice
+  border solid (px 1) Color.dustyGray
+  focus & borderColor Color.silver
   verticalAlign middle
 
 centeredWithMargin :: Css
diff --git a/src/server/Design/LoggedIn/Home/Add.hs b/src/server/Design/LoggedIn/Home/Add.hs
index 1a8b499..f4e001f 100644
--- a/src/server/Design/LoggedIn/Home/Add.hs
+++ b/src/server/Design/LoggedIn/Home/Add.hs
@@ -28,7 +28,7 @@ design = do
       display inlineBlock
       width (px 50)
       textAlign (alignSide sideCenter)
-      backgroundColor Color.mountainMist
+      backgroundColor Color.dustyGray
       color Color.white
       height (px inputHeight)
       lineHeight (px inputHeight)
@@ -40,10 +40,10 @@ design = do
       defaultInput inputHeight
       borderRadius radius (px 0) (px 0) radius
       "width" -: "calc(100% - 40px)"
-    "input:focus + label" ? backgroundColor Color.pumice
+    "input:focus + label" ? backgroundColor Color.silver
     hover & do
-      input ? borderColor Color.pumice
-      label ? backgroundColor Color.pumice
+      input ? borderColor Color.silver
+      label ? backgroundColor Color.silver
 
   ".name" ? minWidth (px 150)
 
@@ -52,36 +52,36 @@ design = do
     marginRight (pct blockPercentMargin)
 
     (".punctual" <> ".monthly") ? do
-      defaultButton Color.mercury Color.mountainMist (px $ inputHeight `Prelude.div` 2) focusLighten
+      defaultButton Color.wildSand Color.dustyGray (px $ inputHeight `Prelude.div` 2) focusLighten
       paddingLeft (px 15)
       paddingRight (px 15)
       ".selected" & do
-        backgroundColor Color.blue
+        backgroundColor Color.gothic
         color Color.white
 
     hover & (".punctual" <> ".monthly") ?
-      ".selected" & backgroundColor (focusLighten Color.blue)
+      ".selected" & backgroundColor (focusLighten Color.gothic)
 
     focus & (".punctual" <> ".monthly") ?
-      ".selected" & backgroundColor (focusLighten Color.blue)
+      ".selected" & backgroundColor (focusLighten Color.gothic)
 
     ".punctual" ? borderRadius radius radius 0 0
     ".monthly" ? borderRadius 0 0 radius radius
 
   button # ".add" ? do
-    defaultButton Color.red Color.white (px inputHeight) focusLighten
+    defaultButton Color.chestnutRose Color.white (px inputHeight) focusLighten
     paddingLeft (px 15)
     paddingRight (px 15)
     i ? marginLeft (px 10)
     ".waitingServer" & ("cursor" -: "not-allowed")
 
   ".name.error" <> ".cost.error" ? do
-    input ? borderColor Color.redError
-    label ? backgroundColor Color.redError
-    "input:focus + label" ? backgroundColor Color.redError
+    input ? borderColor Color.chestnutRose
+    label ? backgroundColor Color.chestnutRose
+    "input:focus + label" ? backgroundColor Color.chestnutRose
 
   ".errorMessage" ? do
     position absolute
-    color Color.redError
+    color Color.chestnutRose
     top (px (inputHeight + 10))
     left (px 0)
diff --git a/src/server/Design/LoggedIn/Home/Expandables.hs b/src/server/Design/LoggedIn/Home/Expandables.hs
index dc36392..635a4a7 100644
--- a/src/server/Design/LoggedIn/Home/Expandables.hs
+++ b/src/server/Design/LoggedIn/Home/Expandables.hs
@@ -18,10 +18,10 @@ design = do
     right blockPadding
     bottom (px 2)
 
-  ".monthlyPayments" ? expandBlock Color.blue Color.white (px inputHeight)
+  ".monthlyPayments" ? expandBlock Color.gothic Color.white (px inputHeight)
 
   ".account" ? do
-    expandBlock Color.green Color.white (px inputHeight)
+    expandBlock Color.mossGreen Color.white (px inputHeight)
     ".userName" ? marginRight (px 10)
 
   ".detail" |> ".header" ? borderRadius radius radius 0 0
diff --git a/src/server/Design/LoggedIn/Home/Pages.hs b/src/server/Design/LoggedIn/Home/Pages.hs
index f95a925..1d5899f 100644
--- a/src/server/Design/LoggedIn/Home/Pages.hs
+++ b/src/server/Design/LoggedIn/Home/Pages.hs
@@ -17,9 +17,9 @@ design = do
   clearFix
 
   ".page" ? do
-    defaultButton Color.white Color.mountainMist (px 50) focusDarken
+    defaultButton Color.white Color.dustyGray (px 50) focusDarken
     display inlineBlock
-    border solid (px 2) Color.mountainMist
+    border solid (px 2) Color.dustyGray
     marginRight (px 10)
     paddingLeft (px 10)
     paddingRight (px 10)
@@ -28,5 +28,5 @@ design = do
     ":not(.current)" & cursor pointer
 
     ".current" & do
-      borderColor Color.red
-      color Color.red
+      borderColor Color.chestnutRose
+      color Color.chestnutRose
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index e7a00d1..d13ab85 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -26,7 +26,7 @@ design = do
 
   ".header" ? do
     fontWeight bold
-    backgroundColor Color.blue
+    backgroundColor Color.gothic
     color Color.white
     fontSize iconFontSize
     lineHeight headerHeight
@@ -46,7 +46,7 @@ design = do
 
         width (px borderW)
         height (px rowHeightPx)
-        backgroundColor Color.green
+        backgroundColor Color.mossGreen
 
       ".cell:first-child::after" ? do
         display block
@@ -59,12 +59,12 @@ design = do
         height (px 0)
         borderTop solid (px triangleH) transparent
         borderBottom solid (px triangleH) transparent
-        borderLeft solid (px triangleW) Color.green
+        borderLeft solid (px triangleW) Color.mossGreen
 
     nthChild "odd" & do
-      backgroundColor Color.mercury
+      backgroundColor Color.wildSand
     ".edition" & do
-      backgroundColor Color.paymentFocus
+      backgroundColor Color.negroni
       ".delete" |> button ? visibility visible
 
   ".cell" ? do
@@ -73,7 +73,7 @@ design = do
     ".category" & width (pct 40)
     ".cost" & do
       width (pct 17)
-      ".refund" & color Color.green
+      ".refund" & color Color.mossGreen
     ".user" & width (pct 20)
     ".date" & do
       width (pct 20)
@@ -88,7 +88,7 @@ design = do
       width (pct 3)
       textAlign (alignSide sideCenter)
       button ? do
-        defaultButton Color.red Color.white (px rowHeightPx) focusLighten
+        defaultButton Color.chestnutRose Color.white (px rowHeightPx) focusLighten
         borderRadius (px 0) (px 0) (px 0) (px 0)
         position absolute
         top (px 0)
diff --git a/src/server/Design/SignIn.hs b/src/server/Design/SignIn.hs
index 479008a..2856016 100644
--- a/src/server/Design/SignIn.hs
+++ b/src/server/Design/SignIn.hs
@@ -27,7 +27,7 @@ design = do
       marginBottom (px 10)
 
     button ? do
-      iconButton Color.blue Color.white (px inputHeight) focusLighten
+      iconButton Color.gothic Color.white (px inputHeight) focusLighten
       display block
       width (pct 100)
       fontSize (em 1.2)
@@ -36,5 +36,5 @@ design = do
   ".result" ? do
     marginTop (px 40)
     textAlign (alignSide sideCenter)
-    ".success" ? color Color.green
-    ".error" ? color Color.redError
+    ".success" ? color Color.mossGreen
+    ".error" ? color Color.chestnutRose
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 0642288..5524ba7 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -22,7 +22,6 @@ import Controller.Income
 import Model.Database (runMigrations)
 import Model.Frequency
 
-import Conf (Conf)
 import qualified Conf
 
 main :: IO ()
@@ -38,9 +37,7 @@ main = do
         middleware $
           staticPolicy (noDots >-> addBase "public")
 
-        api conf
-
-        notFound $
+        get "/" $
           ( do
               signInToken <- param "signInToken" :: ActionM Text
               status ok200
@@ -50,45 +47,41 @@ main = do
             getIndex conf Nothing
           )
 
-api :: Conf -> ScottyM ()
-api conf = do
-  -- Sign
-
-  post "/api/signIn" $ do
-    email <- param "email" :: ActionM Text
-    signIn conf email
+        post "/signIn" $ do
+          email <- param "email" :: ActionM Text
+          signIn conf email
 
-  post "/api/signOut" (signOut conf)
+        post "/signOut" (signOut conf)
 
-  -- Users
+        -- Users
 
-  get "/api/users"  getUsers
+        get "/users"  getUsers
 
-  get "/api/whoAmI" whoAmI
+        get "/whoAmI" whoAmI
 
-  -- Incomes
+        -- Incomes
 
-  get "/api/incomes" getIncomes
+        get "/incomes" getIncomes
 
-  post "/api/income" $ do
-    creation <- param "creation" :: ActionM Int
-    amount <- param "amount" :: ActionM Int
-    addIncome (posixSecondsToUTCTime $ (fromIntegral creation) / 1000) amount
+        post "/income" $ do
+          creation <- param "creation" :: ActionM Int
+          amount <- param "amount" :: ActionM Int
+          addIncome (posixSecondsToUTCTime $ (fromIntegral creation) / 1000) amount
 
-  delete "/api/income/delete" $ do
-    incomeId <- param "id" :: ActionM Text
-    deleteOwnIncome incomeId
+        delete "/income" $ do
+          incomeId <- param "id" :: ActionM Text
+          deleteOwnIncome incomeId
 
-  -- Payments
+        -- Payments
 
-  get "/api/payments" getPayments
+        get "/payments" getPayments
 
-  post "/api/payment/add" $ do
-    name <- param "name" :: ActionM Text
-    cost <- param "cost" :: ActionM Text
-    frequency <- param "frequency" :: ActionM Frequency
-    createPayment name cost frequency
+        post "/payment/add" $ do
+          name <- param "name" :: ActionM Text
+          cost <- param "cost" :: ActionM Text
+          frequency <- param "frequency" :: ActionM Frequency
+          createPayment name cost frequency
 
-  post "/api/payment/delete" $ do
-    paymentId <- param "id" :: ActionM Text
-    deleteOwnPayment paymentId
+        delete "/payment" $ do
+          paymentId <- param "id" :: ActionM Text
+          deleteOwnPayment paymentId
diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs
index 33e32f7..17c59c0 100644
--- a/src/server/View/Page.hs
+++ b/src/server/View/Page.hs
@@ -31,9 +31,9 @@ page conf initResult =
       meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
       H.title (toHtml $ getMessage SharedCost)
       script ! src "javascripts/client.js" $ ""
-      jsonScript "messages" getTranslations
+      jsonScript "translations" getTranslations
       jsonScript "conf" conf
-      jsonScript "initResult" initResult
+      jsonScript "result" initResult
       link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css"
       link ! rel "stylesheet" ! href "css/font-awesome-4.5.0/css/font-awesome.min.css"
       link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"