{- * Programmer: Piotr Borek * E-mail: piotrborek@op.pl * Copyright 2015 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.Options.OptionsAccount ( OptionsAccountWidget, optionsAccountNew, optionsAccountToIDList ) where import qualified System.Glib.Types as Gtk import qualified Graphics.UI.Gtk as Gtk import Graphics.UI.Gtk ( AttrOp(..) ) import Data.Maybe import Control.Monad import Control.Monad.IO.Class import Database.Persist import Coin.DB.Tables import Coin.DB.Functions import Coin.Locale.Translate import Coin.Utils.StringUtils import Coin.UI.Widgets.MessageBox import Coin.Utils.TableView import Coin.UI.Builder.GtkUIBuilder import Coin.UI.Utils.CssUtils import Coin.UI.MainState import Coin.Config.Version data OptionsAccountWidget = OptionsAccountWidget { optionsAccountRoot :: Gtk.VBox, optionsAccountStore :: Gtk.ListStore (Entity AccountsTable) } instance Gtk.GObjectClass OptionsAccountWidget where toGObject = Gtk.toGObject . optionsAccountRoot unsafeCastGObject = undefined instance Gtk.WidgetClass OptionsAccountWidget optionsAccountNew :: MainState -> IO OptionsAccountWidget optionsAccountNew mainState = do let buttonCss = [ "* {" , " transition: 200ms ease-in-out;" , "}" , if gtkVersionOld then ".button {" else "button {" , " border-width: 1px;" , " padding: 5px;" , "}" , if gtkVersionOld then ".button:hover {" else "button:hover {" , " border-color: rgba(40, 40, 40, 0.5);" , "}" ] (treeView, store) <- optionsAccountTableNew (getObject, root) <- uiBuildGtk $ do vbox Nothing False 0 $ do pack Gtk.PackNatural 4 $ hbox Nothing False 4 $ do label Nothing (__"Name") pack Gtk.PackGrow 0 $ entry (Just "entryName") "" hbox Nothing True 0 $ do packing Gtk.PackGrow 0 buttonAttrs [ Gtk.buttonImagePosition := Gtk.PosTop, Gtk.buttonRelief := Gtk.ReliefNone, cssStyle := buttonCss ] buttonFromStock (Just "buttonAdd") Gtk.stockAdd buttonAttrs [ Gtk.buttonImagePosition := Gtk.PosTop, Gtk.buttonRelief := Gtk.ReliefNone, cssStyle := buttonCss ] buttonFromStock (Just "buttonUpdate") Gtk.stockRefresh buttonAttrs [ Gtk.buttonImagePosition := Gtk.PosTop, Gtk.buttonRelief := Gtk.ReliefNone, cssStyle := buttonCss ] buttonFromStock (Just "buttonRemove") Gtk.stockRemove hbox Nothing False 4 $ do pack Gtk.PackNatural 0 $ vbox Nothing False 4 $ do buttonAttrs [ Gtk.buttonImagePosition := Gtk.PosTop ] buttonFromStock (Just "buttonUp") Gtk.stockGoUp buttonAttrs [ Gtk.buttonImagePosition := Gtk.PosTop ] buttonFromStock (Just "buttonDown") Gtk.stockGoDown pack Gtk.PackGrow 0 $ label Nothing "" scrolledWindow (Just "scrolledWindow") $ putWidget treeView let nameEntry = Gtk.castToEntry . fromJust $ getObject "entryName" let buttonAdd = Gtk.castToButton . fromJust $ getObject "buttonAdd" let buttonRemove = Gtk.castToButton . fromJust $ getObject "buttonRemove" let buttonUpdate = Gtk.castToButton . fromJust $ getObject "buttonUpdate" let buttonUp = Gtk.castToButton . fromJust $ getObject "buttonUp" let buttonDown = Gtk.castToButton . fromJust $ getObject "buttonDown" forM_ [buttonAdd, buttonUpdate, buttonRemove, buttonUp, buttonDown] $ flip Gtk.widgetSetSensitive False observableRegister (mainStateSelectedAccountName mainState) $ \_ -> do Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False Gtk.widgetSetSensitive buttonRemove False Gtk.widgetSetSensitive buttonUp False Gtk.widgetSetSensitive buttonDown False Gtk.entrySetText nameEntry "" selection <- Gtk.treeViewGetSelection treeView Gtk.treeSelectionUnselectAll selection void $ Gtk.on treeView Gtk.cursorChanged $ do (index, Entity accountID account) <- optionsAccountGetCursor treeView store listSize <- Gtk.listStoreGetSize store let accountName = accountsTableName account Gtk.entrySetText nameEntry accountName Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False if or [ accountName == mainStateIncomeName mainState , accountName == mainStateOutcomeName mainState , accountName == mainStateCashName mainState ] then Gtk.widgetSetSensitive buttonRemove False else do op <- runDB $ selectFirst ([ OperationsTableFrom ==. accountID ] ||. [ OperationsTableTo ==. accountID ]) [] case op of Just _ -> Gtk.widgetSetSensitive buttonRemove False Nothing -> Gtk.widgetSetSensitive buttonRemove True if | index > 2 && index < listSize - 1 -> do Gtk.widgetSetSensitive buttonUp True Gtk.widgetSetSensitive buttonDown True | index == 2 && listSize /= 3 -> do Gtk.widgetSetSensitive buttonUp False Gtk.widgetSetSensitive buttonDown True | index == listSize - 1 && listSize /= 3 -> do Gtk.widgetSetSensitive buttonUp True Gtk.widgetSetSensitive buttonDown False | otherwise -> do Gtk.widgetSetSensitive buttonUp False Gtk.widgetSetSensitive buttonDown False void $ Gtk.on buttonUp Gtk.buttonActivated $ do (index, entity) <- optionsAccountGetCursor treeView store Gtk.listStoreRemove store index Gtk.listStoreInsert store (index - 1) entity Gtk.treeViewSetCursor treeView [index - 1] Nothing optionsAccountUpdate mainState store void $ Gtk.on buttonDown Gtk.buttonActivated $ do (index, entity) <- optionsAccountGetCursor treeView store Gtk.listStoreRemove store index Gtk.listStoreInsert store (index + 1) entity Gtk.treeViewSetCursor treeView [index + 1] Nothing optionsAccountUpdate mainState store void $ Gtk.on nameEntry Gtk.keyReleaseEvent $ do liftIO $ do name <- strip <$> Gtk.entryGetText nameEntry if null name then do Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False else do list <- Gtk.listStoreToList store let filtered = filter (\(Entity _ account) -> name == accountsTableName account) list if null filtered then do Gtk.widgetSetSensitive buttonAdd True (is, _) <- Gtk.treeViewGetCursor treeView case is of [index] -> do (Entity _ account) <- Gtk.listStoreGetValue store index if or [ accountsTableName account == mainStateIncomeName mainState , accountsTableName account == mainStateOutcomeName mainState , accountsTableName account == mainStateCashName mainState ] then Gtk.widgetSetSensitive buttonUpdate False else Gtk.widgetSetSensitive buttonUpdate True _ -> Gtk.widgetSetSensitive buttonUpdate False else do Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False return True void $ Gtk.on buttonAdd Gtk.buttonActivated $ do name <- strip <$> Gtk.entryGetText nameEntry void $ runDB $ do let accountTable = AccountsTable name 0 accountID <- insert accountTable liftIO $ Gtk.listStoreAppend store $ Entity accountID accountTable Gtk.entrySetText nameEntry "" Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False optionsAccountUpdate mainState store void $ Gtk.on buttonRemove Gtk.buttonActivated $ do (index, (Entity accountID account)) <- optionsAccountGetCursor treeView store messageBoxNew Gtk.MessageQuestion Gtk.ButtonsYesNo (__"Do you want to remove" ++ " \'" ++ accountsTableName account ++ "\' " ++ __"account ?") $ \case Gtk.ResponseYes -> do Gtk.listStoreRemove store index runDB $ delete accountID optionsAccountUpdate mainState store _ -> return () _ <- Gtk.on buttonUpdate Gtk.buttonActivated $ do (index, (Entity accountID account)) <- optionsAccountGetCursor treeView store messageBoxNew Gtk.MessageQuestion Gtk.ButtonsYesNo (__ "Do you want to update" ++ " \'" ++ accountsTableName account ++ "\' " ++ __"account name ?") $ \case Gtk.ResponseYes -> do name <- strip <$> Gtk.entryGetText nameEntry runDB $ do update accountID [AccountsTableName =. name] Just updatedAccount <- get accountID liftIO $ Gtk.listStoreSetValue store index (Entity accountID updatedAccount) Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False optionsAccountUpdate mainState store _ -> return () observableRegister (mainStateAccountsUpdated mainState) $ \entities -> do listSize <- Gtk.listStoreGetSize store when (listSize - 2 /= length entities) $ do Gtk.listStoreClear store (Just incomeEntity) <- runDB $ selectFirst [ AccountsTableId ==. mainStateIncomeID mainState ] [] (Just outcomeEntity) <- runDB $ selectFirst [ AccountsTableId ==. mainStateOutcomeID mainState ] [] forM_ [incomeEntity, outcomeEntity] $ Gtk.listStoreAppend store forM_ entities $ Gtk.listStoreAppend store Gtk.widgetShowAll root return $ OptionsAccountWidget (Gtk.castToVBox root) store where optionsAccountGetCursor treeView store = do ([index], _) <- Gtk.treeViewGetCursor treeView entity <- Gtk.listStoreGetValue store index return (index, entity) optionsAccountToIDList :: OptionsAccountWidget -> IO [AccountsTableId] optionsAccountToIDList accountWidget = do list <- Gtk.listStoreToList $ optionsAccountStore accountWidget forM (drop 2 list) $ \(Entity accountID _) -> return accountID optionsAccountUpdate :: MainState -> Gtk.ListStore (Entity AccountsTable) -> IO () optionsAccountUpdate mainState store = do list <- Gtk.listStoreToList store observableSet (mainStateAccountsUpdated mainState) $ drop 2 list optionsAccountTableNew :: IO (Gtk.TreeView, Gtk.ListStore (Entity AccountsTable)) optionsAccountTableNew = do treeView <- Gtk.treeViewNew store <- Gtk.listStoreNew [] Gtk.treeViewSetModel treeView store column1 <- tableTextColumnNew (__ "Name") store $ \(Entity _ account) -> [ Gtk.cellText := accountsTableName account ] Gtk.treeViewSetHeadersVisible treeView False _ <- Gtk.treeViewAppendColumn treeView column1 Gtk.widgetShowAll treeView return (treeView, store)