My toy editor is not very complicated but it still took a while to build directly. Gtk2Hs is a great library but not as easy to use as HTML + JS. The web has made some amazing progress in making UIs easier to build and I'm hoping that some of those insights can be transferred to the native GUI world.
When you use the gtk api directly, you tend to build things in a hierarchical way based on how you want things laid out. But a lot of the times you want connections between components (I'm hoping to have components that aren't Gtk widgets eventually) that cross hierarchies:
This isn't too bad but once right click menus are added it could get messy. And even when the connections match the hierarchy, you don't want to tie layout to event handling logic.
Glade is supposed to be a solution to this but for my side project coding I'd rather work with direct code.
main :: IO ()
main :: IO ()
main = do
initGUI
window <- windowNew
set window [windowDefaultWidth := 800, windowDefaultHeight := 600]
mainBox <- vBoxNew False 0
_ <- containerAdd window mainBox
buttonBar <- hBoxNew False 0
button <- buttonNewWithLabel "Open Project"
saveButton <- buttonNewWithMnemonic "_Save Files"
refreshButton <- buttonNewWithMnemonic "S_ynchronize Folders"
boxPackStart buttonBar button PackNatural 0
boxPackStart buttonBar saveButton PackNatural 0
boxPackStart buttonBar refreshButton PackNatural 0
widgetShowAll buttonBar
boxPackStart mainBox buttonBar PackNatural 0
editor <- makeEditor
onClicked button $ newFileChooser $ loadFile editor
onClicked saveButton $ saveFiles editor
onClicked refreshButton $ refreshFolders editor
onRowActivated (_fileTreeView editor) $ openFileChooserFile editor
boxPackStart mainBox (mainPane editor) PackGrow 0
onDestroy window mainQuit
widgetShowAll button
widgetShowAll mainBox
widgetShowAll window
mainGUI
makeEditor = do
{- widget creation setup..etc -}
let editorWindow = EditorWindow { mainPane = mainVPane,
_fileTreeView = fileTreeView,
_fileTreeStore = treeStore,
notebook = noteBook,
_rootPath = filePath,
nextGuiId = guiId,
sourceBuffers = buffers
}
consoleBookInitializer editorWindow
return editorWindow
editor <- makeEditor:
onClicked button $ newFileChooser $ loadFile editor
onClicked saveButton $ saveFiles editor
onClicked refreshButton $ refreshFolders editor
Because opening a project and refreshing the folders meant updating the file tree (it should also clear the tabs when opening a project... another bug), the callback needed to get the file tree somehow. But the buttons were created before the file tree since they are on top. Also EditorWindow needs to have the file tree created before it can be created.
I decided to tag components with a String identifier, like HTML ids, then I could query for the component based on the identifier. Like jQuery if the query does not find anything then nothing happens. So then I could setup callbacks without worrying about the order of creating components.
I could store each of the components in a separate container but after trying it out I gave up and went with Data.Dynamic. String identifiers and Data.Dynamic steps aren't the Haskell way but it was the best idea I had at the time. For some extra type-safety I added constants that put the identifiers together with their types.
data Named a = Named { _identifier :: String, _content :: a}
data Widgets = Widgets { _widgets :: HaskQuery.Relation (Named Dynamic) (OrdIndex.OrdIndex String)}
type WidgetRef a = Named (Proxy a)
widgetReference :: String -> WidgetRef a
widgetReference identifier = Named { _identifier = identifier, _content = Proxy}
HaskQuery (as of this post) is just where I put all my query stuff. HaskQuery.Relation is a wrapper around Data.IntMap that makes the interface more SQL-like.
data Relation a b = Relation { _relation :: Data.IntMap.Lazy.IntMap a ,
_lastRowId :: Int, _indices :: UpdatableIndex a b}
deriving (Show)
selectDynamicWithTypeM :: (Data.Typeable.Typeable a, Monad m)
=> Data.Proxy.Proxy a
-> Data.Dynamic.Dynamic
-> Control.Monad.Trans.Cont.Cont (b->m b) a
selectDynamicWithTypeM proxy value =
Control.Monad.Trans.Cont.cont (\continuation ->
(\seed -> (case Data.Dynamic.fromDynamic value of
Just typed -> continuation typed seed
Nothing -> return seed)))
selectM :: Monad m => Relation a c -> Control.Monad.Trans.Cont.Cont (b -> m b) a
selectM relation = Control.Monad.Trans.Cont.cont (\continuation ->
(\seed -> Data.IntMap.Lazy.foldl
(\foldSeed value -> foldSeed >>= continuation value)
(return seed)
(_relation relation)))
selectWidget :: Typeable a => Widgets -> String -> Proxy a -> (HaskQuery.Cont (b -> IO b) a)
selectWidget widgets identifier typeProxy = do
widget <- HaskQuery.selectM $ _widgets widgets
HaskQuery.filterM $ (_identifier widget) == identifier
selectedWidget <- HaskQuery.selectDynamicWithTypeM typeProxy (_content widget)
return selectedWidget
selectWidgetRef :: Typeable a => Widgets -> WidgetRef a -> (HaskQuery.Cont (b -> IO b) a)
selectWidgetRef widgets widgetRef = selectWidget widgets (_identifier widgetRef) (_content widgetRef)
Ok, with that I could now change the direct file tree lookup for refreshing the file list to one that did a lookup for the file tree:
Before
makeEditor = do
{- widget creation setup..etc -}
let editorWindow = EditorWindow { mainPane = mainVPane,
_fileTreeView = fileTreeView,
_fileTreeStore = treeStore,
notebook = noteBook,
_rootPath = filePath,
nextGuiId = guiId,
sourceBuffers = buffers
}
consoleBookInitializer editorWindow
return editorWindow
refreshFolders editor = do
canonicalRootPathMaybe <- atomically $ readTVar (_rootPath editor)
case canonicalRootPathMaybe of
Just canonicalRootPath -> do
forest <- getDirContentsAsTree canonicalRootPath
let fileTreeStore = _fileTreeStore editor
treeStoreClear fileTreeStore
treeStoreInsertForest fileTreeStore [] 0 forest
return ()
Nothing -> return ()
After
fileTreeStoreRef :: WidgetRef (TreeStore DirectoryEntry)
fileTreeStoreRef = widgetReference "fileTreeStore"
makeEditorWindow :: IO EditorWindow
makeEditorWindow = do
filePath <- atomically $ newTVar Nothing
buffers <- atomically $ newTVar IntMap.empty
propertyRelation <- atomically $ newTVar HaskQuery.empty
widgetTVar <- atomically $ newTVar emptyWidgets
guiId <- newIORef 0
let editorWindow = EditorWindow {
_editorWidgets = widgetTVar,
_rootPath = filePath,
nextGuiId = guiId,
sourceBuffers = buffers,
_properties = propertyRelation
}
return editorWindow
refreshFolders :: EditorWindow -> IO ()
refreshFolders editor = do
canonicalRootPathMaybe <- atomically $ readTVar (_rootPath editor)
case canonicalRootPathMaybe of
Just canonicalRootPath -> do
forest <- getDirContentsAsTree canonicalRootPath
_ <- HaskQuery.runQueryM $ do
widgets <- getWidgets (_editorWidgets editor)
fileTreeStore <- selectWidgetRef widgets fileTreeStoreRef
HaskQuery.executeM $ do
treeStoreClear fileTreeStore
treeStoreInsertForest fileTreeStore [] 0 forest
return ()
Nothing -> return ()
The new code is uglier but it's a lot easier to move pieces of code around and separate layout code from event connection code. EditorWindow can now be created without any Gtk widgets which might be useful for writing test code. Another nice thing is that I can now remove the file tree and replace it at run time. This might be useful if I want to rebuild parts of the layout.
I'm still experimenting with the best way to use queries and what the tradeoffs are but it has definitely helped me decouple my GUI code and it's making this project a lot more fun. The code version as of this post is at github/stevechy/HaskellEditor.
