{-# LINE 1 "Sound/RtMidi/Foreign.hsc" #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- | FFI defs for RtMidi
module Sound.RtMidi.Foreign
  ( Wrapper (..)
  , Api (..)
  , ApiInternal
  , toApi
  , fromApi
  , rtmidi_api_display_name
  , rtmidi_api_name
  , rtmidi_close_port
  , rtmidi_compiled_api_by_name
  , rtmidi_get_compiled_api
  , rtmidi_get_port_count
  , rtmidi_get_port_name
  , rtmidi_in_cancel_callback
  , rtmidi_in_create
  , rtmidi_in_create_default
  , rtmidi_in_free
  , rtmidi_in_get_current_api
  , rtmidi_in_get_message
  , rtmidi_in_ignore_types
  , rtmidi_in_set_callback
  , rtmidi_open_port
  , rtmidi_open_virtual_port
  , rtmidi_out_create
  , rtmidi_out_create_default
  , rtmidi_out_free
  , rtmidi_out_get_current_api
  , rtmidi_out_send_message
  ) where



import Control.DeepSeq (NFData)
import Foreign (FunPtr, Ptr, Storable (..))
import Foreign.C (CDouble (..), CInt (..), CString, CSize, CUChar, CUInt (..))
import GHC.Generics (Generic)

data Wrapper = Wrapper
  { Wrapper -> Ptr ()
ptr :: !(Ptr ())
  , Wrapper -> Ptr ()
dat :: !(Ptr ())
  , Wrapper -> Bool
ok  :: !Bool
  , Wrapper -> CString
msg :: !CString
  } deriving stock (Wrapper -> Wrapper -> Bool
(Wrapper -> Wrapper -> Bool)
-> (Wrapper -> Wrapper -> Bool) -> Eq Wrapper
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Wrapper -> Wrapper -> Bool
$c/= :: Wrapper -> Wrapper -> Bool
== :: Wrapper -> Wrapper -> Bool
$c== :: Wrapper -> Wrapper -> Bool
Eq, Int -> Wrapper -> ShowS
[Wrapper] -> ShowS
Wrapper -> String
(Int -> Wrapper -> ShowS)
-> (Wrapper -> String) -> ([Wrapper] -> ShowS) -> Show Wrapper
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Wrapper] -> ShowS
$cshowList :: [Wrapper] -> ShowS
show :: Wrapper -> String
$cshow :: Wrapper -> String
showsPrec :: Int -> Wrapper -> ShowS
$cshowsPrec :: Int -> Wrapper -> ShowS
Show, (forall x. Wrapper -> Rep Wrapper x)
-> (forall x. Rep Wrapper x -> Wrapper) -> Generic Wrapper
forall x. Rep Wrapper x -> Wrapper
forall x. Wrapper -> Rep Wrapper x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Wrapper x -> Wrapper
$cfrom :: forall x. Wrapper -> Rep Wrapper x
Generic)
    deriving anyclass (Wrapper -> ()
(Wrapper -> ()) -> NFData Wrapper
forall a. (a -> ()) -> NFData a
rnf :: Wrapper -> ()
$crnf :: Wrapper -> ()
NFData)

instance Storable Wrapper where
  sizeOf :: Wrapper -> Int
