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 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)