aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--README.md2
-rw-r--r--client/src/Component/Input.hs57
-rw-r--r--client/src/Icon.hs6
-rw-r--r--client/src/View/Payment.hs26
-rw-r--r--client/src/View/Payment/Header.hs25
-rw-r--r--client/src/View/Payment/Pages.hs37
-rw-r--r--client/src/View/Payment/Table.hs9
-rw-r--r--client/src/View/SignIn.hs2
-rw-r--r--common/src/Common/Message/Key.hs2
-rw-r--r--common/src/Common/Message/Translation.hs2
-rw-r--r--common/src/Common/Util/Text.hs8
-rw-r--r--server/migrations/1.sql65
-rw-r--r--server/src/Design/Global.hs26
-rw-r--r--server/src/Design/Helper.hs29
-rw-r--r--server/src/Design/View/Header.hs8
-rw-r--r--server/src/Design/View/Payment/Header.hs34
-rw-r--r--server/src/Job/Model.hs14
17 files changed, 243 insertions, 109 deletions
diff --git a/README.md b/README.md
index e9762ea..aa60885 100644
--- a/README.md
+++ b/README.md
@@ -26,7 +26,7 @@ Start the environment with:
Init the database with migration scripts:
```bash
-sqlite3 database < src/migrations/x.sql
+sqlite3 database < server/migrations/1.sql
```
Inside the tmux session, add some users with sqlite after the migration is done:
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 1923463..7eec7d0 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -4,13 +4,19 @@ module Component.Input
, input
) where
-import Data.Text (Text)
-import Reflex.Dom (Dynamic, Event, MonadWidget, (&), (.~), (=:))
-import qualified Reflex.Dom as R
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import Reflex.Dom (Dynamic, Event, MonadWidget, (&), (.~))
+import qualified Reflex.Dom as R
+
+import Component.Button (ButtonIn (..), ButtonOut (..))
+import qualified Component.Button as Button
+import qualified Icon
data InputIn t a b = InputIn
- { _inputIn_reset :: Event t a
- , _inputIn_placeHolder :: Text
+ { _inputIn_reset :: Event t a
+ , _inputIn_label :: Text
}
data InputOut t = InputOut
@@ -19,13 +25,34 @@ data InputOut t = InputOut
}
input :: forall t m a b. MonadWidget t m => InputIn t a b -> m (InputOut t)
-input inputIn = do
- let placeHolder = R.constDyn ("placeHolder" =: _inputIn_placeHolder inputIn)
- let value = fmap (const "") (_inputIn_reset inputIn)
- textInput <- R.textInput $ R.def & R.attributes .~ placeHolder
- & R.setValue .~ value
- let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
- return $ InputOut
- { _inputOut_value = R._textInput_value textInput
- , _inputOut_enter = enter
- }
+input inputIn =
+ R.divClass "textInput" $ do
+ rec
+ let resetValue = R.leftmost
+ [ fmap (const "") (_inputIn_reset inputIn)
+ , fmap (const "") (_buttonOut_clic reset)
+ ]
+
+ attributes = R.ffor value (\v ->
+ if T.null v then M.empty else M.singleton "class" "filled")
+
+ value = R._textInput_value textInput
+
+ textInput <- R.textInput $ R.def
+ & R.attributes .~ attributes
+ & R.setValue .~ resetValue
+
+ R.el "label" $ R.text (_inputIn_label inputIn)
+
+ reset <- Button.button $ ButtonIn
+ { _buttonIn_class = R.constDyn ""
+ , _buttonIn_content = Icon.cross
+ , _buttonIn_waiting = R.never
+ }
+
+ let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
+
+ return $ InputOut
+ { _inputOut_value = value
+ , _inputOut_enter = enter
+ }
diff --git a/client/src/Icon.hs b/client/src/Icon.hs
index e04e2a8..555d928 100644
--- a/client/src/Icon.hs
+++ b/client/src/Icon.hs
@@ -1,5 +1,6 @@
module Icon
( clone
+ , cross
, delete
, edit
, loading
@@ -21,6 +22,11 @@ clone =
svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
svgAttr "path" (M.fromList [("d", "M15.143 13.244l.837-2.244 2.698 5.641-5.678 2.502.805-2.23s-8.055-3.538-7.708-10.913c2.715 5.938 9.046 7.244 9.046 7.244zm8.857-7.244v18h-18v-6h-6v-18h18v6h6zm-2 2h-12.112c-.562-.578-1.08-1.243-1.521-2h7.633v-4h-14v14h4v-3.124c.6.961 1.287 1.823 2 2.576v6.548h14v-14z")]) $ R.blank
+cross :: forall t m. MonadWidget t m => m ()
+cross =
+ svgAttr "svg" (M.fromList [ ("width", "15"), ("height", "15"), ("viewBox", "0 0 1792 1792") ]) $
+ svgAttr "path" (M.fromList [("d", "M1490 1322q0 40-28 68l-136 136q-28 28-68 28t-68-28l-294-294-294 294q-28 28-68 28t-68-28l-136-136q-28-28-28-68t28-68l294-294-294-294q-28-28-28-68t28-68l136-136q28-28 68-28t68 28l294 294 294-294q28-28 68-28t68 28l136 136q28 28 28 68t-28 68l-294 294 294 294q28 28 28 68z")]) $ R.blank
+
delete :: forall t m. MonadWidget t m => m ()
delete =
svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 15892c4..8aa4d38 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -8,9 +8,10 @@ import Prelude hiding (init)
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Init (..))
+import Common.Model (Frequency (..), Init (..), Payment (..))
+import Common.Util.Text as T
-import View.Payment.Header (HeaderIn (..))
+import View.Payment.Header (HeaderIn (..), HeaderOut (..))
import qualified View.Payment.Header as Header
import View.Payment.Pages (PagesIn (..), PagesOut (..))
import qualified View.Payment.Pages as Pages
@@ -29,15 +30,26 @@ widget :: forall t m. MonadWidget t m => PaymentIn -> m PaymentOut
widget paymentIn = do
R.divClass "payment" $ do
rec
- _ <- Header.widget $ HeaderIn
+ let init = _paymentIn_init paymentIn
+
+ filterPayment s p = search s (_payment_name p) && (_payment_frequency p == Punctual)
+
+ payments = fmap
+ (\s -> filter (filterPayment s) (_init_payments init))
+ (_headerOut_search header)
+
+ header <- Header.widget $ HeaderIn
{ _headerIn_init = init
}
+
_ <- Table.widget $ TableIn
{ _tableIn_init = init
- , _tableIn_currentPage = _pagesOut_currentPage pagesOut
+ , _tableIn_currentPage = _pagesOut_currentPage pages
+ , _tableIn_payments = payments
}
- pagesOut <- Pages.widget $ PagesIn
- { _pagesIn_payments = _init_payments init
+
+ pages <- Pages.widget $ PagesIn
+ { _pagesIn_payments = payments
}
+
return $ PaymentOut {}
- where init = _paymentIn_init paymentIn
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 3f2adc3..f64f11d 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -8,10 +8,11 @@ import Control.Monad (forM_)
import Control.Monad.IO.Class (liftIO)
import qualified Data.List as L hiding (groupBy)
import Data.Maybe (fromMaybe)
+import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Time as Time
import Prelude hiding (init)
-import Reflex.Dom (MonadWidget)
+import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Currency, ExceedingPayer (..),
@@ -21,7 +22,8 @@ import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
-import Component (ButtonIn (..))
+import Component (ButtonIn (..), InputIn (..),
+ InputOut (..))
import qualified Component as Component
import qualified Util.List as L
@@ -29,16 +31,19 @@ data HeaderIn t = HeaderIn
{ _headerIn_init :: Init
}
-data HeaderOut = HeaderOut
- {
+data HeaderOut t = HeaderOut
+ { _headerOut_search :: Dynamic t Text
}
-widget :: forall t m. MonadWidget t m => HeaderIn t -> m HeaderOut
+widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
widget headerIn =
R.divClass "header" $ do
payerAndAdd incomes payments users currency
+ search <- searchLine
infos payments users currency
- return $ HeaderOut {}
+ return $ HeaderOut
+ { _headerOut_search = search
+ }
where init = _headerIn_init headerIn
incomes = _init_incomes init
payments = filter ((==) Punctual . _payment_frequency) (_init_payments init)
@@ -98,3 +103,11 @@ infos payments users currency =
. L.groupBy fst
. map (\p -> (_payment_user p, _payment_cost p))
$ payments
+
+searchLine :: forall t m. MonadWidget t m => m (Dynamic t Text)
+searchLine =
+ R.divClass "searchLine" $
+ _inputOut_value <$> (Component.input $ InputIn
+ { _inputIn_reset = R.never
+ , _inputIn_label = Msg.get Msg.Search_Name
+ })
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 81555ab..dfd92c0 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -8,7 +8,7 @@ import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Frequency (..), Payment (..))
+import Common.Model (Payment (..))
import Component (ButtonIn (..), ButtonOut (..))
import qualified Component as Component
@@ -16,52 +16,57 @@ import qualified Component as Component
import qualified Icon
import qualified View.Payment.Constants as Constants
-data PagesIn = PagesIn
- { _pagesIn_payments :: [Payment]
+data PagesIn t = PagesIn
+ { _pagesIn_payments :: Dynamic t [Payment]
}
data PagesOut t = PagesOut
{ _pagesOut_currentPage :: Dynamic t Int
}
-widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t)
+widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
widget pagesIn = do
R.divClass "pages" $ do
rec
currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ]
- firstPageClic <- pageButton (R.constDyn 0) (R.constDyn 1) Icon.doubleLeftBar
+ firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
- previousPageClic <- pageButton (R.constDyn 0) (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
+ previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
- pageClic <- pageEvent <$> (R.simpleList (fmap (range maxPage) currentPage) $ \p ->
- pageButton currentPage p (R.dynText $ fmap (T.pack . show) p))
+ pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p ->
+ pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p))
- nextPageClic <- pageButton (R.constDyn 0) (fmap (\x -> min (x + 1) maxPage) currentPage) Icon.doubleRight
+ nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight
- lastPageClic <- pageButton (R.constDyn 0) (R.constDyn maxPage) Icon.doubleRightBar
+ lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
return $ PagesOut
{ _pagesOut_currentPage = currentPage
}
- where paymentCount = length . filter ((==) Punctual . _payment_frequency) . _pagesIn_payments $ pagesIn
- maxPage = ceiling $ toRational paymentCount / toRational Constants.paymentsPerPage
+ where maxPage =
+ R.ffor (_pagesIn_payments pagesIn) (\payments ->
+ ceiling $ toRational (length payments) / toRational Constants.paymentsPerPage
+ )
+
pageEvent = R.switchPromptlyDyn . fmap R.leftmost
+ noCurrentPage = R.constDyn Nothing
+
range :: Int -> Int -> [Int]
-range maxPage currentPage = [start..end]
+range currentPage maxPage = [start..end]
where sidePages = 2
- start = max 1 (currentPage - sidePages)
+ start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2))
end = min maxPage (start + sidePages * 2)
-pageButton :: forall t m. MonadWidget t m => Dynamic t Int -> Dynamic t Int -> m () -> m (Event t Int)
+pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int)
pageButton currentPage page content = do
clic <- _buttonOut_clic <$> (Component.button $ ButtonIn
{ _buttonIn_class = do
cp <- currentPage
p <- page
- if cp == p then "page current" else "page"
+ if cp == Just p then "page current" else "page"
, _buttonIn_content = content
, _buttonIn_waiting = R.never
})
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index d8093a5..0c3b769 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -12,8 +12,7 @@ import Prelude hiding (init)
import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Category (..), Frequency (..),
- Init (..), Payment (..),
+import Common.Model (Category (..), Init (..), Payment (..),
PaymentCategory (..), User (..))
import qualified Common.Model as CM
import qualified Common.Msg as Msg
@@ -26,6 +25,7 @@ import qualified View.Payment.Constants as Constants
data TableIn t = TableIn
{ _tableIn_init :: Init
, _tableIn_currentPage :: Dynamic t Int
+ , _tableIn_payments :: Dynamic t [Payment]
}
data TableOut = TableOut
@@ -47,8 +47,8 @@ widget tableIn = do
R.divClass "cell" $ R.blank
let init = _tableIn_init tableIn
currentPage = _tableIn_currentPage tableIn
- payments = _init_payments init
- paymentRange = fmap (getPaymentRange payments) currentPage
+ payments = _tableIn_payments tableIn
+ paymentRange = getPaymentRange <$> payments <*> currentPage
R.simpleList paymentRange (paymentRow init)
return $ TableOut {}
@@ -58,7 +58,6 @@ getPaymentRange payments currentPage =
. drop ((currentPage - 1) * Constants.paymentsPerPage)
. reverse
. L.sortOn _payment_date
- . filter ((==) Punctual . _payment_frequency)
$ payments
paymentRow :: forall t m. MonadWidget t m => Init -> Dynamic t Payment -> m ()
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index 69596d8..be6b152 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -23,7 +23,7 @@ view result =
rec
input <- Component.input $ InputIn
{ _inputIn_reset = R.ffilter Either.isRight signInResult
- , _inputIn_placeHolder = Msg.get Msg.SignIn_EmailPlaceholder
+ , _inputIn_label = Msg.get Msg.SignIn_EmailLabel
}
let userWantsEmailValidation = _inputOut_enter input <> _buttonOut_clic button
diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs
index ad8a7f1..a6828d5 100644
--- a/common/src/Common/Message/Key.hs
+++ b/common/src/Common/Message/Key.hs
@@ -118,7 +118,7 @@ data Key =
| SignIn_Button
| SignIn_DisconnectSuccess
| SignIn_EmailInvalid
- | SignIn_EmailPlaceholder
+ | SignIn_EmailLabel
| SignIn_EmailSendFail
| SignIn_EmailSent
| SignIn_LinkExpired
diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs
index 0a6084d..13ced15 100644
--- a/common/src/Common/Message/Translation.hs
+++ b/common/src/Common/Message/Translation.hs
@@ -517,7 +517,7 @@ m l SignIn_EmailInvalid =
English -> "Your email is not valid."
French -> "Votre courriel n’est pas valide."
-m l SignIn_EmailPlaceholder =
+m l SignIn_EmailLabel =
case l of
English -> "Email"
French -> "Courriel"
diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs
index 7e5c8c2..b49fc55 100644
--- a/common/src/Common/Util/Text.hs
+++ b/common/src/Common/Util/Text.hs
@@ -1,10 +1,16 @@
module Common.Util.Text
- ( unaccent
+ ( search
+ , unaccent
) where
import Data.Text (Text)
import qualified Data.Text as T
+search :: Text -> Text -> Bool
+search s t =
+ (format s) `T.isInfixOf` (format t)
+ where format = T.toLower . unaccent
+
unaccent :: Text -> Text
unaccent = T.map unaccentChar
diff --git a/server/migrations/1.sql b/server/migrations/1.sql
new file mode 100644
index 0000000..d7c300e
--- /dev/null
+++ b/server/migrations/1.sql
@@ -0,0 +1,65 @@
+CREATE TABLE IF NOT EXISTS "user" (
+ "id" INTEGER PRIMARY KEY,
+ "creation" TIMESTAMP NOT NULL,
+ "email" VARCHAR NOT NULL,
+ "name" VARCHAR NOT NULL,
+ CONSTRAINT "uniq_user_email" UNIQUE ("email"),
+ CONSTRAINT "uniq_user_name" UNIQUE ("name")
+);
+
+CREATE TABLE IF NOT EXISTS "job" (
+ "id" INTEGER PRIMARY KEY,
+ "kind" VARCHAR NOT NULL,
+ "last_execution" TIMESTAMP NULL,
+ "last_check" TIMESTAMP NULL,
+ CONSTRAINT "uniq_job_kind" UNIQUE ("kind")
+);
+
+CREATE TABLE IF NOT EXISTS "sign_in"(
+ "id" INTEGER PRIMARY KEY,
+ "token" VARCHAR NOT NULL,
+ "creation" TIMESTAMP NOT NULL,
+ "email" VARCHAR NOT NULL,
+ "is_used" BOOLEAN NOT NULL,
+ CONSTRAINT "uniq_sign_in_token" UNIQUE ("token")
+);
+
+CREATE TABLE IF NOT EXISTS "payment"(
+ "id" INTEGER PRIMARY KEY,
+ "user_id" INTEGER NOT NULL REFERENCES "user",
+ "name" VARCHAR NOT NULL,
+ "cost" INTEGER NOT NULL,
+ "date" DATE NOT NULL,
+ "frequency" VARCHAR NOT NULL,
+ "created_at" TIMESTAMP NOT NULL,
+ "edited_at" TIMESTAMP NULL,
+ "deleted_at" TIMESTAMP NULL
+);
+
+CREATE TABLE IF NOT EXISTS "income"(
+ "id" INTEGER PRIMARY KEY,
+ "user_id" INTEGER NOT NULL REFERENCES "user",
+ "date" DATE NOT NULL,
+ "amount" INTEGERNOT NULL,
+ "created_at" TIMESTAMP NOT NULL,
+ "edited_at" TIMESTAMP NULL,
+ "deleted_at" TIMESTAMP NULL
+);
+
+CREATE TABLE IF NOT EXISTS "category"(
+ "id" INTEGER PRIMARY KEY,
+ "name" VARCHAR NOT NULL,
+ "color" VARCHAR NOT NULL,
+ "created_at" TIMESTAMP NOT NULL,
+ "edited_at" TIMESTAMP NULL,
+ "deleted_at" TIMESTAMP NULL
+);
+
+CREATE TABLE IF NOT EXISTS "payment_category"(
+ "id" INTEGER PRIMARY KEY,
+ "name" VARCHAR NOT NULL,
+ "category" INTEGER NOT NULL REFERENCES "category",
+ "created_at" TIMESTAMP NOT NULL,
+ "edited_at" TIMESTAMP NULL,
+ CONSTRAINT "uniq_payment_category_name" UNIQUE ("name")
+);
diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs
index 34d772e..5e5035c 100644
--- a/server/src/Design/Global.hs
+++ b/server/src/Design/Global.hs
@@ -71,3 +71,29 @@ global = do
".undo" & Helper.button Color.silver Color.white (px Constants.inputHeight) Constants.focusLighten
svg ? height (pct 100)
+
+ button ? do
+ ".content" ? display flex
+ svg # ".loader" ? display none
+
+ ".waiting" & do
+ ".content" ? do
+ display none
+ svg # ".loader" ? do
+ display block
+ rotateKeyframes
+ rotateAnimation
+
+rotateAnimation :: Css
+rotateAnimation = do
+ animationName "rotate"
+ animationDuration (sec 1)
+ animationTimingFunction easeOut
+ animationIterationCount infinite
+
+rotateKeyframes :: Css
+rotateKeyframes = keyframes
+ "rotate"
+ [ (0, "transform" -: "rotate(0deg)")
+ , (100, "transform" -: "rotate(360deg)")
+ ]
diff --git a/server/src/Design/Helper.hs b/server/src/Design/Helper.hs
index 89f5958..6980c71 100644
--- a/server/src/Design/Helper.hs
+++ b/server/src/Design/Helper.hs
@@ -1,7 +1,6 @@
module Design.Helper
( clearFix
, button
- , waitable
, input
, centeredWithMargin
, verticalCentering
@@ -37,20 +36,6 @@ button backgroundCol textCol h focusOp = do
textAlign (alignSide sideCenter)
hover & backgroundColor (focusOp backgroundCol)
focus & backgroundColor (focusOp backgroundCol)
- waitable
-
-waitable :: Css
-waitable = do
- ".content" ? display flex
- svg # ".loader" ? display none
-
- ".waiting" & do
- ".content" ? do
- display none
- svg # ".loader" ? do
- display block
- rotateKeyframes
- rotateAnimation
input :: Double -> Css
input h = do
@@ -72,17 +57,3 @@ verticalCentering = do
position absolute
top (pct 50)
"transform" -: "translateY(-50%)"
-
-rotateAnimation :: Css
-rotateAnimation = do
- animationName "rotate"
- animationDuration (sec 1)
- animationTimingFunction easeOut
- animationIterationCount infinite
-
-rotateKeyframes :: Css
-rotateKeyframes = keyframes
- "rotate"
- [ (0, "transform" -: "rotate(0deg)")
- , (100, "transform" -: "rotate(360deg)")
- ]
diff --git a/server/src/Design/View/Header.hs b/server/src/Design/View/Header.hs
index 904a2f5..97f1802 100644
--- a/server/src/Design/View/Header.hs
+++ b/server/src/Design/View/Header.hs
@@ -2,13 +2,12 @@ module Design.View.Header
( design
) where
-import Data.Monoid ((<>))
+import Data.Monoid ((<>))
import Clay
-import Design.Color as Color
-import qualified Design.Helper as Helper
-import qualified Design.Media as Media
+import Design.Color as Color
+import qualified Design.Media as Media
design :: Css
design = do
@@ -56,7 +55,6 @@ design = do
Media.tabletDesktop $ headerPadding
".signOut" ? do
- Helper.waitable
display flex
svg ? do
Media.tabletDesktop $ width (px 30)
diff --git a/server/src/Design/View/Payment/Header.hs b/server/src/Design/View/Payment/Header.hs
index 36bc8d9..80c5436 100644
--- a/server/src/Design/View/Payment/Header.hs
+++ b/server/src/Design/View/Payment/Header.hs
@@ -50,22 +50,24 @@ design = do
".searchLine" ? do
marginBottom (em 1)
- form ? do
- Media.mobile $ textAlign (alignSide sideCenter)
-
- ".textInput" ? do
- display inlineBlock
- marginBottom (px 0)
-
- Media.tabletDesktop $ marginRight (px 30)
- Media.mobile $ do
- marginBottom (em 1)
- width (pct 100)
-
- ".radioGroup" ? do
- display inlineBlock
- marginBottom (px 0)
- ".title" ? display none
+ Media.mobile $ textAlign (alignSide sideCenter)
+
+ ".textInput" ? do
+ display inlineBlock
+ marginBottom (px 0)
+ button ? do
+ svg ? "path" ? ("fill" -: Color.toString Color.silver)
+ hover & svg ? "path" ? ("fill" -: Color.toString (Color.silver -. 25))
+
+ Media.tabletDesktop $ marginRight (px 30)
+ Media.mobile $ do
+ marginBottom (em 1)
+ width (pct 100)
+
+ ".radioGroup" ? do
+ display inlineBlock
+ marginBottom (px 0)
+ ".title" ? display none
".infos" ? do
Media.tabletDesktop $ lineHeight (px Constants.inputHeight)
diff --git a/server/src/Job/Model.hs b/server/src/Job/Model.hs
index a5fa62b..1dd6c63 100644
--- a/server/src/Job/Model.hs
+++ b/server/src/Job/Model.hs
@@ -5,7 +5,6 @@ module Job.Model
, actualizeLastCheck
) where
-import Data.Maybe (isJust)
import Data.Time.Clock (UTCTime, getCurrentTime)
import Database.SQLite.Simple (Only (Only))
import qualified Database.SQLite.Simple as SQLite
@@ -24,15 +23,20 @@ data Job = Job
getLastExecution :: Kind -> Query (Maybe UTCTime)
getLastExecution jobKind =
Query (\conn -> do
- [Only time] <- SQLite.query conn "SELECT last_execution FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe UTCTime)]
- return time
+ result <- SQLite.query conn "SELECT last_execution FROM job WHERE kind = ?" (Only jobKind) :: IO [Only UTCTime]
+ return $ case result of
+ [Only time] -> Just time
+ _ -> Nothing
)
actualizeLastExecution :: Kind -> UTCTime -> Query ()
actualizeLastExecution jobKind time =
Query (\conn -> do
- [Only result] <- SQLite.query conn "SELECT 1 FROM job WHERE kind = ?" (Only jobKind) :: IO [Only (Maybe Int)]
- if isJust result
+ result <- SQLite.query conn "SELECT 1 FROM job WHERE kind = ?" (Only jobKind) :: IO [Only Int]
+ let hasJob = case result of
+ [Only _] -> True
+ _ -> False
+ if hasJob
then SQLite.execute conn "UPDATE job SET last_execution = ? WHERE kind = ?" (time, jobKind)
else SQLite.execute conn "INSERT INTO job (kind, last_execution, last_check) VALUES (?, ?, ?)" (jobKind, time, time)
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 19:28:42 +0000