{-# LINE 1 "src/Sound/ALSA/Sequencer/Marshal/Port.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "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


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

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

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.EnumSet 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 prec (Cons x) =
      U.showsRecord prec "Port" [U.showsField x]


exp :: T -> C.CInt
exp (Cons p) = fromIntegral p

imp :: C.CInt -> T
imp p = Cons (fromIntegral 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 (Eq, Ord, 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 (Eq, Ord, Show)


capFlagSet :: CapabilityFlag -> Cap
capFlagSet cap =
   case cap of
      CapOther n   -> EnumSet.singletonByPosition n
      CapRead      -> capRead
      CapWrite     -> capWrite
      CapSyncRead  -> capSyncRead
      CapSyncWrite -> capSyncWrite
      CapDuplex    -> capDuplex
      CapSubsRead  -> capSubsRead
      CapSubsWrite -> capSubsWrite
      CapNoExport  -> 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 cap =
      case cap of
         CapOther n -> n
         _ -> EnumSet.mostSignificantPosition (capFlagSet cap)
   toEnum n =
      fromMaybe (CapOther n) $
      lookup (EnumSet.singletonByPosition n) $
      map (\cap -> (capFlagSet cap, cap)) $
         CapRead :
         CapWrite :
         CapSyncRead :
         CapSyncWrite :
         CapDuplex :
         CapSubsRead :
         CapSubsWrite :
         CapNoExport :
         []

instance Ix CapabilityFlag where
   range     = IxEnum.range
   index     = IxEnum.index
   inRange   = IxEnum.inRange
   rangeSize = IxEnum.rangeSize


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

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


instance Ix TypeFlag where
   range     = IxEnum.range
   index     = IxEnum.index
   inRange   = IxEnum.inRange
   rangeSize = IxEnum.rangeSize


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

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

systemTimer     :: T
systemTimer     = Cons 0
systemAnnounce  :: T
systemAnnounce  = Cons 1
unknown         :: T
unknown         = Cons 253

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

capRead       :: Cap
capRead       = EnumSet.Cons 1
capWrite      :: Cap
capWrite      = EnumSet.Cons 2
capSyncRead   :: Cap
capSyncRead   = EnumSet.Cons 4
capSyncWrite  :: Cap
capSyncWrite  = EnumSet.Cons 8
capDuplex     :: Cap
capDuplex     = EnumSet.Cons 16
capSubsRead   :: Cap
capSubsRead   = EnumSet.Cons 32
capSubsWrite  :: Cap
capSubsWrite  = EnumSet.Cons 64
capNoExport   :: Cap
capNoExport   = EnumSet.Cons 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        = EnumSet.Cons 4
typeMidiGS        :: Type
typeMidiGS        = EnumSet.Cons 8
typeMidiXG        :: Type
typeMidiXG        = EnumSet.Cons 16
typeMidiMT32      :: Type
typeMidiMT32      = EnumSet.Cons 32
typeMidiGM2       :: Type
typeMidiGM2       = EnumSet.Cons 64
typeSynth         :: Type
typeSynth         = EnumSet.Cons 1024
typeDirectSample  :: Type
typeDirectSample  = EnumSet.Cons 2048
typeSample        :: Type
typeSample        = EnumSet.Cons 4096
typeHardware      :: Type
typeHardware      = EnumSet.Cons 65536
typeSoftware      :: Type
typeSoftware      = EnumSet.Cons 131072
typeSynthesizer   :: Type
typeSynthesizer   = EnumSet.Cons 262144
typePort          :: Type
typePort          = EnumSet.Cons 524288
typeApplication   :: Type
typeApplication   = EnumSet.Cons 1048576

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

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