As I cannot find any appropriate haskell brushes for SyntaxHighlighter, I developed one by myself. You can download it here, I do hope it will be helpful. If you find any bugs or have any suggestions, please comment here or email me.

SyntaxHighlighter提供了大多流行语言的Brush，但是相对而言支持的语言还是比较少的。如果你需要的某种语言不幸不在支持列表内，那么你还可以求助于第三方Brush，这里有一个更加丰富语言列表，不过不是所有的语言都有对应的Brush。更不幸的是，我需要的Haskell语言甚至都不在这个列表里。google了一下还是看到有别人写的Brush，不过功能实在有点弱，所以我开始按照Handy Custom Brushes Development Guide自己写一个Haskell Brush。

在Guide的指导下，在参考着其他语言的Brush和其他平台下Haskell的高亮配置文件，我自己的shBrushHaskell.js也有模有样的完成了。最后要做的就是把它加到wordpress的plugin里，参照Adding A New Brush (Language)便能很容易完成。事实上在在我使用的SyntaxHighlighter Evolved里只要先把shBrushHaskell.js上传到合适的位置，比如$plugin_dir/watashi-no-brushes，再对syntaxhighlighter.php做两处修改就好了：

1. 在一堆wp_register_script中间插入一句

   /* register my brush */
   wp_register_script('syntaxhighlighter-brush-haskell', plugins_url('syntaxhighlighter/watashi-no-brushes/shBrushHaskell.js'), array('syntaxhighlighter-core'), '20091224'); // ADD_THIS_LINE
   

2. 再添加映射

   $this->brushes = (array) apply_filters( 'syntaxhighlighter_brushes', array(
       /* ... */
       'haskell' => 'haskell', // ADD_THIS_LINE
   ) );
   

大功告成。

首先拿A + B Problem做个测试：

main = do
    input <- getContents
    putStr $ unlines $ map show $ doEMP $ map read $ words input

doEMP [] = []
doEMP (a:b:o) = a + b : doEMP o

再加两个demo，第一个是ProjectEuler的41：

{--
Project Euler 41
http://projecteuler.net/index.php?section=problems&id=41
What is the largest n-digit pandigital prime that exists?
--}

import System.Random
import Control.Monad
import Data.List (inits, delete)

powMod a b m = powMod' b
    where
    powMod' 0 = 1 `mod` m
    powMod' n
    | even n    = p * p `mod` m
    | otherwise = p * p * a `mod` m
    where p = powMod' (n `div` 2)

