RaportSummary.hs

{-
 *  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 Database.Persist

import Coin.DB.Tables
import Coin.DB.Functions
import Coin.UI.MainState
import Coin.Utils.I18N
import Coin.Utils.TableView
import Coin.Utils.ValueParser

type SummaryData = (String, String)

data RaportSummaryWidget = RaportSummaryWidget {
    raportSummaryRoot  :: Gtk.TreeView,
    raportSummaryStore :: Gtk.ListStore SummaryData
}

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

    let raportSummary = RaportSummaryWidget treeView store
    raportSummaryUpdate mainState raportSummary

    q <- Gtk.quarkFromString "Coin.UI.Raports.RaportSummary"
    Gtk.objectSetAttribute q treeView $ Just raportSummary

    return raportSummary

raportSummaryUpdate' :: Gtk.WidgetClass cls => MainState -> cls -> IO ()
raportSummaryUpdate' mainState widget = castToRaportSummary widget >>= raportSummaryUpdate mainState

raportSummaryUpdate :: MainState -> RaportSummaryWidget -> IO ()
raportSummaryUpdate mainState raportSummary = do
    let store = raportSummaryStore raportSummary
    (list, s) <- raportSummarySelect mainState

    Gtk.listStoreClear store
    forM_ list $ Gtk.listStoreAppend store

    void $ Gtk.listStoreAppend store ("--------", "")
    void $ Gtk.listStoreAppend store (__"Sum", valueShow s)

raportSummarySelect :: MainState -> IO ([SummaryData], Int64)
raportSummarySelect mainState = do
    let incomeID = mainStateIncomeID mainState
    let outcomeID = mainStateOutcomeID mainState

    entities <- runDB $
        selectList [ AccountsTableId !=. incomeID, AccountsTableId !=. outcomeID] []

    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)