    {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, CPP #-}
    --------------------------------------------------------------------
    -- |
    -- Module    : Network.Curl.Types
    -- Copyright : (c) Galois Inc 2007-2009
    -- License   : BSD3
    --
    -- Maintainer: Sigbjorn Finne <sof@galois.com>
    -- Stability : provisional
    -- Portability: portable
    --
    -- Basic set of types for the Haskell curl binding, including the
    -- @Curl@ handle type which holds the C library stateful connection
    -- handle along with a set of cleanup actions tht should be performed
    -- upon shutting down the curl session.
    --
    --------------------------------------------------------------------
    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
    -- import System.IO

    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_)  -- libcurl is not thread-safe.
      , Curl -> IORef OptionMap
    curlCleanup :: IORef OptionMap          -- deallocate Haskell curl data
      }

    -- | Execute a "primitve" curl operation.
    -- NOTE: See warnings about the use of 'withForeginPtr'.
    curlPrim :: Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
    curlPrim :: forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
    curlPrim Curl
    c 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
    $ \ 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

    -- | Allocates a Haskell handle from a C handle.
    mkCurl :: CurlH -> IO Curl
    mkCurl :: CurlH -> IO Curl
    mkCurl CurlH
    h = CurlH -> OptionMap -> IO Curl
    mkCurlWithCleanup CurlH
    h OptionMap
    om_empty

    -- | Allocates a Haskell handle from a C handle.
    mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
    mkCurlWithCleanup :: CurlH -> OptionMap -> IO Curl
    mkCurlWithCleanup CurlH
    h OptionMap
    clean = do
      String -> IO ()
    debug String
    "ALLOC: CURL"
      v2  <- OptionMap -> IO (IORef OptionMap)
    forall a. a -> IO (IORef a)
    newIORef OptionMap
    clean
      fh  <- newForeignPtr_ h
      v1  <- newMVar fh
      let new_h = Curl { curlH :: MVar (ForeignPtr Curl_)
    curlH = MVar (ForeignPtr Curl_)
    v1, curlCleanup :: IORef OptionMap
    curlCleanup = IORef OptionMap
    v2 }

      let fnalizr = do
             String -> IO ()
    debug String
    "FREE: CURL"
             CurlH -> IO ()
    easy_cleanup CurlH
    h
             IORef OptionMap -> IO ()
    runCleanup IORef OptionMap
    v2
      Foreign.Concurrent.addForeignPtrFinalizer fh fnalizr
      return new_h

    -- Admin code for cleaning up marshalled data.
    -- Note that these functions assume that they are running atomically,
    -- so access to them should be protected by a lock.
    --------------------------------------------------------------------------------
    runCleanup     :: IORef OptionMap -> IO ()
    runCleanup :: IORef OptionMap -> IO ()
    runCleanup IORef OptionMap
    r    = do m <- IORef OptionMap -> IO OptionMap
    forall a. IORef a -> IO a
    readIORef IORef OptionMap
    r
                         om_cleanup m
                         writeIORef r om_empty

    shareCleanup  :: IORef OptionMap -> IO OptionMap
    shareCleanup :: IORef OptionMap -> IO OptionMap
    shareCleanup IORef OptionMap
    r  = do old <- IORef OptionMap -> IO OptionMap
    forall a. IORef a -> IO a
    readIORef IORef OptionMap
    r
                         new <- om_dup old
                         writeIORef r new
                         return new

    updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
    updateCleanup :: IORef OptionMap -> Int -> IO () -> IO ()
    updateCleanup IORef OptionMap
    r Int
    option 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

    -- Maps that associate curl options with IO actions to
    -- perform cleanup for them.
    --------------------------------------------------------------------------------
    type OptionMap = M.IntMap (IO ())

    -- | An empty option map.
    om_empty :: OptionMap
    om_empty :: OptionMap
    om_empty = OptionMap
    forall a. IntMap a
    M.empty

    -- | Set the IO action for an option,
    -- executing the previvous action, if there was one.
    om_set :: Int -> IO () -> OptionMap -> IO OptionMap
    om_set :: Int -> IO () -> OptionMap -> IO OptionMap
    om_set Int
    opt IO ()
    new_act OptionMap
    old_map =
      do IO () -> Maybe (IO ()) -> IO ()
    forall a. a -> Maybe a -> a
    fromMaybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) Maybe (IO ())
    old_act
         OptionMap -> IO OptionMap
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OptionMap
    new_map
      where
      (Maybe (IO ())
    old_act,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 (\Int
    _ IO ()
    a IO ()
    _ -> IO ()
    a) Int
    opt IO ()
    new_act OptionMap
    old_map

    -- | Execute all IO actions in the map.
    om_cleanup :: OptionMap -> IO ()
    om_cleanup :: OptionMap -> IO ()
    om_cleanup 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)

    -- | Replace the actions in a map, with actions that
    -- will only be executed the second time they are invoked.
    om_dup :: OptionMap -> IO OptionMap
    om_dup :: OptionMap -> IO OptionMap
    om_dup OptionMap
    old_map = [(Int, IO ())] -> OptionMap
    forall a. [(Int, a)] -> IntMap a
    M.fromList ([(Int, IO ())] -> OptionMap) -> IO [(Int, IO ())] -> IO OptionMap
    forall a b. (a -> b) -> IO a -> IO b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 (a
    x,IO ()
    old_io)  = do new_io <- IO () -> IO (IO ())
    shareIO IO ()
    old_io
                                 return (x,new_io)

    -- Share a cleanup action.  When we share cleanup duty between two handles
    -- we need to ensure that the first handle to perform the cleanup will do
    -- nothing (because the other handle still needs the resources).
    shareIO :: IO () -> IO (IO ())
    shareIO :: IO () -> IO (IO ())
    shareIO IO ()
    act =
      do v <- Bool -> IO (MVar Bool)
    forall a. a -> IO (MVar a)
    newMVar Bool
    False
         let new_act = do b <- MVar Bool -> IO Bool
    forall a. MVar a -> IO a
    takeMVar MVar Bool
    v
                          if b then act else putMVar v True
         return new_act
    --------------------------------------------------------------------------------

    {- UNUSED:
    -- FFI for inalizers.

    -- | Make a finalizer from an IO action.
    mkIOfin :: IO a -> IO (FinalizerPtr b)
    mkIOfin m = mfix (\ptr -> ioFinalizer (m >> freeHaskellFunPtr ptr))

    foreign import ccall "wrapper"
      ioFinalizer :: IO () -> IO (FinalizerPtr a)

    -}

    foreign import ccall
      "curl/curl.h curl_easy_cleanup" easy_cleanup :: CurlH -> IO ()