{-# LINE 1 "Foreign/Matlab/Internal.hsc" #-}
module Foreign.Matlab.Internal (
{-# LINE 2 "Foreign/Matlab/Internal.hsc" #-}
    CBool, boolC, cBool,
    MIO,
    MType(..),
    MXClassID, MXClass(..),
    MXChar, MChar,
    MXLogical, MLogical,
    MXDouble, MDouble,
    MXSingle, MSingle,
    MXInt8, MInt8,
    MXInt16, MInt16,
    MXInt32, MInt32,
    MXInt64, MInt64,
    MXUint8, MUint8,
    MXUint16, MUint16,
    MXUint32, MUint32,
    MXUint64, MUint64,
    MXArrayType,
    MXArrayPtr, MXArray(..),
    mkMXArray, withMXArray,
    unsafeCastMXArray,
    MAny, MAnyArray,
    MNull, mNullArray, isMNull,
    MCell(..),
    MStruct(..),
    MFun,
    MWSize, MWIndex, MWSignedIndex
  ) where

import Foreign
import Foreign.C.Types
import qualified Data.Char
import Foreign.Matlab.Util


{-# LINE 36 "Foreign/Matlab/Internal.hsc" #-}

type MIO a = IO a

type CBool = Word8
{-# LINE 40 "Foreign/Matlab/Internal.hsc" #-}

boolC :: CBool -> Bool
boolC = (0 /=)

cBool :: Bool -> CBool
cBool = ii . fromEnum

type MXClassID = Word32
{-# LINE 48 "Foreign/Matlab/Internal.hsc" #-}
data MXClass = 
    MXClassNull
  | MXClassCell 
  | MXClassStruct
  | MXClassLogical
  | MXClassChar
  | MXClassDouble
  | MXClassSingle
  | MXClassInt8
  | MXClassUint8
  | MXClassInt16
  | MXClassUint16
  | MXClassInt32
  | MXClassUint32
  | MXClassInt64
  | MXClassUint64
  | MXClassFun
  | MXClassObject
  deriving (Eq, Show)

-- |A type equivalence between a Matlab and Haskell type
class MType mx a | a -> mx where
  hs2mx :: a -> mx
  mx2hs :: mx -> a
  mxClassOf :: a -> MXClass

instance MType MXClassID MXClass where
  mx2hs (5) = MXClassNull
{-# LINE 76 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (1)    = MXClassCell
{-# LINE 77 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (2)  = MXClassStruct
{-# LINE 78 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (3) = MXClassLogical
{-# LINE 79 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (4)    = MXClassChar
{-# LINE 80 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (6)  = MXClassDouble
{-# LINE 81 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (7)  = MXClassSingle
{-# LINE 82 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (8)    = MXClassInt8
{-# LINE 83 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (9)   = MXClassUint8
{-# LINE 84 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (10)   = MXClassInt16
{-# LINE 85 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (11)  = MXClassUint16
{-# LINE 86 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (12)   = MXClassInt32
{-# LINE 87 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (13)  = MXClassUint32
{-# LINE 88 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (14)   = MXClassInt64
{-# LINE 89 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (15)  = MXClassUint64
{-# LINE 90 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (16)= MXClassFun
{-# LINE 91 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs (18)	 = MXClassObject
{-# LINE 92 "Foreign/Matlab/Internal.hsc" #-}
  mx2hs c = error ("MXClass: unknown mxClassID " ++ show c)
  hs2mx MXClassNull     = 5
{-# LINE 94 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassCell     = 1
{-# LINE 95 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassStruct   = 2
{-# LINE 96 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassLogical  = 3
{-# LINE 97 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassChar     = 4
{-# LINE 98 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassDouble   = 6
{-# LINE 99 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassSingle   = 7
{-# LINE 100 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassInt8     = 8
{-# LINE 101 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassUint8    = 9
{-# LINE 102 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassInt16    = 10
{-# LINE 103 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassUint16   = 11
{-# LINE 104 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassInt32    = 12
{-# LINE 105 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassUint32   = 13
{-# LINE 106 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassInt64    = 14
{-# LINE 107 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassUint64   = 15
{-# LINE 108 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassFun      = 16
{-# LINE 109 "Foreign/Matlab/Internal.hsc" #-}
  hs2mx MXClassObject   = 18
{-# LINE 110 "Foreign/Matlab/Internal.hsc" #-}
  mxClassOf _ = error "mxClassOf: no class for MXClassID"

type MXChar = Word16
{-# LINE 113 "Foreign/Matlab/Internal.hsc" #-}
type MChar = Char
instance MType MXChar MChar where
  hs2mx = ii . Data.Char.ord
  mx2hs = Data.Char.chr . ii
  mxClassOf _ = MXClassChar

type MXLogical = Word8
{-# LINE 120 "Foreign/Matlab/Internal.hsc" #-}
type MLogical = Bool
instance MType MXLogical MLogical where
  hs2mx = cBool
  mx2hs = boolC
  mxClassOf _ = MXClassLogical

type MXDouble = Double
type MDouble = Double
instance MType MXDouble MDouble where
  hs2mx = id
  mx2hs = id
  mxClassOf _ = MXClassDouble
type MXSingle = Float
type MSingle = Float
instance MType MXSingle MSingle where
  hs2mx = id
  mx2hs = id
  mxClassOf _ = MXClassSingle


{-# LINE 144 "Foreign/Matlab/Internal.hsc" #-}

type MXInt8 = Int8
type MInt8 = Int8
instance MType MXInt8 MInt8 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassInt8 }
{-# LINE 146 "Foreign/Matlab/Internal.hsc" #-}
type MXInt16 = Int16
type MInt16 = Int16
instance MType MXInt16 MInt16 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassInt16 }
{-# LINE 147 "Foreign/Matlab/Internal.hsc" #-}
type MXInt32 = Int32
type MInt32 = Int32
instance MType MXInt32 MInt32 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassInt32 }
{-# LINE 148 "Foreign/Matlab/Internal.hsc" #-}
type MXInt64 = Int64
type MInt64 = Int64
instance MType MXInt64 MInt64 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassInt64 }
{-# LINE 149 "Foreign/Matlab/Internal.hsc" #-}
type MXUint8 = Word8
type MUint8 = Word8
instance MType MXUint8 MUint8 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassUint8 }
{-# LINE 150 "Foreign/Matlab/Internal.hsc" #-}
type MXUint16 = Word16
type MUint16 = Word16
instance MType MXUint16 MUint16 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassUint16 }
{-# LINE 151 "Foreign/Matlab/Internal.hsc" #-}
type MXUint32 = Word32
type MUint32 = Word32
instance MType MXUint32 MUint32 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassUint32 }
{-# LINE 152 "Foreign/Matlab/Internal.hsc" #-}
type MXUint64 = Word64
type MUint64 = Word64
instance MType MXUint64 MUint64 where { hs2mx = id ; mx2hs = id ; mxClassOf _ = MXClassUint64 }
{-# LINE 153 "Foreign/Matlab/Internal.hsc" #-}

data MXArrayType
type MXArrayPtr = Ptr MXArrayType

-- |The general Matlab Array type, used for most all Matlab data
newtype MXArray a = MXArray { mxArray :: MXArrayPtr }

mkMXArray :: MXArrayPtr -> IO (MXArray a)
mkMXArray = return . MXArray

withMXArray :: With (MXArray x) MXArrayPtr a
withMXArray (MXArray a) f = f a

unsafeCastMXArray :: MXArray a -> MXArray b
unsafeCastMXArray = MXArray . castPtr . mxArray

-- |Determine whether the given array is NULL
isMNull :: MXArray a -> Bool
isMNull (MXArray a) = nullPtr == a

-- |Tag for a generic array
data MAny
-- |A generic, untyped (void) array, which must be cast (using 'Foreign.Matlab.Array.castMXArray')
type MAnyArray = MXArray MAny

-- |Tag for a NULL array
data MNull 
instance MType MNull MNull where
  hs2mx = id
  mx2hs = id
  mxClassOf _ = MXClassNull

mNullArray :: MXArray MNull
mNullArray = MXArray nullPtr

-- |A wrapper for a member of a cell array, which itself simply any other array
newtype MCell = MCell { mCell :: MAnyArray }
instance MType MCell MCell where
  hs2mx = id
  mx2hs = id
  mxClassOf _ = MXClassCell

-- |A single struct in an array, represented by an (ordered) list of key-value pairs
newtype MStruct = MStruct { mStruct :: [(String,MAnyArray)] }
instance MType MStruct MStruct where
  hs2mx = id
  mx2hs = id
  mxClassOf _ = MXClassStruct

type MXFun = CInt -> Ptr MXArrayPtr -> CInt -> Ptr MXArrayPtr -> IO ()
-- |A Matlab function
type MFun = 
  [MAnyArray] -- ^ RHS input arguments
  -> Int -- ^ LHS output argument count
  -> IO [MAnyArray] -- ^ LHS output arguments
instance MType MXFun MFun where
  hs2mx fun outn outp argn argp = do
    arg <- map MXArray =.< peekArray (ii argn) argp
    out <- fun arg (ii outn)
    pokeArray outp $ map mxArray out
  mx2hs fun arg no =
    withArrayLen (map mxArray arg) $ \argn argp ->
    allocaArray no $ \outp -> do
    fun (ii no) outp (ii argn) argp
    map MXArray =.< peekArray no outp
  mxClassOf _ = MXClassFun


{-# LINE 225 "Foreign/Matlab/Internal.hsc" #-}
type MWSize = Word64
{-# LINE 226 "Foreign/Matlab/Internal.hsc" #-}
type MWIndex = Word64
{-# LINE 227 "Foreign/Matlab/Internal.hsc" #-}
type MWSignedIndex = Int64
{-# LINE 228 "Foreign/Matlab/Internal.hsc" #-}

{-# LINE 229 "Foreign/Matlab/Internal.hsc" #-}