Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data Device
- data ChipType
- getChipType :: Device -> ChipType
- setChipType :: Device -> ChipType -> Device
- fromUSBDevice :: Device -> ChipType -> IO Device
- guessChipType :: DeviceDesc -> Maybe ChipType
- data Interface
- 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 α
- withDetachedKernelDriver :: DeviceHandle -> Interface -> IO a -> IO a
- data ChunkedReaderT m α
- runChunkedReaderT :: ChunkedReaderT m α -> ByteString -> m (α, ByteString)
- readData :: forall m. MonadIO m => InterfaceHandle -> m Bool -> Int -> ChunkedReaderT m [ByteString]
- readBulk :: InterfaceHandle -> Int -> IO (ByteString, Status)
- writeBulk :: InterfaceHandle -> ByteString -> IO (Int, Status)
- reset :: InterfaceHandle -> IO ()
- purgeReadBuffer :: InterfaceHandle -> IO ()
- purgeWriteBuffer :: InterfaceHandle -> IO ()
- getLatencyTimer :: InterfaceHandle -> IO Word8
- setLatencyTimer :: InterfaceHandle -> Word8 -> IO ()
- data BitMode
- setBitMode :: InterfaceHandle -> Word8 -> BitMode -> IO ()
- data Parity
- data BitDataFormat
- data StopBits
- 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 {}
- pollModemStatus :: InterfaceHandle -> IO ModemStatus
- data FlowCtrl
- 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
The type of FTDI chip in a Device
. The capabilities of a device
depend on its chip type.
Instances
Enum ChipType Source # | |
Eq ChipType Source # | |
Data ChipType Source # | |
Defined in System.FTDI.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ChipType -> c ChipType # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ChipType # toConstr :: ChipType -> Constr # dataTypeOf :: ChipType -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ChipType) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ChipType) # gmapT :: (forall b. Data b => b -> b) -> ChipType -> ChipType # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ChipType -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ChipType -> r # gmapQ :: (forall d. Data d => d -> u) -> ChipType -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> ChipType -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> ChipType -> m ChipType # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ChipType -> m ChipType # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ChipType -> m ChipType # | |
Ord ChipType Source # | |
Defined in System.FTDI.Internal | |
Show ChipType Source # | |
Generic ChipType Source # | |
type Rep ChipType Source # | |
Defined in System.FTDI.Internal type Rep ChipType = D1 ('MetaData "ChipType" "System.FTDI.Internal" "ftdi-0.3.0.1-inplace" 'False) ((C1 ('MetaCons "ChipType_AM" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ChipType_BM" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ChipType_2232C" 'PrefixI 'False) (U1 :: Type -> Type))) :+: (C1 ('MetaCons "ChipType_R" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ChipType_2232H" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ChipType_4232H" 'PrefixI 'False) (U1 :: Type -> Type)))) |
getChipType :: Device -> ChipType Source #
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 ChipType Source #
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
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.
Instances
Enum Interface Source # | |
Defined in System.FTDI.Internal succ :: Interface -> Interface # pred :: Interface -> Interface # fromEnum :: Interface -> Int # enumFrom :: Interface -> [Interface] # enumFromThen :: Interface -> Interface -> [Interface] # enumFromTo :: Interface -> Interface -> [Interface] # enumFromThenTo :: Interface -> Interface -> Interface -> [Interface] # | |
Eq Interface Source # | |
Data Interface Source # | |
Defined in System.FTDI.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Interface -> c Interface # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Interface # toConstr :: Interface -> Constr # dataTypeOf :: Interface -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Interface) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Interface) # gmapT :: (forall b. Data b => b -> b) -> Interface -> Interface # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Interface -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Interface -> r # gmapQ :: (forall d. Data d => d -> u) -> Interface -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Interface -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Interface -> m Interface # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Interface -> m Interface # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Interface -> m Interface # | |
Ord Interface Source # | |
Defined in System.FTDI.Internal | |
Show Interface Source # | |
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 -> Int Source #
Returns the USB timeout associated with a handle.
setTimeout :: DeviceHandle -> Int -> DeviceHandle Source #
Modifies the USB timeout associated with a handle.
openDevice :: Device -> IO DeviceHandle Source #
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 handle is released when the monadic computation is completed. Even, or especially, when an exception is thrown.
Interface handles
data InterfaceHandle Source #
openInterface :: DeviceHandle -> Interface -> IO InterfaceHandle Source #
closeInterface :: InterfaceHandle -> IO () Source #
withInterfaceHandle :: DeviceHandle -> Interface -> (InterfaceHandle -> IO α) -> IO α Source #
Kernel drivers
withDetachedKernelDriver :: DeviceHandle -> Interface -> IO a -> IO a Source #
Data transfer
data ChunkedReaderT m α Source #
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 (returnFalse
) 400)empty
print $concat
packets1 (packets2, rest2) ← runChunkedReaderT (readData
ifHnd (returnFalse
) 200) rest1 print $concat
packets2
However, it is much easier to let ChunkedReaderT
s monad instance handle the
plumbing:
example ∷InterfaceHandle
→ IO () example ifHnd = let reader = do packets1 ←readData
ifHnd (returnFalse
) 400 liftIO $ print $concat
packets1 packets2 ←readData
ifHnd (returnFalse
) 200 liftIO $ print $concat
packets1 in runChunkedReaderT readerempty
:: forall m. MonadIO m | |
=> InterfaceHandle | |
-> m Bool | Check stop action |
-> Int | Number of bytes to read |
-> ChunkedReaderT m [ByteString] |
Reads data from the given FTDI interface by performing bulk reads.
This function produces an action in the ChunkedReaderT
monad that
will read exactly the requested number of bytes unless it is
explicitly asked to stop early. Executing the readData
action will
block until either:
- All data are read
- The given checkStop action returns
True
The result value is a list of chunks, represented as
ByteString
s. This representation was choosen for efficiency reasons.
Data are 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 sent 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 (returnFalse
) 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.
:: InterfaceHandle | |
-> Int | Number of bytes to read |
-> IO (ByteString, Status) |
Perform a bulk read.
Returns the bytes that where read (in the form of a ByteString
) and a flag
which indicates whether a timeout occured during the request.
:: InterfaceHandle | |
-> ByteString | Data to be written |
-> IO (Int, Status) |
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 Word8 Source #
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.
MPSSE bitbang modes
BitMode_Reset | Switch off bitbang mode, back to regular serial/FIFO. |
BitMode_BitBang | Classical asynchronous bitbang mode, introduced with B-type chips. |
BitMode_MPSSE | Multi-Protocol Synchronous Serial Engine, available on 2232x chips. |
BitMode_SyncBitBang | Synchronous Bit-Bang Mode, available on 2232x and R-type chips. |
BitMode_MCU | MCU Host Bus Emulation Mode, available on 2232x chips. CPU-style fifo mode gets set via EEPROM. |
BitMode_Opto | Fast Opto-Isolated Serial Interface Mode, available on 2232x chips. |
BitMode_CBus | Bit-Bang on CBus pins of R-type chips, configure in EEPROM before use. |
BitMode_SyncFIFO | Single Channel Synchronous FIFO Mode, available on 2232H chips. |
Instances
Eq BitMode Source # | |
Data BitMode Source # | |
Defined in System.FTDI.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> BitMode -> c BitMode # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c BitMode # toConstr :: BitMode -> Constr # dataTypeOf :: BitMode -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c BitMode) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BitMode) # gmapT :: (forall b. Data b => b -> b) -> BitMode -> BitMode # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BitMode -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BitMode -> r # gmapQ :: (forall d. Data d => d -> u) -> BitMode -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> BitMode -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> BitMode -> m BitMode # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> BitMode -> m BitMode # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> BitMode -> m BitMode # | |
Ord BitMode Source # | |
Show BitMode Source # | |
setBitMode :: InterfaceHandle -> Word8 -> BitMode -> IO () Source #
The bitmode controls the method of communication.
Line properties
Parity_Odd | The 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_Even | The 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_Mark | The parity bit is always 1. |
Parity_Space | The parity bit is always 0. |
Instances
Enum Parity Source # | |
Defined in System.FTDI.Internal | |
Eq Parity Source # | |
Data Parity Source # | |
Defined in System.FTDI.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Parity -> c Parity # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Parity # toConstr :: Parity -> Constr # dataTypeOf :: Parity -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Parity) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Parity) # gmapT :: (forall b. Data b => b -> b) -> Parity -> Parity # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Parity -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Parity -> r # gmapQ :: (forall d. Data d => d -> u) -> Parity -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Parity -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Parity -> m Parity # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Parity -> m Parity # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Parity -> m Parity # | |
Ord Parity Source # | |
Show Parity Source # | |
data BitDataFormat Source #
Instances
Enum StopBits Source # | |
:: InterfaceHandle | |
-> BitDataFormat | Number of bits |
-> StopBits | Number of stop bits |
-> Maybe Parity | Optional parity mode |
-> Bool | Break |
-> IO () |
Set RS232 line characteristics
Representation of a baud rate. The most interesting part is the
instance for Bounded
.
BaudRate | |
|
Instances
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.
ModemStatus | |
|
Instances
pollModemStatus :: InterfaceHandle -> IO ModemStatus Source #
Manually request the modem status.
Flow control
setFlowControl :: InterfaceHandle -> Maybe FlowCtrl -> IO () Source #
Set the flow control for the FTDI chip. Use Nothing
to disable flow
control.
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 :: Int Source #
Default USB timeout. The timeout can be set per device handle with
the setTimeout
function.