diff --git a/coin.cabal b/coin.cabal --- a/coin.cabal +++ b/coin.cabal @@ -1,5 +1,5 @@ name: coin -version: 1.1.1 +version: 1.2 Build-Type: Simple cabal-version: >= 1.16 author: Piotr Borek @@ -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 diff --git a/src/Coin/Locale/LangPL.hs b/src/Coin/Locale/LangPL.hs --- a/src/Coin/Locale/LangPL.hs +++ b/src/Coin/Locale/LangPL.hs @@ -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" diff --git a/src/Coin/UI/Accounts/AccountsHistory.hs b/src/Coin/UI/Accounts/AccountsHistory.hs --- a/src/Coin/UI/Accounts/AccountsHistory.hs +++ b/src/Coin/UI/Accounts/AccountsHistory.hs @@ -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 ] diff --git a/src/Coin/UI/Accounts/AccountsIncome.hs b/src/Coin/UI/Accounts/AccountsIncome.hs --- a/src/Coin/UI/Accounts/AccountsIncome.hs +++ b/src/Coin/UI/Accounts/AccountsIncome.hs @@ -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 diff --git a/src/Coin/UI/Accounts/AccountsOutcome.hs b/src/Coin/UI/Accounts/AccountsOutcome.hs --- a/src/Coin/UI/Accounts/AccountsOutcome.hs +++ b/src/Coin/UI/Accounts/AccountsOutcome.hs @@ -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 diff --git a/src/Coin/UI/Accounts/AccountsTransfer.hs b/src/Coin/UI/Accounts/AccountsTransfer.hs --- a/src/Coin/UI/Accounts/AccountsTransfer.hs +++ b/src/Coin/UI/Accounts/AccountsTransfer.hs @@ -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 diff --git a/src/Coin/UI/MainMultiList.hs b/src/Coin/UI/MainMultiList.hs --- a/src/Coin/UI/MainMultiList.hs +++ b/src/Coin/UI/MainMultiList.hs @@ -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") ] diff --git a/src/Coin/UI/MainWindow.hs b/src/Coin/UI/MainWindow.hs --- a/src/Coin/UI/MainWindow.hs +++ b/src/Coin/UI/MainWindow.hs @@ -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 diff --git a/src/Coin/UI/Raports/RaportHistoryAll.hs b/src/Coin/UI/Raports/RaportHistoryAll.hs new file mode 100644 --- /dev/null +++ b/src/Coin/UI/Raports/RaportHistoryAll.hs @@ -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 ] diff --git a/src/Coin/UI/Widgets/MiniCalendar.hs b/src/Coin/UI/Widgets/MiniCalendar.hs --- a/src/Coin/UI/Widgets/MiniCalendar.hs +++ b/src/Coin/UI/Widgets/MiniCalendar.hs @@ -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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -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