ftdi-0.1: A thin layer over USB to communicate with FTDI chipsSource codeContentsIndex
System.FTDI
Contents
Devices
Interfaces
Device handles
Interface handles
Data transfer
Low level bulk transfers
Control requests
Line properties
Modem status
Flow control
Defaults
Synopsis
data Device
data ChipType
= ChipType_AM
| ChipType_BM
| ChipType_2232C
| ChipType_R
| ChipType_2232H
| ChipType_4232H
getChipType :: Device -> ChipType
setChipType :: Device -> ChipType -> Device
fromUSBDevice :: Device -> ChipType -> Device
guessChipType :: DeviceDesc -> Maybe ChipType
data Interface
= Interface_A
| Interface_B
| Interface_C
| Interface_D
data DeviceHandle
resetUSB :: DeviceHandle -> IO ()
getTimeout :: DeviceHandle -> Int
setTimeout :: DeviceHandle -> Int -> DeviceHandle
openDevice :: Device -> IO DeviceHandle
closeDevice :: DeviceHandle -> IO ()
withDeviceHandle :: Device -> (DeviceHandle -> IO α) -> IO α
data InterfaceHandle
getDeviceHandle :: InterfaceHandle -> DeviceHandle
getInterface :: InterfaceHandle -> Interface
openInterface :: DeviceHandle -> Interface -> IO InterfaceHandle
closeInterface :: InterfaceHandle -> IO ()
withInterfaceHandle :: DeviceHandle -> Interface -> (InterfaceHandle -> IO α) -> IO α
data ChunkedReaderT m α
runChunkedReaderT :: ChunkedReaderT m α -> ByteString -> m (α, ByteString)
readData :: forall m. MonadIO m => InterfaceHandle -> Int -> ChunkedReaderT m [ByteString]
readBulk :: InterfaceHandle -> Int -> IO (ByteString, Bool)
writeBulk :: InterfaceHandle -> ByteString -> IO (Int, Bool)
reset :: InterfaceHandle -> IO ()
purgeReadBuffer :: InterfaceHandle -> IO ()
purgeWriteBuffer :: InterfaceHandle -> IO ()
getLatencyTimer :: InterfaceHandle -> IO Word8
setLatencyTimer :: InterfaceHandle -> Word8 -> IO ()
data BitMode
= BitMode_Reset
| BitMode_BitBang
| BitMode_MPSSE
| BitMode_SyncBitBang
| BitMode_MCU
| BitMode_Opto
| BitMode_CBus
| BitMode_SyncFIFO
setBitMode :: InterfaceHandle -> Word8 -> BitMode -> IO ()
data Parity
= Parity_Odd
| Parity_Even
| Parity_Mark
| Parity_Space
data BitDataFormat
= Bits_7
| Bits_8
data StopBits
= StopBit_1
| StopBit_15
| StopBit_2
setLineProperty :: InterfaceHandle -> BitDataFormat -> StopBits -> Maybe Parity -> Bool -> IO ()
newtype BaudRate α = BaudRate {
unBaudRate :: α
}
nearestBaudRate :: RealFrac α => ChipType -> BaudRate α -> BaudRate α
setBaudRate :: RealFrac α => InterfaceHandle -> BaudRate α -> IO (BaudRate α)
data ModemStatus = ModemStatus {
msClearToSend :: Bool
msDataSetReady :: Bool
msRingIndicator :: Bool
msReceiveLineSignalDetect :: Bool
msDataReady :: Bool
msOverrunError :: Bool
msParityError :: Bool
msFramingError :: Bool
msBreakInterrupt :: Bool
msTransmitterHoldingRegister :: Bool
msTransmitterEmpty :: Bool
msErrorInReceiverFIFO :: Bool
}
pollModemStatus :: InterfaceHandle -> IO ModemStatus
data FlowCtrl
= RTS_CTS
| DTR_DSR
| XOnXOff
setFlowControl :: InterfaceHandle -> Maybe FlowCtrl -> IO ()
setDTR :: InterfaceHandle -> Bool -> IO ()
setRTS :: InterfaceHandle -> Bool -> IO ()
setEventCharacter :: InterfaceHandle -> Maybe Word8 -> IO ()
setErrorCharacter :: InterfaceHandle -> Maybe Word8 -> IO ()
defaultTimeout :: Int
Devices
data Device Source
A representation of an FTDI device.
data ChipType Source
The type of FTDI chip in a Device. The capabilities of a device depend on its chip type.
Constructors
ChipType_AM
ChipType_BM
ChipType_2232C
ChipType_R
ChipType_2232H
ChipType_4232H
show/hide Instances
getChipType :: Device -> ChipTypeSource
setChipType :: Device -> ChipType -> DeviceSource
fromUSBDeviceSource
:: DeviceUSB device
-> ChipType
-> DeviceFTDI device
Promote a USB device to an FTDI device. You are responsible for supplying the correct USB device and specifying the correct chip type. There is no failsafe way to automatically determine whether a random USB device is an actual FTDI device.
guessChipType :: DeviceDesc -> Maybe ChipTypeSource
Tries to guess the type of the FTDI chip by looking at the USB device release number of a device's descriptor. Each FTDI chip uses a specific release number to indicate its type.
Interfaces
data Interface Source
A device interface. You can imagine an interface as a port or a communication channel. Some devices support communication over multiple interfaces at the same time.
Constructors
Interface_A
Interface_B
Interface_C
Interface_D
show/hide Instances
Device handles
data DeviceHandle Source
You need a handle in order to communicate with a Device.
resetUSB :: DeviceHandle -> IO ()Source
Perform a USB device reset.
getTimeout :: DeviceHandle -> IntSource
Returns the USB timeout associated with a handle.
setTimeout :: DeviceHandle -> Int -> DeviceHandleSource
Modifies the USB timeout associated with a handle.
openDevice :: Device -> IO DeviceHandleSource
Open a device handle to enable communication. Only use this if you can't use withDeviceHandle for some reason.
closeDevice :: DeviceHandle -> IO ()Source
Release a device handle.
withDeviceHandle :: Device -> (DeviceHandle -> IO α) -> IO αSource
The recommended way to acquire a handle. Ensures that the handles is released when the monadic computation is completed. Even, or especially, when an exception is thrown.
Interface handles
data InterfaceHandle Source
getDeviceHandle :: InterfaceHandle -> DeviceHandleSource
getInterface :: InterfaceHandle -> InterfaceSource
openInterface :: DeviceHandle -> Interface -> IO InterfaceHandleSource
closeInterface :: InterfaceHandle -> IO ()Source
withInterfaceHandle :: DeviceHandle -> Interface -> (InterfaceHandle -> IO α) -> IO αSource
Data transfer
data ChunkedReaderT m α Source
show/hide Instances
runChunkedReaderT :: ChunkedReaderT m α -> ByteString -> m (α, ByteString)Source

