[Haskell-cafe] FFI for a beginner

[Donn Cave]

>> The docs <http://www.haskell.org/ghc/docs/latest/html/users_guide/ffi-ghc.html#glasgow-foreign-headers>
>> say that -#include pragmas no longer work, but fail to explain how to
>> load code without them. Suffice to say I have no recourse but trial
>> and error."
>
> Ah, now that is a GHC documentation question.  Can you tell us what
> should the docs should say instead?  Then we can fix the docs.

- I believe I would say (agreeing with M Parès) that hsc2hs serves this
purpose - put "#include <termios.h>" in the .hsc file and use hsc2hs 
features like #const and (#peek x, y).  The termios example could
cover a lot more ground by operating on the termios struct and calling
tcsetattr directly from Haskell, using hsc2hs # macros (I append an
example implementation), but you'd also want to explain that hsc2hs
is only needed for these # macros, not for FFI in general.

But hsc2hs as of GHC 7.0.3 generates a "{-# INCLUDE" pragma, which
of course is cause for complaint from ghc.  So there might be more
to be fixed, beyond just the documentation.  That line probably has
no actual purpose other than to annoy ghc, and as a workaround it
can simply be removed from the .hs file.

- My impression is that Greencard isn't the best way to get started
with FFI and hasn't been for a decade or so, so it should probably
be purged from docs.

- The "root" page needs some attention from someone who understands
what "safe" and "unsafe" mean.  Currently (under "Improving efficiency")
it cites the conventional interpretation that a function must be "safe"
if it calls back into the runtime, but neglects to mention that it
must also be "safe" if it is not to block execution of other threads,
including bound OS threads - so related to efficiency issues you
might want to make any slow I/O operation "safe" to avoid this.
There may be other points about "unsafe" that need to be documented.

    Donn
--------

{-# LANGUAGE ForeignFunctionInterface #-}
module TTY (clearICANON) where
import Data.Word (Word32)
import Foreign
import Foreign.C

#include <termios.h>

type TCFlag = (#type tcflag_t)
type Speed = (#type speed_t)

data Termios = Termios {
      termios_c_iflag :: TCFlag
    , termios_c_oflag :: TCFlag
    , termios_c_cflag :: TCFlag
    , termios_c_lflag :: TCFlag
    , termios_c_cc :: [CChar]
    , termios_c_ispeed :: Speed
    , termios_c_ospeed :: Speed
    }
    deriving Show

instance Storable Termios where
    sizeOf _ = #size struct termios
    alignment _ = alignment (undefined::CDouble)
    peek a = do
        iflag <- (#peek struct termios, c_iflag) a
        oflag <- (#peek struct termios, c_oflag) a
        cflag <- (#peek struct termios, c_cflag) a
        lflag <- (#peek struct termios, c_lflag) a
        cc <- peekArray 20 ((#ptr struct termios, c_cc) a)
        ispeed <- (#peek struct termios, c_ispeed) a
        ospeed <- (#peek struct termios, c_ospeed) a
        return (Termios iflag oflag cflag lflag cc ispeed ospeed)
    poke a (Termios iflag oflag cflag lflag cc ispeed ospeed) = do
        (#poke struct termios, c_iflag) a iflag
        (#poke struct termios, c_oflag) a oflag
        (#poke struct termios, c_cflag) a cflag
        (#poke struct termios, c_lflag) a lflag
        pokeArray ((#ptr struct termios, c_cc) a) (take 20 (cc ++ repeat 0))
        (#poke struct termios, c_ispeed) a ispeed
        (#poke struct termios, c_ospeed) a ospeed

foreign import ccall "tcgetattr" tcgetattr
    :: CInt -> Ptr Termios -> IO CInt
foreign import ccall "tcsetattr" tcsetattr
    :: CInt -> CInt -> Ptr Termios -> IO CInt

setLFlag :: TCFlag -> Termios -> Termios
setLFlag c a = a { termios_c_lflag = ((termios_c_lflag a) .|. c) }
clearLFlag :: TCFlag -> Termios -> Termios
clearLFlag c a = a { termios_c_lflag = ((termios_c_lflag a) .&. (complement c)) }

setTTYAttr :: CInt -> (Termios -> Termios) -> IO ()
setTTYAttr fd fn = alloca $ \ termiosp -> do
    status <- tcgetattr fd termiosp
    if status == 0
        then do
            termios <- peek termiosp
            poke termiosp (fn termios)
            status <- tcsetattr fd (#const TCSAFLUSH) termiosp
            if status == 0
                then return ()
                else throwErrno "tcgetattr"
        else throwErrno "tcgetattr"

clearICANON = setTTYAttr 0 (clearLFlag (#const ICANON))