Simple parser from `Write Yourself a Scheme` in Haskell.

simpleparser1.hs

module Main where
import System.Environment
import Text.ParserCombinators.Parsec hiding (spaces)
import Control.Monad
import Numeric
import Data.Char (digitToInt, toLower)

-- our symbols are defined in here.
-- our word should start from one of these.
symbol :: Parser Char
symbol = oneOf "#!?-%*-+^|&_~:<=>@$"

-- skip all the spaces.
-- this is also a Parser.
spaces :: Parser ()
spaces = skipMany1 space

-- A LispVal can be an Atom, List of itself, DottedList like (a b).c,
-- String, Integer or Bool.
data LispVal = Atom String
             | List [LispVal]
             | DottedList [LispVal] LispVal
             | String String
             | Number Integer
             | Bool Bool
             | Char Char deriving Show

-- char is Parser action that returns everything after looking up
-- first arg from second.
-- Do allow espacing quote and other escpae chars.
parseString :: Parser LispVal
parseString = do char '"'
                 x <- many (escapedChars <|> (noneOf "\\\""))
                 char '"'
                 return $ String x

escapedChars :: Parser Char
escapedChars = do char '\\'
                  x <- oneOf "\\\"ntrv"
                  return $ case x of
                                '\\' -> x
                                '"' -> x
                                'n' -> '\n'
                                't' -> '\t'
                                'r' -> '\r'
                                'v' -> '\v'

-- <|> is Choice Parser.
parseAtom :: Parser LispVal
parseAtom = do firstChar <- letter <|> symbol
               restChars <- many (letter <|> digit <|> symbol)
               let atom = [firstChar] ++ restChars
               return $ case atom of
                             "#t" -> Bool True
                             "#f" -> Bool False
                             otherwise -> Atom atom


-- Exercise One : Write parseInteger with do.
parseInteger :: Parser LispVal
parseInteger = parseBasicNumber <|> parseRadixNumber

parseBasicNumber :: Parser LispVal
parseBasicNumber = do digs <- many1 digit
                      return $ (Number . read) digs

parseRadixNumber :: Parser LispVal
parseRadixNumber = do base <- parseBaseInteger
                      (case base of
                                 'b' -> parseBinaryNumber
                                 'o' -> parseOctalNumber 
                                 'x' -> many (oneOf "0123456789ABCDEF") >>= \x -> return $ Number (fst (head (readHex x)))
                                 otherwise -> parseBasicNumber)

parseOctalNumber :: Parser LispVal
parseOctalNumber = do digs <- many (oneOf "0123456")
                      return $ Number (fst (head (readOct digs)))

parseBinaryNumber :: Parser LispVal
parseBinaryNumber = do digs <- many (oneOf "01")
                       return $ Number (fst (head (readInt 2 (`elem` "01") digitToInt digs)))

parseBaseInteger :: Parser Char
parseBaseInteger = do char '#'
                      x <- (oneOf "bodx")
                      return x

-- parseChar :: Parser LispVal
-- parseChar = do string "#\\"
--                x <- many1 letter
--                return $ Char (case (map toLower x) of
--                                  "space" -> ' '
--                                  "newline" -> '\n'
--                                  [x] -> x)

-- It was not honouring <|> with below codes.

parseChar :: Parser LispVal
parseChar = liftM Char (parseSpecialCharNotation <|> parseSingleChar)
               
parseSingleChar :: Parser Char
parseSingleChar = do string "#\\"
                     x <- letter
                     return x

parseSpecialCharNotation :: Parser Char
parseSpecialCharNotation = do string "#\\"
                              x <- (parseSpace <|> parseNewline)
                              return x

parseSpace :: Parser Char
parseSpace = do char 's'
                char 'p'
                char 'a'
                char 'c'
                char 'e'
                return ' '

parseNewline :: Parser Char
parseNewline = do char 'n'
                  char 'e'
                  char 'w'
                  char 'l'
                  char 'i'
                  char 'n'
                  char 'e'
                  return '\n'

-- Exercise Two : Write parseInteger with >>=
parseIntegerPipe :: Parser LispVal
parseIntegerPipe =  (many1 digit) >>= return . Number . read

parseExpr :: Parser LispVal
parseExpr = parseChar <|> parseString <|> parseInteger <|> parseAtom

-- Haskell convention :
-- Errors are passed in Left
-- Values in Right.
readExpr :: String -> String
readExpr input = case parse parseExpr "lisp" input of
                 Left err -> "Parse Error: " ++ show err
                 Right val -> "Found value: " ++ show val

main :: IO ()
main = do
  args <- getArgs
  -- Parse first word.
  -- Actually it parsed only first char earlier.. 
  putStrLn $ readExpr $ args !! 0