coin 1.1.1 → 1.2
raw patch · 11 files changed
+411/−51 lines, 11 files
Files
- coin.cabal +2/−1
- src/Coin/Locale/LangPL.hs +1/−0
- src/Coin/UI/Accounts/AccountsHistory.hs +30/−10
- src/Coin/UI/Accounts/AccountsIncome.hs +24/−11
- src/Coin/UI/Accounts/AccountsOutcome.hs +25/−11
- src/Coin/UI/Accounts/AccountsTransfer.hs +30/−12
- src/Coin/UI/MainMultiList.hs +6/−0
- src/Coin/UI/MainWindow.hs +3/−0
- src/Coin/UI/Raports/RaportHistoryAll.hs +163/−0
- src/Coin/UI/Widgets/MiniCalendar.hs +124/−0
- stack.yaml +3/−6
coin.cabal view
@@ -1,5 +1,5 @@ name: coin-version: 1.1.1+version: 1.2 Build-Type: Simple cabal-version: >= 1.16 author: Piotr Borek <piotrborek@op.pl>@@ -61,6 +61,7 @@ other-modules: Coin.UI.Raports.RaportSummary Coin.UI.Raports.RaportHistory+ Coin.UI.Raports.RaportHistoryAll Coin.UI.Raports.RaportQuery Coin.UI.Options.OptionsTag Coin.UI.Options.OptionsAccount
src/Coin/Locale/LangPL.hs view
@@ -45,6 +45,7 @@ translate "Outcome" = "Wypłata" translate "Transfer" = "Przelew" translate "History" = "Historia"+translate "History: All" = "Historia: Wszystko" translate "Today" = "Dziś" translate "Info" = "Informacja" translate "Warning" = "Ostrzeżenie"
src/Coin/UI/Accounts/AccountsHistory.hs view
@@ -37,9 +37,12 @@ import Coin.UI.MainState import Coin.UI.Builder.GtkUIBuilder import Coin.UI.HistoryView+import Coin.UI.Widgets.MiniCalendar+import Coin.UI.Utils.CalendarUtils accountsHistoryNew :: MainState -> IO Gtk.Widget accountsHistoryNew mainState = do+ cal <- miniCalendarNew2 historyView <- historyViewNew True True True (getObject, root) <- uiBuildGtk $ do@@ -49,6 +52,13 @@ ] gridAttrs [ gridRowHomogeneous := False, gridColumnHomogeneous := False, gridColumnSpacing := 4, gridRowSpacing := 8, Gtk.containerBorderWidth := 4 ] grid Nothing $ do+ gridAttach 0 0 1 1 $ do+ labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]+ label Nothing (__"Date:")+ gridAttach 1 0 1 1 $ do+ widgetAttrs [ Gtk.widgetVExpand := False, Gtk.widgetHExpand := True ]+ putWidget cal+ gridAttach 0 1 1 1 $ do labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ] label Nothing (__"Account name:")@@ -72,15 +82,19 @@ observableRegister (mainStateSelectedAccountName mainState) $ \name -> do Gtk.labelSetText accountName name- accountsHistoryViewUpdate mainState historyView accountName+ accountsHistoryViewUpdate mainState historyView accountName cal accountsHistoryBalanceUpdate accountName balance + miniCalendarOnChange cal $ \_ _ -> do+ accountsHistoryViewUpdate mainState historyView accountName cal+ accountsHistoryBalanceUpdate accountName balance+ return root -accountsHistoryViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> IO ()-accountsHistoryViewUpdate mainState operationsView accountName = do+accountsHistoryViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> MiniCalendarWidget -> IO ()+accountsHistoryViewUpdate mainState operationsView accountName cal = do accountName' <- Gtk.labelGetText accountName- entities <- accountsHistorySelect accountName'+ entities <- accountsHistorySelect accountName' cal historyViewUpdate mainState operationsView entities accountsHistoryBalanceUpdate :: Gtk.Label -> Gtk.Label -> IO ()@@ -90,15 +104,21 @@ val <- accountsTableSelectBalance accountID Gtk.labelSetText balanceLabel $ valueShow val -accountsHistorySelect :: String -> IO [Entity OperationsTable]-accountsHistorySelect accountName =+accountsHistorySelect :: String -> MiniCalendarWidget -> IO [Entity OperationsTable]+accountsHistorySelect accountName cal = if (accountName == []) then return [] else do+ year <- miniCalendarGetDate2 cal accountID <- accountsTableSelectID accountName runDB $- selectList ( [ OperationsTableFrom ==. accountID ]- ||. [ OperationsTableTo ==. accountID ]+ selectList ( [ OperationsTableFrom ==. accountID+ , OperationsTableDate >=. calendarDateToInt (year, 1, 1)+ , OperationsTableDate <=. calendarDateToInt (year, 12, 31)+ ]+ ||. [ OperationsTableTo ==. accountID+ , OperationsTableDate >=. calendarDateToInt (year, 1, 1)+ , OperationsTableDate <=. calendarDateToInt (year, 12, 31)+ ] )- [ LimitTo 100- , Desc OperationsTableDate ]+ [ Desc OperationsTableDate ]
src/Coin/UI/Accounts/AccountsIncome.hs view
@@ -32,6 +32,7 @@ import Database.Persist import Data.Maybe+import Control.Concurrent.MVar import Control.Monad import Control.Monad.IO.Class @@ -130,7 +131,7 @@ labelName <- Gtk.labelGetText accountName when (labelName /= name) $ do Gtk.labelSetText accountName name- accountsIncomeViewUpdate mainState operationsView accountName+ accountsIncomeViewUpdate mainState operationsView accountName cal accountsIncomeBalanceUpdate accountName balance void $ Gtk.on entryValue Gtk.keyReleaseEvent $ do@@ -153,7 +154,7 @@ Gtk.entrySetText entryDescription "" Gtk.widgetShow errorValue Gtk.widgetSetSensitive buttonAdd False- accountsIncomeViewUpdate mainState operationsView accountName+ accountsIncomeViewUpdate mainState operationsView accountName cal accountsIncomeBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name@@ -165,7 +166,7 @@ case entity of Just entity' -> do accountsIncomeRemove accountName entity'- accountsIncomeViewUpdate mainState operationsView accountName+ accountsIncomeViewUpdate mainState operationsView accountName cal accountsIncomeBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name@@ -177,6 +178,15 @@ then Gtk.widgetSetSensitive buttonRemove False else Gtk.widgetSetSensitive buttonRemove True + (y, _, _) <- calendarGetSelectedDate cal+ curYear <- newMVar y+ calendarOnChange cal $ \year _ _ -> do+ yy <- readMVar curYear+ when (yy /= year) $ do+ modifyMVar_ curYear $ const $ return year+ accountsIncomeViewUpdate mainState operationsView accountName cal+ accountsIncomeBalanceUpdate accountName balance+ mainStateSavePropertiesAction mainState "Coin.UI.Accounts.AccountsIncome" $ do i <- liftIO $ Gtk.comboBoxGetActive tagsBox propertyInsert "i" i@@ -187,24 +197,27 @@ return root -accountsIncomeViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> IO ()-accountsIncomeViewUpdate mainState operationsView accountName = do+accountsIncomeViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> CalendarWidget -> IO ()+accountsIncomeViewUpdate mainState operationsView accountName cal = do accountName' <- Gtk.labelGetText accountName- entities <- accountsIncomeSelect mainState accountName'+ entities <- accountsIncomeSelect mainState accountName' cal historyViewUpdate mainState operationsView entities -accountsIncomeSelect :: MainState -> String -> IO [Entity OperationsTable]-accountsIncomeSelect mainState accountName =+accountsIncomeSelect :: MainState -> String -> CalendarWidget -> IO [Entity OperationsTable]+accountsIncomeSelect mainState accountName cal = if (accountName == []) then return [] else do let incomeID = mainStateIncomeID mainState+ (year, _, _) <- calendarGetSelectedDate cal accountID <- accountsTableSelectID accountName runDB $ selectList [ OperationsTableFrom ==. incomeID- , OperationsTableTo ==. accountID ]- [ LimitTo 100- , Desc OperationsTableDate ]+ , OperationsTableTo ==. accountID+ , OperationsTableDate >=. calendarDateToInt (year, 1, 1)+ , OperationsTableDate <=. calendarDateToInt (year, 12, 31)+ ]+ [ Desc OperationsTableDate ] accountsIncomeAppend :: MainState -> CalendarWidget -> Gtk.ComboBox -> Gtk.Label -> Gtk.Entry -> Int -> IO () accountsIncomeAppend mainState cal tagsBox accountName entryDescription value = do
src/Coin/UI/Accounts/AccountsOutcome.hs view
@@ -32,6 +32,7 @@ import Database.Persist import Data.Maybe+import Control.Concurrent.MVar import Control.Monad import Control.Monad.IO.Class @@ -130,7 +131,7 @@ labelName <- Gtk.labelGetText accountName when (labelName /= name) $ do Gtk.labelSetText accountName name- accountsOutcomeViewUpdate mainState operationsView accountName+ accountsOutcomeViewUpdate mainState operationsView accountName cal accountsOutcomeBalanceUpdate accountName balance void $ Gtk.on entryValue Gtk.keyReleaseEvent $ do@@ -153,7 +154,7 @@ Gtk.entrySetText entryDescription "" Gtk.widgetShow errorValue Gtk.widgetSetSensitive buttonAdd False- accountsOutcomeViewUpdate mainState operationsView accountName+ accountsOutcomeViewUpdate mainState operationsView accountName cal accountsOutcomeBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name@@ -165,7 +166,7 @@ case entity of Just entity' -> do accountsOutcomeRemove accountName entity'- accountsOutcomeViewUpdate mainState operationsView accountName+ accountsOutcomeViewUpdate mainState operationsView accountName cal accountsOutcomeBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name@@ -177,6 +178,16 @@ then Gtk.widgetSetSensitive buttonRemove False else Gtk.widgetSetSensitive buttonRemove True + (y, _, _) <- calendarGetSelectedDate cal+ curYear <- newMVar y+ calendarOnChange cal $ \year _ _ -> do+ yy <- readMVar curYear+ when (yy /= year) $ do+ modifyMVar_ curYear $ const $ return year+ accountsOutcomeViewUpdate mainState operationsView accountName cal+ accountsOutcomeBalanceUpdate accountName balance++ mainStateSavePropertiesAction mainState "Coin.UI.Accounts.AccountsOutcome" $ do i <- liftIO $ Gtk.comboBoxGetActive tagsBox propertyInsert "i" i@@ -187,24 +198,27 @@ return root -accountsOutcomeViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> IO ()-accountsOutcomeViewUpdate mainState operationsView accountName = do+accountsOutcomeViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> CalendarWidget -> IO ()+accountsOutcomeViewUpdate mainState operationsView accountName cal = do accountName' <- Gtk.labelGetText accountName- entities <- accountsOutcomeSelect mainState accountName'+ entities <- accountsOutcomeSelect mainState accountName' cal historyViewUpdate mainState operationsView entities -accountsOutcomeSelect :: MainState -> String -> IO [Entity OperationsTable]-accountsOutcomeSelect mainState accountName =+accountsOutcomeSelect :: MainState -> String -> CalendarWidget -> IO [Entity OperationsTable]+accountsOutcomeSelect mainState accountName cal = if (accountName == []) then return [] else do let outcomeID = mainStateOutcomeID mainState+ (year, _, _) <- calendarGetSelectedDate cal accountID <- accountsTableSelectID accountName runDB $ selectList [ OperationsTableFrom ==. accountID- , OperationsTableTo ==. outcomeID ]- [ LimitTo 100- , Desc OperationsTableDate ]+ , OperationsTableTo ==. outcomeID+ , OperationsTableDate >=. calendarDateToInt (year, 1, 1)+ , OperationsTableDate <=. calendarDateToInt (year, 12, 31)+ ]+ [ Desc OperationsTableDate ] accountsOutcomeAppend :: MainState -> CalendarWidget -> Gtk.ComboBox -> Gtk.Label -> Gtk.Entry -> Int -> IO () accountsOutcomeAppend mainState cal tagsBox accountName entryDescription value = do
src/Coin/UI/Accounts/AccountsTransfer.hs view
@@ -32,6 +32,7 @@ import Database.Persist import Data.Maybe+import Control.Concurrent.MVar import Control.Monad import Control.Monad.IO.Class @@ -140,7 +141,7 @@ labelName <- Gtk.labelGetText accountName when (labelName /= name) $ do Gtk.labelSetText accountName name- accountsTransferViewUpdate mainState operationsView accountName+ accountsTransferViewUpdate mainState operationsView accountName cal accountsTransferBalanceUpdate accountName balance text <- Gtk.comboBoxGetActiveText accountsBox@@ -188,7 +189,7 @@ Gtk.entrySetText entryDescription "" Gtk.widgetShow errorValue Gtk.widgetSetSensitive buttonAdd False- accountsTransferViewUpdate mainState operationsView accountName+ accountsTransferViewUpdate mainState operationsView accountName cal accountsTransferBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name@@ -200,7 +201,7 @@ case entity of Just entity' -> do accountsTransferRemove accountsBox accountName entity'- accountsTransferViewUpdate mainState operationsView accountName+ accountsTransferViewUpdate mainState operationsView accountName cal accountsTransferBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name@@ -212,6 +213,15 @@ then Gtk.widgetSetSensitive buttonRemove False else Gtk.widgetSetSensitive buttonRemove True + (y, _, _) <- calendarGetSelectedDate cal+ curYear <- newMVar y+ calendarOnChange cal $ \year _ _ -> do+ yy <- readMVar curYear+ when (yy /= year) $ do+ modifyMVar_ curYear $ const $ return year+ accountsTransferViewUpdate mainState operationsView accountName cal+ accountsTransferBalanceUpdate accountName balance+ mainStateSavePropertiesAction mainState "Coin.UI.Accounts.AccountsTransfer" $ do i <- liftIO $ Gtk.comboBoxGetActive tagsBox propertyInsert "i" i@@ -231,26 +241,34 @@ error2 <- Gtk.widgetGetVisible errorToAccount return $ and [ not error1, not error2 ] -accountsTransferViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> IO ()-accountsTransferViewUpdate mainState operationsView accountName = do+accountsTransferViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> CalendarWidget -> IO ()+accountsTransferViewUpdate mainState operationsView accountName cal = do accountName' <- Gtk.labelGetText accountName- entities <- accountsTransferSelect mainState accountName'+ entities <- accountsTransferSelect mainState accountName' cal historyViewUpdate mainState operationsView entities -accountsTransferSelect :: MainState -> String -> IO [Entity OperationsTable]-accountsTransferSelect mainState accountName =+accountsTransferSelect :: MainState -> String -> CalendarWidget -> IO [Entity OperationsTable]+accountsTransferSelect mainState accountName cal = if (accountName == []) then return [] else do let outcomeID = mainStateOutcomeID mainState let incomeID = mainStateIncomeID mainState+ (year, _, _) <- calendarGetSelectedDate cal accountID <- accountsTableSelectID accountName runDB $- selectList ( [ OperationsTableFrom ==. accountID , OperationsTableTo !=. outcomeID ]- ||. [ OperationsTableTo ==. accountID, OperationsTableFrom !=. incomeID ]+ selectList ( [ OperationsTableFrom ==. accountID+ , OperationsTableTo !=. outcomeID+ , OperationsTableDate >=. calendarDateToInt (year, 1, 1)+ , OperationsTableDate <=. calendarDateToInt (year, 12, 31)+ ]+ ||. [ OperationsTableTo ==. accountID+ , OperationsTableFrom !=. incomeID+ , OperationsTableDate >=. calendarDateToInt (year, 1, 1)+ , OperationsTableDate <=. calendarDateToInt (year, 12, 31)+ ] )- [ LimitTo 100- , Desc OperationsTableDate ]+ [ Desc OperationsTableDate ] accountsTransferAppend :: CalendarWidget -> Gtk.ComboBox -> Gtk.ComboBox -> Gtk.Label -> Gtk.Entry -> Int -> IO () accountsTransferAppend cal tagsBox accountsBox accountName entryDescription value = do
src/Coin/UI/MainMultiList.hs view
@@ -35,6 +35,7 @@ import Coin.UI.Widgets.StackWidget import Coin.UI.Widgets.MultiList import Coin.UI.Raports.RaportHistory+import Coin.UI.Raports.RaportHistoryAll import Coin.UI.Raports.RaportSummary mainMultiListNew :: MainState -> StackWidget -> IO MultiListWidget@@ -61,6 +62,11 @@ do stackWidgetGet stack "raportHistory" >>= raportHistoryUpdate' mainState stackWidgetShow stack "raportHistory"+ )+ , (__"History: All",+ do+ stackWidgetGet stack "raportHistoryAll" >>= raportHistoryAllUpdate' mainState+ stackWidgetShow stack "raportHistoryAll" ) , (__"Queries", stackWidgetShow stack "raportQuery") ]
src/Coin/UI/MainWindow.hs view
@@ -37,6 +37,7 @@ import Coin.UI.Widgets.StackWidget import Coin.UI.Builder.GtkUIBuilder import Coin.UI.Raports.RaportHistory+import Coin.UI.Raports.RaportHistoryAll import Coin.UI.Raports.RaportSummary import Coin.UI.Raports.RaportQuery import Coin.UI.Widgets.MultiList@@ -53,6 +54,7 @@ tags <- optionsTagNew mainState accountsList <- optionsAccountNew mainState raportHistory <- raportHistoryNew mainState+ raportHistoryAll <- raportHistoryAllNew mainState raportSummary <- raportSummaryNew mainState raportQuery <- raportQueryNew mainState @@ -61,6 +63,7 @@ stackWidgetAdd stack "tagsList" tags stackWidgetAdd stack "accountsList" accountsList stackWidgetAdd stack "raportHistory" raportHistory+ stackWidgetAdd stack "raportHistoryAll" raportHistoryAll stackWidgetAdd stack "raportSummary" raportSummary stackWidgetAdd stack "raportQuery" raportQuery
+ src/Coin/UI/Raports/RaportHistoryAll.hs view
@@ -0,0 +1,163 @@+{-+ * Programmer: Piotr Borek+ * E-mail: piotrborek@op.pl+ * Copyright 2016 Piotr Borek+ *+ * Distributed under the terms of the GPL (GNU Public License)+ *+ * This program is free software; you can redistribute it and/or modify+ * it under the terms of the GNU General Public License as published by+ * the Free Software Foundation; either version 2 of the License, or+ * (at your option) any later version.+ *+ * This program is distributed in the hope that it will be useful,+ * but WITHOUT ANY WARRANTY; without even the implied warranty of+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ * GNU General Public License for more details.+ *+ * You should have received a copy of the GNU General Public License+ * along with this program; if not, write to the Free Software+ *+-}++module Coin.UI.Raports.RaportHistoryAll (+ RaportHistoryAllWidget,+ castToRaportHistoryAll,+ raportHistoryAllNew,+ raportHistoryAllUpdate,+ raportHistoryAllUpdate'+) where++import qualified System.Glib.GObject as Gtk+import qualified Graphics.UI.Gtk as Gtk+import Graphics.UI.Gtk ( AttrOp(..) )++import Data.Maybe+import Data.Foldable+import Database.Persist++import Coin.DB.Tables+import Coin.DB.Functions+import Coin.Locale.Translate+import Coin.Utils.ValueParser+import Coin.UI.MainState+import Coin.UI.Builder.GtkUIBuilder+import Coin.UI.Widgets.MiniCalendar+import Coin.UI.Utils.CalendarUtils+import Coin.UI.HistoryView++data RaportHistoryAllWidget = RaportHistoryAllWidget {+ raportHistoryAllRoot :: Gtk.Widget,+ raportHistoryAllView :: HistoryViewWidget,+ raportHistoryAllMiniCalendar :: MiniCalendarWidget,+ raportHistoryAllIncomes :: Gtk.Label,+ raportHistoryAllOutcomes :: Gtk.Label+}++instance Gtk.GObjectClass RaportHistoryAllWidget where+ toGObject = Gtk.toGObject . raportHistoryAllRoot+ unsafeCastGObject = undefined++instance Gtk.WidgetClass RaportHistoryAllWidget++castToRaportHistoryAll :: Gtk.WidgetClass cls => cls -> IO RaportHistoryAllWidget+castToRaportHistoryAll widget = do+ q <- Gtk.quarkFromString "Coin.UI.Raports.RaportHistoryAll"+ (Just h) <- Gtk.objectGetAttributeUnsafe q widget+ return h++raportHistoryAllNew :: MainState -> IO RaportHistoryAllWidget+raportHistoryAllNew mainState = do+ historyView <- historyViewNew True True True+ miniCalendar <- miniCalendarNew++ (getObject, root) <- uiBuildGtk $ do+ globalCss [ "#Marked {"+ , " font-weight: bold;"+ , "}"+ ]+ gridAttrs [ gridRowHomogeneous := False, gridColumnHomogeneous := False, gridColumnSpacing := 4, gridRowSpacing := 8, Gtk.containerBorderWidth := 4 ]+ grid Nothing $ do+ gridAttach 0 0 1 1 $ do+ labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]+ label Nothing (__"Date:")+ gridAttach 1 0 1 1 $ do+ widgetAttrs [ Gtk.widgetVExpand := False, Gtk.widgetHExpand := True ]+ putWidget miniCalendar++ gridAttach 0 1 1 1 $ do+ labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]+ label Nothing (__"Incomes:")+ gridAttach 1 1 1 1 $ do+ labelAttrs [ Gtk.miscXalign := 0.0 ]+ label (Just "incomes") "0.00"++ gridAttach 0 2 1 1 $ do+ labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]+ label Nothing (__"Outcomes:")+ gridAttach 1 2 1 1 $ do+ labelAttrs [ Gtk.miscXalign := 0.0 ]+ label (Just "outcomes") "0.00"++ gridAttach 0 3 2 1 $ do+ widgetAttrs [ Gtk.widgetVExpand := True, Gtk.widgetHExpand := True ]+ scrolledWindow Nothing $ putWidget historyView++ let incomes = Gtk.castToLabel . fromJust . getObject $ "incomes"+ let outcomes = Gtk.castToLabel . fromJust . getObject $ "outcomes"++ let historyAllWidget = RaportHistoryAllWidget+ root+ historyView+ miniCalendar+ incomes+ outcomes++ q <- Gtk.quarkFromString "Coin.UI.Raports.RaportHistoryAll"+ Gtk.objectSetAttribute q root $ Just historyAllWidget++ miniCalendarOnChange miniCalendar $ \_ _ ->+ raportHistoryAllUpdate mainState historyAllWidget++ raportHistoryAllUpdate mainState historyAllWidget++ return historyAllWidget++raportHistoryAllUpdate' :: Gtk.WidgetClass cls => MainState -> cls -> IO ()+raportHistoryAllUpdate' mainState widget = castToRaportHistoryAll widget >>= raportHistoryAllUpdate mainState++raportHistoryAllUpdate :: MainState -> RaportHistoryAllWidget -> IO ()+raportHistoryAllUpdate mainState historyAllWidget = do+ raportHistoryAllViewUpdate historyAllWidget mainState++raportHistoryAllViewUpdate :: RaportHistoryAllWidget -> MainState -> IO ()+raportHistoryAllViewUpdate historyAllWidget mainState = do+ entities <- raportHistoryAllSelect (raportHistoryAllMiniCalendar historyAllWidget)+ historyViewUpdate mainState (raportHistoryAllView historyAllWidget) entities++ let incomeID = mainStateIncomeID mainState+ let outcomeID = mainStateOutcomeID mainState+ let inSum = foldr' (\(Entity _ op) s ->+ if operationsTableFrom op == incomeID+ then s + operationsTableValue op+ else s )+ 0+ entities+ let outSum = foldr' (\(Entity _ op) s ->+ if operationsTableTo op == outcomeID+ then s + operationsTableValue op+ else s )+ 0+ entities++ Gtk.labelSetText (raportHistoryAllIncomes historyAllWidget) $ valueShow inSum+ Gtk.labelSetText (raportHistoryAllOutcomes historyAllWidget) $ valueShow outSum++raportHistoryAllSelect :: MiniCalendarWidget -> IO [Entity OperationsTable]+raportHistoryAllSelect cal = do+ (year, month) <- miniCalendarGetDate cal+ runDB $+ selectList [ OperationsTableDate >=. calendarDateToInt (year, month, 1)+ , OperationsTableDate <=. calendarDateToInt (year, month, 31)+ ]+ [ Desc OperationsTableDate ]
src/Coin/UI/Widgets/MiniCalendar.hs view
@@ -23,7 +23,9 @@ module Coin.UI.Widgets.MiniCalendar ( MiniCalendarWidget, miniCalendarNew,+ miniCalendarNew2, miniCalendarGetDate,+ miniCalendarGetDate2, miniCalendarSetDate, miniCalendarOnChange ) where@@ -194,6 +196,123 @@ return miniCalendarWidget +miniCalendarNew2 :: IO MiniCalendarWidget+miniCalendarNew2 = do+ (year, month, _, _, _) <- calendarGetDate++ refYear <- newIORef year+ refMonth <- newIORef month+ calendarObservable <- observableNew++ cal <- Gtk.calendarNew+ calStyle <- Gtk.widgetGetStyle cal+ bg <- colorToString <$> Gtk.styleGetBackground calStyle Gtk.StateNormal+ fg <- colorToString <$> Gtk.styleGetText calStyle Gtk.StateNormal+ sb <- colorToString <$> Gtk.styleGetLight calStyle Gtk.StateSelected++ let css = [ cssStyleReset+ , "* {"+ , " color: " ++ fg ++ ";"+ , "}"+ , if gtkVersionOld then ".frame {" else "frame {"+ , " background-color: " ++ bg ++ ";"+ , " border: 1px;"+ , " border-style: solid;"+ , " border-radius: 10px;"+ , " padding: 4px 4px 4px 4px;"+ , "}"+ , if gtkVersionOld then ".label {" else "label {"+ , " padding: 2px;"+ , "}"+ , if gtkVersionOld then ".button { " else "button {"+ , " transition: 200ms ease-in-out;"+ , " font-size: 1.1em;"+ , " background-color: " ++ bg ++ ";"+ , " border-color: " ++ bg ++ ";"+ , " border-radius: 8px 0px 8px 0px;"+ , " border-width: 1px;"+ , " border-style: solid;"+ , " padding: 2px;"+ , "}"+ , "#TodayButton {"+ , " transition: none;"+ , " font-size: 1em;"+ , " border-radius: 8px 0px 8px 0px;"+ , " padding: 0px 12px 0px 12px;"+ , "}"+ , "#TodayButton:active {"+ , " background-color: " ++ sb ++ ";"+ , "}"+ , "#Arrow {"+ , " font-weight: bold;"+ , " font-size: 2em;"+#ifdef WINDOWS+ , " padding: 0px 6px 6px 6px;"+#else+ , " padding: 0px 6px 0px 6px;"+#endif+ , " border-style: none;"+ , " border-radius: 12px;"+ , "}"+ , "#Arrow:hover {"+ , " background-color: " ++ sb ++ ";"+ , "}"+ , "#TodayButton:hover {"+ , " border-color: " ++ sb ++ ";"+ , "}"+ ]++ (getObject, root) <- uiBuildGtk $ do+ packing Gtk.PackNatural 0+ vbox Nothing False 0 $ hbox Nothing False 0 $ do+ globalCss css+ hbox Nothing False 0 $ do+ frame Nothing Nothing $ do+ grid Nothing $ do+ gridAttach 5 0 1 1 $ do+ buttonAttrs [ Gtk.widgetName := Just "Arrow" ]+ button (Just "yearLeft") "<"+ gridAttach 6 0 3 1 $ do+ widgetAttrs [ Gtk.widgetWidthRequest := 60 ]+ label (Just "year") (show year)+ gridAttach 9 0 1 1 $ do+ buttonAttrs [ Gtk.widgetName := Just "Arrow" ]+ button (Just "yearRight") ">"+ gridAttach 10 0 3 1 $ do+ buttonAttrs [ Gtk.widgetName := Just "TodayButton" ]+ button (Just "today") (__"Today")++ let yearLabel = Gtk.castToLabel . fromJust . getObject $ "year"+ let yearLeft = Gtk.castToButton . fromJust . getObject $ "yearLeft"+ let yearRight = Gtk.castToButton . fromJust . getObject $ "yearRight"+ let todayButton = Gtk.castToButton . fromJust . getObject $ "today"++ monthLabel <- Gtk.labelNew $ Just ""++ let miniCalendarWidget = MiniCalendarWidget+ (Gtk.castToBox root)+ yearLabel+ monthLabel+ refYear+ refMonth+ calendarObservable++ void $ Gtk.on todayButton Gtk.buttonActivated $ do+ (y, m, _, _, _) <- calendarGetDate+ miniCalendarSetDate miniCalendarWidget y m++ void $ Gtk.on yearLeft Gtk.buttonActivated $ do+ (y, m) <- miniCalendarGetDate miniCalendarWidget+ miniCalendarSetDate miniCalendarWidget (y - 1) m++ void $ Gtk.on yearRight Gtk.buttonActivated $ do+ (y, m) <- miniCalendarGetDate miniCalendarWidget+ miniCalendarSetDate miniCalendarWidget (y + 1) m++ miniCalendarSetDate miniCalendarWidget year month++ return miniCalendarWidget+ miniCalendarSetDate :: MiniCalendarWidget -> Integer -> Int -> IO () miniCalendarSetDate cal year month = do let (month'', year') = if month < 1 then (12, year - 1) else (if month > 12 then (1, year + 1) else (month, year))@@ -212,6 +331,11 @@ y <- readIORef $ miniCalendarYear cal m <- readIORef $ miniCalendarMonth cal return (y, m)++miniCalendarGetDate2 :: MiniCalendarWidget -> IO Integer+miniCalendarGetDate2 cal = do+ y <- readIORef $ miniCalendarYear cal+ return y miniCalendarOnChange :: MiniCalendarWidget -> (Integer -> Int -> IO ()) -> IO () miniCalendarOnChange cal action = do
stack.yaml view
@@ -1,8 +1,5 @@-flags:- text:- integer-simple: false+flags: {} packages: - '.'-extra-deps:-- text-1.2.2.1-resolver: lts-6.0+extra-deps: []+resolver: lts-7.7