参考: https://gist.github.com/abhin4v/017a36477204a1d57745

arith.hs

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text as T
import Data.Attoparsec.Text hiding (take)
import Control.Applicative 
import System.Console.Haskeline
import System.Console.Haskeline.IO
import Control.Concurrent
import Control.Exception

data Expr = Add Expr Expr
          | Sub Expr Expr
          | Mul Expr Expr
          | Div Expr Expr
          | ID Integer deriving (Eq, Show)

literal ch = skipSpace <* char ch <* skipSpace

expr :: Parser Expr
expr = add <|> sub <|> term
  where
    add :: Parser Expr
    add = Add <$> term <* literal '+' <*> expr
    sub :: Parser Expr
    sub = Sub <$> term <* literal '-' <*> expr

term :: Parser Expr
term = mul <|> divide <|> factor
  where
    mul :: Parser Expr
    mul = Mul <$> factor <* literal '*' <*> term
    divide :: Parser Expr
    divide = Div <$> factor <* literal '/' <*> term

factor :: Parser Expr
factor = num <|> parens
  where
    num :: Parser Expr
    num = ID <$> decimal
    parens :: Parser Expr
    parens = literal '(' *> expr <* literal ')'

main :: IO ()
main = bracketOnError (initializeInput defaultSettings) cancelInput (\hd -> loop hd >> closeInput hd)
  where
    loop :: InputState -> IO ()
    loop hd = do
      minput <- queryInput hd (getInputLine "% ")
      case minput of
        Nothing -> return ()
        Just ":q" -> return ()
        Just "exit" -> return ()
        Just "quit" -> return ()
        Just input -> do 
          case parseOnly (expr <* endOfInput) (T.pack(input)) of
            Left result -> do queryInput hd $ outputStrLn $ result 
            Right error -> do queryInput hd $ outputStrLn $ show(error)
          loop hd