{- * 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 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} module Coin.UI.Accounts.AccountsIncome ( accountsIncomeNew ) where import qualified Graphics.UI.Gtk as Gtk import Graphics.UI.Gtk ( AttrOp(..) ) import qualified Data.Text as T import qualified Data.List as List import Database.Persist import Data.Maybe import Control.Concurrent.MVar import Control.Monad import Control.Monad.IO.Class import Coin.DB.Tables import Coin.DB.Functions import Coin.UI.MainState import Coin.UI.Widgets.Calendar import Coin.UI.Builder.GtkUIBuilder import Coin.UI.TagsComboBox import Coin.UI.Utils.CalendarUtils import Coin.Locale.Translate import Coin.Utils.ValueParser import Coin.UI.HistoryView accountsIncomeNew :: MainState -> IO Gtk.Widget accountsIncomeNew mainState = do cal <- calendarNew CalendarSizeNormal operationsView <- historyViewNew True False False tagsBox <- tagsComboBoxNew mainState (getObject, root) <- uiBuildGtk $ do globalCss [ "#Marked {" , " font-weight: bold;" , "}" , "image {" , " margin-left: 10px;" , "}" ] 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 (__"Tag:") gridAttach 1 1 1 1 $ putWidget tagsBox gridAttach 0 2 1 1 $ do labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ] label Nothing (__"Add value:") gridAttach 1 2 1 1 $ hbox Nothing False 0 $ do pack Gtk.PackNatural 0 $ entry (Just "entryValue") "" pack Gtk.PackNatural 0 $ imageFromStock (Just "errorValue") Gtk.stockDialogError Gtk.IconSizeMenu label Nothing "" gridAttach 0 3 1 1 $ do labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ] label Nothing (__"To account:") gridAttach 1 3 1 1 $ do labelAttrs [ Gtk.miscXalign := 0.0 ] label (Just "accountName") "" gridAttach 0 4 1 1 $ do labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ] label Nothing (__"Description:") gridAttach 1 4 1 1 $ entry (Just "entryDescription") "" gridAttach 0 5 1 1 $ do labelAttrs [ Gtk.miscXalign := 1.0, Gtk.widgetName := Just "Marked" ] label Nothing (__"Current balance:") gridAttach 1 5 1 1 $ do labelAttrs [ Gtk.miscXalign := 0.0 ] label (Just "balance") "0.00" gridAttach 0 6 2 1 $ hbox Nothing False 0 $ do label Nothing "" buttonAttrs [ Gtk.widgetWidthRequest := 150, Gtk.buttonImagePosition := Gtk.PosLeft ] pack Gtk.PackNatural 0 $ buttonFromStock (Just "buttonAdd") Gtk.stockAdd gridAttach 0 7 2 1 $ do widgetAttrs [ Gtk.widgetVExpand := True, Gtk.widgetHExpand := True ] scrolledWindow Nothing $ putWidget operationsView gridAttach 0 8 2 1 $ hbox Nothing False 0 $ do label Nothing "" buttonAttrs [ Gtk.widgetWidthRequest := 150, Gtk.buttonImagePosition := Gtk.PosLeft ] pack Gtk.PackNatural 0 $ buttonFromStock (Just "buttonRemove") Gtk.stockRemove let entryValue = Gtk.castToEntry . fromJust . getObject $ "entryValue" let errorValue = fromJust . getObject $ "errorValue" let entryDescription = Gtk.castToEntry . fromJust . getObject $ "entryDescription" let buttonAdd = Gtk.castToButton . fromJust . getObject $ "buttonAdd" let buttonRemove = Gtk.castToButton . fromJust . getObject $ "buttonRemove" let accountName = Gtk.castToLabel . fromJust . getObject $ "accountName" let balance = Gtk.castToLabel . fromJust . getObject $ "balance" Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonRemove False observableRegister (mainStateSelectedAccountName mainState) $ \name -> do labelName <- Gtk.labelGetText accountName when (labelName /= name) $ do Gtk.labelSetText accountName name accountsIncomeViewUpdate mainState operationsView accountName cal accountsIncomeBalanceUpdate accountName balance void $ Gtk.on entryValue Gtk.keyReleaseEvent $ do value <- liftIO $ parseValue <$> Gtk.entryGetText entryValue liftIO $ case value of Just _ -> do Gtk.widgetHide errorValue Gtk.widgetSetSensitive buttonAdd True Nothing -> do Gtk.widgetShow errorValue Gtk.widgetSetSensitive buttonAdd False return True void $ Gtk.on buttonAdd Gtk.buttonActivated $ do value <- parseValue <$> Gtk.entryGetText entryValue case value of Just value' -> do accountsIncomeAppend mainState cal tagsBox accountName entryDescription value' Gtk.entrySetText entryValue "" Gtk.entrySetText entryDescription "" Gtk.widgetShow errorValue Gtk.widgetSetSensitive buttonAdd False accountsIncomeViewUpdate mainState operationsView accountName cal accountsIncomeBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name Nothing -> return () void $ Gtk.on buttonRemove Gtk.buttonActivated $ do entity <- historyViewGetSelected operationsView case entity of Just entity' -> do accountsIncomeRemove accountName entity' accountsIncomeViewUpdate mainState operationsView accountName cal accountsIncomeBalanceUpdate accountName balance name <- Gtk.labelGetText accountName observableSet (mainStateSelectedAccountName mainState) name Nothing -> return () void $ Gtk.on operationsView Gtk.cursorChanged $ do (path, _) <- Gtk.treeViewGetCursor operationsView if List.null path then Gtk.widgetSetSensitive buttonRemove False else Gtk.widgetSetSensitive buttonRemove True (y, _, _) <- calendarGetSelectedDate cal curYear <- newMVar y calendarOnChange cal $ \year _ _ -> do yy <- readMVar curYear when (yy /= year) $ do modifyMVar_ curYear $ const $ return year accountsIncomeViewUpdate mainState operationsView accountName cal accountsIncomeBalanceUpdate accountName balance mainStateSavePropertiesAction mainState "Coin.UI.Accounts.AccountsIncome" $ do i <- liftIO $ Gtk.comboBoxGetActive tagsBox propertyInsert "i" i mainStateReadPropertiesAction mainState "Coin.UI.Accounts.AccountsIncome" $ do propertyRead "i" $ \i -> liftIO $ Gtk.comboBoxSetActive tagsBox i return root accountsIncomeViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> CalendarWidget -> IO () accountsIncomeViewUpdate mainState operationsView accountName cal = do accountName' <- Gtk.labelGetText accountName entities <- accountsIncomeSelect mainState accountName' cal historyViewUpdate mainState operationsView entities accountsIncomeSelect :: MainState -> String -> CalendarWidget -> IO [Entity OperationsTable] accountsIncomeSelect mainState accountName cal = if (accountName == []) then return [] else do let incomeID = mainStateIncomeID mainState (year, _, _) <- calendarGetSelectedDate cal accountID <- accountsTableSelectID accountName runDB $ selectList [ OperationsTableFrom ==. incomeID , OperationsTableTo ==. accountID , OperationsTableDate >=. calendarDateToInt (year, 1, 1) , OperationsTableDate <=. calendarDateToInt (year, 12, 31) ] [ Desc OperationsTableDate ] accountsIncomeAppend :: MainState -> CalendarWidget -> Gtk.ComboBox -> Gtk.Label -> Gtk.Entry -> Int -> IO () accountsIncomeAppend mainState cal tagsBox accountName entryDescription value = do date <- calendarDateToInt <$> calendarGetSelectedDate cal (Just tag) <- Gtk.comboBoxGetActiveText tagsBox tagID <- tagsTableSelectID $ T.unpack tag let fromID = mainStateIncomeID mainState toName <- Gtk.labelGetText accountName toID <- accountsTableSelectID toName desc <- Gtk.entryGetText entryDescription :: IO String runDB $ do void $ insert $ OperationsTable date fromID toID value tagID desc update toID [AccountsTableBalance +=. (fromIntegral value)] accountsIncomeRemove :: Gtk.Label -> Entity OperationsTable -> IO () accountsIncomeRemove accountName entity = do let (Entity entityID op) = entity toName <- Gtk.labelGetText accountName toID <- accountsTableSelectID toName runDB $ do delete entityID update toID [AccountsTableBalance -=. (fromIntegral $ operationsTableValue op)] accountsIncomeBalanceUpdate :: Gtk.Label -> Gtk.Label -> IO () accountsIncomeBalanceUpdate accountName balanceLabel = do name <- Gtk.labelGetText accountName accountID <- accountsTableSelectID name val <- accountsTableSelectBalance accountID Gtk.labelSetText balanceLabel $ valueShow val