Dizajniranje GUI aplikacije je nesto gde su se code generatori pokazali pa samo popunjavas event handlere ;)
To je radilo 90ih bez problema, a verujem i sad.
A sad da dam malo koda evo primera male CRUD aplikacije u Haskell-u ;)
Code:
module Main where
import Graphics.UI.Gtk
import Graphics.UI.Gtk.ModelView as Model
import Control.Monad.Trans
import Control.Monad (void)
import Data.Char
import Data.List
import Database.HDBC
import Database.HDBC.PostgreSQL
main :: IO ()
main = do
initGUI -- is start
conn <- connectPostgreSQL "dbname='test' user='postgres'"
window <- windowNew
rows <- quickQuery' conn "SELECT * from names" []
let vals = map (\[id,name]-> (fromSql id,fromSql name)) rows
list <- listStoreNew vals
list1 <- treeModelSortNewWithModel list
has <- treeSortableHasDefaultSortFunc list1
treeSortableSetSortFunc list1 0 $ \iter1 iter2 -> do
(i1:_) <- treeModelGetPath list iter1
(id1,_) <- listStoreGetValue list i1
(i2:_) <- treeModelGetPath list iter2
(id2,_) <- listStoreGetValue list i2
return (id1 `compare` id2)
treeSortableSetSortFunc list1 1 $ \iter1 iter2 -> do
(i1:_) <- treeModelGetPath list iter1
(_,raw1) <- listStoreGetValue list i1
(i2:_) <- treeModelGetPath list iter2
(_,raw2) <- listStoreGetValue list i2
return (raw1 `compare` raw2)
putStrLn $ "has "++show has
treeview <- Model.treeViewNewWithModel list1
scrolled <- scrolledWindowNew Nothing Nothing
Model.treeViewSetHeadersVisible treeview True
colId <- Model.treeViewColumnNew
colName <- Model.treeViewColumnNew
Model.treeViewColumnSetTitle colId "Id"
Model.treeViewColumnSetTitle colName "Name"
renderer <- Model.cellRendererTextNew
Model.cellLayoutPackStart colId renderer True
Model.cellLayoutPackStart colName renderer True
Model.cellLayoutSetAttributes colId renderer list
$ \ind -> [Model.cellText := show $ fst ind, Model.cellTextEditable := False]
Model.cellLayoutSetAttributes colName renderer list
$ \ind -> [Model.cellText := snd ind, Model.cellTextEditable := True]
on renderer edited $ \paths val -> do
(pathchild:_) <- treeModelSortConvertPathToChildPath list1 paths
(id,row) <- listStoreGetValue list pathchild
listStoreSetValue list pathchild (id,val)
void $ run conn "update names set name = ? where id = ?" [toSql val,toSql id]
commit conn
treeViewColumnSetSortColumnId colId 0
treeViewColumnSetSortColumnId colName 1
treeSortableSetSortColumnId list1 1 SortAscending
Model.treeViewAppendColumn treeview colId
Model.treeViewAppendColumn treeview colName
tree <- Model.treeViewGetSelection treeview
Model.treeSelectionSetMode tree SelectionBrowse --Multiple
on tree treeSelectionSelectionChanged (oneSelection list1 list tree)
Model.treeViewSetEnableSearch treeview True
Model.treeViewSetSearchEqualFunc treeview $ Just $ \str iter -> do
iterchild <- treeModelSortConvertIterToChildIter list1 iter
(i:_) <- treeModelGetPath list iterchild
(_,row) <- listStoreGetValue list i
return (map toLower str `isPrefixOf` map toLower row)
vbox <- vBoxNew False 0
buttonAppend <- buttonNewWithLabel "Append"
buttonDelete <- buttonNewWithLabel "Delete"
bbox <- hButtonBoxNew
buttonBoxSetLayout bbox ButtonboxEnd
containerSetBorderWidth bbox 5
boxSetSpacing bbox 5
boxPackStart bbox buttonAppend PackNatural 0
boxPackStart bbox buttonDelete PackNatural 0
containerAdd scrolled treeview
boxPackStart vbox scrolled PackGrow 0
boxPackStart vbox bbox PackNatural 0
containerAdd window vbox
buttonAppend `on` buttonActivated $ do
putStrLn "append button clicked"
([res]:_) <- quickQuery' conn "insert into names (name) values (?) returning id" [toSql "new name"]
commit conn
path <- addToList list (fromSql res,"new name")
pathparent <- treeModelSortConvertChildPathToPath list1 [path]
treeSelectionSelectPath tree pathparent
buttonDelete `on` buttonActivated $ do
putStrLn "delete button clicked"
sel <- Model.treeSelectionGetSelectedRows tree
if sel /= []
then do
let s = (head sel)
(path:_) <- treeModelSortConvertPathToChildPath list1 s
(id,row) <- Model.listStoreGetValue list path
putStrLn $ "deleting " ++ show id ++ " " ++ row
void $ run conn "delete from names where id = ?" [toSql id]
commit conn
Model.listStoreRemove list path
else putStrLn "nothing selected"
set window [ windowDefaultWidth := 400
, windowDefaultHeight := 400
]
on window objectDestroy mainQuit
windowSetPosition window WinPosCenter
windowSetIconFromFile window "/home/bmaxa/Pictures/lola.png"
widgetShowAll window
mainGUI
return ()
addToList :: ListStore (Int,String) -> (Int,String) -> IO Int
addToList list (id,str) = do
listStoreAppend list (id,str)
oneSelection :: (TreeModelSortClass a)=>a->ListStore (Int,String)->TreeSelection -> IO()
oneSelection list1 list tree = do
sel <- Model.treeSelectionGetSelectedRows tree
if sel /= []
then do
let s = (head sel)
(path:_) <- treeModelSortConvertPathToChildPath list1 s
v <- Model.listStoreGetValue list path
putStrLn $ "selected " ++ show v
else putStrLn "nothing selected"