ToPython.hs

-- | Sifflet to abstract syntax tree for Python.
-- Use Python module's pyPretty to pretty-print the result.

module Language.Sifflet.Export.ToPython
    (
     PythonOptions(..)
    , defaultPythonOptions
    , exprToPExpr
    , nameToPython
    , fixIdentifierChars
    , functionToPyDef
    , defToPy
    , functionsToPyModule
    , functionsToPrettyPy
    , exportPython
    )

where

import Data.Char (isAlpha, isDigit, ord)
import Control.Monad (unless)
import Data.Map ((!))
import System.Directory (copyFile, doesFileExist)
import System.FilePath (replaceFileName)

import Language.Sifflet.Export.Exporter
import Language.Sifflet.Export.Python
import Language.Sifflet.Expr
-- import Text.Sifflet.Pretty
import Language.Sifflet.Util

import Paths_sifflet_lib        -- Cabal-generated paths module

-- | Options for Python export.
-- Should probably include choices like Python2 or Python3;
-- if statement or if expression.  Right now, just a placeholder.

data PythonOptions = PythonOptions
                   deriving (Eq, Show)


defaultPythonOptions :: PythonOptions
defaultPythonOptions = PythonOptions

-- A lot of these are "pass-through" -- simplify: ***
exprToPExpr :: Expr -> Expr
exprToPExpr expr =
    case expr of
      EUndefined -> EUndefined -- was var "undefined"
      ESymbol _ -> expr

      EBool _ -> expr
      EChar c -> EString [c]    -- Python does not distinguish char from str
      ENumber _ -> expr
      EString _ -> expr

      EIf cond action altAction ->
          -- EIf here represents a Python if *expression*:
          --     value if test else altvalue
          -- not the familiar if *statement*!
          EIf (exprToPExpr cond) 
              (exprToPExpr action)
              (exprToPExpr altAction)
      EList exprs -> 
          ECall (Symbol "li") (map exprToPExpr exprs)
      ELambda x body -> ELambda x (EGroup body)
      ECall (Symbol fname) args -> 
          -- Python distinguishes between functions and operators
          case nameToPython fname of
            Left op ->
                case args of
                  [left, right] -> 
                      EOp op (EGroup (exprToPExpr left))
                             (EGroup (exprToPExpr right))
                  _ -> error "exprToPExpr: operation does not have 2 operands"
            Right pname ->
                -- I don't think we need (a) for each arg a
                -- since they are separated by commas
                ECall (Symbol pname) (map exprToPExpr args)
      _ -> errcats ["exprToPExpr: extended expr:", show expr]

-- | Convert Sifflet name (of a function) to Python operator (Left)
-- or function name (Right)
nameToPython :: String -> Either Operator String
nameToPython name =
    let oper oname = Left $ operatorTable ! oname
    in case name of 
         "+" -> oper "+"
         "-" -> oper "-"
         "*" -> oper "*"
         "div" -> oper "//"
         "mod" -> oper "%"
         "/" -> oper "/" -- invalid for integers in Python 2!
         "==" -> oper "=="
         "/=" -> oper "!="
         ">" -> oper ">"
         ">=" -> oper ">="
         "<" -> oper "<"
         "<=" -> oper "<="
         "add1" -> Right "add1"
         "sub1" -> Right "sub1"
         "zero?" -> Right "eqZero"
         "positive?" -> Right "gtZero"
         "negative?" -> Right "ltZero"
         "null" -> Right "null"
         "head" -> Right "head"
         "tail" -> Right "tail"
         ":" -> Right "cons"
         _ -> Right (fixIdentifierChars name)

-- | Remove characters that are not valid in a Python identifier,
-- and in some cases, insert other characters to show what's missing

fixIdentifierChars :: String -> String
fixIdentifierChars =
    let fix s =
            case s of
              [] -> []
              c:cs ->
                  if isAlpha c || isDigit c || c == '_'
                  then c : fix cs
                  else case c of
                         '?' -> "_QUESTION_" ++ fix cs
                         -- other cases can be inserted here
                         _ -> "_CHR" ++ show (ord c) ++ "_" ++ fix cs


    in fix

-- | Create a Python def statement from a Sifflet function.
-- Minimally parenthesized.
functionToPyDef :: Function -> PStatement
functionToPyDef = defToPy . functionToDef

defToPy :: FunctionDefTuple -> PStatement
defToPy (fname, paramNames, _, _, body) =
    fun (fixIdentifierChars fname) 
        paramNames 
        ((simplifyExpr pyRules) (exprToPExpr body))

pyRules :: [Expr -> Expr]
pyRules = commonRulesForSimplifyingExprs

functionsToPyModule :: Functions -> PModule
functionsToPyModule (Functions fs) = PModule (map functionToPyDef fs)

functionsToPrettyPy :: Functions -> String
functionsToPrettyPy = pyPretty . functionsToPyModule

exportPython :: PythonOptions -> Exporter
exportPython _options funcs path = 
    let header = "# File: " ++ path ++
                 "\n# Generated by the Sifflet->Python exporter.\n\n" ++
                 "from sifflet import *\n\n"
        libDest = replaceFileName path "sifflet.py"
    in do
      {
        libDestExists <- doesFileExist libDest
       ; unless libDestExists 
               (do
                 -- copy sifflet.py to the same directory as path
                 {
                   libSrc <- pythonLibSiffletPath 
                 ; copyFile libSrc libDest
                 }
               )
      ; writeFile path (header ++ (functionsToPrettyPy funcs))
      }

pythonLibSiffletPath :: IO FilePath
pythonLibSiffletPath = getDataFileName "sifflet.py"