{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/Port.hsc" #-}
--------------------------------------------------------------------------------
-- |
-- Module    : Sound.ALSA.Sequencer.Marshal.Port
-- Copyright : (c) Henning Thielemann, 2011
--             (c) Iavor S. Diatchki, 2007
-- License   : BSD3
--
-- Maintainer: Henning Thielemann
-- Stability : provisional
--
-- PRIVATE MODULE.
--
-- Here we have the various types used by the library,
-- and how they are imported\/exported to C.
--
-- We use Hsc for expanding C types to Haskell types like Word32.
-- However if a C type is translated to Word32
-- you should not assume that it is translated to Word32 on every platform.
-- On a 64bit machine it may well be Word64.
-- Thus you should use our wrapper types whereever possible.
--------------------------------------------------------------------------------

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Sound.ALSA.Sequencer.Marshal.Port where




import qualified Sound.ALSA.Sequencer.Utility as U
import qualified Foreign.C.Types as C
import qualified Data.Word as Word
import Foreign.Storable (Storable, )
import Data.Ix (Ix, range, index, inRange, rangeSize, )
import Data.Maybe (fromMaybe, )
import qualified Data.Ix.Enum as IxEnum
import qualified Data.EnumBitSet as EnumSet


-- The type of client ports.
newtype T =
   Cons Word.Word8
{-# LINE 42 "src/Sound/ALSA/Sequencer/Marshal/Port.hsc" #-}
      deriving (Eq, Ord, Storable)

instance Show T where
   showsPrec :: Int -> T -> ShowS
showsPrec Int
prec (Cons Word8
x) =
      Int -> String -> [ShowS] -> ShowS
U.showsRecord Int
prec String
"Port" [forall a. Show a => a -> ShowS
U.showsField Word8
x]


exp :: T -> C.CInt
exp :: T -> CInt
exp (Cons Word8
p) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
p

imp :: C.CInt -> T
imp :: CInt -> T
imp CInt
p = Word8 -> T
Cons (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
p)


{-
We could also define

> newtype CapabilityFlag = CapabilityFlag Int

but the enumeration definition gives nicer Show instance.
-}
data CapabilityFlag =
     CapOther Int   {- ^ a capability that cannot be represented by the other constructors -}
   | CapRead        {- ^ readable from this port -}
   | CapWrite       {- ^ writable to this port -}
   | CapSyncRead    {- ^ allow read subscriptions -}
   | CapSyncWrite   {- ^ allow write subscriptions -}
   | CapDuplex      {- ^ allow read/write duplex -}
   | CapSubsRead    {- ^ allow read subscription -}
   | CapSubsWrite   {- ^ allow write subscription -}
   | CapNoExport    {- ^ routing not allowed -}
     deriving (CapabilityFlag -> CapabilityFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CapabilityFlag -> CapabilityFlag -> Bool
$c/= :: CapabilityFlag -> CapabilityFlag -> Bool
== :: CapabilityFlag -> CapabilityFlag -> Bool
$c== :: CapabilityFlag -> CapabilityFlag -> Bool
Eq, Eq CapabilityFlag
CapabilityFlag -> CapabilityFlag -> Bool
CapabilityFlag -> CapabilityFlag -> Ordering
CapabilityFlag -> CapabilityFlag -> CapabilityFlag
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 :: CapabilityFlag -> CapabilityFlag -> CapabilityFlag
$cmin :: CapabilityFlag -> CapabilityFlag -> CapabilityFlag
max :: CapabilityFlag -> CapabilityFlag -> CapabilityFlag
$cmax :: CapabilityFlag -> CapabilityFlag -> CapabilityFlag
>= :: CapabilityFlag -> CapabilityFlag -> Bool
$c>= :: CapabilityFlag -> CapabilityFlag -> Bool
> :: CapabilityFlag -> CapabilityFlag -> Bool
$c> :: CapabilityFlag -> CapabilityFlag -> Bool
<= :: CapabilityFlag -> CapabilityFlag -> Bool
$c<= :: CapabilityFlag -> CapabilityFlag -> Bool
< :: CapabilityFlag -> CapabilityFlag -> Bool
$c< :: CapabilityFlag -> CapabilityFlag -> Bool
compare :: CapabilityFlag -> CapabilityFlag -> Ordering
$ccompare :: CapabilityFlag -> CapabilityFlag -> Ordering
Ord, Int -> CapabilityFlag -> ShowS
[CapabilityFlag] -> ShowS
CapabilityFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CapabilityFlag] -> ShowS
$cshowList :: [CapabilityFlag] -> ShowS
show :: CapabilityFlag -> String
$cshow :: CapabilityFlag -> String
showsPrec :: Int -> CapabilityFlag -> ShowS
$cshowsPrec :: Int -> CapabilityFlag -> ShowS
Show)

data TypeFlag =
     TypeOther Int      {- ^ a type that cannot be represented by the other constructors -}
   | TypeSpecific       {- ^ hardware specific -}
   | TypeMIDIGeneric    {- ^ generic MIDI device -}
   | TypeMIDIGM         {- ^ General MIDI compatible device -}
   | TypeMIDIGS         {- ^ GS compatible device -}
   | TypeMIDIXG         {- ^ XG compatible device -}
   | TypeMIDIMT32       {- ^ MT-32 compatible device -}
   | TypeMIDIGM2        {- ^ General MIDI 2 compatible device -}

   | TypeSynth          {- ^ Synth device -}
   | TypeDirectSample   {- ^ Sampling device (support sample download) -}
   | TypeSample         {- ^ Sampling device (sample can be downloaded at any time) -}

   | TypeHardware       {- ^ This port is implemented in hardware. -}
   | TypeSoftware       {- ^ This port is implemented in software. -}
   | TypeSynthesizer    {- ^ Messages sent to this port will generate sounds. -}
   | TypePort           {- ^ This port may connect to other devices
                             (whose characteristics are not known). -}
   | TypeApplication    {- ^ application (sequencer/editor) -}
     deriving (TypeFlag -> TypeFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeFlag -> TypeFlag -> Bool
$c/= :: TypeFlag -> TypeFlag -> Bool
== :: TypeFlag -> TypeFlag -> Bool
$c== :: TypeFlag -> TypeFlag -> Bool
Eq, Eq TypeFlag
TypeFlag -> TypeFlag -> Bool
TypeFlag -> TypeFlag -> Ordering
TypeFlag -> TypeFlag -> TypeFlag
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 :: TypeFlag -> TypeFlag -> TypeFlag
$cmin :: TypeFlag -> TypeFlag -> TypeFlag
max :: TypeFlag -> TypeFlag -> TypeFlag
$cmax :: TypeFlag -> TypeFlag -> TypeFlag
>= :: TypeFlag -> TypeFlag -> Bool
$c>= :: TypeFlag -> TypeFlag -> Bool
> :: TypeFlag -> TypeFlag -> Bool
$c> :: TypeFlag -> TypeFlag -> Bool
<= :: TypeFlag -> TypeFlag -> Bool
$c<= :: TypeFlag -> TypeFlag -> Bool
< :: TypeFlag -> TypeFlag -> Bool
$c< :: TypeFlag -> TypeFlag -> Bool
compare :: TypeFlag -> TypeFlag -> Ordering
$ccompare :: TypeFlag -> TypeFlag -> Ordering
Ord, Int -> TypeFlag -> ShowS
[TypeFlag] -> ShowS
TypeFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeFlag] -> ShowS
$cshowList :: [TypeFlag] -> ShowS
show :: TypeFlag -> String
$cshow :: TypeFlag -> String
showsPrec :: Int -> TypeFlag -> ShowS
$cshowsPrec :: Int -> TypeFlag -> ShowS
Show)


