{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, CPP #-}
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
{ Curl -> MVar (ForeignPtr Curl_)
curlH :: MVar (ForeignPtr Curl_)
, Curl -> IORef OptionMap
curlCleanup :: IORef OptionMap
}
curlPrim :: Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim :: Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim c :: Curl
c f :: IORef OptionMap -> CurlH -> IO a
f = MVar (ForeignPtr Curl_) -> (ForeignPtr Curl_ -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (Curl -> MVar (ForeignPtr Curl_)
curlH Curl
c) ((ForeignPtr Curl_ -> IO a) -> IO a)
-> (ForeignPtr Curl_ -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ h :: ForeignPtr Curl_
h ->
ForeignPtr Curl_ -> (CurlH -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Curl_
h ((CurlH -> IO a) -> IO a) -> (CurlH -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ IORef OptionMap -> CurlH -> IO a
f (IORef OptionMap -> CurlH -> IO a)
-> IORef OptionMap -> CurlH -> IO a
forall a b. (a -> b) -> a -> b
$ Curl -> IORef OptionMap
curlCleanup Curl
c
mkCurl :: CurlH -> IO Curl
mkCurl :: CurlH -> IO Curl
mkCurl h :: CurlH
h = CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup CurlH
h OptionMap
om_empty
mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
mkCurlWithCleanup h :: CurlH
h clean :: OptionMap
clean = do
String -> IO ()
debug "ALLOC: CURL"
IORef OptionMap
v2 <- OptionMap -> IO (IORef OptionMap)
forall a. a -> IO (IORef a)
newIORef OptionMap
clean
ForeignPtr Curl_
fh <- CurlH -> IO (ForeignPtr Curl_)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ CurlH
h
MVar (ForeignPtr Curl_)
v1 <- ForeignPtr Curl_ -> IO (MVar (ForeignPtr Curl_))
forall a. a -> IO (MVar a)
newMVar ForeignPtr Curl_
fh
let new_h :: Curl
new_h = Curl :: MVar (ForeignPtr Curl_) -> IORef OptionMap -> Curl
Curl { curlH :: MVar (ForeignPtr Curl_)
curlH = MVar (ForeignPtr Curl_)
v1, curlCleanup :: IORef OptionMap
curlCleanup = IORef OptionMap
v2 }
let fnalizr :: IO ()
fnalizr = do
String -> IO ()
debug "FREE: CURL"
CurlH -> IO ()
easy_cleanup CurlH
h
IORef OptionMap -> IO ()
runCleanup IORef OptionMap
v2
ForeignPtr Curl_ -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
Foreign.Concurrent.addForeignPtrFinalizer ForeignPtr Curl_
fh IO ()
fnalizr
Curl -> IO Curl
forall (m :: * -> *) a. Monad m => a -> m a
return Curl
new_h
runCleanup :: IORef OptionMap -> IO ()
runCleanup :: IORef OptionMap -> IO ()
runCleanup r :: IORef OptionMap
r = do OptionMap
m <- IORef OptionMap -> IO OptionMap
forall a. IORef a -> IO a
readIORef IORef OptionMap
r
OptionMap -> IO ()
om_cleanup OptionMap
m
IORef OptionMap -> OptionMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef OptionMap
r OptionMap
om_empty
shareCleanup :: IORef OptionMap -> IO OptionMap
shareCleanup :: IORef OptionMap -> IO OptionMap
shareCleanup r :: IORef OptionMap
r = do OptionMap
old <- IORef OptionMap -> IO OptionMap
forall a. IORef a -> IO a
readIORef IORef OptionMap
r
OptionMap
new <- OptionMap -> IO OptionMap
om_dup OptionMap
old
IORef OptionMap -> OptionMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef OptionMap
r OptionMap
new
OptionMap -> IO OptionMap
forall (m :: * -> *) a. Monad m => a -> m a
return OptionMap
new
updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
updateCleanup r :: IORef OptionMap
r option :: Int
option act :: IO ()
act = IORef OptionMap -> OptionMap -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef OptionMap
r (OptionMap -> IO ()) -> IO OptionMap -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO () -> OptionMap -> IO OptionMap
om_set Int
option IO ()
act (OptionMap -> IO OptionMap) -> IO OptionMap -> IO OptionMap
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef OptionMap -> IO OptionMap
forall a. IORef a -> IO a
readIORef IORef OptionMap
r
type OptionMap = M.IntMap (IO ())
om_empty :: OptionMap
om_empty :: OptionMap
om_empty = OptionMap
forall a. IntMap a
M.empty
om_set :: Int -> IO () -> OptionMap -> IO OptionMap
om_set :: Int -> IO () -> OptionMap -> IO OptionMap
om_set opt :: Int
opt new_act :: IO ()
new_act old_map :: OptionMap
old_map =
do IO () -> Maybe (IO ()) -> IO ()
forall a. a -> Maybe a -> a
fromMaybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (IO ())
old_act
OptionMap -> IO OptionMap
forall (m :: * -> *) a. Monad m => a -> m a
return OptionMap
new_map
where
(old_act :: Maybe (IO ())
old_act,new_map :: OptionMap
new_map) = (Int -> IO () -> IO () -> IO ())
-> Int -> IO () -> OptionMap -> (Maybe (IO ()), OptionMap)
forall a.
(Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
M.insertLookupWithKey (\_ a :: IO ()
a _ -> IO ()
a) Int
opt IO ()
new_act OptionMap
old_map
om_cleanup :: OptionMap -> IO ()
om_cleanup :: OptionMap -> IO ()
om_cleanup m :: OptionMap
m = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (OptionMap -> [IO ()]
forall a. IntMap a -> [a]
M.elems OptionMap
m)
om_dup :: OptionMap -> IO OptionMap
om_dup :: OptionMap -> IO OptionMap
om_dup old_map :: OptionMap
old_map = [(Int, IO ())] -> OptionMap
forall a. [(Int, a)] -> IntMap a
M.fromList ([(Int, IO ())] -> OptionMap) -> IO [(Int, IO ())] -> IO OptionMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ((Int, IO ()) -> IO (Int, IO ()))
-> [(Int, IO ())] -> IO [(Int, IO ())]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int, IO ()) -> IO (Int, IO ())
forall a. (a, IO ()) -> IO (a, IO ())
dup (OptionMap -> [(Int, IO ())]
forall a. IntMap a -> [(Int, a)]
M.assocs OptionMap
old_map)
where dup :: (a, IO ()) -> IO (a, IO ())
dup (x :: a
x,old_io :: IO ()
old_io) = do IO ()
new_io <- IO () -> IO (IO ())
shareIO IO ()
old_io
(a, IO ()) -> IO (a, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x,IO ()
new_io)
shareIO :: IO () -> IO (IO ())
shareIO :: IO () -> IO (IO ())
shareIO act :: IO ()
act =
do MVar Bool
v <- Bool -> IO (MVar Bool)
forall a. a -> IO (MVar a)
newMVar Bool
False
let new_act :: IO ()
new_act = do Bool
b <- MVar Bool -> IO Bool
forall a. MVar a -> IO a
takeMVar MVar Bool
v
if Bool
b then IO ()
act else MVar Bool -> Bool -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Bool
v Bool
True
IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
new_act
foreign import ccall
"curl/curl.h curl_easy_cleanup" easy_cleanup :: CurlH -> IO ()