Python.hs

-- | Abstract syntax tree and pretty-printing for Python.
-- Works for Python 2 and 3.
-- A lot of the data structures are inspired by the language-python package;
-- I have chosen not to have language-python as a dependency of sifflet-lib,
-- however, because it would be overkill and still allows to little control
-- over pretty-printing of Python expressionsw.

module Language.Sifflet.Export.Python
    (PyPretty(..)
    , PModule(..)
    , PStatement(..)
    , alterParens
    , ret
    , condS
    , var
    , ident
    , char
    , fun
    , operatorTable
    )

where

import Data.List (intercalate)
import qualified Data.Map as M

import Language.Sifflet.Expr
import Text.Sifflet.Pretty

class PyPretty a where

    pyPretty :: a -> String

    pyPrettyList :: String -> String -> String -> [a] -> String
    pyPrettyList pre tween post xs =
        pre ++ intercalate tween (map pyPretty xs) ++ post

pyPrettyParens :: (PyPretty a) => [a] -> String
pyPrettyParens = pyPrettyList "(" ", " ")"

instance PyPretty Symbol where
    pyPretty = pretty

instance PyPretty Operator where
    pyPretty = pretty

-- | Python module -- essentially a list of statements;
-- should it also have a name?
newtype PModule = PModule [PStatement]
             deriving (Eq, Show)

instance PyPretty PModule where
    pyPretty (PModule ss) = sepLines2 (map pyPretty ss)

-- | Python statement
data PStatement = PReturn Expr
                | PImport String  -- ^ import statement
                | PCondS Expr 
                         PStatement 
                         PStatement -- ^ if condition action alt-action
                | PFun Symbol 
                       [Symbol]
                       PStatement -- ^ function name, formal parameters, body
             deriving (Eq, Show)

instance PyPretty PStatement where
    pyPretty s =
        case s of
          PReturn e -> "return " ++ pyPretty e
          PImport modName -> "import " ++ modName
          PCondS c a b ->
              sepLines ["if " ++ pyPretty c ++ ":",
                     indentLine 4 (pyPretty a),
                     "else:",
                     indentLine 4 (pyPretty b)]
          PFun fid params body ->
              sepLines ["def " ++ pyPretty fid ++ 
                     pyPrettyParens params ++ ":",
                     indentLine 4 (pyPretty body)]

-- | Expr as an instance of PyPretty.
-- This instance is only for Exprs as Python exprs,
-- for export to Python!  It will conflict with the
-- one in ToHaskell.hs (or Haskell.hs).
--
-- The EOp case needs work to deal with precedences
-- and avoid unnecessary parens.
-- Note that this instance declaration is for *Python* Exprs.
-- Haskell Exprs of course should not be pretty-printed
-- the same way!
instance PyPretty Expr where
    pyPretty pexpr =
        case pexpr of
          EUndefined -> "undefined"
          EChar _ -> error ("Python pyPretty of Expr: " ++
                            "EChar should have been converted to " ++
                            "EString")
          EList _ -> error ("Python pyPretty of Expr: " ++
                            "EList should have been converted to " ++
                            "ECall li ...")
          EIf c a b -> 
              unwords [pyPretty a, "if", pyPretty c, "else", pyPretty b]
          EGroup e -> pyPrettyParens [e]
          ESymbol vid -> pyPretty vid
          ENumber n -> show n
          EBool b -> show b
          EString s -> show s
          ELambda (Symbol x) body -> 
              unwords ["lambda", show x, ":", pyPretty body]
          EApp fexpr argExpr ->
              concat [pyPretty fexpr, pyPrettyParens [argExpr]]
          ECall fexpr argExprs -> 
              concat [pyPretty fexpr, pyPrettyParens argExprs]
          EOp op left right -> 
              unwords [pyPretty left, pyPretty op, pyPretty right]

alterParens :: (Expr -> Expr) -> PStatement -> PStatement
alterParens t s =
    case s of
      PReturn e -> PReturn (t e)
      PCondS c a b -> PCondS (t c) (alterParens t a) (alterParens t b)
      PFun fid params b -> PFun fid params (alterParens t b)
      _ -> s


-- | Python return statement
ret :: Expr -> PStatement
ret pexpr = PReturn pexpr

-- | Python if STATEMENT

-- This is the if STATEMENT:
-- if c:
--     a
-- else:
--     b
--
-- But do I need this at all?

condS :: Expr -> Expr -> Expr -> PStatement
condS c a b = PCondS c (ret a) (ret b)

-- PExpr smart constructors

-- | Python variable
var :: String -> Expr
var name = ESymbol (Symbol name)

-- | Python identifier
ident :: String -> Symbol
ident s = Symbol s

-- | Python character expression = string expression with one character
char :: Char -> Expr
char c = EString [c]

-- | Python function formal parameter
param :: String -> Symbol
param name = Symbol name

-- | Defines function definition
fun :: String -> [String] -> Expr -> PStatement
fun fname paramNames bodyExpr = 
    PFun (ident fname) (map param paramNames) (ret bodyExpr)

-- | Binary operators
-- Precedence levels are rather *informally* described in
-- The Python Language Reference,
-- http://docs.python.org/reference/.
-- I am adopting the infixr levels from Haskell,
-- which seem to be consistent with Python,
-- at least for the operators that Sifflet uses.
--
-- | Operator information
-- Arithmetic operators: 
-- + and - have lower precedence than *, /, //, %
-- | Comparison operators have precedence lower than any arithmetic
-- operator.  Here, I've specified associative = False,
-- because association doesn't even make sense (well, it does in Python
-- but not in other languages);
-- (a == b) == c is in general not well typed.

operatorTable :: M.Map String Operator
operatorTable = 
    M.fromList (map (\ op -> (opName op, op)) 
                    [ (Operator "*" 7 True GroupLtoR) -- times
                    , (Operator "//" 7 False GroupLtoR) -- int div
                    , (Operator "/" 7 False GroupLtoR) -- float div
                    , (Operator "%" 7 False GroupLtoR) -- mod
                    , (Operator "+" 6 True GroupLtoR) -- plus
                    , (Operator "-" 6 False GroupLtoR) -- minus
                    , (Operator "==" 4 False GroupNone) -- eq
                    , (Operator "!=" 4 False GroupNone) -- ne
                    , (Operator ">" 4 False GroupNone) -- gt
                    , (Operator ">=" 4 False GroupNone) -- ge
                    , (Operator "<" 4 False GroupNone) -- lt
                    , (Operator "<=" 4 False GroupNone) -- le
                    ])