Run the ChunkedReaderT given an initial state.

The initial state represents excess bytes carried over from a previous run. When invoking runChunkedReaderT for the first time you can safely pass the empty bytestring as the initial state.

A contrived example showing how you can manually thread the excess bytes through subsequent invocations of runChunkedReaderT:

  example ∷ InterfaceHandle → IO ()
  example ifHnd = do
    (packets1, rest1) ← runChunkedReaderT (readData ifHnd 400) empty
    print $ BS.concat packets1
    (packets2, rest2) ← runChunkedReaderT (readData ifHnd 200) rest1
    print $ BS.concat packets2

However, it is much easier to let ChunkedReaderTs monad instance handle the plumbing:

  example ∷ InterfaceHandle → IO ()
  example ifHnd =
    let reader = do packets1 ← readData ifHnd 400
                    liftIO $ print $ BS.concat packets1
                    packets2 ← readData ifHnd 200
                    liftIO $ print $ BS.concat packets1
    in runChunkedReaderT reader empty
readData :: forall m. MonadIO m => InterfaceHandle -> Int -> ChunkedReaderT m [ByteString]Source

Reads data from the given FTDI interface by performing bulk reads.

This function produces an action in the ChunkedReaderT monad that, when executed, will read exactly the requested number of bytes. Executing the readData action will block until all data is read. The result value is a list of chunks, represented as ByteStrings. This representation was choosen for efficiency reasons.