capFlagSet :: CapabilityFlag -> Cap
capFlagSet :: CapabilityFlag -> Cap
capFlagSet CapabilityFlag
cap =
   case CapabilityFlag
cap of
      CapOther Int
n   -> forall w a. Bits w => Int -> T w a
EnumSet.singletonByPosition Int
n
      CapabilityFlag
CapRead      -> Cap
capRead
      CapabilityFlag
CapWrite     -> Cap
capWrite
      CapabilityFlag
CapSyncRead  -> Cap
capSyncRead
      CapabilityFlag
CapSyncWrite -> Cap
capSyncWrite
      CapabilityFlag
CapDuplex    -> Cap
capDuplex
      CapabilityFlag
CapSubsRead  -> Cap
capSubsRead
      CapabilityFlag
CapSubsWrite -> Cap
capSubsWrite
      CapabilityFlag
CapNoExport  -> Cap
capNoExport

{- |
The Enum instance may not be very efficient,
but it should hardly be used, at all.
Better use constants such as 'capRead' and set manipulation.
If the binary logarithm is computed by constant unfolding,
performance would be better, but direct set manipulation is still faster.
We implement the 'Enum' instance in this way,
in order to stay independent from the particular ALSA definitions,
that may differ between platforms.
-}
instance Enum CapabilityFlag where
   fromEnum :: CapabilityFlag -> Int
