{-# OPTIONS -fallow-overlapping-instances #-}

{- arch-tag: Python type instances
Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{- |
   Module     : Python.Objects
   Copyright  : Copyright (C) 2005 John Goerzen
   License    : GNU GPL, version 2 or above

   Maintainer : John Goerzen,
   Maintainer : jgoerzen\@complete.org
   Stability  : provisional
   Portability: portable

Python type instances and object utilities.

For more similar utilities, see "Python.Objects.File" and
"Python.Objects.Dict".

Written by John Goerzen, jgoerzen\@complete.org
-}

module Python.Objects (
                       -- * Basic Object Types
                       PyObject,
                       -- * Conversions between Haskell and Python Objects
                       ToPyObject(..),
                       FromPyObject(..),
                       -- * Information about Python Objects
                       typeOf,
                       strOf,
                       reprOf,
                       showPyObject,
                       dirPyObject,
                       getattr,
                       hasattr,
                       setattr,
                       -- * Conversions between Python Objects
                       pyList_AsTuple,
                       -- * Calling Python Objects
                       pyObject_Call,
                       pyObject_CallHs,
                       pyObject_RunHs,
                       callMethodHs,
                       runMethodHs,
                       noParms,
                       noKwParms
                      )
where
import Python.Types
import Python.Utils
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import Data.List
import System.IO.Unsafe
import Python.ForeignImports

{- | Members of this class can be converted from a Haskell type
to a Python object. -}
class ToPyObject a where
    toPyObject :: a -> IO PyObject

{- | Members of this class can be derived from a Python object. -}
class FromPyObject a where
    fromPyObject :: PyObject -> IO a

----------------------------------------------------------------------
-- Functions
----------------------------------------------------------------------
{- | Gets the type of a Python object.  Same as type(x) in Python. -}
typeOf :: PyObject -> IO PyObject
typeOf x = withPyObject x (\pyo -> pyObject_Type pyo >>= fromCPyObject)
      
{- | Gets a string representation of a Python object.  Same 
as str(x) in Python. -}
strOf :: PyObject -> IO String
strOf x = withPyObject x 
            (\pyo -> pyObject_Str pyo >>= fromCPyObject >>= fromPyObject)

                                
{- | Gets the Python representation of a Python object.
Same as repr(x) in Python. -}
reprOf :: PyObject -> IO String
reprOf x = withPyObject x
             (\pyo -> pyObject_Repr pyo >>= fromCPyObject >>= fromPyObject)

{- | Displays a Python object and its type. -}
showPyObject :: PyObject -> IO String
showPyObject x = do typestr <- typeOf x >>= strOf
                    contentstr <- strOf x
                    return $ typestr ++ ": " ++ contentstr

{- | Displays a list of keys contained in the Python object. -}
dirPyObject :: PyObject -> IO [String]
dirPyObject x = withPyObject x (\cpyo ->
                   do dr <- pyObject_Dir cpyo >>= fromCPyObject
                      fromPyObject dr
                               )

{- | Call a Python object with all-Haskell parameters.
Similar to 'PyObject_Call'.  This limits you to a single item type for
the regular arguments and another single item type for the keyword arguments. 
Nevertheless, it could be a handy shortcut at times.

For a higher-level wrapper, see 'Python.Interpreter.callByName'.

You may find 'noParms' and 'noKwParms' useful if you aren't passing any
parameters. -}
pyObject_CallHs :: (ToPyObject a, ToPyObject b, FromPyObject c) =>
                   PyObject     -- ^ Object t
                -> [a]          -- ^ List of non-keyword parameters
                -> [(String, b)] -- ^ List of keyword parameters
                -> IO c          -- ^ Return value
pyObject_CallHs callobj simpleargs kwargs =
    pyObject_Hs callobj simpleargs kwargs >>= fromPyObject

pyObject_Hs :: (ToPyObject a, ToPyObject b) =>
                   PyObject     -- ^ Object t
                -> [a]          -- ^ List of non-keyword parameters
                -> [(String, b)] -- ^ List of keyword parameters
                -> IO PyObject         -- ^ Return value
pyObject_Hs callobj simpleargs kwargs =
    let conv (k, v) = do v1 <- toPyObject v
                         return (k, v1)
        in
        do s <- mapM toPyObject simpleargs
           k <- mapM conv kwargs
           pyObject_Call callobj s k

{- | Like 'PyObject_CallHs', but discards the return value. -}
pyObject_RunHs :: (ToPyObject a, ToPyObject b) =>
                   PyObject     -- ^ Object t
                -> [a]          -- ^ List of non-keyword parameters
                -> [(String, b)] -- ^ List of keyword parameters
                -> IO ()         -- ^ Return value
pyObject_RunHs callobj simpleargs kwargs =
    pyObject_Hs callobj simpleargs kwargs >> return ()

callMethodHs_internal :: (ToPyObject a, ToPyObject b) =>
                         PyObject
                      -> String
                      -> [a]
                      -> [(String, b)]
                      -> IO PyObject
callMethodHs_internal pyo method args kwargs =
    do mobj <- getattr pyo method
       pyObject_Hs mobj args kwargs
                            
{- | Calls the named method of the given object. -}
callMethodHs :: (ToPyObject a, ToPyObject b, FromPyObject c) =>
                PyObject        -- ^ The main object
             -> String          -- ^ Name of method to call
             -> [a]             -- ^ Non-kw args
             -> [(String, b)]   -- ^ Keyword args
             -> IO c            -- ^ Result
callMethodHs pyo method args kwargs =
    callMethodHs_internal pyo method args kwargs >>= fromPyObject

{- | Like 'callMethodHs', but discards the return value. -}
runMethodHs :: (ToPyObject a, ToPyObject b) =>
                PyObject        -- ^ The main object
             -> String          -- ^ Name of method to call
             -> [a]             -- ^ Non-kw args
             -> [(String, b)]   -- ^ Keyword args
             -> IO ()            -- ^ Result
runMethodHs pyo method args kwargs =
    callMethodHs_internal pyo method args kwargs >> return ()

noParms :: [String]
noParms = []

noKwParms :: [(String, String)]
noKwParms = []



{- | Call a Python object (function, etc).

For a higher-level wrapper, see 'Python.Interpreter.callByName'.
 -}
pyObject_Call :: PyObject       -- ^ Object to call
              -> [PyObject]     -- ^ List of non-keyword parameters (may be empty)
              -> [(String, PyObject)] -- ^ List of keyword parameters (may be empty)
              -> IO PyObject    -- ^ Return value
pyObject_Call callobj simpleparams kwparams =
        do pyosimple <- toPyObject simpleparams >>= pyList_AsTuple
           pyokw <- toPyObject kwparams
           cval <- withPyObject callobj (\ccallobj ->
                    withPyObject pyosimple (\cpyosimple ->
                     withPyObject pyokw (\cpyokw ->
                      cpyObject_Call ccallobj cpyosimple cpyokw)))
           fromCPyObject cval
       
-- ^ Converts a Python list to a tuple.
pyList_AsTuple :: PyObject -> IO PyObject
pyList_AsTuple x =
    withPyObject x (\cpo -> cpyList_AsTuple cpo >>= fromCPyObject)

{- | An interface to a function similar to Python's getattr.  This will
look up an attribute (such as a method) of an object. -}
getattr :: PyObject -> String -> IO PyObject
getattr pyo s =
    withPyObject pyo (\cpo ->
     withCString s (\cstr ->
      pyObject_GetAttrString cpo cstr >>= fromCPyObject))

{- | An interface to Python's hasattr.  Returns True if the named
attribute exists; False otherwise. -}
hasattr :: PyObject -> String -> IO Bool
hasattr pyo s =
    withPyObject pyo (\cpo ->
     withCString s (\cstr ->
      do r <- pyObject_HasAttrString cpo cstr >>= checkCInt
         if r == 0
            then return False
            else return True
                   )
                     )
{- | An interface to Python's setattr, used to set attributes of an object.
-}
setattr :: PyObject             -- ^ Object to operate on
        -> String               -- ^ Name of attribute
        -> PyObject             -- ^ Set the attribute to this value
        -> IO ()
setattr pyo s setpyo =
    withPyObject pyo (\cpo ->
     withPyObject setpyo (\csetpyo ->
      withCString s (\cstr ->
       pyObject_SetAttrString cpo cstr csetpyo >>= checkCInt >> return ()
                    )))

----------------------------------------------------------------------
-- Instances
----------------------------------------------------------------------

-- FIXME: ERROR CHECKING!

--------------------------------------------------
-- [PyObject] Lists

-- | Lists from a PyObject
instance ToPyObject [PyObject] where
    toPyObject mainlist =
        do l <- pyList_New 0
           mapM_ (\pyo -> withPyObject pyo (\x -> pyList_Append l x >>= checkCInt)) mainlist
           fromCPyObject l

-- | Tuples and Lists to [PyObject] lists
instance FromPyObject [PyObject] where
    fromPyObject x = 
        let worker cpyo =
                do islist <- pyList_Check cpyo >>= checkCInt
                   istuple <- pyTuple_Check cpyo >>= checkCInt
                   if islist /= 0
                      then fromx pyList_Size pyList_GetItem cpyo
                      else if istuple /= 0
                                 then fromx pyTuple_Size pyTuple_GetItem cpyo
                                 else fail "Error fromPyObject to [PyObject]: Passed object not a list or tuple."
            fromx sizefunc itemfunc cpyo = do size <- sizefunc cpyo
                                              fromx_worker 0 size itemfunc cpyo
            fromx_worker counter size itemfunc cpyo =
                if counter >= size 
                   then return []
                   else do thisitem <- itemfunc cpyo counter
                           py_incref thisitem
                           thisobj <- fromCPyObject thisitem
                           {- This unsafeInterlaveIO caused segfaults.  Theory:
                              parent object would be deallocated before all
                              items would be consumed. -}
                           next <- {-unsafeInterleaveIO $-} fromx_worker (succ counter) size itemfunc cpyo
                           return $ thisobj : next
            in
            withPyObject x worker

--------------------------------------------------
-- Association Lists

-- | Dicts from ALs
instance ToPyObject [(PyObject, PyObject)] where
    toPyObject mainlist =
        do d <- pyDict_New
           mapM_ (setitem d) mainlist
           fromCPyObject d
        where setitem l (key, value) =
                  withPyObject key (\keyo ->
                      withPyObject value (\valueo ->
                          pyObject_SetItem l keyo valueo >>= checkCInt))

-- | ALs from Dicts
instance FromPyObject [(PyObject, PyObject)] where
    fromPyObject pydict = withPyObject pydict (\cpydict ->
           -- Type sigs here are for clarity only
        do -- This gives a PyObject
           items <- (pyMapping_Items cpydict >>= fromCPyObject):: IO PyObject
           -- Now, make a Haskell [[PyObject, PyObject]] list
           itemlist <- (fromPyObject items)::IO [[PyObject]]
           -- Finally, convert it to a list of tuples.
           return $ map list2tup itemlist
                                              )
        where list2tup x = case x of
                                  x1:x2:[] -> (x1, x2)
                                  _ -> error "Expected 2-tuples in fromPyObject dict"
                                       
-- | This is a common variant used for arg lists
instance ToPyObject a => ToPyObject [(a, PyObject)] where
    toPyObject mainlist =
        let conv (k, v) = do k1 <- toPyObject k
                             return (k1, v)
            in mapM conv mainlist >>= toPyObject
instance FromPyObject a => FromPyObject [(a, PyObject)] where
    fromPyObject pyo =
        let conv (k, v) = do k1 <- fromPyObject k
                             return (k1, v)
        in do list <- (fromPyObject pyo)::IO [(PyObject, PyObject)]
              mapM conv list


-- | Dicts from Haskell objects
instance (ToPyObject a, ToPyObject b) => ToPyObject [(a, b)] where
    toPyObject mainlist =
        let convone (i1, i2) = do oi1 <- toPyObject i1
                                  oi2 <- toPyObject i2
                                  return (oi1, oi2)
        in do newl <- mapM convone mainlist
              toPyObject newl

-- | Dicts to Haskell objects
instance (FromPyObject a, FromPyObject b) => FromPyObject [(a, b)] where
    fromPyObject pydict =
        let conv (x, y) = do x1 <- fromPyObject x
                             y1 <- fromPyObject y
                             return (x1, y1)
            in do pyodict <- ((fromPyObject pydict)::IO [(PyObject, PyObject)])
                  mapM conv pyodict

--------------------------------------------------
-- Strings

-- CStringLen to PyObject.  Use CStringLen to handle embedded nulls.
instance ToPyObject CStringLen where
   toPyObject (x, len) = 
       pyString_FromStringAndSize x (fromIntegral len) >>= fromCPyObject

-- String to PyObject
instance ToPyObject String where
    toPyObject x = withCString x (\cstr -> toPyObject (cstr, length x))

-- PyObject to String
instance FromPyObject String where
    fromPyObject x = withPyObject x (\po ->
        alloca (\lenptr ->
           alloca (\strptr ->
            do pyString_AsStringAndSize po strptr lenptr
               len <- peek lenptr
               cstr <- peek strptr
               peekCStringLen (cstr, (fromIntegral) len)
                  )
               )
                                    )

--------------------------------------------------
-- Numbers, Python Ints

-- Python ints are C longs
instance ToPyObject CLong where
    toPyObject x =  pyInt_FromLong x >>= fromCPyObject

-- And convert back.
instance FromPyObject CLong where
    fromPyObject x = withPyObject x pyInt_AsLong

-- We'll also support CInts.
instance ToPyObject CInt where
    toPyObject x = toPyObject ((fromIntegral x)::CLong)

instance FromPyObject CInt where
    fromPyObject x = do y <- (fromPyObject x)::IO CLong
                        return $ fromIntegral y

--------------------------------------------------
-- Numbers, Python Longs

instance ToPyObject Integer where
    toPyObject i = 
        -- Use strings here since no other C type supports
        -- unlimited precision.
        let repr = show i
        in withCString repr (\cstr -> 
             pyLong_FromString cstr nullPtr 10 >>= fromCPyObject)
                                 
instance FromPyObject Integer where
    fromPyObject pyo = 
        do longstr <- strOf pyo
           return $ read longstr

--------------------------------------------------
-- Numbers, anything else.
{- For these, we attempt to guess whether to handle it as an
int or a long. -}
{-
Disabled for now; this is a low-level interface, and it seems to be overly
complex for this.

instance Integral a => ToPyObject a where
    toPyObject x =
        let intval = toInteger x
            in
            if (intval < (toInteger (minBound::CLong)) ||
                intval > (toInteger (maxBound::CLong)))
                then toPyObject intval
                else toPyObject ((fromIntegral x)::CLong)

-- On the return conversion, we see what the bounds for
-- the desired type are, and treat it thusly.
instance (Bounded a, Integral a) => FromPyObject a where
    fromPyObject x =
        let minpyint = toInteger (minBound::CLong)
            maxpyint = toInteger (maxBound::CLong)
            minpassed = toInteger (minBound::a)
            maxpassed = toInteger (maxBound::a)
            in if (minpassed < minpyint || maxpassed > maxpyint)
                  then do intval <- fromPyObject x
                          return $ fromInteger intval
                  else do longval <- ((fromPyObject x)::IO CLong)
                          return $ fromIntegral longval

-}

--------------------------------------------------
-- Floating-Point Values

instance ToPyObject CDouble where
    toPyObject x = pyFloat_FromDouble x >>= fromCPyObject

instance FromPyObject CDouble where
    fromPyObject x = withPyObject x pyFloat_AsDouble

-- | Lists from anything else
instance ToPyObject a => ToPyObject [a] where
    toPyObject mainlist = 
        do newlist <- mapM toPyObject mainlist
           toPyObject newlist

instance FromPyObject a => FromPyObject [a] where
    fromPyObject pylistobj = 
        do pylist <- fromPyObject pylistobj
           mapM fromPyObject pylist