{- * 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 ]