{- * 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.OptionsTag ( OptionsTagWidget, optionsTagNew ) 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 OptionsTagWidget = OptionsTagWidget { widgetContainer :: Gtk.VBox } instance Gtk.GObjectClass OptionsTagWidget where toGObject = Gtk.toGObject . widgetContainer unsafeCastGObject = undefined instance Gtk.WidgetClass OptionsTagWidget optionsTagNew :: MainState -> IO OptionsTagWidget optionsTagNew 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) <- optionsTagTableNew (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 scrolledWindow Nothing $ putWidget treeView let nameEntry = Gtk.castToEntry . fromJust $ getObject "entryName" let buttonAdd = Gtk.castToButton . fromJust $ getObject "buttonAdd" let buttonUpdate = Gtk.castToButton . fromJust $ getObject "buttonUpdate" let buttonRemove = Gtk.castToButton . fromJust $ getObject "buttonRemove" forM_ [buttonAdd, buttonUpdate, buttonRemove] $ flip Gtk.widgetSetSensitive False observableRegister (mainStateSelectedAccountName mainState) $ \_ -> do Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False Gtk.widgetSetSensitive buttonRemove False Gtk.entrySetText nameEntry "" selection <- Gtk.treeViewGetSelection treeView Gtk.treeSelectionUnselectAll selection void $ Gtk.on treeView Gtk.cursorChanged $ do (_, (Entity tagID tag)) <- optionsTagGetCursor treeView store let tagName = tagsTableName tag Gtk.entrySetText nameEntry tagName Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False if tagName == mainStateNoneName mainState then Gtk.widgetSetSensitive buttonRemove False else do op <- runDB $ selectFirst [ OperationsTableTag ==. tagID ] [] case op of Just _ -> Gtk.widgetSetSensitive buttonRemove False Nothing -> Gtk.widgetSetSensitive buttonRemove True void $ Gtk.on nameEntry Gtk.keyReleaseEvent $ do liftIO $ do name <- strip <$> Gtk.entryGetText nameEntry if name == [] then do Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False else do list <- Gtk.listStoreToList store let filtered = filter (\(Entity _ tag) -> name == tagsTableName tag) list if length filtered == 0 then do Gtk.widgetSetSensitive buttonAdd True (is, _) <- Gtk.treeViewGetCursor treeView case is of [index] -> do (Entity _ tag) <- Gtk.listStoreGetValue store index if tagsTableName tag == mainStateNoneName 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 tagID <- insert $ TagsTable name liftIO $ Gtk.listStoreAppend store $ Entity tagID (TagsTable name) Gtk.entrySetText nameEntry "" Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False optionsTagUpdate mainState store void $ Gtk.on buttonUpdate Gtk.buttonActivated $ do (index, Entity tagID tag) <- optionsTagGetCursor treeView store messageBoxNew Gtk.MessageQuestion Gtk.ButtonsYesNo ((__"Do you want to update") ++ " \'" ++ tagsTableName tag ++ "\' " ++ (__"tag name ?")) $ \case Gtk.ResponseYes -> do name <- strip <$> Gtk.entryGetText nameEntry runDB $ do update tagID [TagsTableName =. name] Just updatedTag <- get tagID liftIO $ Gtk.listStoreSetValue store index (Entity tagID updatedTag) Gtk.widgetSetSensitive buttonAdd False Gtk.widgetSetSensitive buttonUpdate False optionsTagUpdate mainState store _ -> return () void $ Gtk.on buttonRemove Gtk.buttonActivated $ do (index, Entity tagID tag) <- optionsTagGetCursor treeView store messageBoxNew Gtk.MessageQuestion Gtk.ButtonsYesNo ((__"Do you want to remove") ++ " \'" ++ tagsTableName tag ++ "\' " ++ (__"tag ?")) $ \case Gtk.ResponseYes -> do Gtk.listStoreRemove store index runDB $ delete tagID optionsTagUpdate mainState store _ -> return () observableRegister (mainStateTagsUpdated mainState) $ \entities -> do listSize <- Gtk.listStoreGetSize store when (listSize /= length entities) $ do Gtk.listStoreClear store forM_ entities $ Gtk.listStoreAppend store Gtk.widgetShowAll root return $ OptionsTagWidget $ Gtk.castToVBox root where optionsTagGetCursor treeView store = do ([index], _) <- Gtk.treeViewGetCursor treeView entity <- Gtk.listStoreGetValue store index return (index, entity) optionsTagUpdate :: MainState -> Gtk.ListStore (Entity TagsTable) -> IO () optionsTagUpdate mainState store = do list <- Gtk.listStoreToList store observableSet (mainStateTagsUpdated mainState) list optionsTagTableNew :: IO (Gtk.TreeView, Gtk.ListStore (Entity TagsTable)) optionsTagTableNew = do treeView <- Gtk.treeViewNew store <- Gtk.listStoreNew [] Gtk.treeViewSetModel treeView store column1 <- tableTextColumnNew (__ "Name") store $ \(Entity _ tag) -> [ Gtk.cellText := tagsTableName tag ] Gtk.treeViewSetHeadersVisible treeView False _ <- Gtk.treeViewAppendColumn treeView column1 Gtk.widgetShowAll treeView return (treeView, store)