language-python-colour-0.1: src/Main.hs

-----------------------------------------------------------------------------
-- |
-- Module      : Main
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- Generate coloured XHTML for a Python source file. Supports version 2 and
-- 3 of Python. The name of the file is given as a command line argument
-- and an XHTML file is produced on the standard output. 
--
-----------------------------------------------------------------------------

module Main where

import Language.Python.Colour.Options 
import Language.Python.Colour.Colourise
import qualified Language.Python.Version2 as V2
import qualified Language.Python.Version3 as V3
import Language.Python.Common
import Prelude hiding (lex)
import System 
import Control.Monad (when, liftM)
import IO

main :: IO ()
main = do
   args <- getArgs
   (flags, filename) <- processOptions args
   tryContents <- safeReadFile filename
   case tryContents of
      Left error -> putStrLn error >> exitFailure
      Right contents -> do
         -- decide which parser and lexer to use (version 2 or 3?)
         let (parser, lexer) = getParserLexer flags
         case lexer contents filename of
            Left e -> hPutStrLn stderr (prettyText e) >> exitFailure
            Right tokens -> putStrLn $ colourise filename tokens

type Parser = String -> String -> Either ParseError (ModuleSpan, [Token])
type Lexer = String -> String -> Either ParseError [Token]

-- decide which parser and lexer to use based on command line arguments (version 2 or 3?)
getParserLexer :: [Flag] -> (Parser, Lexer)
getParserLexer [] = (V2.parseModule, V2.lex)
getParserLexer flags =
   case pyVersion of
      V2 -> (V2.parseModule, V2.lex)
      V3 -> (V3.parseModule, V3.lex)
   where
   pyVersion = probeFlagsFirst flags getPyVersion defaultPyVersion

-- Read a file and check for exceptions.
safeReadFile :: FilePath -> IO (Either String String)
safeReadFile file
   = catch (rightReadFile file) $ \error -> return $ Left $ show error
   where
   rightReadFile :: FilePath -> IO (Either String String)
   rightReadFile file = liftM Right $ readFile file