-- -*-haskell-*-
{-# LANGUAGE ForeignFunctionInterface #-}

    JACK bindings for Haskell
    Copyright (C) 2011 Henning Thielemann
    Copyright (C) 2007 Soenke Hahn

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along
    with this program; if not, write to the Free Software Foundation, Inc.,
    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

module Sound.JACK.FFI where

import Foreign.Ptr (Ptr, FunPtr)
import Foreign.C.String (CString)
import Foreign.C.Error (Errno, )
import Foreign.C.Types (CUInt, CInt, CULong, )

import qualified Data.EnumSet as ES
import Data.Word (Word, )
import Data.Ix (Ix(range, inRange, rangeSize, index))
import Data.Monoid (Monoid, mempty, mappend, )

data Client = Client
data Port typ = Port

foreign import ccall "static jack/jack.h jack_client_open"
  client_open :: CString -> OpenOptionSet -> Ptr StatusSet -> CString -> IO (Ptr Client)

{-# DEPRECATED client_new "use client_open instead" #-}
foreign import ccall "static jack/jack.h jack_client_new"
  client_new :: CString -> IO (Ptr Client)

foreign import ccall "static jack/jack.h jack_get_sample_rate"
  get_sample_rate :: Ptr Client -> IO CInt

type OpenOptionSet = ES.T CULong OpenOptions

data OpenOptions =
   | UseExactName
   | ServerName
     deriving (Enum, Eq, Ord, Show, Ix)

wordNullOption, wordNoStartServer, wordUseExactName, wordServerName :: OpenOptionSet
wordNullOption    = ES.empty
wordNoStartServer = ES.fromEnum NoStartServer
wordUseExactName  = ES.fromEnum UseExactName
wordServerName    = ES.fromEnum ServerName

type StatusSet = ES.T CULong Status

data Status =
   | InvalidOption
   | NameNotUnique
   | ServerStarted
   | ServerFailed
   | ServerError
   | NoSuchClient
   | LoadFailure
   | InitFailure
   | ShmFailure
   | VersionError
     deriving (Enum, Eq, Ord, Show, Ix)

wordFailure, wordInvalidOption, wordNameNotUnique, wordServerStarted,
  wordServerFailed, wordServerError, wordNoSuchClient, wordLoadFailure,
  wordInitFailure, wordShmFailure, wordVersionError :: StatusSet
wordFailure       = ES.fromEnum Failure
wordInvalidOption = ES.fromEnum InvalidOption
wordNameNotUnique = ES.fromEnum NameNotUnique
wordServerStarted = ES.fromEnum ServerStarted
wordServerFailed  = ES.fromEnum ServerFailed
wordServerError   = ES.fromEnum ServerError
wordNoSuchClient  = ES.fromEnum NoSuchClient
wordLoadFailure   = ES.fromEnum LoadFailure
wordInitFailure   = ES.fromEnum InitFailure
wordShmFailure    = ES.fromEnum ShmFailure
wordVersionError  = ES.fromEnum VersionError

type PortFlagSet = ES.T CULong PortFlag

data PortFlag =
   | PortIsOutput
   | PortIsPhysical
   | PortCanMonitor
   | PortIsTerminal
     deriving (Enum, Eq, Ord, Show, Ix)

newtype PortName = PortName {deconsPortName :: CString}

portIsInput, portIsOutput :: PortFlagSet
portIsInput  = ES.fromEnum PortIsInput
portIsOutput = ES.fromEnum PortIsOutput

foreign import ccall "static jack/jack.h jack_port_register"
  port_register :: Ptr Client -> PortName -> CString ->
        PortFlagSet -> CULong -> IO (Ptr (Port a))

-- | represents absolute frame time
newtype NFrames = NFrames CUInt
    deriving (Show, Eq, Ord)

nframesToWord :: NFrames -> Word
nframesToWord (NFrames n) = fromIntegral n

instance Ix NFrames where
    range (a,b) =
        map (NFrames . fromIntegral) $
        range (nframesToWord a, nframesToWord b)
    index (a,b) i =
        index (nframesToWord a, nframesToWord b) (nframesToWord i)
    inRange (a,b) i =
        inRange (nframesToWord a, nframesToWord b) (nframesToWord i)
    rangeSize (a,b) =
        rangeSize (nframesToWord a, nframesToWord b)

instance Monoid NFrames where
    mempty = NFrames 0
    mappend (NFrames x) (NFrames y) = NFrames (x+y)

nframesIndices :: NFrames -> [NFrames]
nframesIndices (NFrames n) =
    take (fromIntegral n) $ map NFrames $ iterate (1+) 0

nframesBounds :: NFrames -> (NFrames,NFrames)
nframesBounds (NFrames n) =
    (NFrames 0, NFrames $ n - 1)

data CallbackArg = CallbackArg

type Process = NFrames -> Ptr CallbackArg -> IO Errno

foreign import ccall "static jack/jack.h jack_set_process_callback"
  set_process_callback ::
        Ptr Client -> FunPtr Process -> Ptr CallbackArg -> IO Errno

foreign import ccall "static jack/jack.h jack_last_frame_time"
  last_frame_time :: Ptr Client -> IO NFrames

foreign import ccall "static jack/jack.h jack_port_get_buffer"
  port_get_buffer :: Ptr (Port a) -> NFrames -> IO (Ptr a)

foreign import ccall "static jack/jack.h jack_get_buffer_size"
  get_buffer_size :: Ptr Client -> IO (CUInt)

foreign import ccall "static jack/jack.h jack_activate"
  activate :: Ptr Client -> IO Errno

foreign import ccall "static jack/jack.h jack_client_close"
  client_close :: Ptr Client -> IO Errno

foreign import ccall "static jack/jack.h jack_get_ports"
  get_ports :: Ptr Client -> CString -> CString -> CULong -> IO (Ptr CString)
--  get_ports :: Ptr Client -> CString -> CString -> CULong -> IO (Ptr PortName)

-- may return eEXIST
foreign import ccall "static jack/jack.h jack_connect"
  connect :: Ptr Client -> PortName -> PortName -> IO Errno

foreign import ccall "static jack/jack.h jack_disconnect"
  disconnect :: Ptr Client -> PortName -> PortName -> IO Errno

foreign import ccall "static jack/jack.h jack_port_unregister"
  port_unregister :: Ptr Client -> Ptr (Port a) -> IO Errno

foreign import ccall "static jack/jack.h jack_deactivate"
  deactivate :: Ptr Client -> IO Errno