module Data.Geolocation.GEOS
( Context ()
, CoordinateSequence ()
, Geometry ()
, Reader ()
, Writer ()
, coordinateSequence
, envelope
, exteriorRing
, intersection
, mkReader
, mkWriter
, readGeometry
, withContext
, writeGeometry
) where
import Control.Exception
import Data.Geolocation.GEOS.Imports
import Data.IORef
import Foreign.C
data Context = Context ContextStateRef
data ContextState = ContextState
{ hCtx :: GEOSContextHandle_t
, hReaders :: [GEOSWKTReaderPtr]
, hWriters :: [GEOSWKTWriterPtr]
, hGeometries :: [GEOSGeometryPtr]
, hCoordinateSequences :: [GEOSCoordSequencePtr]
}
type ContextStateRef = IORef ContextState
data CoordinateSequence = CoordinateSequence ContextStateRef GEOSCoordSequencePtr
data Reader = Reader ContextStateRef GEOSWKTReaderPtr
data Writer = Writer ContextStateRef GEOSWKTWriterPtr
data Geometry = Geometry ContextStateRef GEOSGeometryPtr
coordinateSequence :: Geometry -> IO CoordinateSequence
coordinateSequence (Geometry sr hGeometry) = do
ContextState{..} <- readIORef sr
h <- c_GEOSGeom_getCoordSeq_r hCtx hGeometry
return $ CoordinateSequence sr h
doNotTrack :: ContextStateRef -> (GEOSContextHandle_t -> IO GEOSGeometryPtr) -> IO Geometry
doNotTrack sr f = do
ContextState{..} <- readIORef sr
h <- f hCtx
return $ Geometry sr h
envelope :: Geometry -> IO Geometry
envelope (Geometry sr h) =
track sr (\hCtx -> c_GEOSEnvelope_r hCtx h)
exteriorRing :: Geometry -> IO Geometry
exteriorRing (Geometry sr h) =
doNotTrack sr (\hCtx -> c_GEOSGetExteriorRing_r hCtx h)
intersection :: Geometry -> Geometry -> IO Geometry
intersection (Geometry sr0 h0) (Geometry sr1 h1) =
track sr0 (\hCtx -> c_GEOSIntersection_r hCtx h0 h1)
mkContext :: IO Context
mkContext = do
hCtx <- c_initializeGEOSWithHandlers
sr <- newIORef $ ContextState hCtx [] [] [] []
return $ Context sr
mkReader :: Context -> IO Reader
mkReader (Context sr) = do
ContextState{..} <- readIORef sr
h <- c_GEOSWKTReader_create_r hCtx
modifyIORef' sr (\p@ContextState{..} -> p { hReaders = h : hReaders })
return $ Reader sr h
mkWriter :: Context -> IO Writer
mkWriter (Context sr) = do
ContextState{..} <- readIORef sr
h <- c_GEOSWKTWriter_create_r hCtx
modifyIORef' sr (\p@ContextState{..} -> p { hWriters = h : hWriters })
return $ Writer sr h
readGeometry :: Reader -> String -> IO Geometry
readGeometry (Reader sr h) str = withCString str $ \cs -> do
track sr (\hCtx -> c_GEOSWKTReader_read_r hCtx h cs)
releaseContext :: Context -> IO ()
releaseContext (Context sr) = do
ContextState{..} <- readIORef sr
mapM_ (c_GEOSCoordSeq_destroy_r hCtx) hCoordinateSequences
mapM_ (c_GEOSGeom_destroy_r hCtx) hGeometries
mapM_ (c_GEOSWKTWriter_destroy_r hCtx) hWriters
mapM_ (c_GEOSWKTReader_destroy_r hCtx) hReaders
c_uninitializeGEOS hCtx
track :: ContextStateRef -> (GEOSContextHandle_t -> IO GEOSGeometryPtr) -> IO Geometry
track sr f = do
ContextState{..} <- readIORef sr
h <- f hCtx
modifyIORef' sr $ (\p@ContextState{..} -> p { hGeometries = h : hGeometries })
return $ Geometry sr h
withContext :: (Context -> IO a) -> IO a
withContext = bracket mkContext releaseContext
writeGeometry :: Writer -> Geometry -> IO String
writeGeometry (Writer sr hWriter) (Geometry _ hGeometry) = do
ContextState{..} <- readIORef sr
str <- bracket
(c_GEOSWKTWriter_write_r hCtx hWriter hGeometry)
(c_GEOSFree_r_CString hCtx)
peekCString
return str