{-# LANGUAGE ForeignFunctionInterface #-}
import Control.Applicative
import Foreign
import Foreign.C
import System.IO.Unsafe
import Text.Printf(printf)

-- For simple types like integers and strings, the Foreign.C library contains
-- the C versions of the types and functions for converting back and forth.

-- We can import foreign functions as pure functions, but we are responsible
-- for making sure that they don't have unpleasant side effects.
foreign import ccall "inc" c_inc :: CInt -> CInt

inc :: Int -> Int
inc n = fromIntegral $ c_inc (fromIntegral n)

-- If a function isn't pure, we import it with IO type.
foreign import ccall "encrypt" c_encrypt :: CString -> IO ()

-- Since the side effects are local (creating a string and doing things to it)
-- we can safely pretend that our wrapper is side effect free.
encrypt :: String -> String
encrypt s = unsafePerformIO $ withCString s $ \cs -> do
  c_encrypt cs
  peekCString cs

-- For more complex foreign types we give an instance of the Storable class to
-- explain how to read and write them from memory. In this example the type on the
-- C side is struct { int x, y; }

-- First declare the corresponding Haskell type.
data Point = Pt Int Int
  deriving Show

-- Import functions to read and write the components.
foreign import ccall "init_pt"   c_init_pt   :: Ptr Point -> CInt -> CInt -> IO ()
foreign import ccall "get_x"     c_get_x     :: Ptr Point -> IO CInt
foreign import ccall "get_y"     c_get_y     :: Ptr Point -> IO CInt
foreign import ccall "sqdist"    c_sqdist    :: Ptr Point -> CInt
foreign import ccall "sizeof_pt" c_sizeof_pt :: CInt  -- still needs to be a function on the C side

-- Give the storable instance. For portability we should use foreign functions
-- to manipulate the structure.
instance Storable Point where
  sizeOf _    = fromIntegral c_sizeof_pt
  alignment _ = 4
  peek p = do
    x <- c_get_x p
    y <- c_get_y p
    return $ Pt (fromIntegral x) (fromIntegral y)
  poke p (Pt x y) = c_init_pt p (fromIntegral x) (fromIntegral y)

createPt :: Int -> Int -> Point
createPt x y = unsafePerformIO $ alloca $ \p -> do
  c_init_pt p (fromIntegral x) (fromIntegral y)
  peek p

sqDist :: Point -> Int
sqDist pt = unsafePerformIO $ alloca $ \p -> do
  poke p pt
  return $ fromIntegral $ c_sqdist p

----------------
test1 :: Int
test1 = inc 1737
test2 :: (String, String)
test2 = (encrypted, encrypt encrypted)
  where encrypted = encrypt "Patrik"
test3 :: Int
test3 = sqDist (Pt 3 4)

main :: IO ()
main = do print test1
          uncurry (printf "(%s,%s)\n") test2
          print test3