isPrime :: Int -> Integer -> IO Bool
isPrime k n
    | n < 2     = return False
    | n == 2    = return True
    | even n    = return False
    | otherwise = do
        g <- getStdGen
        return $ foldl1 (&&) $ take k $ map gao $ take k $ randomRs (2, n') g
        where
            n' = pred n
            (s, d) = (\(a, b) -> (length a, head b)) $ span even $ iterate (`div` 2) n'
            itr = until (\(x, r) -> x == 1 || x == n' || r == s) (\(x, r) -> (x * x `mod` n, succ r))
            gao r = let x = powMod r d n in x == 1 || x == n' || (fst . itr) (x, 1) == n'

permutations [] = [0]
permutations a = concat [map ((+ai) . (*10)) $ permutations $ delete ai a | ai <- a]

main = do
    -- sum [1 .. 8] = 36 mod 3 = 0, sum [1 .. 9] = 45 mod 3 = 0, not prime
    todo <- filterM (isPrime 10) $ concat $ map permutations $ tail $ inits $ [1 .. 7]
    putStrLn $ show $ maximum $ todo

第二个是SPOJ的1739：

{-# OPTIONS -O2 -optc-O3 #-}

-- SPOJ 1739. Yet Another Equation

main =
    interact $ unlines . map (pellEQU . cFracSqrt . read) . tail . lines

isqrt n =
    last $ takeWhile((<= n) . (^ 2)) [1 ..]

cFracSqrt d = cFracSqrt' d 0 1
    where cFracSqrt' d c q
        | a == 2 * t = [a]
        | otherwise = a : cFracSqrt' d c' q'
        where
            t = isqrt d
            a = (t + c) `div` q
            c' = a * q - c
            q' = (d - c' ^ 2) `div` q

toFrac [] = (1, 0)
toFrac (x:xs) = (n, d)
    where
        (n', d') = toFrac xs
        n = x * n' + d'
        d = n'

pellEQU a =
    show n ++ " " ++ show d
    where (n, d)
        | odd $ length a = toFrac $ init a
        | otherwise = toFrac $ a ++ (init . tail $ a)

{-
ID      DATE        USER        PROBLEM     RESULT      TIME        MEM     LANG
2756031   2009-09-22 17:46:36   watashi   Yet Another Equation   accepted   0.00   3.6M   HASK
-}

下面是shBrushHaskell.js的源代码，未必是最新的。最新的请从这里下载。

SyntaxHighlighter.brushes.Haskell = function()
{
	// Copyright 2009 watashi
    // http://watashi.ws/blog
    // Zejun.WU@gmail.com

    var constants = 'True False Nothing Just Left Right LT EQ GT';

	var datatypes =	'Bool Maybe Either Ordering Char String Int Integer Float Double Rational ' +
                    'IO ReadS ShowS FilePath IOError Monad Functor Show Read' +
                    'Eq Ord Enum Bounded Num Real Integral Fractional Floating RealFrac RealFloat';

	var functions =	'abs acos acosh all and any appendFile applyM asTypeOf asin asinh atan atan2 atanh ' +
                    'break catch ceiling compare concat concatMap const cos cosh curry cycle ' +
                    'decodeFloat div divMod drop dropWhile elem encodeFloat enumFrom enumFromThen ' +
                    'enumFromThenTo enumFromTo error even exp exponent fail filter flip floatDigits ' +
                    'floatRadix floatRange floor fmap foldl foldl1 foldr foldr1 fromEnum fromInteger ' +
                    'fromIntegral fromRational fst gcd getChar getContents getLine head id init interact ' +
                    'ioError isDenormalized isIEEE isInfinite isNaN isNegativeZero iterate last lcm ' +
                    'length lex lines log logBase lookup map mapM mapM_ max maxBound maximum maybe min ' +
                    'minBound minimum mod negate not notElem null odd or otherwise pi pred print product ' +
                    'properFraction putChar putStr putStrLn quot quotRem read readFile readIO readList ' +
                    'readLn readParen reads readsPrec realToFrac recip rem repeat replicate return ' +
                    'reverse round scaleFloat scanl scanl1 scanr scanr1 seq sequence sequence_ show ' +
                    'showChar showList showParen showString shows showsPrec significand signum sin sinh ' +
                    'snd span splitAt sqrt subtract succ sum tail take takeWhile tan tanh toEnum ' +
                    'toInteger toRational truncate uncurry undefined unlines until unwords unzip unzip3 ' +
                    'userError words writeFile zip zip3 zipWith zipWith3';    

	var keywords =	'as case of class data default deriving do forall foreign hiding ' +
                    'if then else import instance let in mdo module newtype qualified type where';

	this.findMatches = function(regexList, code) {
		code = code.replace(/&gt;/g, '>').replace(/&lt;/g, '<').replace(/&amp;/g, '&');
		this.code = code;
		return SyntaxHighlighter.Highlighter.prototype.findMatches.apply(this, [regexList, code]);
	};

    this.regexList = [
		{ regex: /{-#[\s\S]*?#-}/g,	                                css: 'preprocessor' },
		{ regex: /--.*/g,	                                        css: 'comments' },      // one line comments
		{ regex: /{-(?!\$)[\s\S]*?-}/gm,	                        css: 'comments' },      // multiline comments
		{ regex: /'.'/g,                                     		css: 'string' },        // chars
		{ regex: SyntaxHighlighter.regexLib.doubleQuotedString,		css: 'string' },        // strings
        { regex: /([-!#$%&*+/<=>?@^|~:.\\])+/g,                     css: 'keyword bold' },  // infix operators
        { regex: /`[a-z][a-z0-9_']*`/g,                             css: 'keyword bold' },  // infix operators
        { regex: /\b(\d+|0x[0-9a-f]+)\b/gi,                         css: 'value' },         // integer
        { regex: /\b\d+(\.\d*)?([eE][+-]?\d+)?\b/gi,                css: 'value' },         // floating number
        { regex: new RegExp(this.getKeywords(constants), 'g'),      css: 'color1 bold' },
		{ regex: new RegExp(this.getKeywords(datatypes), 'g'),		css: 'color1 bold' },
		{ regex: new RegExp(this.getKeywords(functions), 'g'),		css: 'functions bold' },
		{ regex: new RegExp(this.getKeywords(keywords), 'gm'),   	css: 'keyword bold' }
	];
};

SyntaxHighlighter.brushes.Haskell.prototype	= new SyntaxHighlighter.Highlighter();
SyntaxHighlighter.brushes.Haskell.aliases	= ['haskell'];

This entry was posted on Thursday, December 24th, 2009 at 7:40 pm and is filed under work. You can follow any responses to this entry through the RSS 2.0 feed. You can leave a response, or trackback from your own site.