hat 2.7.0.1 → 2.7.0.2
raw patch · 4 files changed
+522/−141 lines, 4 files
Files
- Hat/hat-c.h +381/−0
- hat.cabal +5/−5
- tools/HighlightStyle.hs +136/−0
- tools/Highlightstyle.hs +0/−136
+ Hat/hat-c.h view
@@ -0,0 +1,381 @@+/* interface for writing the ART trace */++#ifndef _HAT_C_H+#define _HAT_C_H++#include "art.h"++void hat_Open(char *progname);+void hat_Close(void);+void hat_Error(char* errmsg);+void hat_ErrorExit(char* errmsg, FileOffset trace, int ecode);+void hat_ArithmeticError(int);+void hat_Interrupt(int);+void hat_Abort(char *msg);+void hat_OutputTrace(FileOffset trace, char *output);+Bool hat_Hidden(FileOffset node);++FileOffset+mkRoot(void);++FileOffset+mkModule(char *modname, char *srcfile, Bool traced);++FileOffset+mkSrcPos(FileOffset moduleTraceInfo,int begin,int end);++/* Exp nodes; if use is 0, then the variant without a use field is written */++FileOffset+mkResApp1(FileOffset parent,FileOffset use+ ,FileOffset fun,FileOffset arg1);++FileOffset+mkApp1(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1);++FileOffset+mkApp2(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2);++FileOffset+mkApp3(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3);++FileOffset+mkApp4(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4);++FileOffset+mkApp5(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5);++FileOffset+mkApp6(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6);++FileOffset+mkApp7(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7);++FileOffset+mkApp8(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8);++FileOffset+mkApp9(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9);++FileOffset+mkApp10(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10);++FileOffset+mkApp11(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11);++FileOffset+mkApp12(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12);++FileOffset+mkApp13(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+ ,FileOffset arg13);++FileOffset+mkApp14(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+ ,FileOffset arg13,FileOffset arg14);++FileOffset+mkApp15(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+ ,FileOffset arg13,FileOffset arg14,FileOffset arg15);++FileOffset+mkValueApp1(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1);++FileOffset+mkValueApp2(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2);++FileOffset+mkValueApp3(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3);++FileOffset+mkValueApp4(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4);++FileOffset+mkValueApp5(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5);++FileOffset+mkValueApp6(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6);++FileOffset+mkValueApp7(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7);++FileOffset+mkValueApp8(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8);++FileOffset+mkValueApp9(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9);++FileOffset+mkValueApp10(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10);++FileOffset+mkValueApp11(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11);++FileOffset+mkValueApp12(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12);++FileOffset+mkValueApp13(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+ ,FileOffset arg13);++FileOffset+mkValueApp14(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+ ,FileOffset arg13,FileOffset arg14);++FileOffset+mkValueApp15(FileOffset parent,FileOffset use,FileOffset fun+ ,FileOffset arg1,FileOffset arg2,FileOffset arg3,FileOffset arg4+ ,FileOffset arg5,FileOffset arg6,FileOffset arg7,FileOffset arg8+ ,FileOffset arg9,FileOffset arg10,FileOffset arg11,FileOffset arg12+ ,FileOffset arg13,FileOffset arg14,FileOffset arg15);++FileOffset+mkChar(FileOffset parent,FileOffset use,char c);++FileOffset+mkInt(FileOffset parent,FileOffset use,int i);++FileOffset+mkInteger(FileOffset parent,FileOffset use,char *i);++FileOffset+mkRat(FileOffset parent,FileOffset use,int num,int denom);++FileOffset+mkRational(FileOffset parent,FileOffset use+ ,char *num,char *denom);++FileOffset+mkFloat(FileOffset parent,FileOffset use,float f);++FileOffset+mkDouble(FileOffset parent,FileOffset use,double d);++FileOffset+mkValueUse(FileOffset parent,FileOffset use,FileOffset value);++FileOffset+mkConstUse(FileOffset parent,FileOffset use,FileOffset con);++FileOffset+mkConstDef(FileOffset context,FileOffset var);++FileOffset+mkGuard(FileOffset parent,FileOffset use,FileOffset cond);++FileOffset+mkCase(FileOffset parent,FileOffset use,FileOffset cond);++FileOffset+mkIf(FileOffset parent,FileOffset use,FileOffset cond);++FileOffset+mkFieldUpdate1(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1);++FileOffset+mkFieldUpdate2(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2);++FileOffset+mkFieldUpdate3(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3);++FileOffset+mkFieldUpdate4(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3+ ,FileOffset binder4,FileOffset bindee4);++FileOffset+mkFieldUpdate5(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3+ ,FileOffset binder4,FileOffset bindee4+ ,FileOffset binder5,FileOffset bindee5);++FileOffset+mkFieldUpdate6(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3+ ,FileOffset binder4,FileOffset bindee4+ ,FileOffset binder5,FileOffset bindee5+ ,FileOffset binder6,FileOffset bindee6);++FileOffset+mkFieldUpdate7(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3+ ,FileOffset binder4,FileOffset bindee4+ ,FileOffset binder5,FileOffset bindee5+ ,FileOffset binder6,FileOffset bindee6+ ,FileOffset binder7,FileOffset bindee7);++FileOffset+mkFieldUpdate8(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3+ ,FileOffset binder4,FileOffset bindee4+ ,FileOffset binder5,FileOffset bindee5+ ,FileOffset binder6,FileOffset bindee6+ ,FileOffset binder7,FileOffset bindee7+ ,FileOffset binder8,FileOffset bindee8);++FileOffset+mkFieldUpdate9(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3+ ,FileOffset binder4,FileOffset bindee4+ ,FileOffset binder5,FileOffset bindee5+ ,FileOffset binder6,FileOffset bindee6+ ,FileOffset binder7,FileOffset bindee7+ ,FileOffset binder8,FileOffset bindee8+ ,FileOffset binder9,FileOffset bindee9);++FileOffset+mkFieldUpdate10(FileOffset parent,FileOffset use+ ,FileOffset arg,FileOffset binder1,FileOffset bindee1+ ,FileOffset binder2,FileOffset bindee2+ ,FileOffset binder3,FileOffset bindee3+ ,FileOffset binder4,FileOffset bindee4+ ,FileOffset binder5,FileOffset bindee5+ ,FileOffset binder6,FileOffset bindee6+ ,FileOffset binder7,FileOffset bindee7+ ,FileOffset binder8,FileOffset bindee8+ ,FileOffset binder9,FileOffset bindee9+ ,FileOffset binder10,FileOffset bindee10);++FileOffset+mkProjection(FileOffset parent,FileOffset use,FileOffset exp);++FileOffset+mkHidden(FileOffset parent);++FileOffset+mkForward(FileOffset result);++FileOffset+mkDoStmt(FileOffset stmt);++/* Atom */++FileOffset+mkLambda(void);++FileOffset+mkDoLambda(void);++FileOffset+mkVariable(FileOffset module,int begin,int end,int fixity,int arity,char *name+ ,Bool local);++FileOffset+mkConstructor(FileOffset module,int begin,int end,int fixity,int arity+ ,char *name);++FileOffset+mkConstructorWFields(FileOffset module,int begin,int end,int fixity,int arity+ ,char *name,FileOffset labels[]);++ /* mmmh, need arity greater 30 for Flags of nhc98 ... */++FileOffset+mkAbstract(char *description);++FileOffset+mkListCons(FileOffset elem,FileOffset tail);++/* record that given redex is child of given hidden node */+void recordChild(FileOffset hidden,FileOffset child);+++/* Update node that it was entered */++void entResult(FileOffset node,FileOffset use);+void entForward(FileOffset node,FileOffset hidden);++/* Update node with result */++void resResult(FileOffset node,FileOffset result,FileOffset use);+void resForward(FileOffset node,FileOffset result);++/* Implementation of update */+void hat_enter(FileOffset at,FileOffset offset,FileOffset entry);+void hat_reduce(FileOffset at,FileOffset offset,FileOffset entry);+FileOffset hat_topStack(void);+void hat_dumpBuffer(void);+void hat_dumpStack(void); ++#endif
hat.cabal view
@@ -1,6 +1,6 @@ name: hat-version: 2.7.0.1+version: 2.7.0.2 synopsis: The Haskell tracer, generating and viewing Haskell execution traces description: hat-trans transforms Module.hs into Hat/Module.hs such that when the program is@@ -56,7 +56,7 @@ data-dir: libraries data-files: *.hx, *.hs, Control/*.hx, Control/*.hs, Data/*.hx, Data/*.hs-extra-source-files: include/*.h, tools/*.h, docs/*.html, docs/*.hs, docs/*.ps.gz, docs/*.eps, docs/*.gif, docs/*.pdf, docs/*.tex, docs/*.dvi, docs/*.hva, docs/man/*.1, docs/man/*.1.in, examples/*.hs+extra-source-files: include/*.h, tools/*.h, Hat/*.h, docs/*.html, docs/*.hs, docs/*.ps.gz, docs/*.eps, docs/*.gif, docs/*.pdf, docs/*.tex, docs/*.dvi, docs/*.hva, docs/man/*.1, docs/man/*.1.in, examples/*.hs source-repository head type: git@@ -85,7 +85,7 @@ executable hat-trail main-is: HatTrail.hs hs-source-dirs: tools - other-modules: LowLevel, SrcRef, Ident, SExp, PrettyLibHighlight, Highlightstyle, CommonUI+ other-modules: LowLevel, SrcRef, Ident, SExp, PrettyLibHighlight, HighlightStyle, CommonUI build-depends: base ==4.5.*, containers ==0.4.*, directory ==1.1.*, process ==1.1.* extensions: ForeignFunctionInterface includes: art.h@@ -172,7 +172,7 @@ executable black-hat main-is: BlackHat.hs hs-source-dirs: tools- other-modules: LowLevel, Sexp, PrettyLibHighlight, Highlightstyle, Run, NonTermLib+ other-modules: LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Run, NonTermLib build-depends: base ==4.5.*, process ==1.1.* extensions: ForeignFunctionInterface includes: art.h, ntohl.h@@ -183,7 +183,7 @@ executable hat-nonterm main-is: HatNonTerm.hs hs-source-dirs: tools- other-modules: LowLevel, Sexp, PrettyLibHighlight, Highlightstyle, Run, NonTermLib+ other-modules: LowLevel, SExp, PrettyLibHighlight, HighlightStyle, Run, NonTermLib build-depends: base ==4.5.*, process ==1.1.* extensions: ForeignFunctionInterface includes: art.h, ntohl.h
+ tools/HighlightStyle.hs view
@@ -0,0 +1,136 @@+-- Partially taken from Hugs AnsiScreen.hs library:+module HighlightStyle+ ( highlightOn+ , highlightOff+ , highlight+ , cleareol, clearbol, clearline, clearDown, clearUp, cls+ , goto, home+ , cursorUp, cursorDown, cursorLeft, cursorRight+ , savePosition, restorePosition+ , Highlight(..)+ , Colour(..)+ , colourCycle+ , enableScrollRegion, scrollUp, scrollDown+ , lineWrap++ , getTerminalSize -- :: IO (Int,Int) (width,height)+ , hasEscapes+ ) where++import Data.List (intersperse,isPrefixOf)+import System.Process(readProcessWithExitCode)+import System.Exit(ExitCode(ExitSuccess))+-- import Run (runAndReadStdout)+import Data.Char (isDigit)+import System.Info (os)+++hasEscapes :: Bool+hasEscapes = os /= "windows" && os /= "mingw32"+++-- Basic screen control codes:++type Pos = (Int,Int)++at :: Pos -> String -> String+goto :: Int -> Int -> String+home :: String+cls :: String++at (x,y) s = goto x y ++ s+goto x y = '\ESC':'[':(show y ++(';':show x ++ "H"))+home = goto 1 1++cursorUp = "\ESC[A"+cursorDown = "\ESC[B"+cursorRight = "\ESC[C"+cursorLeft = "\ESC[D"++cleareol = "\ESC[K"+clearbol = "\ESC[1K"+clearline = "\ESC[2K"+clearDown = "\ESC[J"+clearUp = "\ESC[1J"+-- Choose whichever of the following lines is suitable for your system:+cls = "\ESC[2J" -- for PC with ANSI.SYS+--cls = "\^L" -- for Sun window++savePosition = "\ESC7"+restorePosition = "\ESC8"+++data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White+ deriving (Eq,Show,Read,Enum)++data Highlight =+ Normal+ | Bold+ | Dim+ | Underscore+ | Blink+ | ReverseVideo+ | Concealed+ | Foreground Colour+ | Background Colour+ deriving (Eq,Show,Read)++instance Enum Highlight where+ fromEnum Normal = 0+ fromEnum Bold = 1+ fromEnum Dim = 2+ fromEnum Underscore = 4+ fromEnum Blink = 5+ fromEnum ReverseVideo = 7+ fromEnum Concealed = 8+ fromEnum (Foreground c) = 30 + fromEnum c+ fromEnum (Background c) = 40 + fromEnum c++highlight :: [Highlight] -> String -> String+highlight attrs s = highlightOn attrs ++ s ++ highlightOff++highlightOn _ | not hasEscapes = ""+highlightOn [] = highlightOn [Normal]+highlightOn attrs = "\ESC["+ ++ concat (intersperse ";" (map (show.fromEnum) attrs))+ ++"m"++highlightOff = if hasEscapes then "\ESC[0m" else ""+++-- An infinite supply of colours.+colourCycle :: [Colour]+colourCycle = cycle [Red,Blue,Magenta,Green,Cyan]+++-- Scrolling+enableScrollRegion :: Int -> Int -> String+enableScrollRegion start end = "\ESC["++show start++';':show end++"r"++scrollDown = "\ESCD"+scrollUp = "\ESCM"++-- Line-wrapping mode+lineWrap True = "\ESC[7h"+lineWrap False = "\ESC[7l"++-- Find width and height of terminal screen+getTerminalSize :: IO (Int,Int)+getTerminalSize =+ if hasEscapes then do+ -- str <- runAndReadStdout "resize -u"+ (exitCode, stdout, stderr) <- readProcessWithExitCode "resize" ["-u"] ""+ if (exitCode == ExitSuccess && stderr == "")+ then+ let ls = lines stdout in+ return (find "COLUMNS" ls, find "LINES" ls)+ else+ return (80, 30)+ else+ return (80, 30)+ where+ find x [] = 0+ find x (s:ss) | x `isPrefixOf` s = read (filter isDigit s)+ | otherwise = find x ss+ s `containedIn` [] = False+ s `containedIn` x@(_:xs) = s `isPrefixOf` x || s `containedIn` xs
− tools/Highlightstyle.hs
@@ -1,136 +0,0 @@--- Partially taken from Hugs AnsiScreen.hs library:-module HighlightStyle- ( highlightOn- , highlightOff- , highlight- , cleareol, clearbol, clearline, clearDown, clearUp, cls- , goto, home- , cursorUp, cursorDown, cursorLeft, cursorRight- , savePosition, restorePosition- , Highlight(..)- , Colour(..)- , colourCycle- , enableScrollRegion, scrollUp, scrollDown- , lineWrap-- , getTerminalSize -- :: IO (Int,Int) (width,height)- , hasEscapes- ) where--import Data.List (intersperse,isPrefixOf)-import System.Process(readProcessWithExitCode)-import System.Exit(ExitCode(ExitSuccess))--- import Run (runAndReadStdout)-import Data.Char (isDigit)-import System.Info (os)---hasEscapes :: Bool-hasEscapes = os /= "windows" && os /= "mingw32"----- Basic screen control codes:--type Pos = (Int,Int)--at :: Pos -> String -> String-goto :: Int -> Int -> String-home :: String-cls :: String--at (x,y) s = goto x y ++ s-goto x y = '\ESC':'[':(show y ++(';':show x ++ "H"))-home = goto 1 1--cursorUp = "\ESC[A"-cursorDown = "\ESC[B"-cursorRight = "\ESC[C"-cursorLeft = "\ESC[D"--cleareol = "\ESC[K"-clearbol = "\ESC[1K"-clearline = "\ESC[2K"-clearDown = "\ESC[J"-clearUp = "\ESC[1J"--- Choose whichever of the following lines is suitable for your system:-cls = "\ESC[2J" -- for PC with ANSI.SYS---cls = "\^L" -- for Sun window--savePosition = "\ESC7"-restorePosition = "\ESC8"---data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White- deriving (Eq,Show,Read,Enum)--data Highlight =- Normal- | Bold- | Dim- | Underscore- | Blink- | ReverseVideo- | Concealed- | Foreground Colour- | Background Colour- deriving (Eq,Show,Read)--instance Enum Highlight where- fromEnum Normal = 0- fromEnum Bold = 1- fromEnum Dim = 2- fromEnum Underscore = 4- fromEnum Blink = 5- fromEnum ReverseVideo = 7- fromEnum Concealed = 8- fromEnum (Foreground c) = 30 + fromEnum c- fromEnum (Background c) = 40 + fromEnum c--highlight :: [Highlight] -> String -> String-highlight attrs s = highlightOn attrs ++ s ++ highlightOff--highlightOn _ | not hasEscapes = ""-highlightOn [] = highlightOn [Normal]-highlightOn attrs = "\ESC["- ++ concat (intersperse ";" (map (show.fromEnum) attrs))- ++"m"--highlightOff = if hasEscapes then "\ESC[0m" else ""----- An infinite supply of colours.-colourCycle :: [Colour]-colourCycle = cycle [Red,Blue,Magenta,Green,Cyan]----- Scrolling-enableScrollRegion :: Int -> Int -> String-enableScrollRegion start end = "\ESC["++show start++';':show end++"r"--scrollDown = "\ESCD"-scrollUp = "\ESCM"---- Line-wrapping mode-lineWrap True = "\ESC[7h"-lineWrap False = "\ESC[7l"---- Find width and height of terminal screen-getTerminalSize :: IO (Int,Int)-getTerminalSize =- if hasEscapes then do- -- str <- runAndReadStdout "resize -u"- (exitCode, stdout, stderr) <- readProcessWithExitCode "resize" ["-u"] ""- if (exitCode == ExitSuccess && stderr == "")- then- let ls = lines stdout in- return (find "COLUMNS" ls, find "LINES" ls)- else- return (80, 30)- else- return (80, 30)- where- find x [] = 0- find x (s:ss) | x `isPrefixOf` s = read (filter isDigit s)- | otherwise = find x ss- s `containedIn` [] = False- s `containedIn` x@(_:xs) = s `isPrefixOf` x || s `containedIn` xs