packages feed

language-python-colour-0.1: src/Language/Python/Colour/Colourise.hs

-----------------------------------------------------------------------------
-- |
-- Module      : Language.Python.Colour.Colourise
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- Turn Python tokens into HTML (for colouring), matching the layout of 
-- the input program.
-----------------------------------------------------------------------------
module Language.Python.Colour.Colourise ( colourise ) where

import Language.Python.Common
import Text.XHtml.Transitional

colourise :: String -> [Token] -> String
colourise progName tokens = showHtml $ makeHtml progName tokens

makeHtml :: String -> [Token] -> Html
makeHtml progName tokens = theHead progName +++ theBody tokens

theHead :: String -> Html
theHead progName = 
   header << (title +++ link)
   where 
   title = thetitle << progName 
   link = (thelink << noHtml) ! 
          [ thetype "text/css", rel "stylesheet", href "pycol.css" ] 

theBody :: [Token] -> Html
theBody tokens = pre << renderTokens tokens

renderTokens :: [Token] -> Html 
renderTokens [] = noHtml  
renderTokens [t] = tokenSpan t 
renderTokens (t1:t2:ts)
   | getSpan t1 == SpanEmpty = renderTokens (t2:ts)
   | getSpan t2 == SpanEmpty = renderTokens (t1:ts)
   | otherwise = 
        tokenSpan t1 +++
        (toHtml $ pad t1EndRow t1EndCol t2StartRow t2StartCol) +++
        renderTokens (t2:ts)
   where
   t1Span = getSpan t1
   t2Span = getSpan t2
   t1EndRow = endRow t1Span 
   t1EndCol = endCol t1Span 
   t2StartRow = startRow t2Span 
   t2StartCol = startCol t2Span 

pad :: Int -> Int -> Int -> Int -> String
pad endRow endCol startRow startCol
   | endRow /= startRow = 
        replicate (startRow - endRow) '\n' ++ 
        replicate (startCol-1) ' '
   | otherwise = replicate (startCol - endCol - 1) ' '

tokenSpan :: Token -> Html
tokenSpan token =
   (thespan << tokenString token) ! 
   [ theclass $ show $ classifyToken token ]