Data is read in packets. The function may choose to request more than needed in order to get the highest possible bandwidth. The excess of bytes is kept as the state of the ChunkedReaderT monad. A subsequent invocation of readData will first return bytes from the stored state before requesting more from the device itself. A consequence of this behaviour is that even when you request 100 bytes the function will actually request 512 bytes (depending on the packet size) and block until all 512 bytes are read! There is no workaround since requesting less bytes than the packet size is an error.

USB timeouts will not interrupt readData. In case of a timeout readData will simply resume reading data. A small USB timeout can degrade performance.

The FTDI latency timer can cause poor performance. If the FTDI chip can't fill a packet before the latency timer fires it is forced to send an incomplete packet. This will cause a stream of tiny packets instead of a few large packets. Performance will suffer horribly, but the request will still be completed.

If you need to make a lot of small requests then a small latency can actually improve performance.

Modem status bytes are filtered from the result. Every packet send by the FTDI chip contains 2 modem status bytes. They are not part of the data and do not count for the number of bytes read. They will not appear in the result.

Example:

  -- Read 100 data bytes from ifHnd
  (packets, rest) ← runChunkedReaderT (readData ifHnd 100) empty
Low level bulk transfers

These are low-level functions and as such they ignores things like:

  • Max packet size
  • Latency timer
  • Modem status bytes

USB timeouts are not ignored, but they will prevent the request from being completed.

readBulkSource
:: InterfaceHandle
-> IntNumber of bytes to read
-> IO (ByteString, Bool)

Perform a bulk read.

Returns the data that was read (in the form of a ByteString) and a flag which indicates whether a timeout occured during the request.

writeBulkSource
:: InterfaceHandle
-> ByteStringData to be written
-> IO (Int, Bool)

Perform a bulk write.

Returns the number of bytes that where written and a flag which indicates whether a timeout occured during the request.

Control requests
reset :: InterfaceHandle -> IO ()Source
Reset the FTDI device.
purgeReadBuffer :: InterfaceHandle -> IO ()Source
Clear the on-chip read buffer.
purgeWriteBuffer :: InterfaceHandle -> IO ()Source
Clear the on-chip write buffer.
getLatencyTimer :: InterfaceHandle -> IO Word8Source
Returns the current value of the FTDI latency timer.
setLatencyTimer :: InterfaceHandle -> Word8 -> IO ()Source
Set the FTDI latency timer. The latency is the amount of milliseconds after which the FTDI chip will send a packet regardless of the number of bytes in the packet.
data BitMode Source
MPSSE bitbang modes
Constructors
BitMode_ResetSwitch off bitbang mode, back to regular serial/FIFO.
BitMode_BitBangClassical asynchronous bitbang mode, introduced with B-type chips.
BitMode_MPSSEMulti-Protocol Synchronous Serial Engine, available on 2232x chips.
BitMode_SyncBitBangSynchronous Bit-Bang Mode, available on 2232x and R-type chips.
BitMode_MCUMCU Host Bus Emulation Mode, available on 2232x chips. CPU-style fifo mode gets set via EEPROM.
BitMode_OptoFast Opto-Isolated Serial Interface Mode, available on 2232x chips.
BitMode_CBusBit-Bang on CBus pins of R-type chips, configure in EEPROM before use.
BitMode_SyncFIFOSingle Channel Synchronous FIFO Mode, available on 2232H chips.
show/hide Instances
setBitMode :: InterfaceHandle -> Word8 -> BitMode -> IO ()Source
The bitmode controls the method of communication.
Line properties
data Parity Source
Constructors
Parity_OddThe parity bit is set to one if the number of ones in a given set of bits is even (making the total number of ones, including the parity bit, odd).
Parity_EvenThe parity bit is set to one if the number of ones in a given set of bits is odd (making the total number of ones, including the parity bit, even).
Parity_MarkThe parity bit is always 1.
Parity_SpaceThe parity bit is always 0.
show/hide Instances
data BitDataFormat Source
Constructors
Bits_7
Bits_8
data StopBits Source
Constructors
StopBit_1
StopBit_15
StopBit_2
show/hide Instances
setLinePropertySource
:: InterfaceHandle
-> BitDataFormatNumber of bits
-> StopBitsNumber of stop bits
-> Maybe ParityOptional parity mode
-> BoolBreak
-> IO ()
Set RS232 line characteristics
newtype BaudRate α Source
Representation of a baud rate. The most interesting part is the instance for Bounded.
Constructors
BaudRate
unBaudRate :: α
show/hide Instances
Num α => Bounded (BaudRate α)
Enum α => Enum (BaudRate α)
Eq α => Eq (BaudRate α)
Fractional α => Fractional (BaudRate α)
Integral α => Integral (BaudRate α)
Num α => Num (BaudRate α)
Ord α => Ord (BaudRate α)
Read α => Read (BaudRate α)
Real α => Real (BaudRate α)
RealFrac α => RealFrac (BaudRate α)
Show α => Show (BaudRate α)
nearestBaudRate :: RealFrac α => ChipType -> BaudRate α -> BaudRate αSource
Calculates the nearest representable baud rate.
setBaudRate :: RealFrac α => InterfaceHandle -> BaudRate α -> IO (BaudRate α)Source
Sets the baud rate. Internally the baud rate is represented as a fraction. The maximum baudrate is the numerator and a special divisor is used as the denominator. The maximum baud rate is given by the BaudRate instance for Bounded. The divisor consists of an integral part and a fractional part. Both parts are limited in range. As a result not all baud rates can be accurately represented. This function returns the nearest representable baud rate relative to the requested baud rate. According to FTDI documentation the maximum allowed error is 3%. The nearest representable baud rate can be calculated with the nearestBaudRate function.
Modem status
data ModemStatus Source