sizeOf Wrapper
_ = (Int
32)
{-# LINE 52 "Sound/RtMidi/Foreign.hsc" #-}
  alignment _ = 8
{-# LINE 53 "Sound/RtMidi/Foreign.hsc" #-}
  poke ptr (Wrapper a b c d) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr a
{-# LINE 55 "Sound/RtMidi/Foreign.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr b
{-# LINE 56 "Sound/RtMidi/Foreign.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr c
{-# LINE 57 "Sound/RtMidi/Foreign.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr d
{-# LINE 58 "Sound/RtMidi/Foreign.hsc" #-}
  peek ptr = do
    a <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 60 "Sound/RtMidi/Foreign.hsc" #-}
    b <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 61 "Sound/RtMidi/Foreign.hsc" #-}
    c <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 62 "Sound/RtMidi/Foreign.hsc" #-}
    d <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 63 "Sound/RtMidi/Foreign.hsc" #-}
    pure (Wrapper a b c d)

-- | Enum of RtMidi-supported APIs
data Api
  = UnspecifiedApi
  | CoreMidiApi
  | AlsaApi
  | JackApi
  | MultimediaApi
  | DummyApi
  deriving stock (Api -> Api -> Bool
(Api -> Api -> Bool) -> (Api -> Api -> Bool) -> Eq Api
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Api -> Api -> Bool
$c/= :: Api -> Api -> Bool
== :: Api -> Api -> Bool
$c== :: Api -> Api -> Bool
Eq, Int -> Api -> ShowS
[Api] -> ShowS
Api -> String
(Int -> Api -> ShowS)
-> (Api -> String) -> ([Api] -> ShowS) -> Show Api
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Api] -> ShowS
$cshowList :: [Api] -> ShowS
show :: Api -> String
$cshow :: Api -> String
showsPrec :: Int -> Api -> ShowS
$cshowsPrec :: Int -> Api -> ShowS
Show, Eq Api
Eq Api
-> (Api -> Api -> Ordering)
-> (Api -> Api -> Bool)
-> (Api -> Api -> Bool)
-> (Api -> Api -> Bool)
-> (Api -> Api -> Bool)
-> (Api -> Api -> Api)
-> (Api -> Api -> Api)
-> Ord Api
Api -> Api -> Bool
Api -> Api -> Ordering
Api -> Api -> Api
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Api -> Api -> Api
$cmin :: Api -> Api -> Api
max :: Api -> Api -> Api
$cmax :: Api -> Api -> Api
>= :: Api -> Api -> Bool
$c>= :: Api -> Api -> Bool
> :: Api -> Api -> Bool
$c> :: Api -> Api -> Bool
<= :: Api -> Api -> Bool
$c<= :: Api -> Api -> Bool
< :: Api -> Api -> Bool
$c< :: Api -> Api -> Bool
compare :: Api -> Api -> Ordering
$ccompare :: Api -> Api -> Ordering
$cp1Ord :: Eq Api
Ord, Int -> Api
Api -> Int
Api -> [Api]
Api -> Api
Api -> Api -> [Api]
Api -> Api -> Api -> [Api]
(Api -> Api)
-> (Api -> Api)
-> (Int -> Api)
-> (Api -> Int)
-> (Api -> [Api])
-> (Api -> Api -> [Api])
-> (Api -> Api -> [Api])
-> (Api -> Api -> Api -> [Api])
-> Enum Api
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Api -> Api -> Api -> [Api]
$cenumFromThenTo :: Api -> Api -> Api -> [Api]
enumFromTo :: Api -> Api -> [Api]
$cenumFromTo :: Api -> Api -> [Api]
enumFromThen :: Api -> Api -> [Api]
$cenumFromThen :: Api -> Api -> [Api]
enumFrom :: Api -> [Api]
$cenumFrom :: Api -> [Api]
fromEnum :: Api -> Int
$cfromEnum :: Api -> Int
toEnum :: Int -> Api
$ctoEnum :: Int -> Api
pred :: Api -> Api
$cpred :: Api -> Api
succ :: Api -> Api
$csucc :: Api -> Api
Enum, Api
Api -> Api -> Bounded Api
forall a. a -> a -> Bounded a
maxBound :: Api
$cmaxBound :: Api
minBound :: Api
$cminBound :: Api
Bounded, (forall x. Api -> Rep Api x)
-> (forall x. Rep Api x -> Api) -> Generic Api
forall x. Rep Api x -> Api
forall x. Api -> Rep Api x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Api x -> Api
$cfrom :: forall x. Api -> Rep Api x
Generic)
  deriving anyclass (Api -> ()
(Api -> ()) -> NFData Api
forall a. (a -> ()) -> NFData a
rnf :: Api -> ()
$crnf :: Api -> ()
NFData)

-- A parameter we'll be de/serializing from the 'Api' enum.
newtype ApiInternal = ApiInternal { ApiInternal -> CInt
unApiInternal :: CInt } deriving newtype (Ptr b -> Int -> IO ApiInternal
Ptr b -> Int -> ApiInternal -> IO ()
Ptr ApiInternal -> IO ApiInternal
Ptr ApiInternal -> Int -> IO ApiInternal
Ptr ApiInternal -> Int -> ApiInternal -> IO ()
Ptr ApiInternal -> ApiInternal -> IO ()
ApiInternal -> Int
(ApiInternal -> Int)
-> (ApiInternal -> Int)
-> (Ptr ApiInternal -> Int -> IO ApiInternal)
-> (Ptr ApiInternal -> Int -> ApiInternal -> IO ())
-> (forall b. Ptr b -> Int -> IO ApiInternal)
-> (forall b. Ptr b -> Int -> ApiInternal -> IO ())
-> (Ptr ApiInternal -> IO ApiInternal)
-> (Ptr ApiInternal -> ApiInternal -> IO ())
-> Storable ApiInternal
forall b. Ptr b -> Int -> IO ApiInternal
forall b. Ptr b -> Int -> ApiInternal -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr ApiInternal -> ApiInternal -> IO ()
$cpoke :: Ptr ApiInternal -> ApiInternal -> IO ()
peek :: Ptr ApiInternal -> IO ApiInternal
$cpeek :: Ptr ApiInternal -> IO ApiInternal
pokeByteOff :: Ptr b -> Int -> ApiInternal -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> ApiInternal -> IO ()
peekByteOff :: Ptr b -> Int -> IO ApiInternal
$cpeekByteOff :: forall b. Ptr b -> Int -> IO ApiInternal
pokeElemOff :: Ptr ApiInternal -> Int -> ApiInternal -> IO ()
$cpokeElemOff :: Ptr ApiInternal -> Int -> ApiInternal -> IO ()
peekElemOff :: Ptr ApiInternal -> Int -> IO ApiInternal
$cpeekElemOff :: Ptr ApiInternal -> Int -> IO ApiInternal
alignment :: ApiInternal -> Int
$calignment :: ApiInternal -> Int
sizeOf :: ApiInternal -> Int
$csizeOf :: ApiInternal -> Int
Storable)

toApi :: ApiInternal -> Api
toApi :: ApiInternal -> Api
toApi = Int -> Api
forall a. Enum a => Int -> a
toEnum (Int -> Api) -> (ApiInternal -> Int) -> ApiInternal -> Api
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> (ApiInternal -> CInt) -> ApiInternal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiInternal -> CInt
unApiInternal

fromApi :: Api -> ApiInternal
fromApi :: Api -> ApiInternal
fromApi = CInt -> ApiInternal
ApiInternal (CInt -> ApiInternal) -> (Api -> CInt) -> Api -> ApiInternal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Api -> Int) -> Api -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Api -> Int
forall a. Enum a => a -> Int
fromEnum

foreign import ccall "rtmidi_c.h rtmidi_api_display_name"
  rtmidi_api_display_name :: ApiInternal -> IO CString

foreign import ccall "rtmidi_c.h rtmidi_api_name"
  rtmidi_api_name :: ApiInternal -> IO CString

foreign import ccall "rtmidi_c.h rtmidi_close_port"
  rtmidi_close_port :: Ptr Wrapper -> IO ()

foreign import ccall "rtmidi_c.h rtmidi_compiled_api_by_name"
  rtmidi_compiled_api_by_name :: CString -> IO ApiInternal

foreign import ccall "rtmidi_c.h rtmidi_get_compiled_api"
  rtmidi_get_compiled_api :: Ptr ApiInternal -> CUInt -> IO CInt

foreign import ccall "rtmidi_c.h rtmidi_get_port_count"
  rtmidi_get_port_count :: Ptr Wrapper -> IO CUInt

foreign import ccall "rtmidi_c.h rtmidi_get_port_name"
  rtmidi_get_port_name :: Ptr Wrapper -> CUInt -> IO CString

foreign import ccall "rtmidi_c.h rtmidi_in_cancel_callback"
  rtmidi_in_cancel_callback :: Ptr Wrapper -> IO ()

foreign import ccall "rtmidi_c.h rtmidi_in_create"
  rtmidi_in_create :: ApiInternal -> CString -> CUInt -> IO (Ptr Wrapper)

foreign import ccall "rtmidi_c.h rtmidi_in_create_default"
  rtmidi_in_create_default :: IO (Ptr Wrapper)

foreign import ccall "rtmidi_c.h &rtmidi_in_free"
  rtmidi_in_free :: FunPtr (Ptr Wrapper -> IO ())

foreign import ccall "rtmidi_c.h rtmidi_in_get_current_api"
  rtmidi_in_get_current_api :: Ptr Wrapper -> IO ApiInternal

foreign import ccall "rtmidi_c.h rtmidi_in_get_message"
  rtmidi_in_get_message :: Ptr Wrapper -> Ptr (Ptr CUChar) -> Ptr CSize -> IO CDouble

foreign import ccall "rtmidi_c.h rtmidi_in_ignore_types"
  rtmidi_in_ignore_types :: Ptr Wrapper -> Bool -> Bool -> Bool -> IO ()

foreign import ccall "rtmidi_c.h rtmidi_in_set_callback"
  rtmidi_in_set_callback :: Ptr Wrapper -> FunPtr (CDouble -> Ptr CUChar -> CInt -> Ptr () -> IO ()) -> Ptr () -> IO ()

foreign import ccall "rtmidi_c.h rtmidi_open_port"
  rtmidi_open_port :: Ptr Wrapper -> CUInt -> CString -> IO ()

foreign import ccall "rtmidi_c.h rtmidi_open_virtual_port"
  rtmidi_open_virtual_port :: Ptr Wrapper -> CString -> IO ()

foreign import ccall "rtmidi_c.h rtmidi_out_create"
  rtmidi_out_create :: ApiInternal -> CString -> IO (Ptr Wrapper)

foreign import ccall "rtmidi_c.h rtmidi_out_create_default"
  rtmidi_out_create_default :: IO (Ptr Wrapper)

foreign import ccall "rtmidi_c.h &rtmidi_out_free"
  rtmidi_out_free :: FunPtr (Ptr Wrapper -> IO ())

foreign import ccall "rtmidi_c.h rtmidi_out_get_current_api"
  rtmidi_out_get_current_api :: Ptr Wrapper -> IO ApiInternal

foreign import ccall "rtmidi_c.h rtmidi_out_send_message"
  rtmidi_out_send_message :: Ptr Wrapper -> Ptr CUChar -> CInt -> IO CInt