fromEnum CapabilityFlag
cap =
      case CapabilityFlag
cap of
         CapOther Int
n -> Int
n
         CapabilityFlag
_ -> forall w a. (Bits w, Storable w) => T w a -> Int
EnumSet.mostSignificantPosition (CapabilityFlag -> Cap
capFlagSet CapabilityFlag
cap)
   toEnum :: Int -> CapabilityFlag
toEnum Int
n =
      forall a. a -> Maybe a -> a
fromMaybe (Int -> CapabilityFlag
CapOther Int
n) forall a b. (a -> b) -> a -> b
$
      forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall w a. Bits w => Int -> T w a
EnumSet.singletonByPosition Int
n) forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (\CapabilityFlag
cap -> (CapabilityFlag -> Cap
capFlagSet CapabilityFlag
cap, CapabilityFlag
cap)) forall a b. (a -> b) -> a -> b
$
         CapabilityFlag
CapRead forall a. a -> [a] -> [a]
:
         CapabilityFlag
CapWrite forall a. a -> [a] -> [a]
:
         CapabilityFlag
CapSyncRead forall a. a -> [a] -> [a]
:
         CapabilityFlag
CapSyncWrite forall a. a -> [a] -> [a]
:
         CapabilityFlag
CapDuplex forall a. a -> [a] -> [a]
:
         CapabilityFlag
CapSubsRead forall a. a -> [a] -> [a]
:
         CapabilityFlag
CapSubsWrite forall a. a -> [a] -> [a]
:
         CapabilityFlag
CapNoExport forall a. a -> [a] -> [a]
:
         []

instance Ix CapabilityFlag where
   range :: (CapabilityFlag, CapabilityFlag) -> [CapabilityFlag]
range     = forall a. Enum a => (a, a) -> [a]
IxEnum.range
   index :: (CapabilityFlag, CapabilityFlag) -> CapabilityFlag -> Int
index     = forall a. Enum a => (a, a) -> a -> Int
IxEnum.index
   inRange :: (CapabilityFlag, CapabilityFlag) -> CapabilityFlag -> Bool
inRange   = forall a. Enum a => (a, a) -> a -> Bool
IxEnum.inRange
   rangeSize :: (CapabilityFlag, CapabilityFlag) -> Int
rangeSize = forall a. Enum a => (a, a) -> Int
IxEnum.rangeSize


typeFlagSet :: TypeFlag -> Type
typeFlagSet :: TypeFlag -> Type
typeFlagSet TypeFlag
typ =
   case TypeFlag
typ of
      TypeOther Int
n      -> forall w a. Bits w => Int -> T w a
EnumSet.singletonByPosition Int
n
      TypeFlag
TypeSpecific     -> Type
typeSpecific
      TypeFlag
TypeMIDIGeneric  -> Type
typeMidiGeneric
      TypeFlag