Modem status information. The modem status is send as a header for each read access. In the absence of data the FTDI chip will generate the status every 40 ms.

The modem status can be explicitely requested with the pollModemStatus function.

Constructors
ModemStatus
msClearToSend :: BoolClear to send (CTS)
msDataSetReady :: BoolData set ready (DTS)
msRingIndicator :: BoolRing indicator (RI)
msReceiveLineSignalDetect :: BoolReceive line signal detect (RLSD)
msDataReady :: BoolData ready (DR)
msOverrunError :: BoolOverrun error (OE)
msParityError :: BoolParity error (PE)
msFramingError :: BoolFraming error (FE)
msBreakInterrupt :: BoolBreak interrupt (BI)
msTransmitterHoldingRegister :: BoolTransmitter holding register (THRE)
msTransmitterEmpty :: BoolTransmitter empty (TEMT)
msErrorInReceiverFIFO :: BoolError in RCVR FIFO
show/hide Instances
pollModemStatus :: InterfaceHandle -> IO ModemStatusSource
Manually request the modem status.
Flow control
data FlowCtrl Source
Constructors
RTS_CTSRequest-To-Send / Clear-To-Send
DTR_DSRData-Terminal-Ready / Data-Set-Ready
XOnXOffTransmitter on / Transmitter off
setFlowControl :: InterfaceHandle -> Maybe FlowCtrl -> IO ()Source
Set the flow control for the FTDI chip. Use Nothing to disable flow control.
setDTR :: InterfaceHandle -> Bool -> IO ()Source
Set DTR line.
setRTS :: InterfaceHandle -> Bool -> IO ()Source
Set RTS line.
setEventCharacter :: InterfaceHandle -> Maybe Word8 -> IO ()Source
Set the special event character. Use Nothing to disable the event character.
setErrorCharacter :: InterfaceHandle -> Maybe Word8 -> IO ()Source
Set the error character. Use Nothing to disable the error character.
Defaults
defaultTimeout :: IntSource
Default USB timeout. The timeout can be set per device handle with the setTimeout function.
Produced by Haddock version 2.6.0