{-# LANGUAGE QuasiQuotes #-}

-- | Various types of function arguments

module Language.Embedded.Imperative.Args where

import Data.Proxy

import Language.C.Quote.C

import Language.C.Monad
import Language.Embedded.Imperative.CMD
import Language.Embedded.Backend.C

-- | Reference argument
data RefArg pred where
  RefArg :: pred a => Ref a -> RefArg pred

instance CompTypeClass ct => Arg RefArg ct where
  mkArg :: RefArg ct -> CGen Exp
mkArg   (RefArg Ref a
r) = Ref a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Ref a
r CGenT Identity () -> CGen Exp -> CGen Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> CGen Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| &$id:r |]
  mkParam :: RefArg ct -> CGen Param
mkParam (RefArg (Ref a
r :: Ref a)) = do
    Type
t <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct) (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| $ty:t* |]

-- | Mutable array argument
data ArrArg pred where
  ArrArg :: pred a => Arr i a -> ArrArg pred

instance CompTypeClass ct => Arg ArrArg ct where
  mkArg :: ArrArg ct -> CGen Exp
mkArg   (ArrArg Arr i a
a) = Arr i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Arr i a
a CGenT Identity () -> CGen Exp -> CGen Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> CGen Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:a |]
  mkParam :: ArrArg ct -> CGen Param
mkParam (ArrArg (Arr i a
_ :: Arr i a)) = do
    Type
t <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct) (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| $ty:t* |]

-- | Immutable array argument
data IArrArg pred where
  IArrArg :: pred a => IArr i a -> IArrArg pred

instance CompTypeClass ct => Arg IArrArg ct where
  mkArg :: IArrArg ct -> CGen Exp
mkArg   (IArrArg IArr i a
a) = IArr i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar IArr i a
a CGenT Identity () -> CGen Exp -> CGen Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> CGen Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:a |]
  mkParam :: IArrArg ct -> CGen Param
mkParam (IArrArg (IArr i a
_ :: IArr i a)) = do
    Type
t <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct) (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| $ty:t* |]

-- | Pointer argument
data PtrArg pred where
  PtrArg :: pred a => Ptr a -> PtrArg pred

instance CompTypeClass ct => Arg PtrArg ct where
  mkArg :: PtrArg ct -> CGen Exp
mkArg   (PtrArg Ptr a
p) = Ptr a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Ptr a
p CGenT Identity () -> CGen Exp -> CGen Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> CGen Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:p |]
  mkParam :: PtrArg ct -> CGen Param
mkParam (PtrArg (Ptr a
_ :: Ptr a)) = do
    Type
t <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct) (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| $ty:t* |]

-- | Abstract object argument
data ObjArg pred where
  ObjArg :: Object -> ObjArg pred

instance Arg ObjArg pred where
  mkArg :: ObjArg pred -> CGen Exp
mkArg   (ObjArg Object
o) = Object -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Object
o CGenT Identity () -> CGen Exp -> CGen Exp
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> CGen Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:o |]
  mkParam :: ObjArg pred -> CGen Param
mkParam (ObjArg (Object Bool
pointed [Char]
t [Char]
_))
      | Bool
pointed   = Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| $ty:t'* |]
      | Bool
otherwise = Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| $ty:t'  |]
    where
      t' :: Type
t' = [Char] -> Type
namedType [Char]
t

-- | Constant string argument
data StrArg pred where
  StrArg :: String -> StrArg pred

instance Arg StrArg pred where
  mkArg :: StrArg pred -> CGen Exp
mkArg   (StrArg [Char]
s) = Exp -> CGen Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $s |]
  mkParam :: StrArg pred -> CGen Param
mkParam (StrArg [Char]
s) = Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| const char* |]

data ConstArg pred where
  ConstArg :: { ConstArg pred -> [Char]
constArgType :: String, ConstArg pred -> [Char]
constArg :: String } -> ConstArg pred

instance Arg ConstArg pred where
  mkArg :: ConstArg pred -> CGen Exp
mkArg   (ConstArg [Char]
_ [Char]
n) = Exp -> CGen Exp
forall (m :: * -> *) a. Monad m => a -> m a
return [cexp| $id:n |]
  mkParam :: ConstArg pred -> CGen Param
mkParam (ConstArg [Char]
t [Char]
_) = Param -> CGen Param
forall (m :: * -> *) a. Monad m => a -> m a
return [cparam| $ty:t' |]
    where
      t' :: Type
t' = [Char] -> Type
namedType [Char]
t