{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module CPython.Simple.Instances where

import Control.Exception (Exception(..), throwIO)
import Control.Monad ((<=<))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable

import qualified CPython.Constants as Py
import qualified CPython.Protocols.Object as Py
import qualified CPython.Types as Py
import qualified CPython.Types.Tuple as Py (fromTuple)

-- TODO: ToPy/FromPy for Bool will require some library changes (e.g. adding fromBool)

class ToPy a where
  toPy :: a -> IO Py.SomeObject

class FromPy a where
  fromPy :: Py.SomeObject -> IO a

data PyCastException = PyCastException String
  deriving (Int -> PyCastException -> ShowS
[PyCastException] -> ShowS
PyCastException -> String
(Int -> PyCastException -> ShowS)
-> (PyCastException -> String)
-> ([PyCastException] -> ShowS)
-> Show PyCastException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PyCastException] -> ShowS
$cshowList :: [PyCastException] -> ShowS
show :: PyCastException -> String
$cshow :: PyCastException -> String
showsPrec :: Int -> PyCastException -> ShowS
$cshowsPrec :: Int -> PyCastException -> ShowS
Show)

instance Exception PyCastException where
  displayException :: PyCastException -> String
displayException (PyCastException typename :: String
typename) =
    "FromPy could not cast to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typename

easyToPy
  :: Py.Object c
  => (a -> IO c) -- ^ python to- conversion, e.g. Py.toFloat
  -> a           -- ^ haskell type being converted
  -> IO Py.SomeObject
easyToPy :: (a -> IO c) -> a -> IO SomeObject
easyToPy f :: a -> IO c
f = (c -> SomeObject) -> IO c -> IO SomeObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> SomeObject
forall a. Object a => a -> SomeObject
Py.toObject (IO c -> IO SomeObject) -> (a -> IO c) -> a -> IO SomeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO c
f

easyFromPy
  :: (Py.Concrete b, Typeable c)
  => (b -> IO c)   -- ^ python from- conversion, e.g. Py.fromFloat
  -> Proxy c       -- ^ proxy for the type being converted to
  -> Py.SomeObject -- ^ python object to cast from
  -> IO c
easyFromPy :: (b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy conversion :: b -> IO c
conversion typename :: Proxy c
typename obj :: SomeObject
obj = do
  Maybe b
casted <- SomeObject -> IO (Maybe b)
forall a b. (Object a, Concrete b) => a -> IO (Maybe b)
Py.cast SomeObject
obj
  case Maybe b
casted of
    Nothing -> PyCastException -> IO c
forall e a. Exception e => e -> IO a
throwIO (PyCastException -> IO c) -> PyCastException -> IO c
forall a b. (a -> b) -> a -> b
$ String -> PyCastException
PyCastException (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy c -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy c
typename)
    Just x :: b
x -> b -> IO c
conversion b
x

instance ToPy Integer where
  toPy :: Integer -> IO SomeObject
toPy = (Integer -> IO Integer) -> Integer -> IO SomeObject
forall c a. Object c => (a -> IO c) -> a -> IO SomeObject
easyToPy Integer -> IO Integer
Py.toInteger

instance FromPy Integer where
  fromPy :: SomeObject -> IO Integer
fromPy = (Integer -> IO Integer)
-> Proxy Integer -> SomeObject -> IO Integer
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy Integer -> IO Integer
Py.fromInteger Proxy Integer
forall k (t :: k). Proxy t
Proxy

instance ToPy Double where
  toPy :: Double -> IO SomeObject
toPy = (Double -> IO Float) -> Double -> IO SomeObject
forall c a. Object c => (a -> IO c) -> a -> IO SomeObject
easyToPy Double -> IO Float
Py.toFloat

instance FromPy Double where
  fromPy :: SomeObject -> IO Double
fromPy = (Float -> IO Double) -> Proxy Double -> SomeObject -> IO Double
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy Float -> IO Double
Py.fromFloat Proxy Double
forall k (t :: k). Proxy t
Proxy

instance ToPy Text where
  toPy :: Text -> IO SomeObject
toPy = (Text -> IO Unicode) -> Text -> IO SomeObject
forall c a. Object c => (a -> IO c) -> a -> IO SomeObject
easyToPy Text -> IO Unicode
Py.toUnicode

instance FromPy Text where
  fromPy :: SomeObject -> IO Text
fromPy = (Unicode -> IO Text) -> Proxy Text -> SomeObject -> IO Text
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy Unicode -> IO Text
Py.fromUnicode Proxy Text
forall k (t :: k). Proxy t
Proxy

instance ToPy Char where
  toPy :: Char -> IO SomeObject
toPy = (Text -> IO Unicode) -> Text -> IO SomeObject
forall c a. Object c => (a -> IO c) -> a -> IO SomeObject
easyToPy Text -> IO Unicode
Py.toUnicode (Text -> IO SomeObject) -> (Char -> Text) -> Char -> IO SomeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton

instance FromPy Char where
  fromPy :: SomeObject -> IO Char
fromPy c :: SomeObject
c = Text -> Char
T.head (Text -> Char) -> IO Text -> IO Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Unicode -> IO Text) -> Proxy Text -> SomeObject -> IO Text
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy Unicode -> IO Text
Py.fromUnicode Proxy Text
forall k (t :: k). Proxy t
Proxy SomeObject
c

