{- * 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.Accounts.AccountsHistory ( accountsHistoryNew ) where import qualified Graphics.UI.Gtk as Gtk import Graphics.UI.Gtk ( AttrOp(..) ) import Data.Maybe 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.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 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 cal gridAttach 0 1 1 1 $ do labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ] label Nothing (__"Account name:") gridAttach 1 1 1 1 $ do labelAttrs [ Gtk.miscXalign := 0.0, Gtk.widgetVExpand := False, Gtk.widgetHExpand := True ] label (Just "accountName") "" gridAttach 0 2 1 1 $ do labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ] label Nothing (__"Current balance:") gridAttach 1 2 1 1 $ do labelAttrs [ Gtk.miscXalign := 0.0 ] label (Just "balance") "0.00" gridAttach 0 3 2 1 $ do widgetAttrs [ Gtk.widgetVExpand := True, Gtk.widgetHExpand := True ] scrolledWindow Nothing $ putWidget historyView let accountName = Gtk.castToLabel . fromJust . getObject $ "accountName" let balance = Gtk.castToLabel . fromJust . getObject $ "balance" observableRegister (mainStateSelectedAccountName mainState) $ \name -> do Gtk.labelSetText accountName name 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 -> MiniCalendarWidget -> IO () accountsHistoryViewUpdate mainState operationsView accountName cal = do accountName' <- Gtk.labelGetText accountName entities <- accountsHistorySelect accountName' cal historyViewUpdate mainState operationsView entities accountsHistoryBalanceUpdate :: Gtk.Label -> Gtk.Label -> IO () accountsHistoryBalanceUpdate accountName balanceLabel = do name <- Gtk.labelGetText accountName accountID <- accountsTableSelectID name val <- accountsTableSelectBalance accountID Gtk.labelSetText balanceLabel $ valueShow val 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 , OperationsTableDate >=. calendarDateToInt (year, 1, 1) , OperationsTableDate <=. calendarDateToInt (year, 12, 31) ] ||. [ OperationsTableTo ==. accountID , OperationsTableDate >=. calendarDateToInt (year, 1, 1) , OperationsTableDate <=. calendarDateToInt (year, 12, 31) ] ) [ Desc OperationsTableDate ]