AccountsHistory.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.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 ]