TypeMIDIGM       -> Type
typeMidiGM
      TypeFlag
TypeMIDIGS       -> Type
typeMidiGS
      TypeFlag
TypeMIDIXG       -> Type
typeMidiXG
      TypeFlag
TypeMIDIMT32     -> Type
typeMidiMT32
      TypeFlag
TypeMIDIGM2      -> Type
typeMidiGM2
      TypeFlag
TypeSynth        -> Type
typeSynth
      TypeFlag
TypeDirectSample -> Type
typeDirectSample
      TypeFlag
TypeSample       -> Type
typeSample
      TypeFlag
TypeHardware     -> Type
typeHardware
      TypeFlag
TypeSoftware     -> Type
typeSoftware
      TypeFlag
TypeSynthesizer  -> Type
typeSynthesizer
      TypeFlag
TypePort         -> Type
typePort
      TypeFlag
TypeApplication  -> Type
typeApplication

instance Enum TypeFlag where
   fromEnum :: TypeFlag -> Int
fromEnum TypeFlag
typ =
      case TypeFlag
typ of
         TypeOther Int
n -> Int
n
         TypeFlag
_ -> forall w a. (Bits w, Storable w) => T w a -> Int
EnumSet.mostSignificantPosition (TypeFlag -> Type
typeFlagSet TypeFlag
typ)
   toEnum :: Int -> TypeFlag
toEnum Int
n =
      forall a. a -> Maybe a -> a
fromMaybe (Int -> TypeFlag
TypeOther Int
n) forall a b. (a -> b) -> a -> b
$
      forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall w a. Bits w => Int -> T w a
EnumSet.singletonByPosition Int
n) forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (\TypeFlag
typ -> (TypeFlag -> Type
typeFlagSet TypeFlag
typ, TypeFlag
typ)) forall a b. (a -> b) -> a -> b
$
         TypeFlag
TypeSpecific forall a. a -> [a] -> [a]
:
         TypeFlag
TypeMIDIGeneric forall a. a -> [a] -> [a]
:
         TypeFlag
TypeMIDIGM forall a. a -> [a] -> [a]
:
         TypeFlag
TypeMIDIGS forall a. a -> [a] -> [a]
:
         TypeFlag
TypeMIDIXG forall a. a -> [a] -> [a]
:
         TypeFlag
TypeMIDIMT32 forall a. a -> [a] -> [a]
:
         TypeFlag
TypeMIDIGM2 forall a. a -> [a] -> [a]
:
         TypeFlag
TypeSynth forall a. a -> [a] -> [a]
:
         TypeFlag
TypeDirectSample forall a. a -> [a] -> [a]
:
         TypeFlag
TypeSample forall a. a -> [a] -> [a]
:
         TypeFlag
TypeHardware forall a. a -> [a] -> [a]
:
         TypeFlag
TypeSoftware forall a. a -> [a] -> [a]
:
         TypeFlag
TypeSynthesizer forall a. a -> [a] -> [a]
:
         TypeFlag
TypePort forall a. a -> [a] -> [a]
:
         TypeFlag
TypeApplication forall a. a -> [a] -> [a]
:
         []


instance Ix TypeFlag where
   range :: (TypeFlag, TypeFlag) -> [TypeFlag]
range     = forall a. Enum a => (a, a) -> [a]
IxEnum.range
   index :: (TypeFlag, TypeFlag) -> TypeFlag -> Int
index     = forall a. Enum a => (a, a) -> a -> Int
IxEnum.index
   inRange :: (TypeFlag, TypeFlag) -> TypeFlag -> Bool
inRange   = forall a. Enum a => (a, a) -> a -> Bool
IxEnum.inRange
   rangeSize :: (TypeFlag, TypeFlag) -> Int
rangeSize = forall a. Enum a => (a, a) -> Int
IxEnum.rangeSize


-- | Port capabilities.
type Cap = EnumSet.T C.CUInt CapabilityFlag

-- | Port types.
type Type = EnumSet.T C.CUInt TypeFlag

