{-# 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)

-- | `ToPy` instances indicate that a type can be marshalled from Haskell to Python automatically
--
-- For example, @ToPy Integer@ indicates that we know how to take a Haskell `Integer` and convert
-- it into a Python `int` object
class ToPy a where
  -- | Takes some Haskell type, and converts it to a Python object by going over FFI
  --
  -- Generally you'll only need to call `toPy` manually on some type when writing your own `ToPy` instances for another type
  toPy :: a -> IO Py.SomeObject

-- | `FromPy` instances indicate that a type can be marshalled from Python to Haskell automatically
--
-- For example, @FromPy Integer@ indicates that we know how to take some Python object and convert
-- it into a Haskell Integer. If the Python object is `int`, then we can cast properly. Failed casts throw a `PyCastException`
class FromPy a where
  -- | Takes some Python object, and converts it to the corresponding Haskell type by going over FFI. Might throw a `PyCastException`
  --
  -- Generally you'll only need to call `fromPy` manually on some type when writing your own `FromPy` instances for another type
  fromPy :: Py.SomeObject -> IO a

-- | An exception representing a failed cast from a Python object to Haskell value, usually because the expected type of the Python object was not correct.
--
-- Carries a `String` which represents the name of the expected Haskell type which caused a failed cast. If using `easyFromPy`, this `String` is found with `typeRep`
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
$cshowsPrec :: Int -> PyCastException -> ShowS
showsPrec :: Int -> PyCastException -> ShowS
$cshow :: PyCastException -> String
show :: PyCastException -> String
$cshowList :: [PyCastException] -> ShowS
showList :: [PyCastException] -> ShowS
Show)

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

-- | Helper that lets you convert a Haskell value to a Python object by providing both a Python conversion function (from the Haskell type, over FFI, to some Python Object) as well as the Haskell value
--
-- Lets you define `toPy` with just a Python conversion function
easyToPy
  :: Py.Object p
  => (h -> IO p)      -- ^ python to- conversion, e.g. Py.toFloat
  -> h                -- ^ haskell type being converted
  -> IO Py.SomeObject -- ^ Python object
easyToPy :: forall p h. Object p => (h -> IO p) -> h -> IO SomeObject
easyToPy h -> IO p
convert = (p -> SomeObject) -> IO p -> IO SomeObject
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p -> SomeObject
forall a. Object a => a -> SomeObject
Py.toObject (IO p -> IO SomeObject) -> (h -> IO p) -> h -> IO SomeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h -> IO p
convert

-- | Helper that takes a conversion function and a Python object, and casts the Python object
-- into a Haskell value.
--
-- Lets you define `fromPy` with just a Python conversion function
--
-- We use `Proxy` to infer the type name for use in case of a failed cast. In the context of defining an instance, this type will be inferrable, so you can just provide a `Proxy` value
easyFromPy
  :: (Py.Concrete p, Typeable h)
  => (p -> IO h)   -- ^ python from- conversion, e.g. Py.fromFloat
  -> Proxy h       -- ^ proxy for the type being converted to
  -> Py.SomeObject -- ^ python object to cast from
  -> IO h          -- ^ Haskell value
easyFromPy :: forall p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
easyFromPy p -> IO h
convert Proxy h
typename SomeObject
obj = do
  Maybe p
casted <- SomeObject -> IO (Maybe p)
forall a b. (Object a, Concrete b) => a -> IO (Maybe b)
Py.cast SomeObject
obj
  case Maybe p
casted of
    Maybe p
Nothing -> PyCastException -> IO h
forall e a. Exception e => e -> IO a
throwIO (PyCastException -> IO h) -> PyCastException -> IO h
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 h -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy h
typename)
    Just p
x -> p -> IO h
convert p
x

instance ToPy Bool where
  toPy :: Bool -> IO SomeObject
toPy Bool
b = if Bool
b then IO SomeObject
Py.true else IO SomeObject
Py.false

instance FromPy Bool where
  fromPy :: SomeObject -> IO Bool
fromPy SomeObject
pyB = do
    Bool
isTrue <- SomeObject -> IO Bool
Py.isTrue SomeObject
pyB
    Bool
isFalse <- SomeObject -> IO Bool
Py.isFalse SomeObject
pyB
    case (Bool
isTrue, Bool
isFalse) of
      (Bool
True, Bool
False) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      (Bool
False, Bool
True) -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      (Bool
False, Bool
False) -> PyCastException -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (PyCastException -> IO Bool)
-> (TypeRep -> PyCastException) -> TypeRep -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PyCastException
PyCastException (String -> PyCastException)
-> (TypeRep -> String) -> TypeRep -> PyCastException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> IO Bool) -> TypeRep -> IO Bool
forall a b. (a -> b) -> a -> b
$ Proxy Bool -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy Bool
forall {k} (t :: k). Proxy t
Proxy :: Proxy Bool)
      (Bool
True, Bool
True) -> PyCastException -> IO Bool
forall e a. Exception e => e -> IO a
throwIO (PyCastException -> IO Bool)
-> (String -> PyCastException) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PyCastException
PyCastException (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy Bool -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy Bool
forall {k} (t :: k). Proxy t
Proxy :: Proxy Bool)) String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
". Python object was True and False at the same time. Should be impossible."

