Re: Hat-Gui, new tool

"Neil Mitchell" <[email protected]> Fri, 7 Jul 2006 15:52:53 +0100

Newsgroups	gmane.comp.lang.haskell.hat
Message-ID	<[email protected]>

Hi,

I have now committed hat-gui, with support for only hat-stack.

This version requires a split version of HatStack, where the existing
HatStack.hs is divided into HatStack.hs for the libary and
HatStackText.hs for the console input/output. Since this breaks the
makefile's for Linux, and is a reasonable amount of restructuring, I
thought I'd send the new versions of HatStack and HatStackText for
comments first. They are attached. Is this split/names/interface
acceptable?

Thanks

Neil

On 7/6/06, Neil Mitchell <[email protected]> wrote:
> Hi
>
> > I agree that splitting every tool module into a "model" module with a
> > nice API and a textual "view" module is a very good idea. I wouldn't yet
> > introduce any directory hierarchy (the hierarchical name space isn't
> > Haskell 98 anyway). I think it would be slightly more meaningful if the
> > models would keep the original names and the views be named e.g.
> > HatStackText.
>
> Thats fine by me - I wouldn't have thought using hierarchical module
> names would be a massive problem though, since every supported Haskell
> compiler has them, and hat-trans looks as though it depends on them
> (generating Hat.Something files) - but it doesn't make much difference
> to me. If we ever wanted to provide Hat as a library for external
> programs, as seems to be the trend (for example HsColour and Cpphs)
> then hierarchical modules would be required.
>
> > Do you plan extensions of the user interface? For a long time I thought
> > it would be nice to make hat-observe source-oriented: Make it a source
> > browser in which you can mark any expression and then this expression is
> > observed. This could even be combined with hat-cover, because obviously
> > you should not be able to observe a slice of code that was never executed.
>
> My only planned extension is to have a continually available Source
> window at the bottom of each pane, which is sync'd with the tool - for
> example clicking on each line in hat-stack will jump to that line and
> similarly for hat-observe. Of course, there is no reason that I can't
> add links back from the source to hat-observe, and this source window
> can certainly have hat-cover applied to it.
>
> Once we have a "design" for the tool library/console split I will
> commit my hat-gui and then anyone is welcome to add stuff to it!
>
> Thanks
>
> Neil
>

_______________________________________________
Hat mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/hat

HatStack.hs (text/x-haskell, 1.2 KB)

module HatStack(hatStack) where	-- HatStack main program

import LowLevel           (openHatFile,FileNode(..),nil,getParentNode
                          ,getErrorLoc,getErrorMessage
                          ,getSrcRef)
import SrcRef		  (SrcRef(..),readSrcRef)
import SExp               (SExp(..),Label,fileNode2SExp,sExp2Doc,prune)
import System             (getProgName)
import FFIExtensions      (withCString)


-- first item is the expression, second is the position
type StackEntry = (SExp Label, Maybe (String, Int))

hatStack :: FilePath -> IO (Maybe (String, [StackEntry]))
hatStack hatfile = do
    prog <- getProgName
    withCString prog (\p-> withCString hatfile (openHatFile p))
    
    errloc <- getErrorLoc
    errmsg <- getErrorMessage
    if errloc == nil
        then return Nothing
        else return $ Just (errmsg, map toSExp $ takeWhile (/=nil) $ iterate getParentNode errloc)
    
    
toSExp :: FileNode -> (SExp Label, Maybe (String, Int))
toSExp node = let srcref = getSrcRef node
                  sr = readSrcRef srcref in
              ( fileNode2SExp 10 False True True ("l",node)
              , if (srcref==nil) then Nothing
                else Just (SrcRef.filename sr, SrcRef.line sr)
              )

HatStackText.hs (text/x-haskell, 2 KB)

module Main where	-- HatStack main program

import LowLevel           (openHatFile,FileNode(..),nil,getParentNode
                          ,getErrorLoc,getErrorMessage
                          ,getSrcRef)
import SrcRef		  (SrcRef(..),readSrcRef)
import SExp               (SExp(..),Label,fileNode2SExp,sExp2Doc,prune)
import PrettyLibHighlight (Doc,pretty,nest,text,(<>),parens)
import HighlightStyle     (getTerminalSize)
import System             (getArgs,getProgName,exitWith,ExitCode(..))
import FFIExtensions      (withCString)
import IO                 (hPutStrLn,stderr)
import List               (isSuffixOf)
import Monad              (when)

import Maybe (isNothing)
import HatStack (hatStack)

main = do
    args    <- System.getArgs
    hatfile <- case args of (f:_) -> return (rectify f)
                            _     -> do hPutStrLn stderr
                                                  ("hat-stack: no trace file")
                                        exitWith (ExitFailure 1)
    stack <- hatStack hatfile
    when (isNothing stack)
         (do hPutStrLn stderr ("Tracefile \""++hatfile
                               ++"\" contains no reference to a program error.")
             exitWith (ExitFailure 1))
             
    let Just (errmsg, stck) = stack
    putStrLn ("Program terminated with error:\n\t"++errmsg)
    putStrLn ("Virtual stack trace:")
    (width,lines) <- getTerminalSize
    mapM_ (putStrLn . paint width) stck


rectify :: FilePath -> FilePath
rectify f | ".hat" `isSuffixOf` f = f
          | otherwise = f ++ ".hat"



paint :: Int -> (SExp Label, Maybe (String, Int)) -> String
paint width (sexp, srcpos) =
    let doc = sExp2Doc False True False (\_->id) (prune 10 sexp) in
        pretty width
               (parens (maybe (text "unknown")
                              (\(mod,line)-> text mod <> text ":"
                                             <> text (show line))
                              srcpos)
               <> text "\t" <> nest 3 doc)