coin-1.0: src/Coin/UI/Raports/RaportHistory.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.RaportHistory (
RaportHistoryWidget,
castToRaportHistory,
raportHistoryNew,
raportHistoryUpdate,
raportHistoryUpdate'
) where
import qualified System.Glib.GObject as Gtk
import qualified Graphics.UI.Gtk as Gtk
import Graphics.UI.Gtk ( AttrOp(..) )
import qualified Data.Text as T
import Control.Monad
import Control.Monad.IO.Class
import Data.Maybe
import Data.Foldable
import Database.Persist
import Coin.DB.Tables
import Coin.DB.Functions
import Coin.Utils.I18N
import Coin.Utils.ValueParser
import Coin.UI.MainState
import Coin.UI.Builder.GtkUIBuilder
import Coin.UI.Widgets.MiniCalendar
import Coin.UI.Utils.CalendarUtils
import Coin.UI.HistoryView
import Coin.UI.AccountsComboBox
data RaportHistoryWidget = RaportHistoryWidget {
raportHistoryRoot :: Gtk.Widget,
raportHistoryAccountsBox :: Gtk.ComboBox,
raportHistoryView :: HistoryViewWidget,
raportHistoryMiniCalendar :: MiniCalendarWidget,
raportHistoryBalance :: Gtk.Label,
raportHistoryIncomes :: Gtk.Label,
raportHistoryOutcomes :: Gtk.Label
}
instance Gtk.GObjectClass RaportHistoryWidget where
toGObject = Gtk.toGObject . raportHistoryRoot
unsafeCastGObject = undefined
instance Gtk.WidgetClass RaportHistoryWidget
castToRaportHistory :: Gtk.WidgetClass cls => cls -> IO RaportHistoryWidget
castToRaportHistory widget = do
q <- Gtk.quarkFromString "Coin.UI.Raports.RaportHistory"
(Just h) <- Gtk.objectGetAttributeUnsafe q widget
return h
raportHistoryNew :: MainState -> IO RaportHistoryWidget
raportHistoryNew mainState = do
accountsBox <- accountsComboBoxNew mainState
historyView <- historyViewNew True True True
miniCalendar <- miniCalendarNew
(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 miniCalendar
gridAttach 0 1 1 1 $ do
labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]
label Nothing (__"Account name:")
gridAttach 1 1 1 1 $ putWidget accountsBox
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 1 1 $ do
labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]
label Nothing (__"Incomes:")
gridAttach 1 3 1 1 $ do
labelAttrs [ Gtk.miscXalign := 0.0 ]
label (Just "incomes") "0.00"
gridAttach 0 4 1 1 $ do
labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]
label Nothing (__"Outcomes:")
gridAttach 1 4 1 1 $ do
labelAttrs [ Gtk.miscXalign := 0.0 ]
label (Just "outcomes") "0.00"
gridAttach 0 5 2 1 $ do
widgetAttrs [ Gtk.widgetVExpand := True, Gtk.widgetHExpand := True ]
scrolledWindow Nothing $ putWidget historyView
let balance = Gtk.castToLabel . fromJust . getObject $ "balance"
let incomes = Gtk.castToLabel . fromJust . getObject $ "incomes"
let outcomes = Gtk.castToLabel . fromJust . getObject $ "outcomes"
let historyWidget = RaportHistoryWidget
root
accountsBox
historyView
miniCalendar
balance
incomes
outcomes
q <- Gtk.quarkFromString "Coin.UI.Raports.RaportHistory"
Gtk.objectSetAttribute q root $ Just historyWidget
void $ Gtk.on accountsBox Gtk.changed $ raportHistoryUpdate mainState historyWidget
miniCalendarOnChange miniCalendar $ \_ _ ->
raportHistoryUpdate mainState historyWidget
raportHistoryUpdate mainState historyWidget
mainStateSavePropertiesAction mainState "Coin.UI.Raports.RaportHistory" $ do
i <- liftIO $ Gtk.comboBoxGetActive accountsBox
propertyInsert "i" i
mainStateReadPropertiesAction mainState "Coin.UI.Raports.RaportHistory" $ do
propertyRead "i" $ \i ->
liftIO $ Gtk.comboBoxSetActive accountsBox i
return historyWidget
raportHistoryUpdate' :: Gtk.WidgetClass cls => MainState -> cls -> IO ()
raportHistoryUpdate' mainState widget = castToRaportHistory widget >>= raportHistoryUpdate mainState
raportHistoryUpdate :: MainState -> RaportHistoryWidget -> IO ()
raportHistoryUpdate mainState historyWidget = do
raportHistoryViewUpdate historyWidget mainState
raportHistoryBalanceUpdate historyWidget
raportHistoryBalanceUpdate :: RaportHistoryWidget -> IO ()
raportHistoryBalanceUpdate historyWidget = do
name <- Gtk.comboBoxGetActiveText (raportHistoryAccountsBox historyWidget)
when (isJust name) $ do
accountID <- accountsTableSelectID $ T.unpack $ fromJust name
val <- accountsTableSelectBalance accountID
Gtk.labelSetText (raportHistoryBalance historyWidget) $ valueShow val
raportHistoryViewUpdate :: RaportHistoryWidget -> MainState -> IO ()
raportHistoryViewUpdate historyWidget mainState = do
name <- Gtk.comboBoxGetActiveText (raportHistoryAccountsBox historyWidget)
when (isJust name) $ do
entities <- raportHistorySelect (raportHistoryMiniCalendar historyWidget) $ T.unpack $ fromJust name
historyViewUpdate mainState (raportHistoryView historyWidget) entities
let incomeID = mainStateIncomeID mainState
let outcomeID = mainStateOutcomeID mainState
let inSum = foldr' (\(Entity _ op) s ->
if operationsTableFrom op == incomeID
then s + operationsTableValue op
else s )
0
entities
let outSum = foldr' (\(Entity _ op) s ->
if operationsTableTo op == outcomeID
then s + operationsTableValue op
else s )
0
entities
Gtk.labelSetText (raportHistoryIncomes historyWidget) $ valueShow inSum
Gtk.labelSetText (raportHistoryOutcomes historyWidget) $ valueShow outSum
raportHistorySelect :: MiniCalendarWidget -> String -> IO [Entity OperationsTable]
raportHistorySelect cal accountName =
if (accountName == [])
then return []
else do
accountID <- accountsTableSelectID accountName
(year, month) <- miniCalendarGetDate cal
runDB $
selectList ( [ OperationsTableFrom ==. accountID
, OperationsTableDate >=. calendarDateToInt (year, month, 1)
, OperationsTableDate <=. calendarDateToInt (year, month, 31)
]
||. [ OperationsTableTo ==. accountID
, OperationsTableDate >=. calendarDateToInt (year, month, 1)
, OperationsTableDate <=. calendarDateToInt (year, month, 31)
]
)
[ Desc OperationsTableDate ]