instance ToPy String where
  toPy :: String -> IO SomeObject
toPy = (Text -> IO Unicode) -> Text -> IO SomeObject
forall c a. Object c => (a -> IO c) -> a -> IO SomeObject
easyToPy Text -> IO Unicode
Py.toUnicode (Text -> IO SomeObject)
-> (String -> Text) -> String -> IO SomeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance FromPy String where
  fromPy :: SomeObject -> IO String
fromPy s :: SomeObject
s = Text -> String
T.unpack (Text -> String) -> IO Text -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Unicode -> IO Text) -> Proxy Text -> SomeObject -> IO Text
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy Unicode -> IO Text
Py.fromUnicode Proxy Text
forall k (t :: k). Proxy t
Proxy SomeObject
s

instance (FromPy a, FromPy b) => FromPy (a, b) where
  fromPy :: SomeObject -> IO (a, b)
fromPy val :: SomeObject
val = do
    [pyA :: SomeObject
pyA, pyB :: SomeObject
pyB] <- (Tuple -> IO [SomeObject])
-> Proxy [SomeObject] -> SomeObject -> IO [SomeObject]
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy Tuple -> IO [SomeObject]
Py.fromTuple Proxy [SomeObject]
forall k (t :: k). Proxy t
Proxy SomeObject
val
    a
a <- SomeObject -> IO a
forall a. FromPy a => SomeObject -> IO a
fromPy SomeObject
pyA
    b
b <- SomeObject -> IO b
forall a. FromPy a => SomeObject -> IO a
fromPy SomeObject
pyB
    (a, b) -> IO (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)

instance (FromPy a, FromPy b, FromPy c) => FromPy (a, b, c) where
  fromPy :: SomeObject -> IO (a, b, c)
fromPy val :: SomeObject
val = do
    [pyA :: SomeObject
pyA, pyB :: SomeObject
pyB, pyC :: SomeObject
pyC] <- (Tuple -> IO [SomeObject])
-> Proxy [SomeObject] -> SomeObject -> IO [SomeObject]
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy Tuple -> IO [SomeObject]
Py.fromTuple Proxy [SomeObject]
forall k (t :: k). Proxy t
Proxy SomeObject
val
    a
a <- SomeObject -> IO a
forall a. FromPy a => SomeObject -> IO a
fromPy SomeObject
pyA
    b
b <- SomeObject -> IO b
forall a. FromPy a => SomeObject -> IO a
fromPy SomeObject
pyB
    c
c <- SomeObject -> IO c
forall a. FromPy a => SomeObject -> IO a
fromPy SomeObject
pyC
    (a, b, c) -> IO (a, b, c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c)

instance FromPy a => FromPy (Maybe a) where
  fromPy :: SomeObject -> IO (Maybe a)
fromPy val :: SomeObject
val = do
    Bool
isNone <- SomeObject -> IO Bool
Py.isNone SomeObject
val
    if Bool
isNone
      then Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
      else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeObject -> IO a
forall a. FromPy a => SomeObject -> IO a
fromPy SomeObject
val

instance ToPy a => ToPy (Maybe a) where
  toPy :: Maybe a -> IO SomeObject
toPy Nothing = IO SomeObject
Py.none
  toPy (Just a :: a
a) = a -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy a
a

instance FromPy a => FromPy [a] where
  fromPy :: SomeObject -> IO [a]
fromPy val :: SomeObject
val = do
    [SomeObject]
list <- (List -> IO [SomeObject])
-> Proxy [SomeObject] -> SomeObject -> IO [SomeObject]
forall b c.
(Concrete b, Typeable c) =>
(b -> IO c) -> Proxy c -> SomeObject -> IO c
easyFromPy List -> IO [SomeObject]
Py.fromList Proxy [SomeObject]
forall k (t :: k). Proxy t
Proxy SomeObject
val
    (SomeObject -> IO a) -> [SomeObject] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SomeObject -> IO a
forall a. FromPy a => SomeObject -> IO a
fromPy [SomeObject]
list

instance ToPy a => ToPy [a] where
  toPy :: [a] -> IO SomeObject
toPy val :: [a]
val = do
    [SomeObject]
list <- (a -> IO SomeObject) -> [a] -> IO [SomeObject]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy [a]
val
    List -> SomeObject
forall a. Object a => a -> SomeObject
Py.toObject (List -> SomeObject) -> IO List -> IO SomeObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeObject] -> IO List
Py.toList [SomeObject]
list

instance FromPy () where
  fromPy :: SomeObject -> IO ()
fromPy _ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()