astview (empty) → 0.1
raw patch · 14 files changed
+1734/−0 lines, 14 filesdep +Globdep +astview-utilsdep +basebuild-type:Customsetup-changed
Dependencies added: Glob, astview-utils, base, bytestring, containers, directory, filepath, glade, glib, gtk, gtksourceview2, hint, mtl, process, syb
Files
- LICENSE +23/−0
- Setup.hs +86/−0
- astview.cabal +53/−0
- data/CsvParser.hs +45/−0
- data/ExprParser.hs +88/−0
- data/HaskellExtParser.hs +30/−0
- data/LICENSE.unwrapped +9/−0
- data/Parsers.hs +48/−0
- data/astview.glade +412/−0
- data/astview.html +161/−0
- data/style.css +151/−0
- src/Language/Astview/GUI.hs +547/−0
- src/Language/Astview/Registry.hs +37/−0
- src/Main.hs +44/−0
+ LICENSE view
@@ -0,0 +1,23 @@+astview: View abstract syntax trees for your custom languages and+parsers in a graphical (GTK+) application.++Copyright (C) 2009 Sebastian Menge and Pascal Hof++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+``Software''), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHOR(s) BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,86 @@+#!/usr/bin/runhaskell++import Distribution.Simple+import Distribution.Simple.Setup (ConfigFlags (..))+import Distribution.PackageDescription (emptyHookedBuildInfo,HookedBuildInfo(..))+import Language.Haskell.HsColour (hscolour,Output(CSS))+import Language.Haskell.HsColour.Colourise (defaultColourPrefs)+import Control.Monad+import Data.Maybe+import Data.List++main :: IO ()+main = defaultMainWithHooks hooks++hooks :: UserHooks+hooks = simpleUserHooks { preConf = myPreConf }++myPreConf :: Args -> ConfigFlags -> IO HookedBuildInfo+myPreConf args cf = do+ makedocs + return emptyHookedBuildInfo++-- read template file with markers, call replaceOrEcho for each marker+makedocs :: IO ()+makedocs = do+ putStr "Generating custom html documentation... "+ file <- readFile "data/astview-tmpl.html"+ replaced <- mapM replaceOrEcho (lines file)+ putStrLn " done."+ writeFile "data/astview.html" (unlines . concat $ replaced)+ return ()+++-- echoes the current line, or, if mymatch succeeds:+-- replaces the line with colourized haskell code.+replaceOrEcho :: String -> IO [String]+replaceOrEcho s = if not $ match s + then return [s]+ else do+ putStr $ (extract s)++" "+ file <- readFile ("data/"++(extract s)++".hs")+ let replacement = lines $ hscolour CSS defaultColourPrefs False True (extract s) False file+ return (["<!-- Example "++(extract s)++" follows: -->"]+ ++ replacement+ ++ ["<!-- Example "++(extract s)++" done. -->"])+++-- interface that delegates to various implementations:++-- recognizes Template marker of the form "%%asdf%%"+match :: String -> Bool+match = match0 "%%"++--extracts the filename from the marker+extract :: String -> String+extract = extract1 "%%"++-------- Implementations --------------++match0 :: String -> String -> Bool+match0 p s = take 2 s == p && take 2 (reverse s) == p++match1 :: String -> String -> Bool+match1 p = liftM2 (&&) + (help p) + (help p . reverse) + where help q = (q ==) . (take (length q))++match2 :: String -> String -> Bool+match2 p s = p `isSuffixOf` s && (reverse p) `isPrefixOf` s++extract1 :: String -> String -> String+extract1 p s = let remainder = (drop (length p) s) in reverse (drop (length p) (reverse remainder) )++extract2 :: String -> String -> String+extract2 p s = reverse (drop (length p) (reverse (drop (length p) s)))+++extract3 :: String -> String -> String+extract3 p s = reverse . drop (length p) $ reverse $ drop (length p) s+++extract4 :: String -> String+extract4 = help . reverse . help+ where help :: String -> String+ help = fromJust . (stripPrefix "%%%")
+ astview.cabal view
@@ -0,0 +1,53 @@+Name: astview+Version: 0.1+License: BSD4+License-File: LICENSE+Author: + Pascal Hof <pascal.hof@udo.edu>, + Sebastian Menge <sebastian.menge@udo.edu>+Maintainer: Sebastian Menge <sebastian.menge@udo.edu>+Synopsis: View abstract syntax trees for your custom + languages and parsers in a graphical (GTK+) + application+Description: + Astview is a graphical viewer for abstract + syntax trees. It is implemented on the basis + of scrap-your-boilerplate (i.e. data2tree) + and works with all parsers that generate trees + that are instances of the Data.Data class. + Custom parsers can be dynamically loaded + (via package hint) at startup.++Category: Language++Cabal-Version: >= 1.2+Build-Type: Custom+Data-Files:+ data/astview.glade+ data/Parsers.hs+ data/CsvParser.hs+ data/ExprParser.hs+ data/HaskellExtParser.hs+ data/astview.html+ data/style.css+ data/LICENSE.unwrapped++Executable astview+ Hs-Source-Dirs: src+ Main-is: Main.hs+ Other-Modules: Language.Astview.GUI, Language.Astview.Registry+ Build-Depends: base>=4 && <5+ , filepath+ , bytestring+ , Glob+ , containers+ , syb+ , hint+ , glib+ , gtk+ , glade+ , gtksourceview2+ , astview-utils+ , directory+ , mtl+ , process
+ data/CsvParser.hs view
@@ -0,0 +1,45 @@+module CsvParser where++-- container+import Data.Tree (Tree(Node,rootLabel))++-- syb+import Data.Generics (Data)++-- base+import Unsafe.Coerce (unsafeCoerce)++-- local imports+import Language.Astview.Parser as Astview+import Language.Astview.DataTree++-- Parsec (CSV Parser)+import Text.ParserCombinators.Parsec as Parsec+import Data.Generics hiding (Infix)+import Text.ParserCombinators.Parsec+import qualified Text.ParserCombinators.Parsec.Token as P+import Text.ParserCombinators.Parsec.Language (javaStyle)+import Text.ParserCombinators.Parsec.Expr++csv = Parser "CSV" ["*.csv"] buildTreeCSV++-- CSV+buildTreeCSV :: String -> Tree String+buildTreeCSV s = case parseCSV s of+ Right ast -> flat $ data2tree (ast::[[String]])+ Left ParseError -> Node "ParseError" []++parseCSV :: (Data a) => String -> Either Astview.ParseError a+parseCSV s = case parseCSV' s of+ Right p -> unsafeCoerce $ Right p+ _ -> Left ParseError++-- Parsec (Simple CSV)+csvFile = endBy line eol+line = sepBy cell (char ',')+cell = many (noneOf ",\n")+eol = char '\n'++parseCSV' :: String -> Either Parsec.ParseError [[String]]+parseCSV' input = parse csvFile "(unknown)" input+
+ data/ExprParser.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveDataTypeable #-}++module ExprParser where++-- container+import Data.Tree (Tree(Node,rootLabel))++-- syb+import Data.Generics (Data)++-- base+import Unsafe.Coerce (unsafeCoerce)++-- local imports+import Language.Astview.Parser as Astview+import Language.Astview.DataTree++-- Parsec (CSV Parser)+import Text.ParserCombinators.Parsec as Parsec+import Data.Generics hiding (Infix)+import Text.ParserCombinators.Parsec+import qualified Text.ParserCombinators.Parsec.Token as P+import Text.ParserCombinators.Parsec.Language (javaStyle)+import Text.ParserCombinators.Parsec.Expr++expr = Parser "Expr" [".expr"] buildTreeExpr++-- Expr+buildTreeExpr :: String -> Tree String+buildTreeExpr s = case parseExpr s of+ Right ast -> flat $ data2tree (ast::Expr)+ Left ParseError -> Node "ParseError" []++parseExpr :: (Data a) => String -> Either Astview.ParseError a+parseExpr s = case parse lexedExpr "unknown" s of+ Right p -> unsafeCoerce $ Right p+ _ -> Left ParseError++++-- ------------ a parsec parser ----------------------++-- a very tiny expr language deriving data+data Expr = Add Expr Expr | Sub Expr Expr | I Integer deriving (Show,Data,Typeable)++runLex :: Show a => Parsec.Parser a -> String -> IO ()+runLex p input+ = parseTest (do{ whiteSpace+ ; x <- p+ ; eof+ ; return x+ }) input++lexedExpr = do { whiteSpace+ ; x <- expr'+ ; eof+ ; return x+ }++expr' :: Parsec.Parser Expr+expr' = buildExpressionParser table subexpr <?> "expression"++subexpr = parens expr'+ <|> myint + <?> "subexpr"++myint = do {n <- natural; return (I n) }++table = [[op "+" Add AssocLeft, op "-" Sub AssocLeft]]+ where+ op s f assoc+ = Infix (do{ reservedOp s; return f}) assoc+++lexer :: P.TokenParser ()+lexer = P.makeTokenParser+ (javaStyle { P.reservedOpNames = ["+","-"] })++whiteSpace = P.whiteSpace lexer+lexeme = P.lexeme lexer+symbol = P.symbol lexer+natural = P.natural lexer+parens = P.parens lexer+semi = P.semi lexer+identifier= P.identifier lexer+reserved = P.reserved lexer+reservedOp= P.reservedOp lexer+
+ data/HaskellExtParser.hs view
@@ -0,0 +1,30 @@+module HaskellExtParser where++-- container+import Data.Tree (Tree(Node,rootLabel))++-- syb+import Data.Generics (Data)++-- base+import Unsafe.Coerce (unsafeCoerce)++-- local imports+import Language.Astview.Parser as Astview+import Language.Astview.DataTree++import Language.Haskell.Exts (parseFileContents)+import Language.Haskell.Exts.Parser (ParseResult(ParseOk))+import Language.Haskell.Exts.Syntax (Module)++haskellexts = Parser "Haskell" [".hs"] buildTreeHaskellExt++buildTreeHaskellExt :: String -> Tree String+buildTreeHaskellExt s = case parseHaskellExt s of+ Right ast -> flat $ data2tree (ast::Module)+ Left ParseError -> Node "ParseError" []++parseHaskellExt :: (Data a) => String -> Either ParseError a+parseHaskellExt s = case parseFileContents s of+ ParseOk p -> unsafeCoerce $ Right p+ _ -> Left ParseError
+ data/LICENSE.unwrapped view
@@ -0,0 +1,9 @@+astview: View abstract syntax trees for your custom languages and parsers in a graphical (GTK+) application.++Copyright (C) 2009 Sebastian Menge and Pascal Hof++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the ``Software''), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHOR(s) BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ data/Parsers.hs view
@@ -0,0 +1,48 @@+{-++This File exports the list of known parsers for astview.+You can extend the list with your own parsers as proposed with the +CustomParsers.hs module and the concatenation of the list.++Beware, this file will be overwritten when updating the package.++-}++module Parsers where++-- container+import Data.Tree (Tree(Node,rootLabel),drawTree)++-- -- local imports+import Language.Astview.Parser (Parser (..))+import Language.Astview.DataTree (flat,data2tree)+import HaskellExtParser -- requires haskell-src-exts+import CsvParser -- requires parsec+import ExprParser -- requires parsec++-- | Main export for dynamic interpretation by astview+parsers :: [Parser]+parsers = [linesAndWords + ,csv+ ,expr+ ,haskellexts]++-- --------------------------------------------------------++-- | Define a custom parser+linesAndWords :: Parser+linesAndWords = Parser "Lines and Words" [".law"] treeLinesAndWords++-- | Seperate tree construction from parsing.+treeLinesAndWords :: String -> Tree String+treeLinesAndWords s = flat $ data2tree $ parseLinesAndWords s++-- | This simply parses+parseLinesAndWords :: String -> [[String]]+parseLinesAndWords s = map words (lines s)+++-- | A simple test function to launch parsers from ghci.+-- When this works, astview should work too.+testParser :: Parser -> String -> IO ()+testParser p s = putStrLn $ drawTree $ (tree p) s
+ data/astview.glade view
@@ -0,0 +1,412 @@+<?xml version="1.0"?>+<glade-interface>+ <!-- interface-requires gtk+ 2.16 -->+ <!-- interface-naming-policy toplevel-contextual -->+ <widget class="GtkWindow" id="mainWindow">+ <property name="visible">True</property>+ <property name="title" translatable="yes">astview</property>+ <property name="default_width">600</property>+ <property name="default_height">400</property>+ <child>+ <widget class="GtkVBox" id="vboxMain">+ <property name="visible">True</property>+ <property name="border_width">4</property>+ <property name="orientation">vertical</property>+ <property name="spacing">4</property>+ <child>+ <widget class="GtkMenuBar" id="menubar">+ <property name="visible">True</property>+ <child>+ <widget class="GtkMenuItem" id="mFile">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_File</property>+ <property name="use_underline">True</property>+ <child>+ <widget class="GtkMenu" id="menuFile">+ <property name="visible">True</property>+ <child>+ <widget class="GtkImageMenuItem" id="mNew">+ <property name="label">gtk-new</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mParse">+ <property name="label">Parse</property>+ <property name="visible">True</property>+ <property name="use_stock">False</property>+ <child internal-child="image">+ <widget class="GtkImage" id="image1">+ <property name="visible">True</property>+ <property name="stock">gtk-refresh</property>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mOpen">+ <property name="label">gtk-open</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mSave">+ <property name="label">gtk-save</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mSaveAs">+ <property name="label">gtk-save-as</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkSeparatorMenuItem" id="sepFile">+ <property name="visible">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mQuit">+ <property name="label">gtk-quit</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkMenuItem" id="mEdit">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Edit</property>+ <property name="use_underline">True</property>+ <child>+ <widget class="GtkMenu" id="menuEdit">+ <property name="visible">True</property>+ <child>+ <widget class="GtkImageMenuItem" id="mCut">+ <property name="label">gtk-cut</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mCopy">+ <property name="label">gtk-copy</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mPaste">+ <property name="label">gtk-paste</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mDelete">+ <property name="label">gtk-delete</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ <child>+ <widget class="GtkMenuItem" id="mHelp">+ <property name="visible">True</property>+ <property name="label" translatable="yes">_Help</property>+ <property name="use_underline">True</property>+ <child>+ <widget class="GtkMenu" id="menuHelp">+ <property name="visible">True</property>+ <child>+ <widget class="GtkImageMenuItem" id="mShowHelp">+ <property name="label">gtk-help</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ <child>+ <widget class="GtkImageMenuItem" id="mAbout">+ <property name="label">gtk-about</property>+ <property name="visible">True</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkHPaned" id="hpnMain">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="position">300</property>+ <child>+ <widget class="GtkScrolledWindow" id="swSource">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="vscrollbar_policy">automatic</property>+ <child>+ <placeholder/>+ </child>+ </widget>+ <packing>+ <property name="resize">False</property>+ <property name="shrink">True</property>+ </packing>+ </child>+ <child>+ <widget class="GtkScrolledWindow" id="swTreeview">+ <property name="width_request">400</property>+ <property name="height_request">500</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="border_width">4</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="vscrollbar_policy">automatic</property>+ <property name="shadow_type">in</property>+ <child>+ <widget class="GtkTreeView" id="treeview">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="rules_hint">True</property>+ </widget>+ </child>+ </widget>+ <packing>+ <property name="resize">True</property>+ <property name="shrink">True</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="position">2</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <widget class="GtkFileChooserDialog" id="dlgOpen">+ <property name="border_width">5</property>+ <property name="type_hint">normal</property>+ <property name="has_separator">False</property>+ <child internal-child="vbox">+ <widget class="GtkVBox" id="vboxOpen">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <property name="spacing">2</property>+ <child>+ <placeholder/>+ </child>+ <child internal-child="action_area">+ <widget class="GtkHButtonBox" id="daaOpen">+ <property name="visible">True</property>+ <property name="layout_style">end</property>+ <child>+ <widget class="GtkButton" id="btnOpenCancel">+ <property name="label" translatable="yes">gtk-cancel</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="btnOpenOpen">+ <property name="label" translatable="yes">gtk-open</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="pack_type">end</property>+ <property name="position">0</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <widget class="GtkFileChooserDialog" id="dlgSave">+ <property name="border_width">5</property>+ <property name="type_hint">normal</property>+ <property name="has_separator">False</property>+ <child internal-child="vbox">+ <widget class="GtkVBox" id="vboxSave">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <property name="spacing">2</property>+ <child>+ <widget class="GtkHBox" id="hboxName">+ <property name="visible">True</property>+ <child>+ <widget class="GtkLabel" id="lblName">+ <property name="visible">True</property>+ <property name="label" translatable="yes">Name:</property>+ </widget>+ <packing>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkEntry" id="entryName">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ </widget>+ <packing>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">2</property>+ </packing>+ </child>+ <child internal-child="action_area">+ <widget class="GtkHButtonBox" id="daaSave">+ <property name="visible">True</property>+ <property name="layout_style">end</property>+ <child>+ <widget class="GtkButton" id="btnSaveCancel">+ <property name="label" translatable="yes">gtk-cancel</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <widget class="GtkButton" id="btnSaveSave">+ <property name="label" translatable="yes">gtk-save</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="use_stock">True</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="pack_type">end</property>+ <property name="position">0</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+ <widget class="GtkAboutDialog" id="dlgAbout">+ <property name="border_width">5</property>+ <property name="destroy_with_parent">True</property>+ <property name="icon_name">dialog-information</property>+ <property name="type_hint">dialog</property>+ <property name="program_name">astview</property>+ <property name="version">0.1</property>+ <property name="copyright" translatable="yes">Copyright © 2009 Sebastian Menge and Pascal Hof</property>+ <property name="comments" translatable="yes">a graphical syntax tree viewer</property>+ <property name="website">http://ls10-www.cs.tu-dortmund.de</property>+ <property name="website_label">Lehrstuhl fuer Software-Technologie</property>+ <property name="license">astview: View abstract syntax trees for your custom languages and+parsers in a graphical (GTK+) application.++Copyright (c) 2009 Sebastian Menge and Pascal Hof++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+``Software''), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHOR(s) BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.</property>+ <property name="authors">Sebastian Menge <sebastian.menge@uni-dortmund.de>+Pascal Hof <pascal.hof@uni-dortmund.de></property>+ <property name="documenters">Haddock: Sebastian Menge <sebastian.menge@uni-dortmund.de></property>+ <property name="artists"></property>+ <property name="wrap_license">True</property>+ <child internal-child="vbox">+ <widget class="GtkVBox" id="vboxAbout">+ <property name="visible">True</property>+ <property name="orientation">vertical</property>+ <property name="spacing">2</property>+ <child internal-child="action_area">+ <widget class="GtkHButtonBox" id="daaAbout">+ <property name="visible">True</property>+ <property name="homogeneous">True</property>+ <property name="layout_style">end</property>+ </widget>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="pack_type">end</property>+ <property name="position">0</property>+ </packing>+ </child>+ </widget>+ </child>+ </widget>+</glade-interface>
+ data/astview.html view
@@ -0,0 +1,161 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">+<html>++<head>+ <meta content="text/html; charset=ISO-8859-1" http-equiv="content-type"/>+ <title>astview - Documentation</title>+ <link rel="stylesheet" type="text/css" href="style.css"/>+</head>++<script LANGUAGE="JavaScript">+ function mailme(name, domain) {location.href='mailto:'+ name + '@'+ domain;}+</script>++<body>+<h1>Astview - Documentation</h1>++<p>Astview is a little desktop program to be used by people that want+to investigate syntax trees, e.g. students and lecturers in compiler+construction courses. Given a parse function <code>p :: String ->+a</code>, where <code>a</code> is a member of haskell's Data+typeclass, astview can show syntax trees in a standard tree+widget.</p>++<p>The program evolved as a case study in a) generic programming and+b) building graphical user interfaces in haskell.</p>++<ul>+<li><a href="#user-guide">User Guide</a></li>+<li><a href="#adding-parsers">Adding Custom Parsers</a></li>+<li><a href="#developer-notes">Developer Notes</a></li>+</ul>++<h2>User Guide <a name="user-guide"/> </h2>+<h3>Working with source files</h3>+<p>We tried to make the user interface as common as possible by+following the <a href="http://library.gnome.org/devel/hig-book/stable/">+GNOME human interface guidelines</a> closely. You can open a file by+giving the filename at the CLI:+<pre>astview .../path/to/mysource.hs</pre>+or simply open it via the file menu. The file's extension will+determine the parser automaticall. When there are multiple parsers for+one extension, the first one will be taken. Launching astview without+any files will enable the "lines and words"-parser. Saving works as+expected: Ctrl-S saves, Save-As has to be done via the menu. When the+file was changed, the usual star appears in the title bar, next to the+filename.</p>++<p>Cut-and-Paste functionality works as usual (Ctrl-C/P/X), allowing+to copy-paste source code to or from other programs.</p>++<p>Astview uses the same syntax-higlighting sourceview widget as+GNOME's standard editor gedit, so any language recognized there will+be highlighted by astview. For syntax-highlighting, the language is+determined by the name of the parser.</p>++<h3>Choosing Parsers</h3>+<p>As noted above, the parser is chosen automatically when opening a+file. When editing source code, one can change the parser using the+parser menu issuing an immediate reparse. Ctrl-P reparses the source+at any time.</p>++<h2>Adding Custom Parsers <a name="adding-parsers"/></h2>+<p>Astview loads the available parsers <i>at runtime</i> using the+GHC-API wrapper <a href="http://hackage.haskell.org/package/hint"+>hint</a>. In this section we show how to add custom parsers.</p>++<p>A parser is described by a 3-tuple</p>++<!-- Example EX1 follows: -->+<pre><span class='hs-keyword'>data</span> <span class='hs-conid'>Parser</span> + <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Parser</span> <span class='hs-layout'>{</span> <span class='hs-varid'>name</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span>+ <span class='hs-layout'>,</span> <span class='hs-varid'>exts</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>String</span><span class='hs-keyglyph'>]</span>+ <span class='hs-layout'>,</span> <span class='hs-varid'>tree</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tree</span> <span class='hs-conid'>String</span><span class='hs-layout'>}</span>+</pre>+<!-- Example EX1 done. -->++<p>The <i>name></i> of the parser is shown in the parser menu and is+used to determine syntax highlighting. The list of extensions+<i>exts</i> is used to determine the parser when opening a file.+Finally - the magic bit of the whole tool - the buildTree function+constructs a tree of Strings (Data.Tree String) from a haskell value.+Each node of this tree denotes a constructor. This tree can be+constructed using the data2tree function from the SYB approach to+generic programming <i>(TODO: ref)</i>, which is delivered with astview.+Here is an example:</p>++<!-- Example EX2 follows: -->+<pre><span class='hs-definition'>haskell</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>Parser</span>+<span class='hs-definition'>haskell</span> <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Parser</span> <span class='hs-str'>"Haskell"</span> <span class='hs-keyglyph'>[</span><span class='hs-str'>".hs"</span><span class='hs-keyglyph'>]</span> <span class='hs-varid'>buildTreeHaskell</span>++<span class='hs-definition'>buildTreeHaskell</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tree</span> <span class='hs-conid'>String</span>+<span class='hs-definition'>buildTreeHaskell</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>parseHaskell</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>of</span>+ <span class='hs-conid'>Right</span> <span class='hs-varid'>ast</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>flat</span> <span class='hs-varop'>$</span> <span class='hs-varid'>data2tree</span> <span class='hs-layout'>(</span><span class='hs-varid'>ast</span><span class='hs-keyglyph'>::</span><span class='hs-conid'>HsModule</span><span class='hs-layout'>)</span>+ <span class='hs-conid'>Left</span> <span class='hs-conid'>ParseError</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Node</span> <span class='hs-str'>"ParseError"</span> <span class='hs-conid'>[]</span>++<span class='hs-definition'>parseHaskell</span> <span class='hs-keyglyph'>::</span> <span class='hs-layout'>(</span><span class='hs-conid'>Data</span> <span class='hs-varid'>a</span><span class='hs-layout'>)</span> <span class='hs-keyglyph'>=></span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Either</span> <span class='hs-conid'>ParseError</span> <span class='hs-varid'>a</span>+<span class='hs-definition'>parseHaskell</span> <span class='hs-varid'>s</span> <span class='hs-keyglyph'>=</span> <span class='hs-keyword'>case</span> <span class='hs-varid'>parseModule</span> <span class='hs-varid'>s</span> <span class='hs-keyword'>of</span>+ <span class='hs-conid'>ParseOk</span> <span class='hs-varid'>p</span> <span class='hs-keyglyph'>-></span> <span class='hs-varid'>unsafeCoerce</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Right</span> <span class='hs-varid'>p</span>+ <span class='hs-keyword'>_</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Left</span> <span class='hs-conid'>ParseError</span>+</pre>+<!-- Example EX2 done. -->++<p>You can simply put such a parser into the file </p>+<pre>~/.cabal/share/astview-0.2/data/Parsers.hs</pre>+<p>which exports a list of all parsers:</p>++<!-- Example EX3 follows: -->+<pre><span class='hs-definition'>parsers</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>Parser</span><span class='hs-keyglyph'>]</span>+<span class='hs-definition'>parsers</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>haskell</span><span class='hs-conop'>:</span><span class='hs-varid'>stdParserData</span>+</pre>+<!-- Example EX3 done. -->++<p>Here, the predefined list of parsers <code>stdParserData</code> is+extended with the new haskell-parser.</p>++<p>If your Parser needs additional modules, these modules have either+be exposed to GHC's package-management, or have to exist as+source-file under the data-Directory of astview. Remember that these+modules are linked in at runtime!</p>++<p>To test your parser consider the following ghci-session:</p>++<!-- Example EX4 follows: -->+<pre><span class='hs-definition'>user</span><span class='hs-keyglyph'>@</span><span class='hs-varid'>host</span><span class='hs-conop'>:</span><span class='hs-varid'>path</span><span class='hs-varop'>$</span> <span class='hs-varid'>cd</span> <span class='hs-varop'>~/.</span><span class='hs-varid'>cabal</span><span class='hs-varop'>/</span><span class='hs-varid'>share</span><span class='hs-varop'>/</span><span class='hs-varid'>astview</span><span class='hs-comment'>-</span><span class='hs-num'>0.2</span><span class='hs-varop'>/</span><span class='hs-keyword'>data</span>+<span class='hs-definition'>user</span><span class='hs-keyglyph'>@</span><span class='hs-varid'>host</span><span class='hs-conop'>:~/.</span><span class='hs-varid'>cabal</span><span class='hs-varop'>/</span><span class='hs-varid'>share</span><span class='hs-varop'>/</span><span class='hs-varid'>astview</span><span class='hs-comment'>-</span><span class='hs-num'>0.2</span><span class='hs-varop'>/</span><span class='hs-keyword'>data</span><span class='hs-varop'>$</span> <span class='hs-varid'>ghci</span> <span class='hs-conid'>Parsers</span><span class='hs-varop'>.</span><span class='hs-varid'>hs</span>++<span class='hs-comment'>-- ghci package-messages stripped</span>++<span class='hs-varop'>*</span><span class='hs-conid'>Parsers</span><span class='hs-varop'>></span> <span class='hs-conop'>:</span><span class='hs-varid'>info</span> <span class='hs-conid'>Parser</span>+<span class='hs-keyword'>data</span> <span class='hs-conid'>Parser</span>+ <span class='hs-keyglyph'>=</span> <span class='hs-conid'>Parser</span> <span class='hs-layout'>{</span><span class='hs-varid'>name</span> <span class='hs-keyglyph'>::</span> <span class='hs-varop'>!</span><span class='hs-conid'>String</span><span class='hs-layout'>,</span>+ <span class='hs-varid'>exts</span> <span class='hs-keyglyph'>::</span> <span class='hs-keyglyph'>[</span><span class='hs-conid'>String</span><span class='hs-keyglyph'>]</span><span class='hs-layout'>,</span>+ <span class='hs-varid'>tree</span> <span class='hs-keyglyph'>::</span> <span class='hs-conid'>String</span> <span class='hs-keyglyph'>-></span> <span class='hs-conid'>Tree</span> <span class='hs-conid'>String</span><span class='hs-layout'>}</span>++<span class='hs-comment'>-- show all registered parsers</span>+<span class='hs-varop'>*</span><span class='hs-conid'>Parsers</span><span class='hs-varop'>></span> <span class='hs-varid'>map</span> <span class='hs-varid'>name</span> <span class='hs-varid'>parsers</span> +<span class='hs-keyglyph'>[</span><span class='hs-str'>"Haskell"</span><span class='hs-layout'>,</span><span class='hs-str'>"CSV"</span><span class='hs-layout'>,</span><span class='hs-str'>"Expr"</span><span class='hs-layout'>,</span><span class='hs-str'>"Java"</span><span class='hs-layout'>,</span><span class='hs-str'>"IsoPascal"</span><span class='hs-layout'>,</span><span class='hs-str'>"C"</span><span class='hs-layout'>,</span><span class='hs-str'>"Glade"</span><span class='hs-layout'>,</span><span class='hs-str'>"List"</span><span class='hs-keyglyph'>]</span>++<span class='hs-comment'>-- get haskell parser</span>+<span class='hs-varop'>*</span><span class='hs-conid'>Parsers</span><span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>haskell</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>head</span> <span class='hs-varid'>parsers</span> ++<span class='hs-comment'>-- build a sample tree of strings</span>+<span class='hs-varop'>*</span><span class='hs-conid'>Parsers</span><span class='hs-varop'>></span> <span class='hs-keyword'>let</span> <span class='hs-varid'>sample</span> <span class='hs-keyglyph'>=</span> <span class='hs-varid'>tree</span> <span class='hs-varid'>haskell</span> <span class='hs-str'>"main = putStrLn \"Hello World\""</span>++<span class='hs-comment'>-- draw the tree</span>+<span class='hs-varop'>*</span><span class='hs-conid'>Parsers</span><span class='hs-varop'>></span> <span class='hs-varid'>putStrLn</span> <span class='hs-varop'>$</span> <span class='hs-conid'>Data</span><span class='hs-varop'>.</span><span class='hs-conid'>Tree</span><span class='hs-varop'>.</span><span class='hs-varid'>drawTree</span> <span class='hs-varid'>sample</span>++<span class='hs-comment'>-- lengthy output follows</span>+</pre>+<!-- Example EX4 done. -->++<p>If <code>drawString</code> works for your sourcecode, astview will+too, since ghci uses the parsers in interpreted mode just as astview+does.</p>++<i>describe background, especially unsafeCast, describe hin</i>++<h2>Developer Notes <a name="developer-notes"/></h2>+<p><i>Notes for Developers, Short Module descriptions, references to+haddock (include haddock !?), code conventions, history, GTK+things</i></p>
+ data/style.css view
@@ -0,0 +1,151 @@+body {+ font-family:sans-serif;+ font-size:12pt;+ color:#000000;+ margin-top:20px;+ margin-left:10%;+ margin-right:10%;+ padding:0px 20px 0px 20px;+}++p {+ text-align: justify;+}++h1 {+ font-size:20pt;+ font-weight:bold;+ padding:0px 0px 0px 0px;+ margin:0px 5px 5px 0px;+ color:#0E3292;+}++h2 {+ font-size:16pt;+ font-weight:bold;+ margin:15px 5px 3px 0px;+ color:#0E3292;+}++h3 {+ font-size:14pt;+ margin:15px 5px 3px 0px;+ color:#0E3292;+}++hr {+ border:1px;+ border-style: solid;+}++input {+ border-width:1px;+ border-style:solid;+ color:#000000;+ padding-left:3px;+ padding-right:3px;+ background-color:#ffffff;+ border-color:#9a9a9a;+ margin:1px;+}++form {+ padding:8px 0px 5px 0px;+}++/********* Alles was wir nicht benutzen erstmal auskommentieren.+++table{+ font-family:sans-serif;+ font-size:11pt;+ width:700px;+ border:0px;+ margin:15px 0px 15px 0px;+ border-collapse:collapse;+}++++div.title {+ position:relative;+ top:3px;+ left:115px;+ width:600px;+ height:50px;+}++++div.important {+ position:absolute;+ left:550px;+ top:105px;+ width:220px;+ border-style:solid;+ padding:5px;+ border-color:#bbbbbb;+ border-width:1px;+ background-color:#f0f1f2;+}+++div.alert {+ color:#FE0202;+}++div.disclaimer {+ font-size:9pt;+ padding-top:2px;+ padding-right:10px;+ color:#666666;+ text-align:right;+ border-style:solid;+ border-color:#bbbbbb;+ border-width:1px 0px 0px 0px;+}+++++a {+ color:#000000;+ border-width:0px 0px 1px 0px;+ border-color:#777777;+}++a.image {+ border-width:0px 0px 0px 0px;+}++a:hover {+ color:#20acee;+}+++ul,ol {+ margin: 2px 0px 0px 0px;+}+++table.table{+ margin:5px 0px 5px 0px;+}++table[class=table] td{+ border-style:solid;+ border-width:1px;+ margin:0px 0px 0px 0px;+ padding:1px 1px 1px 1px;+ border-collapse:collapse;+}+img {+ border-width:0px;+}+*/++.hs-keyglyph, .hs-layout {color: red;}+.hs-keyword {color: blue;}+.hs-comment, .hs-comment a {color: green;}+.hs-str, .hs-chr {color: teal;}+.hs-keyword, .hs-conid, .hs-varid, .hs-conop, .hs-varop, .hs-num, .hs-cpp, .hs-sel, .hs-definition {}
+ src/Language/Astview/GUI.hs view
@@ -0,0 +1,547 @@+module Language.Astview.GUI where++-- base+import Prelude hiding (writeFile)+import Data.Maybe(fromJust,isJust)+import Data.List (find,findIndex)+import Control.Monad ((=<<),when,liftM,filterM)+import Data.Char (toLower)+import Control.Monad.Trans (liftIO)++-- io+import System.IO + (IOMode,withFile,hGetContents,IOMode(..),hPutStr,hClose)+import System.IO.Error++-- state+import Data.IORef++-- filepath+import System.FilePath + (takeExtension,splitFileName,pathSeparator,joinPath)+import System.Directory (doesDirectoryExist)++-- bytestring+import qualified Data.ByteString.Char8 as BS (hGetContents,unpack)++-- containers+import Data.Tree ( Tree(Node,rootLabel) )++-- gtk+import Graphics.UI.Gtk -- (import all)+import Graphics.UI.Gtk.Gdk.EventM++-- glib+import System.Glib.Signals (ConnectId)++-- glade+import Graphics.UI.Gtk.Glade -- (import all)+import Graphics.UI.Gtk.ModelView -- (import all)++-- gtksourceview+import Graphics.UI.Gtk.SourceView -- (import all)++-- commands+import System.Cmd (rawSystem)++-- astview-utils+import Language.Astview.Parser++-- generated on-the-fly by cabal+import Paths_astview (getDataFileName,getDataDir) +++-- -------------------------------------------------------------------+-- * Main GUI types and functions+-- -------------------------------------------------------------------++-- | a simple container type to ease access to GUI components+data GUI = GUI {+ window :: Window -- ^ main window+ , tv :: TreeView -- ^ treeview+ , tb :: SourceBuffer -- ^ sourceview+ , rFile :: IORef String -- ^ current file+ , rChanged :: IORef Bool -- ^ true if file changed+ , rParsers:: IORef [Parser] -- ^ parsers+ , rCurParser :: IORef Parser -- ^ current parser+ , dlgOpen :: FileChooserDialog -- ^ filechooser (fc)+ , dlgSave :: FileChooserDialog -- ^ filechooser (save as)+ , dlgAbout :: AboutDialog -- ^ about dialog+ , btnOpenOpen :: Button -- ^ open button of the fc+ , btnOpenCancel :: Button -- ^ cancel button of the fc+ , btnSaveSave :: Button -- ^ save as button of dlg_SaveAs+ , btnSaveCancel :: Button -- ^ cancel button of dlg_SaveAs+ , entryName :: Entry -- ^ text entry of dlg_SaveAs+ , cbox :: ComboBox+ }++-- | takes a reference to the compound GUI type and performs+-- some action on the GUI. see section GUI-Actions below+type GUIAction = GUI -> IO ()++-- | pairs a gtk-id with a GUIAction to easily map over all MenuItems+type MenuAction = (String,GUIAction)++-- | a list of pairs of gtk-ids and GUIActions +menuActions :: [MenuAction]+menuActions = + [("mNew",actionEmptyGUI)+ ,("mOpen",actionDlgOpenRun)+ ,("mParse",actionReparse)+ ,("mSave",actionSave)+ ,("mSaveAs",actionDlgSaveRun)+ ,("mCut",actionCutSource)+ ,("mCopy",actionCopySource)+ ,("mPaste",actionPasteSource)+ ,("mDelete",actionDeleteSource)+ ,("mAbout",actionAbout)+ ,("mShowHelp",actionHelp)+ ,("mQuit",actionQuit)+ ]++-- | builds the GUI +buildGUI :: [Parser] -> IO GUI+buildGUI parsers = do+ -- GTK init+ initGUI ++ -- load GladeXML+ Just xml <- xmlNew =<< getDataFileName "data/astview.glade"+ + -- get or create widgets+ window <- xmlGetWidget xml castToWindow "mainWindow"+ treeview <- xmlGetWidget xml castToTreeView "treeview"++ tb <- buildSourceView + =<< xmlGetWidget xml castToScrolledWindow "swSource" ++ dlgOpen <-xmlGetWidget xml castToFileChooserDialog "dlgOpen"+ dlgSave <-xmlGetWidget xml castToFileChooserDialog "dlgSave"+ dlgAbout <-xmlGetWidget xml castToAboutDialog "dlgAbout"+ btnOpenOpen <- xmlGetWidget xml castToButton "btnOpenOpen"+ btnOpenCancel <- xmlGetWidget xml castToButton "btnOpenCancel"+ btnSaveSave <- xmlGetWidget xml castToButton "btnSaveSave"+ btnSaveCancel <- xmlGetWidget xml castToButton "btnSaveCancel"+ entryName <- xmlGetWidget xml castToEntry "entryName"++ -- storage for current file+ rFile <- newIORef unsavedDoc+ -- + rChanged <- newIORef False+ -- storage for all parsers+ rParsers <- newIORef parsers+ -- storage for current parser + rCurParser <- newIORef $ head parsers++ -- setup combobox+ vbox <- xmlGetWidget xml castToVBox "vboxMain"+ cbox <- comboBoxNewText+ containerAdd vbox cbox+ mapM_ (comboBoxAppendText cbox . buildLabel) parsers ++ -- build compound datatype+ let gui = GUI {+ window=window + , tv=treeview + , tb=tb+ , rFile=rFile+ , rChanged=rChanged+ , rParsers=rParsers+ , rCurParser=rCurParser+ , dlgOpen=dlgOpen+ , dlgSave=dlgSave+ , dlgAbout=dlgAbout+ , btnOpenOpen=btnOpenOpen + , btnOpenCancel=btnOpenCancel + , btnSaveSave=btnSaveSave+ , btnSaveCancel=btnSaveCancel+ , entryName=entryName+ , cbox=cbox+ }++ -- get all menuitems from xml and register guiactions to them+ mapM_ (registerMenuAction xml gui) menuActions+ + -- add hooks to buttons+ hooks gui ++ -- finally return gui+ return gui++-- -------------------------------------------------------------------+-- ** some helper functions+-- -------------------------------------------------------------------++-- |builds combobox label for a parser+buildLabel :: Parser -> String+buildLabel parser = + name parser+ ++ " ["+ ++ concatMap (" "++) (exts parser)+ ++ "]"++-- |suffix of window title+suffix :: String+suffix = " - astview"++-- |unsaved document+unsavedDoc :: String+unsavedDoc = "Unsaved document"++-- | setup the GtkSourceView and add it to the ScrollPane. return the +-- underlying textbuffer+buildSourceView :: ScrolledWindow -> IO SourceBuffer+buildSourceView sw = do+ sourceBuffer <- sourceBufferNew Nothing+ sourceBufferSetHighlightSyntax sourceBuffer True+ sourceView <- sourceViewNewWithBuffer sourceBuffer+ sourceViewSetShowLineNumbers sourceView True+ sourceViewSetHighlightCurrentLine sourceView True+ srcfont <- fontDescriptionFromString "Monospace 10"+ widgetModifyFont sourceView (Just srcfont)+ containerAdd sw sourceView+ return sourceBuffer++-- | registers one GUIAction with a MenuItem+registerMenuAction + :: GladeXML -> GUI -> MenuAction -> IO (ConnectId MenuItem)+registerMenuAction xml gui (gtkId,guiaction) = do+ item <- xmlGetWidget xml castToMenuItem gtkId+ onActivateLeaf item (guiaction gui)++-- | adds actions to some widgets+hooks :: GUI -> IO (ConnectId Window)+hooks gui = do+ -- filechooser open+ onClicked (btnOpenOpen gui) (actionLoadChooser gui)+ onClicked (btnOpenCancel gui) (widgetHide (dlgOpen gui) )+ afterFileActivated (dlgOpen gui) (actionLoadChooser gui)+ -- filechooser save+ onClicked (btnSaveSave gui) (actionSaveAs gui)+ onClicked (btnSaveCancel gui) (widgetHide (dlgSave gui))+ onUpdatePreview (dlgSave gui) (actionUpdateName gui) + + -- textbuffer+ onBufferChanged (tb gui) (actionBufferChanged gui)+ + -- ctrl+p to reparse+ (window gui) `on` keyPressEvent $ tryEvent $ do+ [Control] <- eventModifier+ "p" <- eventKeyName+ liftIO $ actionReparse gui ++ (cbox gui) `on` changed $ do+ i <- comboBoxGetActive (cbox gui) + parsers <- readIORef (rParsers gui)+ let parser = parsers!!i+ writeIORef (rCurParser gui) parser + comboBoxSetActive (cbox gui) i+ actionParse (parser) gui++ (dlgAbout gui) `onResponse` (\ _ -> widgetHide (dlgAbout gui) )+ + (window gui) `on` deleteEvent $ tryEvent $ do+ liftIO $ actionQuit gui+ + -- window + onDestroy (window gui) mainQuit+ +-- -------------------------------------------------------------------+-- * GUI Actions+-- -------------------------------------------------------------------++-- -------------------------------------------------------------------+-- ** filemenu+-- -------------------------------------------------------------------++-- | resets the GUI, +actionEmptyGUI :: GUIAction+actionEmptyGUI gui = do+ maybeCol <- treeViewGetColumn (tv gui) 0+ case maybeCol of+ Just col-> treeViewRemoveColumn (tv gui) col+ Nothing -> return undefined+ textBufferSetText (tb gui) ""+ writeIORef (rFile gui) unsavedDoc+ writeIORef (rChanged gui) False+ windowSetTitle (window gui) (unsavedDoc++suffix)++-- | updates the sourceview with a given file, chooses a parser by +-- extension and parses the file+actionLoadHeadless :: FilePath -> GUIAction+actionLoadHeadless file gui = + catch + (do+ parsers <- readIORef (rParsers gui) + writeIORef (rFile gui) file+ contents <- withFile + file ReadMode (fmap BS.unpack . BS.hGetContents)+ textBufferSetText (tb gui) contents++ let filename = snd $ splitFileName file+ windowSetTitle (window gui) (filename ++ suffix)+ let e = takeExtension file+ whenJust + (find (elem e . exts) parsers) $+ \parser -> do + activateParser parser gui+ actionParse parser gui+ writeIORef (rChanged gui) False + )+ print++-- | helper for loadHeadless+activateParser :: Parser -> GUIAction+activateParser parser gui = do+ writeIORef (rCurParser gui) parser+ parsers <- readIORef (rParsers gui) + case findIndex (parser==) parsers of+ Just i -> comboBoxSetActive (cbox gui) i+ Nothing-> return ()++-- | helper for loadHeadless+setupSyntaxHighlighting :: Parser -> GUIAction+setupSyntaxHighlighting parser gui = do+ langManager <- sourceLanguageManagerGetDefault+ maybeLang <- sourceLanguageManagerGetLanguage + langManager + (map toLower (name parser))+ case maybeLang of+ Just l -> do+ sourceBufferSetHighlightSyntax (tb gui) True+ sourceBufferSetLanguage (tb gui) l + Nothing-> + sourceBufferSetHighlightSyntax (tb gui) False ++ +-- | gets filename from filechooser and delegates to +-- actionLoadHeadless+actionLoadChooser :: GUIAction+actionLoadChooser gui = do+ whenJustM+ (fileChooserGetFilename (dlgOpen gui)) $ + \file -> do+ actionLoadHeadless file gui+ widgetHide (dlgOpen gui)++-- | parses the contents of the sourceview with the selected parser+actionParse :: Parser -> GUIAction+actionParse parser gui = do+ writeIORef (rCurParser gui) parser+ sourceBufferSetHighlightSyntax (tb gui) True+ setupSyntaxHighlighting parser gui+ plain <- getText gui+ maybeCol <- treeViewGetColumn (tv gui) 0+ case maybeCol of+ Just col-> treeViewRemoveColumn (tv gui) col+ Nothing -> return (-1)+ let tree' = (tree parser) plain+ model <- treeStoreNew [Node "" [tree']]+ treeViewSetModel (tv gui) model+ col <- treeViewColumnNew+ renderer <- cellRendererTextNew+ cellLayoutPackStart col renderer True + cellLayoutSetAttributes + col + renderer + model + (\row -> [ cellText := row ] )+ treeViewAppendColumn (tv gui) col + return ()++-- |saves file to url saved in clipboard+actionSave :: GUIAction+actionSave gui = do+ file <- readIORef (rFile gui)+ text <- getText gui+ actionSaveWorker gui text file++-- |saves curren file if a file is active or calls "save as"-dialog+actionSaveWorker :: GUI -> String -> String -> IO ()+actionSaveWorker gui plain file =+ case file of+ "Unsaved document" -> actionDlgSaveRun gui+ otherwise -> do + deleteStar gui+ writeIORef (rChanged gui) False+ writeFile file plain + +-- |saves file with filename given by textentry+actionSaveAs :: GUIAction+actionSaveAs gui =+ whenJustM+ (fileChooserGetCurrentFolder (dlgSave gui)) $+ \path -> do+ name <- entryGetText (entryName gui)+ let filepath = (path++[pathSeparator]++name)+ writeIORef (rFile gui) filepath+ writeIORef (rChanged gui) False+ writeFile filepath =<< getText gui+ windowSetTitle (window gui) (name++suffix)+ widgetHide (dlgSave gui)+ +-- |updates the textview after selecting a file in save as filechooser+actionUpdateName :: GUIAction+actionUpdateName gui = do+ whenJustM (fileChooserGetFilename (dlgSave gui)) $ \ path -> do+ isDir <- doesDirectoryExist path+ when (not isDir) $+ let (_,file) = splitFileName path in + entrySetText (entryName gui) file++-- -------------------------------------------------------------------+-- ** edit menu+-- -------------------------------------------------------------------++-- |moves selected source to clipboard (cut)+actionCutSource :: GUIAction +actionCutSource gui = do+ actionCopySource gui+ actionDeleteSource gui+ +-- |copies selected source to clipboard +actionCopySource :: GUIAction+actionCopySource gui = do+ (start,end) <- textBufferGetSelectionBounds (tb gui) + clipBoard <- clipboardGet selectionClipboard+ clipboardSetText + clipBoard + =<< textBufferGetText (tb gui) start end True++-- |pastes text from clipboard at current cursor position +actionPasteSource :: GUIAction+actionPasteSource gui = do+ clipBoard <- clipboardGet selectionClipboard+ clipboardRequestText clipBoard (insertAt (tb gui)) where+ insertAt :: SourceBuffer -> Maybe String -> IO ()+ insertAt tb m = whenJust m (textBufferInsertAtCursor tb)++-- |deletes selected source+actionDeleteSource :: GUIAction+actionDeleteSource gui = + textBufferDeleteSelection (tb gui) False False >> return ()++++-- -------------------------------------------------------------------+-- ** help menu+-- -------------------------------------------------------------------++-- | shows the help dialog+actionHelp :: GUIAction+actionHelp gui = do+ helpfile <- getDataFileName "data/astview.html"+ dir <- getDataDir+ rawSystem "firefox" [joinPath [dir,helpfile]]+ return ()+ +-- | launches info dialog+actionAbout :: GUIAction+actionAbout gui = do+ aboutDialogSetUrlHook (\_ -> return ())+ licensefile <- getDataFileName "data/LICENSE.unwrapped"+ contents <- catch + (withFile licensefile ReadMode ((fmap BS.unpack) . BS.hGetContents))+ (\ioe -> return $ "Err" ++ (show ioe))+ aboutDialogSetWrapLicense (dlgAbout gui) True + aboutDialogSetLicense (dlgAbout gui) (Just contents)+ widgetShow (dlgAbout gui)+++-- -------------------------------------------------------------------+-- ** other actions and helpers+-- -------------------------------------------------------------------++-- |similar to *when*. +whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()+whenJust m action =+ when (isJust m) ((action.fromJust) m) + +-- |similar to *whenJust*, but value is inside a monad+whenJustM :: Monad m => m(Maybe a) -> (a -> m ()) -> m ()+whenJustM val action = do+ m <- val+ when (isJust m) ((action.fromJust) m) ++-- | adds '*' to window title if file changed and sets state+actionBufferChanged :: GUIAction+actionBufferChanged gui = do+ writeIORef (rChanged gui) True+ t <- windowGetTitle (window gui)+ when (head t /= '*') (windowSetTitle (window gui) ('*':t))+++-- | destroys window widget +actionQuit :: GUIAction+actionQuit gui = do + changed <- readIORef (rChanged gui) + if changed + then do + dia <- dialogNew+ dialogAddButton dia stockYes ResponseYes+ dialogAddButton dia stockNo ResponseNo+ dialogAddButton dia stockCancel ResponseCancel+ contain <- dialogGetUpper dia+ + windowSetTitle dia "astview"+ containerSetBorderWidth dia 2+ file <- readIORef (rFile gui)+ lbl <- labelNew + (Just $ "Save changes to document \""+++ (snd $ splitFileName file) +++ "\" before closing?")+ boxPackStartDefaults contain lbl++ widgetShowAll dia+ response <- dialogRun dia+ case response of + ResponseYes -> actionSave gui+ ResponseCancel -> return ()+ ResponseNo -> widgetDestroy (window gui)+ widgetHide dia+ else widgetDestroy (window gui)+ ++-- | launches open dialog+actionDlgOpenRun :: GUIAction+actionDlgOpenRun gui = dialogRun (dlgOpen gui) >> return ()++-- | launches save dialog+actionDlgSaveRun :: GUIAction+actionDlgSaveRun gui = do+ setupDlgSave gui =<< readIORef (rFile gui)+ dialogRun (dlgSave gui) >> return ()++-- |set current directory and filename in dlgSave (setup)+setupDlgSave :: GUI -> String -> IO ()+setupDlgSave gui s = do + let (dir,file) = splitFileName s+ fileChooserSetFilename (dlgSave gui) dir+ entrySetText (entryName gui) file++-- |applies current parser to current sourcebuffer +actionReparse :: GUIAction+actionReparse gui = do+ parser <- readIORef (rCurParser gui)+ activateParser parser gui+ actionParse parser gui++-- |removes @*@ from window title if existing +deleteStar :: GUIAction+deleteStar gui = do+ t <- windowGetTitle (window gui)+ when (head t == '*') (windowSetTitle (window gui) (tail t))++-- | helper for various text-processing actions+getText :: GUI -> IO String+getText gui = do+ start <- textBufferGetStartIter (tb gui)+ end <- textBufferGetEndIter (tb gui)+ textBufferGetText (tb gui) start end True+ +-- |safe function to write files+writeFile :: FilePath -> String -> IO ()+writeFile f str = catch+ (withFile f WriteMode (\h -> hPutStr h str >> hClose h))+ (putStrLn . show)+
+ src/Language/Astview/Registry.hs view
@@ -0,0 +1,37 @@+module Language.Astview.Registry where++-- hint+import Language.Haskell.Interpreter hiding ((:=),set)++-- containers+import Data.Tree ( Tree(Node,rootLabel) )++-- glob+import System.FilePath.Glob (compile,globDir)++-- astview-utils+import Language.Astview.Parser++-- local+import Paths_astview (getDataFileName,getDataDir) -- by cabal+++-- | loads the parserRegistration and all modules in the data dir+loadParsers :: IO [Parser]+loadParsers = do+ -- find additional modules in data+ (glob,_) <- globDir [compile "data/**/*.hs"] =<< getDataDir+ let modules = head glob+ -- run Interpreter+ parsers' <- runInterpreter $ interpretParsers modules+ case parsers' of+ Right parser -> return parser+ Left err -> error (show err)++-- | interprets the modules and returns all parsers found.+interpretParsers :: [FilePath] -> Interpreter [Parser]+interpretParsers modules = do + loadModules modules+ setTopLevelModules ["Parsers"]+ return =<< interpret "parsers" (as :: [Parser])+
+ src/Main.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE Rank2Types #-}+module Main where++-- order of imports analogous to cabal build-depends++-- base+import System.Environment(getArgs)++-- gtk+import Graphics.UI.Gtk -- (import all)++-- hint+import Language.Haskell.Interpreter hiding ((:=),set)++-- astview-utils+import Language.Astview.Parser+import Language.Astview.DataTree++-- local+import Language.Astview.GUI+import Language.Astview.Registry++-- --------------------------------------------------------+-- * main ()+-- --------------------------------------------------------++-- | loads ParserRegistration, inits GTK-GUI, checks for a +-- CLI-argument (one file to parse) and finally starts the GTK-GUI+main :: IO ()+main = do+ parsers <- loadParsers+ gui <- buildGUI parsers++ -- startup+ args <- getArgs+ case length args of+ 1 -> actionLoadHeadless (head args) gui+ 0 -> actionEmptyGUI gui+ _ -> error "Zero or one parameter expected"+ + -- show UI+ widgetShowAll (window gui)+ mainGUI+