{-# LANGUAGE GeneralizedNewtypeDeriving, RankNTypes #-}
module Data.Geometry.Geos.Raw.Base (
Geos
, runGeos
, throwIfZero
, withGeos
, mkErrorMessage
) where
import qualified Data.Geometry.Geos.Raw.Internal as I
import Foreign
import Data.Monoid ((<>))
import System.IO.Unsafe
import qualified Control.Concurrent.MVar as MV
import Control.Monad.Reader
newtype GEOSHandle = GEOSHandle (MV.MVar (ForeignPtr I.GEOSContextHandle_HS))
newtype Geos a = Geos { unGeos :: ReaderT GEOSHandle IO a }
deriving (MonadReader GEOSHandle, Monad, Functor, Applicative)
withGeos :: (I.GEOSContextHandle_t -> IO a) -> Geos a
withGeos f = Geos . ReaderT $ \(GEOSHandle mv) -> MV.withMVar mv $ \fp -> withForeignPtr fp f
runGeos :: Geos a -> a
runGeos g = unsafePerformIO $ do
ptrC <- I.geos_init
fptr <- newForeignPtr I.geos_finish ptrC
mv <- MV.newMVar fptr
runReaderT (unGeos g) $ GEOSHandle mv
throwIfZero :: (Eq a, Num a) => (a -> String) -> IO a -> IO a
throwIfZero = throwIf ((==) 0)
mkErrorMessage :: Show a => String -> (a -> String)
mkErrorMessage s = \n -> s <> " has thrown an error: " <> show n