{- * 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.RaportSummary ( RaportSummaryWidget, castToRaportSummary, raportSummaryNew, raportSummaryUpdate, raportSummaryUpdate' ) where import qualified System.Glib.GObject as Gtk import qualified Graphics.UI.Gtk as Gtk import Graphics.UI.Gtk ( AttrOp(..) ) import Control.Monad import Data.Foldable import Data.Int import Data.IORef import Database.Persist import Coin.DB.Tables import Coin.DB.Functions import Coin.UI.MainState import Coin.Locale.Translate import Coin.Utils.TableView import Coin.Utils.ValueParser type SummaryData = (String, String) data RaportSummaryWidget = RaportSummaryWidget { raportSummaryRoot :: Gtk.TreeView, raportSummaryStore :: Gtk.ListStore SummaryData, raportSummaryAccounts :: IORef [Entity AccountsTable] } instance Gtk.GObjectClass RaportSummaryWidget where toGObject = Gtk.toGObject . raportSummaryRoot unsafeCastGObject = undefined instance Gtk.WidgetClass RaportSummaryWidget castToRaportSummary :: Gtk.WidgetClass cls => cls -> IO RaportSummaryWidget castToRaportSummary widget = do q <- Gtk.quarkFromString "Coin.UI.Raports.RaportSummary" (Just h) <- Gtk.objectGetAttributeUnsafe q widget return h raportSummaryNew :: MainState -> IO RaportSummaryWidget raportSummaryNew mainState = do store <- Gtk.listStoreNew [] treeView <- Gtk.treeViewNewWithModel store col1 <- tableTextColumnNew (__"Account name") store $ \(x, _) -> [ Gtk.cellText := x ] col2 <- tableTextColumnNew (__"Current balance") store $ \(_, x) -> [ Gtk.cellText := x ] forM_ [col1, col2] $ Gtk.treeViewAppendColumn treeView Gtk.treeViewSetHeadersVisible treeView True accounts <- newIORef [] let raportSummary = RaportSummaryWidget treeView store accounts raportSummaryUpdate raportSummary q <- Gtk.quarkFromString "Coin.UI.Raports.RaportSummary" Gtk.objectSetAttribute q treeView $ Just raportSummary observableRegister (mainStateAccountsUpdated mainState) $ \entities -> modifyIORef' accounts (const entities) return raportSummary raportSummaryUpdate' :: Gtk.WidgetClass cls => cls -> IO () raportSummaryUpdate' widget = castToRaportSummary widget >>= raportSummaryUpdate raportSummaryUpdate :: RaportSummaryWidget -> IO () raportSummaryUpdate raportSummary = do let store = raportSummaryStore raportSummary (list, s) <- raportSummarySelect raportSummary Gtk.listStoreClear store forM_ list $ Gtk.listStoreAppend store void $ Gtk.listStoreAppend store ("--------", "") void $ Gtk.listStoreAppend store (__"Sum", valueShow s) raportSummarySelect :: RaportSummaryWidget -> IO ([SummaryData], Int64) raportSummarySelect raportSummary = do entities <- readIORef $ raportSummaryAccounts raportSummary entities' <- forM entities $ \(Entity accountID _) -> runDB $ do (Just e) <- selectFirst [AccountsTableId ==. accountID] [] return e let s = foldr' (\(Entity _ account) x -> x + accountsTableBalance account ) 0 entities' let list = flip map entities' $ \(Entity _ account) -> (accountsTableName account, valueShow $ accountsTableBalance account) return (list, s)