instance ToPy Integer where
  toPy :: Integer -> IO SomeObject
toPy = (Integer -> IO Integer) -> Integer -> IO SomeObject
forall p h. Object p => (h -> IO p) -> h -> 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 p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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 p h. Object p => (h -> IO p) -> h -> 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 p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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 p h. Object p => (h -> IO p) -> h -> 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 p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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 p h. Object p => (h -> IO p) -> h -> 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 SomeObject
c = HasCallStack => Text -> Char
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 p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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 p h. Object p => (h -> IO p) -> h -> 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 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 p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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 SomeObject
val = do
    [SomeObject
pyA, SomeObject
pyB] <- (Tuple -> IO [SomeObject])
-> Proxy [SomeObject] -> SomeObject -> IO [SomeObject]
forall p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b)

instance (ToPy a, ToPy b) => ToPy (a, b) where
  toPy :: (a, b) -> IO SomeObject
toPy (a
a, b
b) = do
    SomeObject
pyA <- a -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy a
a
    SomeObject
pyB <- b -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy b
b
    ([SomeObject] -> IO Tuple) -> [SomeObject] -> IO SomeObject
forall p h. Object p => (h -> IO p) -> h -> IO SomeObject
easyToPy [SomeObject] -> IO Tuple
Py.toTuple [SomeObject
pyA, SomeObject
pyB]

instance (FromPy a, FromPy b, FromPy c) => FromPy (a, b, c) where
  fromPy :: SomeObject -> IO (a, b, c)
fromPy SomeObject
val = do
    [SomeObject
pyA, SomeObject
pyB, SomeObject
pyC] <- (Tuple -> IO [SomeObject])
-> Proxy [SomeObject] -> SomeObject -> IO [SomeObject]
forall p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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 a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c)

instance (ToPy a, ToPy b, ToPy c) => ToPy (a, b, c) where
  toPy :: (a, b, c) -> IO SomeObject
toPy (a
a, b
b, c
c) = do
    SomeObject
pyA <- a -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy a
a
    SomeObject
pyB <- b -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy b
b
    SomeObject
pyC <- c -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy c
c
    ([SomeObject] -> IO Tuple) -> [SomeObject] -> IO SomeObject
forall p h. Object p => (h -> IO p) -> h -> IO SomeObject
easyToPy [SomeObject] -> IO Tuple
Py.toTuple [SomeObject
pyA, SomeObject
pyB, SomeObject
pyC]

instance (FromPy a, FromPy b, FromPy c, FromPy d) => FromPy (a, b, c, d) where
  fromPy :: SomeObject -> IO (a, b, c, d)
fromPy SomeObject
val = do
    [SomeObject
pyA, SomeObject
pyB, SomeObject
pyC, SomeObject
pyD] <- (Tuple -> IO [SomeObject])
-> Proxy [SomeObject] -> SomeObject -> IO [SomeObject]
forall p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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
    d
d <- SomeObject -> IO d
forall a. FromPy a => SomeObject -> IO a
fromPy SomeObject
pyD
    (a, b, c, d) -> IO (a, b, c, d)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, b
b, c
c, d
d)

instance (ToPy a, ToPy b, ToPy c, ToPy d) => ToPy (a, b, c, d) where
  toPy :: (a, b, c, d) -> IO SomeObject
toPy (a
a, b
b, c
c, d
d) = do
    SomeObject
pyA <- a -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy a
a
    SomeObject
pyB <- b -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy b
b
    SomeObject
pyC <- c -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy c
c
    SomeObject
pyD <- d -> IO SomeObject
forall a. ToPy a => a -> IO SomeObject
toPy d
d
    ([SomeObject] -> IO Tuple) -> [SomeObject] -> IO SomeObject
forall p h. Object p => (h -> IO p) -> h -> IO SomeObject
easyToPy [SomeObject] -> IO Tuple
Py.toTuple [SomeObject
pyA, SomeObject
pyB, SomeObject
pyC, SomeObject
pyD]

instance FromPy a => FromPy (Maybe a) where
  fromPy :: SomeObject -> IO (Maybe a)
fromPy SomeObject
val = do
    Bool
isNone <- SomeObject -> IO Bool
Py.isNone SomeObject
val
    if Bool
isNone
      then Maybe a -> IO (Maybe a)
forall a. a -> IO 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 Maybe a
Nothing = IO SomeObject
Py.none
  toPy (Just 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 SomeObject
val = do
    [SomeObject]
list <- (List -> IO [SomeObject])
-> Proxy [SomeObject] -> SomeObject -> IO [SomeObject]
forall p h.
(Concrete p, Typeable h) =>
(p -> IO h) -> Proxy h -> SomeObject -> IO h
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 SomeObject
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()