From 8e3a7bf1cb83bbb6e3dcd54308eefa52a29cd679 Mon Sep 17 00:00:00 2001 From: Joris Date: Fri, 3 Jun 2016 20:27:16 +0200 Subject: Migrate to elm 0.17 --- src/server/Controller/Index.hs | 2 +- src/server/Cookie.hs | 6 +-- src/server/Design/Color.hs | 33 +++++++------- src/server/Design/Global.hs | 4 +- src/server/Design/Header.hs | 8 ++-- src/server/Design/Helper.hs | 4 +- src/server/Design/LoggedIn/Home/Add.hs | 26 +++++------ src/server/Design/LoggedIn/Home/Expandables.hs | 4 +- src/server/Design/LoggedIn/Home/Pages.hs | 8 ++-- src/server/Design/LoggedIn/Home/Table.hs | 14 +++--- src/server/Design/SignIn.hs | 6 +-- src/server/Main.hs | 61 ++++++++++++-------------- src/server/View/Page.hs | 4 +- 13 files changed, 86 insertions(+), 94 deletions(-) (limited to 'src/server') 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 ".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" -- cgit v1.2.3