CoreMIDI.hs

-- |Low-level binding to the CoreMIDI services present in Mac OS X.
-- Error handling is via `fail`-s in the IO monad. 

{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module System.MacOSX.CoreMIDI 
  (
    enumerateDevices
  , enumerateSources
  , enumerateDestinations
  , MIDIHasName
  , getName
  , getModel
  , getManufacturer
  , newSource
  , newDestination
  , disposeEndpoint
  , newClient
  , disposeClient
  , newInputPort
  , newOutputPort
  , disposePort
  , connectToSource
  , disconnectFromSource
  , midiSend
  , midiSend'
  , midiSendList
  , midiSendList'
  , midiSendSysEx

  -- types  
  , OpaqueMIDIClient
  , OpaqueMIDIObject
  , OpaqueMIDIDevice
  , OpaqueMIDIEntity
  , OpaqueMIDIEndpoint
  , OpaqueMIDIPort
  
  , MIDIClientRef
  , MIDIObjectRef
  , MIDIDeviceRef
  , MIDIEntityRef
  , MIDIEndpointRef
  , MIDIPortRef

  , MIDITimeStamp
  , MIDIReadProc
  , mkMIDIReadProc
  , MIDIPacket
  , Source(..)
  , Destination(..)

  -- helper functions to write callbacks
  , depackMIDIPacketList
  , depackSingleMIDIPacket
  , decodeShortMessage 
  , isShortMessage 
  ) where

import Control.Monad
import Control.Concurrent.MVar
import Foreign
import Foreign.Marshal
import System.IO.Unsafe

import System.MIDI.Base
import System.MacOSX.CoreFoundation

data OpaqueMIDIClient
data OpaqueMIDIObject
data OpaqueMIDIDevice
data OpaqueMIDIEntity
data OpaqueMIDIEndpoint
data OpaqueMIDIPort

type MIDIClientRef    = Ptr OpaqueMIDIClient
type MIDIObjectRef    = Ptr OpaqueMIDIObject
type MIDIDeviceRef    = Ptr OpaqueMIDIDevice
type MIDIEntityRef    = Ptr OpaqueMIDIEntity
type MIDIEndpointRef  = Ptr OpaqueMIDIEndpoint
type MIDIPortRef      = Ptr OpaqueMIDIPort

type MIDIUniqueID     = SInt32 
type MIDIObjectType   = SInt32 
 
type MIDITimeStamp    = UInt64 
 
data MIDINotification   
type MIDINotifyProc a = Ptr MIDINotification -> Ptr a -> IO ()

data MIDIPacket
data MIDISysexSendRequest

-- | 'r' is readProcRefCon (The refCon you passed to MIDIInputPortCreate or MIDIDestinationCreate);
-- 's' is srcConnRefCon (A refCon you passed to MIDIPortConnectSource, which identifies the source of the data).
type MIDIReadProc r s = Ptr MIDIPacket -> Ptr r -> Ptr s -> IO ()

foreign import ccall safe "wrapper" 
  mkMIDIReadProc :: MIDIReadProc () () -> IO (FunPtr (MIDIReadProc () ()))

----- Properties ----- 

foreign import ccall "&kMIDIPropertyName"          ptr_kMIDIPropertyName          :: Ptr CFStringRef
foreign import ccall "&kMIDIPropertyManufacturer"  ptr_kMIDIPropertyManufacturer  :: Ptr CFStringRef
foreign import ccall "&kMIDIPropertyModel"         ptr_kMIDIPropertyModel         :: Ptr CFStringRef

kMIDIPropertyName         = unsafePerformIO $ peek ptr_kMIDIPropertyName
kMIDIPropertyManufacturer = unsafePerformIO $ peek ptr_kMIDIPropertyManufacturer
kMIDIPropertyModel        = unsafePerformIO $ peek ptr_kMIDIPropertyModel

----- Send

foreign import ccall unsafe "MIDIServices.h MIDISend" 
  c_MIDISend :: MIDIPortRef -> MIDIEndpointRef -> Ptr MIDIPacket -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDISendSysex" 
  c_MIDISendSysex :: Ptr MIDISysexSendRequest -> IO OSStatus

----- Clients

foreign import ccall unsafe "MIDIServices.h MIDIClientCreate" 
  c_MIDIClientCreate :: CFStringRef -> FunPtr (MIDINotifyProc a) -> Ptr a -> Ptr MIDIClientRef -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIClientDispose" 
  c_MIDIClientDispose   :: MIDIClientRef -> IO OSStatus

----- Devices

foreign import ccall unsafe "MIDIServices.h MIDIGetNumberOfDevices" 
  c_MIDIGetNumberOfDevices      :: IO ItemCount

foreign import ccall unsafe "MIDIServices.h MIDIGetDevice" 
  c_MIDIGetDevice      :: ItemCount -> IO MIDIDeviceRef

----- Endpoints

foreign import ccall unsafe "MIDIServices.h MIDIGetNumberOfSources" 
  c_MIDIGetNumberOfSources      :: IO ItemCount

foreign import ccall unsafe "MIDIServices.h MIDIGetNumberOfDestinations" 
  c_MIDIGetNumberOfDestinations :: IO ItemCount


foreign import ccall unsafe "MIDIServices.h MIDIGetSource" 
  c_MIDIGetSource      :: ItemCount -> IO MIDIEndpointRef

foreign import ccall unsafe "MIDIServices.h MIDIGetDestination" 
  c_MIDIGetDestination :: ItemCount -> IO MIDIEndpointRef


foreign import ccall unsafe "MIDIServices.h MIDISourceCreate" 
  c_MIDISourceCreate      :: MIDIClientRef -> CFStringRef -> Ptr MIDIEndpointRef -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIDestinationCreate" 
  c_MIDIDestinationCreate :: MIDIClientRef -> CFStringRef -> Ptr MIDIEndpointRef -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIEndpointDispose" 
  c_MIDIEndpointDispose   :: MIDIEndpointRef -> IO OSStatus

  
foreign import ccall unsafe "MIDIServices.h MIDIEndpointGetEntity" 
  c_MIDIEndpointGetEntity :: MIDIEndpointRef -> Ptr MIDIEntityRef -> IO OSStatus

------ Ports

foreign import ccall safe "MIDIServices.h MIDIInputPortCreate" 
  c_MIDIInputPortCreate  :: MIDIClientRef -> CFStringRef -> FunPtr (MIDIReadProc r s) -> Ptr r 
                            -> Ptr MIDIPortRef -> IO OSStatus

foreign import ccall safe "MIDIServices.h MIDIOutputPortCreate" 
  c_MIDIOutputPortCreate  :: MIDIClientRef -> CFStringRef -> Ptr MIDIPortRef -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIPortDispose"
  c_MIDIPortDispose :: MIDIPortRef -> IO OSStatus
  
foreign import ccall safe "MIDIServices.h MIDIPortConnectSource" 
  c_MIDIPortConnectSource  :: MIDIPortRef -> MIDIEndpointRef -> Ptr a -> IO OSStatus

foreign import ccall safe "MIDIServices.h MIDIPortDisconnectSource" 
  c_MIDIPortDisconnectSource  :: MIDIPortRef -> MIDIEndpointRef -> IO OSStatus

------ Objects

foreign import ccall unsafe "MIDIServices.h MIDIObjectFindByUniqueID" 
  c_MIDIObjectFindByUniqueID :: MIDIUniqueID -> Ptr MIDIObjectRef -> Ptr MIDIObjectType -> IO OSStatus
    
    
foreign import ccall unsafe "MIDIServices.h MIDIObjectGetDataProperty" 
  c_MIDIObjectGetDataProperty    :: MIDIObjectRef -> CFStringRef -> Ptr CFDataRef -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIObjectGetIntegerProperty" 
  c_MIDIObjectGetIntegerProperty :: MIDIObjectRef -> CFStringRef -> Ptr SInt32 -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIObjectGetStringProperty" 
  c_MIDIObjectGetStringProperty  :: MIDIObjectRef -> CFStringRef -> Ptr CFStringRef -> IO OSStatus


foreign import ccall unsafe "MIDIServices.h MIDIObjectSetDataProperty" 
  c_MIDIObjectSetDataProperty    :: MIDIObjectRef -> CFStringRef -> CFDataRef -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIObjectSetIntegerProperty" 
  c_MIDIObjectSetIntegerProperty :: MIDIObjectRef -> CFStringRef -> SInt32 -> IO OSStatus

foreign import ccall unsafe "MIDIServices.h MIDIObjectSetStringProperty" 
  c_MIDIObjectSetStringProperty  :: MIDIObjectRef -> CFStringRef -> CFStringRef -> IO OSStatus


midiObjectGetStringProperty :: MIDIObjectRef -> CFStringRef -> IO String
midiObjectGetStringProperty object propertyid = 
  alloca $ \ptr_cfstringref -> do
    osstatus <- c_MIDIObjectGetStringProperty object propertyid ptr_cfstringref 
    if osstatus /= 0
      then osStatusError osstatus 
      else do
        cfstringref <- peek ptr_cfstringref
        string <- peekCFString cfstringref
        releaseCFString cfstringref
        return string

midiObjectGetIntegerProperty :: MIDIObjectRef -> CFStringRef -> IO SInt32
midiObjectGetIntegerProperty object propertyid = 
  alloca $ \ptr_sint32 -> do
    osstatus <- c_MIDIObjectGetIntegerProperty object propertyid ptr_sint32
    if osstatus /= 0
      then osStatusError osstatus
      else do
        sint32 <- peek ptr_sint32
        return sint32
      
      
---------- exported Haskell functions ----------

newtype Source      = Source      MIDIEndpointRef deriving (Eq,Show)
newtype Destination = Destination MIDIEndpointRef deriving (Eq,Show)

class Endpoint a where endpoint :: a -> MIDIEndpointRef

instance Endpoint Source          where endpoint (Source      src) = src
instance Endpoint Destination     where endpoint (Destination src) = src
instance Endpoint MIDIEndpointRef where endpoint = id

class MIDIObject a where midiObject :: a -> MIDIObjectRef

instance MIDIObject MIDIClientRef    where midiObject = castPtr
instance MIDIObject MIDIDeviceRef    where midiObject = castPtr
instance MIDIObject MIDIPortRef      where midiObject = castPtr
instance MIDIObject MIDIEndpointRef  where midiObject = castPtr
instance MIDIObject MIDIEntityRef    where midiObject = castPtr

instance MIDIObject Source      where midiObject (Source src) = castPtr src
instance MIDIObject Destination where midiObject (Destination dst) = castPtr dst

-- |MIDI objects which can have a name, model name and manufacturer
class MIDIObject a => MIDIHasName a where
  getName         :: a -> IO String
  getModel        :: a -> IO String
  getManufacturer :: a -> IO String
  
  getName  = genericGetName  . midiObject
  getModel = genericGetModel . midiObject
  getManufacturer = genericGetManufacturer . midiObject

instance MIDIHasName MIDIDeviceRef
instance MIDIHasName MIDIEntityRef
instance MIDIHasName MIDIPortRef
instance MIDIHasName MIDIEndpointRef
instance MIDIHasName Source
instance MIDIHasName Destination

genericGetName obj         = midiObjectGetStringProperty obj kMIDIPropertyName
genericGetModel obj        = midiObjectGetStringProperty obj kMIDIPropertyModel
genericGetManufacturer obj = midiObjectGetStringProperty obj kMIDIPropertyManufacturer

data Notification = Notification NotificationMessageID (Maybe [Word8])

data NotificationMessageID 
  = SetupChanged 
  | ObjectAdded  
  | ObjectRemoved
  | PropertyChanged 
  | ThruConnectionsChanged  
  | SerialPortOwnerChanged  
  | MIDIMsgIOError 
 
----- encode / decode 

encodeShortMessageList :: [ShortMessage] -> [Word8]
encodeShortMessageList list = concatMap encodeShortMessage list

encodeShortMessage :: ShortMessage -> [Word8]
encodeShortMessage (ShortMessage chn' msg' bt1 bt2) =
  case msg of
    8  -> [cmd,bt1,bt2]   -- ?!
    9  -> [cmd,bt1,bt2]  
    10 -> [cmd,bt1,bt2]  
    11 -> [cmd,bt1,bt2]  
    12 -> [cmd,bt1]  
    13 -> [cmd,bt1]  
    14 -> [cmd,bt1,bt2]  
    15 -> case chn of
      2 -> [cmd,bt1,bt2]
      3 -> [cmd,bt1]
      0 -> error "SysEx is not a short message!"
      _ -> [cmd]
  where 
    chn = 15 .&. chn'
    msg = 15 .&. msg'
    cmd = chn + shiftL msg 4 

isShortMessage :: [Word8] -> Bool
isShortMessage msg = (head msg /= 0xf0)

decodeShortMessage :: [Word8] -> ShortMessage 
decodeShortMessage bytes = ShortMessage chn msg bt1 bt2 where
  cmd = head bytes
  chn = cmd .&. 15
  msg = shiftR cmd 4
  (bt1,bt2) = case tail bytes of
    []    -> (0,0)
    [a]   -> (a,0)
    [a,b] -> (a,b)
    _     -> error "a short message shouldn't be longer than 3 bytes!"
    
depackMIDIPacketList :: Ptr MIDIPacket -> IO [ (MIDITimeStamp, [Word8]) ]
depackMIDIPacketList p = 
  do
    npackets <- peek (castPtr p) :: IO UInt32
    depack' (p `plusPtr` 4) npackets 
  where
    depack' _ 0 = return []
    depack' p k = do
      ( n , ts , msgs ) <- depackSingleMIDIPacket p 
      let xs = zip (repeat ts) msgs
      ys <- depack' (p `plusPtr` n) (k-1) 
      return (xs++ys) 
 
-- decodes a single MIDIPacket, and returns the length (in bytes), the timestamp, and the list of midi messages
depackSingleMIDIPacket :: Ptr MIDIPacket -> IO ( Int , MIDITimeStamp , [[Word8]] )
depackSingleMIDIPacket p = do
  ts   <- peek (castPtr p            ) :: IO MIDITimeStamp
  len' <- peek (castPtr p `plusPtr` 8) :: IO UInt16
  let len = fromIntegral len'
  msglist <- depackMsgList (castPtr p `plusPtr` 10 :: Ptr Word8) len
  return ( len + 8 + 2, ts, msglist )

-- helper function  
depackMsgList :: Ptr Word8 -> Int -> IO [[Word8]]
depackMsgList _ 0 = return []
depackMsgList p n = if n < 0
  then fail "fatal error while depacking MIDI messages"
  else do
    (k,x) <- depackSingleMessage p
    xs <- depackMsgList (p `plusPtr` k) (n-k)
    return (x:xs)
    
depackSingleMessage :: Ptr Word8 -> IO (Int,[Word8])
depackSingleMessage p = do

  cmd <- peek p

  let hi  = shiftR cmd 4
      lo  = cmd .&. 15
 
  let ret :: Int -> IO (Int,[Word8])
      ret k = do 
        xs <- mapM (peekElemOff p) [0..k-1]
        return $ ( k , xs  )

  case hi of        
    8  -> ret 3  -- ?!
    9  -> ret 3  
    10 -> ret 3  
    11 -> ret 3 
    12 -> ret 2  
    13 -> ret 2  
    14 -> ret 3  
    15 -> case lo of
      2 -> ret 3
      3 -> ret 2
      0 -> sysex p
      _ -> ret 1
    _ -> fail "fatal error while interpreting a MIDI message"
      
-- does not include the terminating 0xf7 byte!      
sysex :: Ptr Word8 -> IO (Int,[Word8])
sysex p = do 
  n <- sysexloop p 2 
  xs <- mapM (peekElemOff p) [0..n]
  return ( n+2 , xs ) 

sysexloop :: Ptr Word8 -> Int -> IO Int
sysexloop q i = do
  x <- peekElemOff q i
  if x == 0xf7 then return (i-1) else sysexloop q (i+1) 
    
----- Send

-- |Sends a short message with timestamp "now".
midiSend :: MIDIPortRef -> Destination -> ShortMessage -> IO () 
midiSend port dst msg     = midiSend' port dst 0 msg

-- |Sends a list of short messages with timestamp "now".
midiSendList :: MIDIPortRef -> Destination -> [ShortMessage] -> IO () 
midiSendList port dst msglist = midiSendList' port dst 0 msglist

-- |Sends a short message with the given timestamp.
midiSend' :: MIDIPortRef -> Destination -> MIDITimeStamp -> ShortMessage -> IO ()
midiSend' port (Destination dst) ts msg = do
  let encoded = encodeShortMessage msg
      n = length encoded
  allocaBytes (4 + 8 + 2 + n) $ \p -> do
    poke      (        p              :: Ptr UInt32) 1
    poke      (castPtr p `plusPtr`  4 :: Ptr UInt64) ts
    poke      (castPtr p `plusPtr` 12 :: Ptr UInt16) (fromIntegral n)
    pokeArray (castPtr p `plusPtr` 14 :: Ptr Word8 ) encoded   
    osstatus <- c_MIDISend port dst (castPtr p)
    when (osstatus /= 0) $ osStatusError osstatus

-- |Sends a list of short messages with the given timestamp.
midiSendList' :: MIDIPortRef -> Destination -> MIDITimeStamp -> [ShortMessage] -> IO ()
midiSendList' port (Destination dst) ts msglist = do
  let encoded = encodeShortMessageList msglist
      n = length encoded
  allocaBytes (4 + 8 + 2 + n) $ \p -> do
    poke      (        p              :: Ptr UInt32) 1
    poke      (castPtr p `plusPtr`  4 :: Ptr UInt64) ts
    poke      (castPtr p `plusPtr` 12 :: Ptr UInt16) (fromIntegral n)
    pokeArray (castPtr p `plusPtr` 14 :: Ptr Word8 ) encoded   
    osstatus <- c_MIDISend port dst (castPtr p)
    when (osstatus /= 0) $ osStatusError osstatus

type MIDISendSysExCallback =  Ptr Word8 -> IO ()
    
foreign import ccall safe "wrapper" 
  mkMidiSendSysExCallback :: MIDISendSysExCallback -> IO (FunPtr MIDISendSysExCallback)
    
midiSendSysExCallback :: MIDISendSysExCallback 
midiSendSysExCallback p = do
  free p
  
-- Sends a system exclusive message. You shouldn't include the starting/trailing bytes 0xF0 and 0xF7.  
midiSendSysEx :: Endpoint a => a -> [Word8] -> IO ()
midiSendSysEx dst dat' = do
  let ptrsize = sizeOf (undefined :: Ptr Word8)
      n = length dat
      k = 4*ptrsize + 8  
      ep = endpoint dst
      dat = 0xf0 : (dat' ++ [0xf7])
  cb <- mkMidiSendSysExCallback midiSendSysExCallback
  p  <- mallocBytes (k + n)
  let q = (castPtr p `plusPtr` k) :: Ptr Word8
  pokeArray q dat
  poke (castPtr p) ep         ; r <- return (p `plusPtr` ptrsize) 
  poke (castPtr r) q          ; r <- return (r `plusPtr` ptrsize) 
  poke (castPtr r) n          ; r <- return (r `plusPtr` 4      ) 
  poke (castPtr r) (0::Int32) ; r <- return (r `plusPtr` 4      ) 
  poke (castPtr r) cb         ; r <- return (r `plusPtr` ptrsize) 
  poke (castPtr r) p             -- not used (?)       
  osstatus <- c_MIDISendSysex p  -- this is asynchronous! (returns immediately before data has been sent)
  when (osstatus /= 0) $ osStatusError osstatus
  
----- Ports  
 
-- |Creates a new input port. 
newInputPort :: MIDIClientRef -> String -> FunPtr (MIDIReadProc r s) -> Ptr r -> IO MIDIPortRef
newInputPort client name proc ref = do
  withCFString name $ \cfname -> alloca $ \pport -> do
    osstatus <- c_MIDIInputPortCreate client cfname proc ref pport   
    when (osstatus /= 0) $ osStatusError osstatus
    peek pport  

-- |Creates a new output port. 
newOutputPort :: MIDIClientRef -> String -> IO MIDIPortRef
newOutputPort client name = do
  withCFString name $ \cfname -> alloca $ \pport -> do
    osstatus <- c_MIDIOutputPortCreate client cfname pport   
    when (osstatus /= 0) $ osStatusError osstatus
    peek pport  
  
-- |Disposes an existing port. 
disposePort :: MIDIPortRef -> IO ()
disposePort port = do
  osstatus <- c_MIDIPortDispose port   
  when (osstatus /= 0) $ osStatusError osstatus
 
-- |Connects an input port to a source.
connectToSource :: MIDIPortRef -> Source -> Ptr a -> IO ()
connectToSource port (Source src) ref = do
  osstatus <- c_MIDIPortConnectSource port src ref  
  when (osstatus /= 0) $ osStatusError osstatus

-- |Disconnects an input port from a source.
disconnectFromSource :: MIDIPortRef -> Source -> IO ()
disconnectFromSource port (Source src) = do
  osstatus <- c_MIDIPortDisconnectSource port src   
  when (osstatus /= 0) $ osStatusError osstatus
   
----- Clients  
  
-- |Creates a new MIDI client with the given name.
newClient :: String -> IO MIDIClientRef
newClient name = do
  withCFString name $ \cfname -> alloca $ \pclient -> do
    osstatus <- c_MIDIClientCreate cfname nullFunPtr nullPtr pclient   
    when (osstatus /= 0) $ osStatusError osstatus
    peek pclient
    
-- |Disposes an existing MIDI client.
disposeClient :: MIDIClientRef -> IO ()
disposeClient client = do
  osstatus <- c_MIDIClientDispose client
  when (osstatus /= 0) $ osStatusError osstatus
      
    
----- Devices

-- |Note: If a client iterates through the devices and entities in the system, it will not ever visit any virtual sources and destinations created by other clients. Also, a device iteration will return devices which are offline (were present in the past but are not currently present), while iterations through the system's sources and destinations will not include the endpoints of offline devices. 
--
-- Thus clients should usually use `enumerateSources` and `enumerateDestinations`, rather iterating through devices and entities to locate endpoints.
enumerateDevices :: IO [MIDIDeviceRef]
enumerateDevices = do
  n <- c_MIDIGetNumberOfDevices
  if n > 0  -- n is unsigned => (n-1)=(2^32)-1  !! 
    then forM [0..n-1] c_MIDIGetDevice
    else return []

----- Endpoints

-- |Enumaretes the MIDI sources present.
enumerateSources :: IO [Source]
enumerateSources = do
  n <- c_MIDIGetNumberOfSources
  if n > 0  -- n is unsigned => (n-1)=(2^32)-1  !! 
    then forM [0..n-1] $ \i -> liftM Source (c_MIDIGetSource i) 
    else return []
    
-- |Enumaretes the MIDI destinations present.
enumerateDestinations :: IO [Destination]
enumerateDestinations = do
  n <- c_MIDIGetNumberOfSources
  if n > 0  -- n is unsigned => (n-1)=(2^32)-1  !! 
    then forM [0..n-1] $ \i -> liftM Destination (c_MIDIGetDestination i)
    else return []
    
-- a helper function; not exposed.
newEndpoint :: (MIDIClientRef -> CFStringRef -> Ptr MIDIEndpointRef -> IO OSStatus) 
               -> MIDIClientRef -> String -> IO MIDIEndpointRef 
newEndpoint createEndpoint client name = withCFString name $ \cfname -> do
  alloca $ \ptr_endpoint -> do 
    osstatus <- createEndpoint client cfname ptr_endpoint
    if osstatus /= 0
      then osStatusError osstatus
      else peek ptr_endpoint
       
-- |Creates a new MIDI source with the given name.
newSource :: MIDIClientRef -> String -> IO Source
newSource client name = do
  src <- newEndpoint c_MIDISourceCreate client name      
  return $ Source src
  
-- |Creates a new MIDI destination with the given name.
newDestination ::  MIDIClientRef -> String -> IO Destination 
newDestination client name = do
  dst <- newEndpoint c_MIDIDestinationCreate client name       
  return $ Destination dst
  
-- |Disposes an existing MIDI endpoint.
disposeEndpoint :: Endpoint a => a -> IO ()  
disposeEndpoint x = do
  osstatus <- c_MIDIEndpointDispose (endpoint x)
  when (osstatus /= 0) $ osStatusError osstatus