module Network.Curl.Types
( CurlH, URLString, Port, Long, LLong, Slist_
, Curl, curlPrim, mkCurl, mkCurlWithCleanup
, OptionMap, shareCleanup, runCleanup, updateCleanup
) where
import Network.Curl.Debug
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Concurrent ( addForeignPtrFinalizer )
import Data.Word
import Control.Concurrent
import Data.Maybe(fromMaybe)
import qualified Data.IntMap as M
import Data.IORef
data Curl_
type CurlH = Ptr Curl_
type URLString = String
type Port = Long
type Long = Word32
type LLong = Word64
data Slist_
data Curl = Curl
{ curlH :: MVar (ForeignPtr Curl_)
, curlCleanup :: IORef OptionMap
}
curlPrim :: Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim c f = withMVar (curlH c) $ \ h ->
withForeignPtr h $ f $ curlCleanup c
mkCurl :: CurlH -> IO Curl
mkCurl h = mkCurlWithCleanup h om_empty
mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup h clean = do
debug "ALLOC: CURL"
v2 <- newIORef clean
fh <- newForeignPtr_ h
v1 <- newMVar fh
let new_h = Curl { curlH = v1, curlCleanup = v2 }
let fnalizr = do
debug "FREE: CURL"
easy_cleanup h
runCleanup v2
Foreign.Concurrent.addForeignPtrFinalizer fh fnalizr
return new_h
runCleanup :: IORef OptionMap -> IO ()
runCleanup r = do m <- readIORef r
om_cleanup m
writeIORef r om_empty
shareCleanup :: IORef OptionMap -> IO OptionMap
shareCleanup r = do old <- readIORef r
new <- om_dup old
writeIORef r new
return new
updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
updateCleanup r option act = writeIORef r =<< om_set option act =<< readIORef r
type OptionMap = M.IntMap (IO ())
om_empty :: OptionMap
om_empty = M.empty
om_set :: Int -> IO () -> OptionMap -> IO OptionMap
om_set opt new_act old_map =
do fromMaybe (return ()) old_act
return new_map
where
(old_act,new_map) = M.insertLookupWithKey (\_ a _ -> a) opt new_act old_map
om_cleanup :: OptionMap -> IO ()
om_cleanup m = sequence_ (M.elems m)
om_dup :: OptionMap -> IO OptionMap
om_dup old_map = M.fromList `fmap` mapM dup (M.assocs old_map)
where dup (x,old_io) = do new_io <- shareIO old_io
return (x,new_io)
shareIO :: IO () -> IO (IO ())
shareIO act =
do v <- newMVar False
let new_act = do b <- takeMVar v
if b then act else putMVar v True
return new_act
foreign import ccall
"curl/curl.h curl_easy_cleanup" easy_cleanup :: CurlH -> IO ()