{- * 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.AccountsOutcome ( accountsOutcomeNew ) 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 accountsOutcomeNew :: MainState -> IO Gtk.Widget accountsOutcomeNew mainState = do cal <- calendarNew CalendarSizeNormal operationsView <- historyViewNew False True 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 (__"Subtract 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 (__"From 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 accountsOutcomeViewUpdate mainState operationsView accountName cal accountsOutcomeBalanceUpdate 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 accountsOutcomeAppend mainState cal tagsBox accountName entryDescription value' Gtk.entrySetText entryValue "" Gtk.entrySetText entryDescription "" Gtk.widgetShow errorValue Gtk.widgetSetSensitive buttonAdd False accountsOutcomeViewUpdate mainState operationsView accountName cal accountsOutcomeBalanceUpdate 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 accountsOutcomeRemove accountName entity' accountsOutcomeViewUpdate mainState operationsView accountName cal accountsOutcomeBalanceUpdate 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 accountsOutcomeViewUpdate mainState operationsView accountName cal accountsOutcomeBalanceUpdate accountName balance mainStateSavePropertiesAction mainState "Coin.UI.Accounts.AccountsOutcome" $ do i <- liftIO $ Gtk.comboBoxGetActive tagsBox propertyInsert "i" i mainStateReadPropertiesAction mainState "Coin.UI.Accounts.AccountsOutcome" $ do propertyRead "i" $ \i -> liftIO $ Gtk.comboBoxSetActive tagsBox i return root accountsOutcomeViewUpdate :: MainState -> HistoryViewWidget -> Gtk.Label -> CalendarWidget -> IO () accountsOutcomeViewUpdate mainState operationsView accountName cal = do accountName' <- Gtk.labelGetText accountName entities <- accountsOutcomeSelect mainState accountName' cal historyViewUpdate mainState operationsView entities accountsOutcomeSelect :: MainState -> String -> CalendarWidget -> IO [Entity OperationsTable] accountsOutcomeSelect mainState accountName cal = if (accountName == []) then return [] else do let outcomeID = mainStateOutcomeID mainState (year, _, _) <- calendarGetSelectedDate cal accountID <- accountsTableSelectID accountName runDB $ selectList [ OperationsTableFrom ==. accountID , OperationsTableTo ==. outcomeID , OperationsTableDate >=. calendarDateToInt (year, 1, 1) , OperationsTableDate <=. calendarDateToInt (year, 12, 31) ] [ Desc OperationsTableDate ] accountsOutcomeAppend :: MainState -> CalendarWidget -> Gtk.ComboBox -> Gtk.Label -> Gtk.Entry -> Int -> IO () accountsOutcomeAppend mainState cal tagsBox accountName entryDescription value = do date <- calendarDateToInt <$> calendarGetSelectedDate cal (Just tag) <- Gtk.comboBoxGetActiveText tagsBox tagID <- tagsTableSelectID $ T.unpack tag let toID = mainStateOutcomeID mainState fromName <- Gtk.labelGetText accountName fromID <- accountsTableSelectID fromName desc <- Gtk.entryGetText entryDescription :: IO String runDB $ do void $ insert $ OperationsTable date fromID toID value tagID desc update fromID [AccountsTableBalance -=. (fromIntegral value)] accountsOutcomeRemove :: Gtk.Label -> Entity OperationsTable -> IO () accountsOutcomeRemove accountName entity = do let (Entity entityID op) = entity fromName <- Gtk.labelGetText accountName fromID <- accountsTableSelectID fromName runDB $ do delete entityID update fromID [AccountsTableBalance +=. (fromIntegral $ operationsTableValue op)] accountsOutcomeBalanceUpdate :: Gtk.Label -> Gtk.Label -> IO () accountsOutcomeBalanceUpdate accountName balanceLabel = do name <- Gtk.labelGetText accountName accountID <- accountsTableSelectID name val <- accountsTableSelectBalance accountID Gtk.labelSetText balanceLabel $ valueShow val