From 341ee99c5d3e9874322f50623587c9064d6867e7 Mon Sep 17 00:00:00 2001 From: Pascal Hof Date: Tue, 12 Dec 2017 10:37:34 +0100 Subject: [PATCH 1/3] Hide IORef in Reader monad #11 --- src/gui/Language/Astview/Gui/Init.hs | 5 +++++ src/gui/Language/Astview/Gui/Types.hs | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/gui/Language/Astview/Gui/Init.hs b/src/gui/Language/Astview/Gui/Init.hs index e4c6fb9..626b6e0 100644 --- a/src/gui/Language/Astview/Gui/Init.hs +++ b/src/gui/Language/Astview/Gui/Init.hs @@ -13,6 +13,11 @@ import Control.Monad.Reader import Control.Monad.Trans (liftIO) import Data.IORef +<<<<<<< 34651e0375c21059d8f26f0aea7afa4ce62f5f74 +======= + + +>>>>>>> Hide IORef in Reader monad #11 import Graphics.UI.Gtk hiding (Language) import Graphics.UI.Gtk.SourceView diff --git a/src/gui/Language/Astview/Gui/Types.hs b/src/gui/Language/Astview/Gui/Types.hs index 54f1eb0..cbfdeac 100644 --- a/src/gui/Language/Astview/Gui/Types.hs +++ b/src/gui/Language/Astview/Gui/Types.hs @@ -67,7 +67,7 @@ data GUI = GUI } --- * getter functions +-- * getAstStateter functions mkLabels [ ''AstState , ''Options From 12193c5d3948614c8e2f770b122932618c84fff6 Mon Sep 17 00:00:00 2001 From: Pascal Hof Date: Tue, 12 Dec 2017 14:31:11 +0100 Subject: [PATCH 2/3] Split program logic and gtk code #11 --- astview.cabal | 1 + src/gui/Language/Astview/Gui/Actions.hs | 324 ++------------------- src/gui/Language/Astview/Gui/GtkActions.hs | 288 ++++++++++++++++++ src/gui/Language/Astview/Gui/Init.hs | 12 +- src/gui/Language/Astview/Gui/Menu.hs | 21 +- 5 files changed, 333 insertions(+), 313 deletions(-) create mode 100644 src/gui/Language/Astview/Gui/GtkActions.hs diff --git a/astview.cabal b/astview.cabal index c9c59c3..5433ab7 100755 --- a/astview.cabal +++ b/astview.cabal @@ -65,6 +65,7 @@ Executable astview -fno-warn-hi-shadowing -fno-warn-name-shadowing Other-Modules: Language.Astview.Gui.Actions + Language.Astview.Gui.GtkActions Language.Astview.Gui.Init Language.Astview.Gui.Menu Language.Astview.Gui.Types diff --git a/src/gui/Language/Astview/Gui/Actions.hs b/src/gui/Language/Astview/Gui/Actions.hs index 09a6505..610d9c4 100644 --- a/src/gui/Language/Astview/Gui/Actions.hs +++ b/src/gui/Language/Astview/Gui/Actions.hs @@ -2,62 +2,41 @@ -} module Language.Astview.Gui.Actions where -import Language.Astview.Gui.Types -import Language.Astview.Language -import Language.Astview.SmallestSrcLocContainingCursor - (smallestSrcLocContainingCursorPos) -import Language.Astview.DataTree(flatten) - - -import Prelude hiding (span,writeFile) -import Data.List (find) -import Control.Monad (when,unless,void,zipWithM_) -import Control.Monad.IO.Class(liftIO) -import Data.Char (toLower) -import System.IO (withFile,IOMode(..),hPutStr,hClose) -import System.FilePath (takeExtension,takeFileName) -import qualified Data.ByteString.Char8 as BS (hGetContents,unpack) -import Data.Tree ( Tree(Node) ) -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative((<$>)) -#endif - -import Graphics.UI.Gtk hiding (Language,response,bufferChanged) -import Graphics.UI.Gtk.SourceView - --- ------------------------------------------------------------------- --- * filemenu menu actions --- ------------------------------------------------------------------- - -clearTreeView :: AstAction () -clearTreeView = do - t <- getTreeView - liftIO $ do - c <- treeViewGetColumn t 0 - case c of - Just col-> treeViewRemoveColumn t col - Nothing -> return 0 - return () +import Language.Astview.DataTree (flatten) +import Language.Astview.Gui.GtkActions +import Language.Astview.Gui.Types +import Language.Astview.Language +import Language.Astview.SmallestSrcLocContainingCursor (smallestSrcLocContainingCursorPos) + +import Control.Monad (unless, void, + when) +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString.Char8 as BS (hGetContents, + unpack) +import Data.List (find) +import Data.Tree (Tree (Node)) +import Prelude hiding + (writeFile) +import System.FilePath (takeExtension, + takeFileName) +import System.IO (IOMode (..), + withFile) -- | resets the GUI, actionEmptyGUI :: AstAction () actionEmptyGUI = do - g <- getGui - sb <- getSourceBuffer clearTreeView - liftIO $ do - flip textBufferSetText ("" :: String) sb - windowSetTitleSuffix (window g) unsavedDoc + sourceViewSetText "" + winSetTitle unsavedDoc -- | updates the sourceview with a given file and parses the file actionLoadHeadless :: FilePath -> AstAction () actionLoadHeadless file = do setCurrentFile file - w <- getWindow - liftIO $ windowSetTitleSuffix w (takeFileName file) - buffer <- getSourceBuffer - liftIO $ textBufferSetText buffer =<< withFile file ReadMode (fmap BS.unpack . BS.hGetContents) + winSetTitle (takeFileName file) + sourceViewSetText =<< liftIO (withFile file ReadMode (fmap BS.unpack . BS.hGetContents)) deleteStar + setChanged False actionReparse -- |tries to find a language based on the extension of @@ -84,29 +63,10 @@ actionGetAst l = do -- | parses the contents of the sourceview with the selected language actionParse :: Language -> AstAction (Tree String) actionParse l = do - buffer <- getSourceBuffer - view <- getTreeView - liftIO $ do - sourceBufferSetHighlightSyntax buffer True - setupSyntaxHighlighting buffer l - tree <- buildTree <$> actionGetAst l clearTreeView - fontsize <- getFontsize - liftIO $ do - model <- treeStoreNew [tree] - treeViewSetModel view model - col <- treeViewColumnNew - renderer <- cellRendererTextNew - cellLayoutPackStart col renderer True - cellLayoutSetAttributes - col - renderer - model - (\row -> [ cellText := row - , cellTextSize := (fromInteger . toInteger) fontsize - ] ) - treeViewAppendColumn view col - return tree + setupSyntaxHighlighting l + tree <- buildTree <$> actionGetAst l + treeviewSetTree tree -- |constructs the tree which will be presented by our gtk-treeview buildTree :: Either Error Ast -> Tree String @@ -115,20 +75,6 @@ buildTree (Left (ErrMessage m)) = Node m [] buildTree (Left (ErrLocation pos m)) = Node ("Parse error at:"++show pos++": "++m) [] buildTree (Right t) = label <$> ast t --- |uses the name of given language to establish syntax highlighting in --- source buffer -setupSyntaxHighlighting :: SourceBuffer -> Language -> IO () -setupSyntaxHighlighting buffer language = do - langManager <- sourceLanguageManagerGetDefault - maybeLang <- sourceLanguageManagerGetLanguage - langManager - (map toLower $ syntax language) - case maybeLang of - Just lang -> do - sourceBufferSetHighlightSyntax buffer True - sourceBufferSetLanguage buffer (Just lang) - Nothing -> sourceBufferSetHighlightSyntax buffer False - -- |saves current file if a file is active or calls "save as"-dialog actionSave :: AstAction () actionSave = do @@ -139,88 +85,8 @@ actionSave = do _ -> do deleteStar writeFile file text + setChanged False --- |sets up a simple filechooser dialog, whose response to Ok --- is given by argument function -actionMkDialog :: FileChooserAction -> (FileChooserDialog -> AstAction ()) -> AstAction() -actionMkDialog fileChooser actionOnOkay = do - dia <- liftIO $ fileChooserDialogNew - (Just ("astview" :: String)) - Nothing - fileChooser - [] - - liftIO $ zipWithM_ (dialogAddButton dia) - [stockCancel,stockOpen] [ResponseCancel,ResponseOk] - - liftIO $ widgetShowAll dia - response <- liftIO $ dialogRun dia - case response of - ResponseCancel -> return () - ResponseOk -> actionOnOkay dia - _ -> return () - liftIO $ widgetHide dia - --- |lanches the "save as"-dialog -actionSaveAs :: AstAction () -actionSaveAs = actionMkDialog FileChooserActionSave onOkay where - - onOkay :: FileChooserDialog -> AstAction () - onOkay dia = do - maybeFile <- liftIO $ fileChooserGetFilename dia - case maybeFile of - Nothing-> return () - Just file -> do - setCurrentFile file - writeFile file =<< getText - --- |removes @*@ from window title if existing and updates state -deleteStar :: AstAction () -deleteStar = do - w <- getWindow - bufferChanged <- getChanged - liftIO $ do - (t :: String) <- get w windowTitle - when bufferChanged $ - set w [windowTitle := tail t] - setChanged False - --- ------------------------------------------------------------------- --- ** editmenu menu actions --- ------------------------------------------------------------------- - --- |moves selected source to clipboard (cut) -actionCutSource :: AstAction () -actionCutSource = do - actionCopySource - actionDeleteSource - --- |copies selected source to clipboard -actionCopySource :: AstAction () -actionCopySource = do - buffer <- getSourceBuffer - liftIO $ do - (start,end) <- textBufferGetSelectionBounds buffer - clipBoard <- clipboardGet selectionClipboard - s :: String <- textBufferGetText buffer start end True - clipboardSetText clipBoard s - --- |pastes text from clipboard at current cursor position -actionPasteSource :: AstAction () -actionPasteSource = do - buffer <- getSourceBuffer - liftIO $ do - clipBoard <- clipboardGet selectionClipboard - clipboardRequestText clipBoard (insertAt buffer) where - - insertAt :: SourceBuffer -> Maybe String -> IO () - insertAt buff m = whenJust m (textBufferInsertAtCursor buff) - --- |deletes selected source -actionDeleteSource :: AstAction () -actionDeleteSource = void $ do - buffer <- getSourceBuffer - liftIO $ textBufferDeleteSelection buffer False False -- |launches a dialog which displays the text position associated to -- last clicked tree node. @@ -242,17 +108,6 @@ actionJumpToTextLoc = do Nothing -> return () Just l -> actionSelectSrcLoc l --- |selects the given source location in gui textview -actionSelectSrcLoc :: SrcSpan -> AstAction () -actionSelectSrcLoc (SrcSpan (SrcPos bl br) (SrcPos el er)) = do - textBuffer <- getSourceBuffer - liftIO $ do - let getIter line row = textBufferGetIterAtLineOffset textBuffer (line-1) (0 `max` row-1) - -- we need to subtract 1 since lines and offsets start with 0 - begin <- getIter bl br - end <- getIter el er - textBufferSelectRange textBuffer begin end - at :: Tree AstNode -> Path -> Maybe SrcSpan at (Node n _ ) [] = srcspan n at (Node _ cs) (i:is) = get i cs >>= \tree -> tree `at` is where @@ -265,19 +120,6 @@ at (Node _ cs) (i:is) = get i cs >>= \tree -> tree `at` is where | otherwise = Just x --- |returns the current cursor position in a source view. --- return type: (line,row) -getCursorPosition :: AstAction SrcSpan -getCursorPosition = do - buffer <- getSourceBuffer - liftIO $ do - (startIter,endIter) <- textBufferGetSelectionBounds buffer - lineStart <- textIterGetLine startIter - rowStart <- textIterGetLineOffset startIter - lineEnd <- textIterGetLine endIter - rowEnd <- textIterGetLineOffset endIter - return $ span (lineStart+1) (rowStart+1) (lineEnd+1) (rowEnd+1) - -- |opens tree position associated with current cursor position. actionJumpToSrcLoc :: AstAction () actionJumpToSrcLoc = do @@ -302,126 +144,18 @@ actionGetAssociatedPath = do return $ smallestSrcLocContainingCursorPos sele ast --- |select tree path -activatePath :: Path -> AstAction () -activatePath p = do - view <- getTreeView - liftIO $ do - treeViewExpandToPath view p - treeViewExpandRow view p True - treeViewSetCursor view p Nothing - -- ------------------------------------------------------------------- -- ** other actions -- ------------------------------------------------------------------- --- | adds '*' to window title if file changed and sets state -actionBufferChanged :: AstAction () -actionBufferChanged = do - w <- fmap window getGui - t <- liftIO $ get w windowTitle - c <- getChanged - unless c $ liftIO $ set w [windowTitle := '*':t] - cp <- getCursorPosition - setCursor cp - setChanged True - -- | destroys window widget actionQuit :: AstAction () actionQuit = do isChanged <- getChanged - when isChanged $ actionQuitWorker + when isChanged $ actionQuitWorker actionSave actionQuitForce actionQuitForce --- |ends program with force -actionQuitForce :: AstAction () -actionQuitForce = do - w <- getWindow - liftIO $ widgetDestroy w - -actionQuitWorker :: AstAction () -actionQuitWorker = do - file <- getCurrentFile - - dialog <- liftIO $ messageDialogNew Nothing [] MessageQuestion ButtonsYesNo - ("Save changes to document \""++takeFileName file ++ "\" before closing?") - response <- liftIO $ do - containerSetBorderWidth dialog 2 - widgetShowAll dialog - dialogRun dialog - case response of - ResponseYes -> actionSave - _ -> actionQuitForce - liftIO $ widgetHide dialog - - --- | launches open dialog -actionDlgOpen :: AstAction () -actionDlgOpen = actionMkDialog FileChooserActionOpen onOkay where - - onOkay :: FileChooserDialog -> AstAction () - onOkay dia = whenJustM (liftIO $ fileChooserGetFilename dia) actionLoadHeadless - --- | launches save dialog -actionDlgSave :: AstAction () -actionDlgSave = actionMkDialog FileChooserActionSave onOkay where - - onOkay :: FileChooserDialog -> AstAction () - onOkay dia = do - maybeFile <- liftIO $ fileChooserGetFilename dia - case maybeFile of - Nothing-> return () - Just file -> do - g <- getGui - setChanged False - setCurrentFile file - writeFile file =<< getText - liftIO $ set (window g) [windowTitle := takeFileName file] - -- |applies current parser to sourcebuffer actionReparse :: AstAction () actionReparse = whenJustM getLanguage (void . actionParse) - -actionGetPath :: AstAction Path -actionGetPath = do - tv <- getTreeView - rows <- liftIO (treeSelectionGetSelectedRows =<< treeViewGetSelection tv) - return $ case rows of - [] -> [] - (p:_) -> p - --- ------------------------------------------------------------------- --- ** Helpers --- ------------------------------------------------------------------- - --- |similar to @when@ -whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () -whenJust Nothing _ = return () -whenJust (Just x) action = action x - --- |similar to @whenJust@, but value is inside a monad -whenJustM :: Monad m => m(Maybe a) -> (a -> m ()) -> m () -whenJustM val action = do - m <- val - whenJust m action - --- |returns the text in given text buffer -getText :: AstAction String -getText = do - tb <- getSourceBuffer - liftIO $ do - start <- textBufferGetStartIter tb - end <- textBufferGetEndIter tb - textBufferGetText tb start end True - --- |uses the given string to set the title of given window with --- suffix "-astview". Window titles should only be set by this --- function, hence it replaces the corresponding gtk function. -windowSetTitleSuffix :: WindowClass w => w -> String -> IO () -windowSetTitleSuffix win title = set win [windowTitle := title++" - astview" ] - --- |safe function to write files -writeFile :: FilePath -> String -> AstAction () -writeFile f str = liftIO $ - withFile f WriteMode (\h -> hPutStr h str >> hClose h) diff --git a/src/gui/Language/Astview/Gui/GtkActions.hs b/src/gui/Language/Astview/Gui/GtkActions.hs new file mode 100644 index 0000000..6626904 --- /dev/null +++ b/src/gui/Language/Astview/Gui/GtkActions.hs @@ -0,0 +1,288 @@ +module Language.Astview.Gui.GtkActions where + +import Graphics.UI.Gtk hiding (Language) +import Graphics.UI.Gtk.SourceView + +import Prelude hiding (span, + writeFile) +import Control.Monad.IO.Class (liftIO) +import Data.Char (toLower) +import Data.Tree (Tree) +import Control.Monad +import System.FilePath (takeFileName) +import System.IO (IOMode (..), + hClose, + hPutStr, + withFile) + +import Language.Astview.Language +import Language.Astview.Gui.Types + + +clearTreeView :: AstAction () +clearTreeView = do + t <- getTreeView + liftIO $ do + c <- treeViewGetColumn t 0 + case c of + Just col-> treeViewRemoveColumn t col + Nothing -> return 0 + return () + +sourceViewSetText :: String -> AstAction () +sourceViewSetText text = do + sb <- getSourceBuffer + liftIO $ textBufferSetText sb text + +winSetTitle :: String -> AstAction () +winSetTitle title = do + w <- getWindow + liftIO $ set w [windowTitle := title++" - astview" ] + +-- | adds '*' to window title if file changed and sets state +actionBufferChanged :: AstAction () +actionBufferChanged = do + w <- fmap window getGui + t <- liftIO $ get w windowTitle + c <- getChanged + unless c $ liftIO $ set w [windowTitle := '*':t] + cp <- getCursorPosition + setCursor cp + setChanged True + +-- |removes @*@ from window title if existing and updates state +deleteStar :: AstAction () +deleteStar = do + w <- getWindow + bufferChanged <- getChanged + liftIO $ do + (t :: String) <- get w windowTitle + when bufferChanged $ + set w [windowTitle := tail t] + +-- |uses the name of given language to establish syntax highlighting in +-- source buffer +setupSyntaxHighlighting :: Language -> AstAction () +setupSyntaxHighlighting language = do + buffer <- getSourceBuffer + liftIO $ do + langManager <- sourceLanguageManagerGetDefault + maybeLang <- sourceLanguageManagerGetLanguage + langManager + (map toLower $ syntax language) + case maybeLang of + Just lang -> do + sourceBufferSetHighlightSyntax buffer True + sourceBufferSetLanguage buffer (Just lang) + Nothing -> sourceBufferSetHighlightSyntax buffer False + + +-- |select tree path +activatePath :: Path -> AstAction () +activatePath p = do + view <- getTreeView + liftIO $ do + treeViewExpandToPath view p + treeViewExpandRow view p True + treeViewSetCursor view p Nothing + +-- |returns the current cursor position in a source view. +-- return type: (line,row) +getCursorPosition :: AstAction SrcSpan +getCursorPosition = do + buffer <- getSourceBuffer + liftIO $ do + (startIter,endIter) <- textBufferGetSelectionBounds buffer + lineStart <- textIterGetLine startIter + rowStart <- textIterGetLineOffset startIter + lineEnd <- textIterGetLine endIter + rowEnd <- textIterGetLineOffset endIter + return $ span (lineStart+1) (rowStart+1) (lineEnd+1) (rowEnd+1) + +-- |selects the given source location in gui textview +actionSelectSrcLoc :: SrcSpan -> AstAction () +actionSelectSrcLoc (SrcSpan (SrcPos bl br) (SrcPos el er)) = do + textBuffer <- getSourceBuffer + liftIO $ do + let getIter line row = textBufferGetIterAtLineOffset textBuffer (line-1) (0 `max` row-1) + -- we need to subtract 1 since lines and offsets start with 0 + begin <- getIter bl br + end <- getIter el er + textBufferSelectRange textBuffer begin end + +treeviewSetTree :: Tree String -> AstAction (Tree String) +treeviewSetTree tree = do + fontsize <- getFontsize + view <- getTreeView + liftIO $ do + model <- treeStoreNew [tree] + treeViewSetModel view model + col <- treeViewColumnNew + renderer <- cellRendererTextNew + cellLayoutPackStart col renderer True + cellLayoutSetAttributes + col + renderer + model + (\row -> [ cellText := row + , cellTextSize := (fromInteger . toInteger) fontsize + ] ) + treeViewAppendColumn view col + return tree + +actionGetPath :: AstAction Path +actionGetPath = do + tv <- getTreeView + rows <- liftIO (treeSelectionGetSelectedRows =<< treeViewGetSelection tv) + return $ case rows of + [] -> [] + (p:_) -> p + + +-- |moves selected source to clipboard (cut) +actionCutSource :: AstAction () +actionCutSource = do + actionCopySource + actionDeleteSource + +-- |copies selected source to clipboard +actionCopySource :: AstAction () +actionCopySource = do + buffer <- getSourceBuffer + liftIO $ do + (start,end) <- textBufferGetSelectionBounds buffer + clipBoard <- clipboardGet selectionClipboard + s :: String <- textBufferGetText buffer start end True + clipboardSetText clipBoard s + +-- |pastes text from clipboard at current cursor position +actionPasteSource :: AstAction () +actionPasteSource = do + buffer <- getSourceBuffer + liftIO $ do + clipBoard <- clipboardGet selectionClipboard + clipboardRequestText clipBoard (insertAt buffer) where + + insertAt :: SourceBuffer -> Maybe String -> IO () + insertAt buff m = whenJust m (textBufferInsertAtCursor buff) + +-- |deletes selected source +actionDeleteSource :: AstAction () +actionDeleteSource = void $ do + buffer <- getSourceBuffer + liftIO $ textBufferDeleteSelection buffer False False + + + + +-- * dialogs + +-- |sets up a simple filechooser dialog, whose response to Ok +-- is given by argument function +actionMkDialog :: FileChooserAction -> (FileChooserDialog -> AstAction ()) -> AstAction() +actionMkDialog fileChooser actionOnOkay = do + dia <- liftIO $ fileChooserDialogNew + (Just ("astview" :: String)) + Nothing + fileChooser + [] + + liftIO $ zipWithM_ (dialogAddButton dia) + [stockCancel,stockOpen] [ResponseCancel,ResponseOk] + + liftIO $ widgetShowAll dia + response <- liftIO $ dialogRun dia + case response of + ResponseCancel -> return () + ResponseOk -> actionOnOkay dia + _ -> return () + liftIO $ widgetHide dia + + +-- |lanches the "save as"-dialog +actionSaveAs :: AstAction () +actionSaveAs = actionMkDialog FileChooserActionSave onOkay where + + onOkay :: FileChooserDialog -> AstAction () + onOkay dia = do + maybeFile <- liftIO $ fileChooserGetFilename dia + case maybeFile of + Nothing-> return () + Just file -> do + setCurrentFile file + Language.Astview.Gui.GtkActions.writeFile file =<< getText + +-- | launches open dialog +actionDlgOpen :: (FilePath -> AstAction ()) -> AstAction () +actionDlgOpen f = actionMkDialog FileChooserActionOpen onOkay where + + onOkay :: FileChooserDialog -> AstAction () + onOkay dia = whenJustM (liftIO $ fileChooserGetFilename dia) f + +-- | launches save dialog +actionDlgSave :: AstAction () +actionDlgSave = actionMkDialog FileChooserActionSave onOkay where + + onOkay :: FileChooserDialog -> AstAction () + onOkay dia = do + maybeFile <- liftIO $ fileChooserGetFilename dia + case maybeFile of + Nothing-> return () + Just file -> do + g <- getGui + setChanged False + setCurrentFile file + writeFile file =<< getText + liftIO $ set (window g) [windowTitle := takeFileName file] + +-- * Shutting down astview + +-- |ends program with force +actionQuitForce :: AstAction () +actionQuitForce = do + w <- getWindow + liftIO $ widgetDestroy w + +actionQuitWorker :: AstAction () -> AstAction () -> AstAction () +actionQuitWorker onYes onElse = do + file <- getCurrentFile + + dialog <- liftIO $ messageDialogNew Nothing [] MessageQuestion ButtonsYesNo + ("Save changes to document \""++takeFileName file ++ "\" before closing?") + response <- liftIO $ do + containerSetBorderWidth dialog 2 + widgetShowAll dialog + dialogRun dialog + case response of + ResponseYes -> onYes + _ -> onElse + liftIO $ widgetHide dialog + +-- * Helper functions + +-- |similar to @when@ +whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () +whenJust Nothing _ = return () +whenJust (Just x) action = action x + +-- |similar to @whenJust@, but value is inside a monad +whenJustM :: Monad m => m(Maybe a) -> (a -> m ()) -> m () +whenJustM val action = do + m <- val + whenJust m action + +-- |returns the text in given text buffer +getText :: AstAction String +getText = do + tb <- getSourceBuffer + liftIO $ do + start <- textBufferGetStartIter tb + end <- textBufferGetEndIter tb + textBufferGetText tb start end True + + + +-- |safe function to write files +writeFile :: FilePath -> String -> AstAction () +writeFile f str = liftIO $ + withFile f WriteMode (\h -> hPutStr h str >> hClose h) diff --git a/src/gui/Language/Astview/Gui/Init.hs b/src/gui/Language/Astview/Gui/Init.hs index 626b6e0..8e33ef6 100644 --- a/src/gui/Language/Astview/Gui/Init.hs +++ b/src/gui/Language/Astview/Gui/Init.hs @@ -5,20 +5,16 @@ function. module Language.Astview.Gui.Init(setupGui,hooks) where import Language.Astview.Gui.Actions +import Language.Astview.Gui.GtkActions import Language.Astview.Gui.Menu import Language.Astview.Gui.Types -import Language.Astview.Languages (languages) +import Language.Astview.Languages (languages) import Control.Monad.Reader -import Control.Monad.Trans (liftIO) +import Control.Monad.Trans (liftIO) import Data.IORef -<<<<<<< 34651e0375c21059d8f26f0aea7afa4ce62f5f74 -======= - - ->>>>>>> Hide IORef in Reader monad #11 -import Graphics.UI.Gtk hiding (Language) +import Graphics.UI.Gtk hiding (Language) import Graphics.UI.Gtk.SourceView setupGui :: Builder -> IO (IORef AstState) diff --git a/src/gui/Language/Astview/Gui/Menu.hs b/src/gui/Language/Astview/Gui/Menu.hs index c7a3bf8..831c4cf 100644 --- a/src/gui/Language/Astview/Gui/Menu.hs +++ b/src/gui/Language/Astview/Gui/Menu.hs @@ -4,19 +4,20 @@ to the respective MenuItems. module Language.Astview.Gui.Menu (initMenu,connect,builderGetObjectStr) where import Language.Astview.Gui.Actions +import Language.Astview.Gui.GtkActions import Language.Astview.Gui.Types import Language.Astview.Language -import Language.Astview.Languages (languages) +import Language.Astview.Languages (languages) -import Control.Monad (forM_) -import Control.Monad.IO.Class (liftIO) +import Control.Monad (forM_) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader -import Data.List (intercalate) -import Data.Monoid ((<>)) -import Graphics.UI.Gtk hiding (Language) -import Paths_astview (getDataFileName) -import System.FilePath (()) -import System.Glib.UTFString (stringToGlib) +import Data.List (intercalate) +import Data.Monoid ((<>)) +import Graphics.UI.Gtk hiding (Language) +import Paths_astview (getDataFileName) +import System.FilePath (()) +import System.Glib.UTFString (stringToGlib) -- |sets up the menu and binds menu items to logic initMenu :: Builder -> AstAction () @@ -70,7 +71,7 @@ menuActions = menuFile ++ menuEdit ++ menuNavigate where menuFile = [("actionNew",actionEmptyGUI) ,("actionSaveAs",actionSaveAs) - ,("actionOpen",actionDlgOpen) + ,("actionOpen",actionDlgOpen actionLoadHeadless) ,("actionSave",actionSave) ,("actionQuit",actionQuit) ] From 78a4e77342e54dbb2b9f384c6d41d4931a4936f2 Mon Sep 17 00:00:00 2001 From: Pascal Hof Date: Wed, 13 Dec 2017 10:34:08 +0100 Subject: [PATCH 3/3] extracted gui types from main state #11 --- src/gui/Language/Astview/Gui/Init.hs | 46 +++++++++++---------------- src/gui/Language/Astview/Gui/Menu.hs | 20 ++++++------ src/gui/Language/Astview/Gui/Types.hs | 27 +++++++++++----- src/gui/Main.hs | 10 ++++-- 4 files changed, 56 insertions(+), 47 deletions(-) diff --git a/src/gui/Language/Astview/Gui/Init.hs b/src/gui/Language/Astview/Gui/Init.hs index 8e33ef6..f5fc7a2 100644 --- a/src/gui/Language/Astview/Gui/Init.hs +++ b/src/gui/Language/Astview/Gui/Init.hs @@ -2,7 +2,7 @@ function. - -} -module Language.Astview.Gui.Init(setupGui,hooks) where +module Language.Astview.Gui.Init(setupGui,setupAstState,hooks) where import Language.Astview.Gui.Actions import Language.Astview.Gui.GtkActions @@ -10,22 +10,19 @@ import Language.Astview.Gui.Menu import Language.Astview.Gui.Types import Language.Astview.Languages (languages) -import Control.Monad.Reader import Control.Monad.Trans (liftIO) import Data.IORef import Graphics.UI.Gtk hiding (Language) import Graphics.UI.Gtk.SourceView -setupGui :: Builder -> IO (IORef AstState) -setupGui builder = do - gui <- builderToGui builder - let initState = AstState (defaultValue { knownLanguages = languages}) gui defaultValue - newIORef initState +setupAstState :: IO (IORef AstState) +setupAstState = do + newIORef $ AstState (defaultValue { knownLanguages = languages}) defaultValue -- |builds initial gui state from builder file -builderToGui :: Builder -> IO GUI -builderToGui builder = do +setupGui :: Builder -> IO GUI +setupGui builder = do win <- builderGetObjectStr builder castToWindow "mainWindow" treeview <- builderGetObjectStr builder castToTreeView "treeview" tb <- buildSourceView =<< builderGetObjectStr builder castToScrolledWindow "swSource" @@ -50,41 +47,36 @@ buildSourceView sw = do -- | adds actions to widgets defined in type 'Gui'. hooks :: AstAction (ConnectId Window) hooks = do - storeLastActiveTextPosition - storeLastActiveTreePosition - closeAstviewOnWindowClosed - close + runner <- ioRunner + storeLastActiveTextPosition runner + storeLastActiveTreePosition runner + closeAstviewOnWindowClosed runner + close runner -type Hook a = AstAction (ConnectId a) +type Hook a = (AstAction () -> IO ()) -> AstAction (ConnectId a) -- |stores the last active cursor position in text to the program state storeLastActiveTextPosition :: Hook SourceBuffer -storeLastActiveTextPosition = do - ioref <- ask +storeLastActiveTextPosition runner = do buffer <- getSourceBuffer - - liftIO $ buffer `on` bufferChanged $ do - runReaderT actionBufferChanged ioref + liftIO $ buffer `on` bufferChanged $ runner actionBufferChanged -- |stores the path to the last selected tree cell to the program state storeLastActiveTreePosition :: Hook TreeView -storeLastActiveTreePosition = do - ioref <- ask +storeLastActiveTreePosition runner = do tree <- getTreeView - liftIO $ tree `on` cursorChanged $ do (p,_) <- treeViewGetCursor tree - runReaderT (setTreePath p) ioref + runner (setTreePath p) -- |softly terminate application on main window closed closeAstviewOnWindowClosed :: Hook Window -closeAstviewOnWindowClosed = do - ioref <- ask +closeAstviewOnWindowClosed runner = do w <- getWindow - liftIO $ w `on` deleteEvent $ tryEvent $ liftIO $ runReaderT actionQuit ioref + liftIO $ w `on` deleteEvent $ tryEvent $ liftIO $ runner actionQuit -- |terminate application on main window closed close :: Hook Window -close = do +close _ = do w <- getWindow liftIO $ w `on` objectDestroy $ mainQuit diff --git a/src/gui/Language/Astview/Gui/Menu.hs b/src/gui/Language/Astview/Gui/Menu.hs index 831c4cf..c13f458 100644 --- a/src/gui/Language/Astview/Gui/Menu.hs +++ b/src/gui/Language/Astview/Gui/Menu.hs @@ -11,7 +11,6 @@ import Language.Astview.Languages (languages) import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Reader import Data.List (intercalate) import Data.Monoid ((<>)) import Graphics.UI.Gtk hiding (Language) @@ -92,12 +91,12 @@ menuActions = menuFile ++ menuEdit ++ menuNavigate where -- gui function from module Actions connect :: Action -> AstAction (ConnectId Action) connect action = do - st <- ask + runner <- ioRunner liftIO $ do name <- actionGetName action case lookup name menuActions of Nothing -> error $ "No action associated with "++ show name - Just f -> action `on` actionActivated $ runReaderT f st + Just f -> action `on` actionActivated $ runner f -- * the menu File @@ -146,11 +145,14 @@ initMenuEdit actionGroup = do -- |bind the check menu for flattening lists to the boolean value in the state. initMenuItemFlatten :: ActionGroup -> AstAction () initMenuItemFlatten actionGroup = do + run <- ioRunner isFlat <- getFlattenLists - st <- ask - let actionToggleFlatten = ToggleActionEntry "actionFlatten" - "Flatten lists in tree?" - Nothing Nothing Nothing (runReaderT f st) isFlat + let actionToggleFlatten = + ToggleActionEntry "actionFlatten" + "Flatten lists in tree?" + Nothing Nothing Nothing + (run f) + isFlat f :: AstAction () f = do @@ -183,7 +185,7 @@ initMenuNavigate actionGroup = do initMenuLanguages :: ActionGroup -> AstAction () initMenuLanguages actionGroup = do langs <- getKnownLanguages - st <- ask + run <- ioRunner liftIO $ do actionLangs <- actionNewStr "actionMenuLanguages" "Languages" Nothing Nothing actionGroupAddAction actionGroup actionLangs @@ -192,7 +194,7 @@ initMenuLanguages actionGroup = do "Automatically select languages" Nothing Nothing Nothing 0 raes = auto:languagesToRadioActionEntry langs - actionGroupAddRadioActions actionGroup raes 0 (\a -> runReaderT (onRadioChange a) st) + actionGroupAddRadioActions actionGroup raes 0 $ \a -> run (onRadioChange a) -- |creates a 'RadioActionEntry' for every language languagesToRadioActionEntry :: [Language] -> [RadioActionEntry] diff --git a/src/gui/Language/Astview/Gui/Types.hs b/src/gui/Language/Astview/Gui/Types.hs index cbfdeac..abff2c6 100644 --- a/src/gui/Language/Astview/Gui/Types.hs +++ b/src/gui/Language/Astview/Gui/Types.hs @@ -14,12 +14,23 @@ import Language.Astview.Language(Language,SrcSpan,Path,position) class Default a where defaultValue :: a -type AstAction a = ReaderT (IORef AstState) IO a +type AstAction a = ReaderT (IORef AstState) (ReaderT GUI IO) a --- |union of internal program state and gui +-- |run a 'AstAction' by providing values for the reader monad. +-- (in most cases 'ioRunner' is more useful) +runAsIo :: GUI -> IORef AstState -> AstAction a -> IO a +runAsIo gui st f = runReaderT (runReaderT f st) gui + +-- |returns a transformer from 'AstAction' to 'IO' +ioRunner :: AstAction (AstAction a -> IO a) +ioRunner = do + ioref <- ask + gui <- lift ask + return $ \f -> runAsIo gui ioref f + +-- |internal program state data AstState = AstState { state :: State -- ^ intern program state - , gui :: GUI -- ^ gtk data types , options :: Options -- ^ global program options } @@ -58,8 +69,8 @@ instance Default State where -- |unsaved document unsavedDoc :: String unsavedDoc = "Unsaved document" --- |main gui data type, contains gtk components +-- |main gui data type, contains gtk components data GUI = GUI { window :: Window -- ^ main window , tv :: TreeView -- ^ treeview @@ -83,13 +94,13 @@ getAstState = do liftIO (readIORef ioRef) getSourceBuffer :: AstAction SourceBuffer -getSourceBuffer = (sb . gui) <$> getAstState +getSourceBuffer = sb <$> getGui getTreeView :: AstAction TreeView -getTreeView = (tv . gui) <$> getAstState +getTreeView = tv <$> getGui getGui :: AstAction GUI -getGui = gui <$> getAstState +getGui = lift ask getState :: AstAction State getState = state <$> getAstState @@ -114,7 +125,7 @@ getActiveLanguage :: AstAction (Maybe Language) getActiveLanguage = (activeLanguage . state) <$> getAstState getWindow :: AstAction Window -getWindow = (window . gui) <$> getAstState +getWindow = window <$> getGui getFlattenLists :: AstAction Bool getFlattenLists = (flattenLists . options) <$> getAstState diff --git a/src/gui/Main.hs b/src/gui/Main.hs index dbdad95..9f6c519 100644 --- a/src/gui/Main.hs +++ b/src/gui/Main.hs @@ -8,7 +8,7 @@ import System.FilePath (()) import Language.Astview.Gui.Actions (actionEmptyGUI, actionLoadHeadless) -import Language.Astview.Gui.Init (hooks, setupGui) +import Language.Astview.Gui.Init (hooks, setupAstState, setupGui) import Language.Astview.Gui.Menu (initMenu) import Language.Astview.Gui.Types @@ -19,12 +19,16 @@ import Language.Astview.Gui.Types main :: IO () main = do initGUI + builder <- builderNew builderAddFromFile builder =<< getDataFileName ("data" "astview.xml") - ioref <- setupGui builder + + gui <- setupGui builder + ioref <- setupAstState args <- getArgs - flip runReaderT ioref $ do + + runAsIo gui ioref $ do initMenu builder hooks