systemTimer     :: T
systemTimer :: T
systemTimer     = Word8 -> T
Cons Word8
0
systemAnnounce  :: T
systemAnnounce :: T
systemAnnounce  = Word8 -> T
Cons Word8
1
unknown         :: T
unknown :: T
unknown         = Word8 -> T
Cons Word8
253

{-# LINE 212 "src/Sound/ALSA/Sequencer/Marshal/Port.hsc" #-}

capRead       :: Cap
capRead       = EnumSet.Cons 1
capWrite      :: Cap
capWrite :: Cap
capWrite      = forall word index. word -> T word index
EnumSet.Cons CUInt
2
capSyncRead   :: Cap
capSyncRead :: Cap
capSyncRead   = forall word index. word -> T word index
EnumSet.Cons CUInt
4
capSyncWrite  :: Cap
capSyncWrite :: Cap
capSyncWrite  = forall word index. word -> T word index
EnumSet.Cons CUInt
8
capDuplex     :: Cap
capDuplex :: Cap
capDuplex     = forall word index. word -> T word index
EnumSet.Cons CUInt
16
capSubsRead   :: Cap
capSubsRead :: Cap
capSubsRead   = forall word index. word -> T word index
EnumSet.Cons CUInt
32
capSubsWrite  :: Cap
capSubsWrite :: Cap
capSubsWrite  = forall word index. word -> T word index
EnumSet.Cons CUInt
64
capNoExport   :: Cap
capNoExport :: Cap
capNoExport   = forall word index. word -> T word index
EnumSet.Cons CUInt
128

{-# LINE 223 "src/Sound/ALSA/Sequencer/Marshal/Port.hsc" #-}

caps :: [Cap] -> Cap
caps = EnumSet.unions

typeSpecific      :: Type
typeSpecific      = EnumSet.Cons 1
typeMidiGeneric   :: Type
typeMidiGeneric   = EnumSet.Cons 2
typeMidiGM        :: Type
typeMidiGM :: Type
typeMidiGM        = forall word index. word -> T word index
EnumSet.Cons CUInt
4
typeMidiGS        :: Type
typeMidiGS :: Type
typeMidiGS        = forall word index. word -> T word index
EnumSet.Cons CUInt
8
typeMidiXG        :: Type
typeMidiXG :: Type
typeMidiXG        = forall word index. word -> T word index
EnumSet.Cons CUInt
16
typeMidiMT32      :: Type
typeMidiMT32 :: Type
typeMidiMT32      = forall word index. word -> T word index
EnumSet.Cons CUInt
32
typeMidiGM2       :: Type
typeMidiGM2 :: Type
typeMidiGM2       = forall word index. word -> T word index
EnumSet.Cons CUInt
64
typeSynth         :: Type
typeSynth :: Type
typeSynth         = forall word index. word -> T word index
EnumSet.Cons CUInt
1024
typeDirectSample  :: Type
typeDirectSample :: Type
typeDirectSample  = forall word index. word -> T word index
EnumSet.Cons CUInt
2048
typeSample        :: Type
typeSample :: Type
typeSample        = forall word index. word -> T word index
EnumSet.Cons CUInt
4096
typeHardware      :: Type
typeHardware :: Type
typeHardware      = forall word index. word -> T word index
EnumSet.Cons CUInt
65536
typeSoftware      :: Type
typeSoftware :: Type
typeSoftware      = forall word index. word -> T word index
EnumSet.Cons CUInt
131072
typeSynthesizer   :: Type
typeSynthesizer :: Type
typeSynthesizer   = forall word index. word -> T word index
EnumSet.Cons CUInt
262144
typePort          :: Type
typePort :: Type
typePort          = forall word index. word -> T word index
EnumSet.Cons CUInt
524288
typeApplication   :: Type
typeApplication :: Type
typeApplication   = forall word index. word -> T word index
EnumSet.Cons CUInt
1048576

{-# LINE 246 "src/Sound/ALSA/Sequencer/Marshal/Port.hsc" #-}

types :: [Type] -> Type
types = EnumSet.unions