RaportHistoryAll.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.RaportHistoryAll (
    RaportHistoryAllWidget,
    castToRaportHistoryAll,
    raportHistoryAllNew,
    raportHistoryAllUpdate,
    raportHistoryAllUpdate'
) where

import qualified System.Glib.GObject as Gtk
import qualified Graphics.UI.Gtk as Gtk
import Graphics.UI.Gtk ( AttrOp(..) )

import Data.Maybe
import Data.Foldable
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.Widgets.MiniCalendar
import Coin.UI.Utils.CalendarUtils
import Coin.UI.HistoryView

data RaportHistoryAllWidget = RaportHistoryAllWidget {
    raportHistoryAllRoot         :: Gtk.Widget,
    raportHistoryAllView         :: HistoryViewWidget,
    raportHistoryAllMiniCalendar :: MiniCalendarWidget,
    raportHistoryAllIncomes      :: Gtk.Label,
    raportHistoryAllOutcomes     :: Gtk.Label
}

instance Gtk.GObjectClass RaportHistoryAllWidget where
    toGObject = Gtk.toGObject . raportHistoryAllRoot
    unsafeCastGObject = undefined

instance Gtk.WidgetClass RaportHistoryAllWidget

castToRaportHistoryAll :: Gtk.WidgetClass cls => cls -> IO RaportHistoryAllWidget
castToRaportHistoryAll widget = do
    q <- Gtk.quarkFromString "Coin.UI.Raports.RaportHistoryAll"
    (Just h) <- Gtk.objectGetAttributeUnsafe q widget
    return h

raportHistoryAllNew :: MainState -> IO RaportHistoryAllWidget
raportHistoryAllNew mainState = do
    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 (__"Incomes:")
            gridAttach 1 1 1 1 $ do
                labelAttrs [ Gtk.miscXalign := 0.0 ]
                label (Just "incomes") "0.00"

            gridAttach 0 2 1 1 $ do
                labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ]
                label Nothing (__"Outcomes:")
            gridAttach 1 2 1 1 $ do
                labelAttrs [ Gtk.miscXalign := 0.0 ]
                label (Just "outcomes") "0.00"

            gridAttach 0 3 2 1 $ do
                widgetAttrs [ Gtk.widgetVExpand := True, Gtk.widgetHExpand := True ]
                scrolledWindow Nothing $ putWidget historyView

    let incomes  = Gtk.castToLabel . fromJust . getObject $ "incomes"
    let outcomes = Gtk.castToLabel . fromJust . getObject $ "outcomes"

    let historyAllWidget = RaportHistoryAllWidget
                            root
                            historyView
                            miniCalendar
                            incomes
                            outcomes

    q <- Gtk.quarkFromString "Coin.UI.Raports.RaportHistoryAll"
    Gtk.objectSetAttribute q root $ Just historyAllWidget

    miniCalendarOnChange miniCalendar $ \_ _ ->
        raportHistoryAllUpdate mainState historyAllWidget

    raportHistoryAllUpdate mainState historyAllWidget

    return historyAllWidget

raportHistoryAllUpdate' :: Gtk.WidgetClass cls => MainState -> cls -> IO ()
raportHistoryAllUpdate' mainState widget = castToRaportHistoryAll widget >>= raportHistoryAllUpdate mainState

raportHistoryAllUpdate :: MainState -> RaportHistoryAllWidget -> IO ()
raportHistoryAllUpdate mainState historyAllWidget = do
    raportHistoryAllViewUpdate historyAllWidget mainState

raportHistoryAllViewUpdate :: RaportHistoryAllWidget -> MainState -> IO ()
raportHistoryAllViewUpdate historyAllWidget mainState = do
    entities <- raportHistoryAllSelect (raportHistoryAllMiniCalendar historyAllWidget)
    historyViewUpdate mainState (raportHistoryAllView historyAllWidget) 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 (raportHistoryAllIncomes historyAllWidget) $ valueShow inSum
    Gtk.labelSetText (raportHistoryAllOutcomes historyAllWidget) $ valueShow outSum

raportHistoryAllSelect :: MiniCalendarWidget -> IO [Entity OperationsTable]
raportHistoryAllSelect cal = do
    (year, month) <- miniCalendarGetDate cal
    runDB $
        selectList [ OperationsTableDate >=. calendarDateToInt (year, month, 1)
                   , OperationsTableDate <=. calendarDateToInt (year, month, 31)
                   ]
                   [ Desc OperationsTableDate ]