module Data.Geolocation.GEOS
( Context ()
, CoordinateSequence ()
, Geometry ()
, GeometryTypeId (..)
, Reader ()
, Writer ()
, area
, coordinateSequence
, envelope
, exteriorRing
, geometryTypeId
, getGeometry
, getNumGeometries
, getSize
, getX
, getY
, getZ
, intersection
, isEmpty
, mkReader
, mkWriter
, readGeometry
, version
, withGEOS
, writeGeometry
) where
import Control.Exception
import Data.Geolocation.GEOS.Imports
import Data.IORef
import Data.Word
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
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 GeometryTypeId =
Point |
LineString |
LinearRing |
Polygon |
MultiPoint |
MultlLineString |
MultiPolygon |
GeometryCollection deriving (Enum, Show)
data Reader = Reader ContextStateRef GEOSWKTReaderPtr
data Writer = Writer ContextStateRef GEOSWKTWriterPtr
data Geometry = Geometry ContextStateRef GEOSGeometryPtr
area :: Geometry -> IO (Maybe Double)
area (Geometry sr h) = do
ContextState{..} <- readIORef sr
alloca $ \valuePtr -> do
status <- c_GEOSArea_r hCtx h valuePtr
case status of
0 -> return Nothing
_ -> do
value <- peek valuePtr
return $ Just (realToFrac value)
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)
geometryTypeId :: Geometry -> IO GeometryTypeId
geometryTypeId (Geometry sr h) = do
ContextState{..} <- readIORef sr
value <- c_GEOSGeomTypeId_r hCtx h
return $ toEnum (fromIntegral value)
getGeometry :: Geometry -> Int -> IO Geometry
getGeometry (Geometry sr h) index =
doNotTrack sr (\hCtx -> c_GEOSGetGeometryN_r hCtx h (fromIntegral index))
getNumGeometries :: Geometry -> IO Int
getNumGeometries (Geometry sr h) = do
ContextState{..} <- readIORef sr
value <- c_GEOSGetNumGeometries_r hCtx h
return $ fromIntegral value
getOrdinate :: (GEOSContextHandle_t -> GEOSCoordSequencePtr -> CUInt -> Ptr CDouble -> IO CInt) ->
CoordinateSequence -> Word -> IO (Maybe Double)
getOrdinate f (CoordinateSequence sr h) index = do
ContextState{..} <- readIORef sr
alloca $ \valuePtr -> do
status <- f hCtx h (fromIntegral index) valuePtr
case status of
0 -> return Nothing
_ -> do
value <- peek valuePtr
return $ Just (realToFrac value)
getSize :: CoordinateSequence -> IO (Maybe Word)
getSize (CoordinateSequence sr h) = do
ContextState{..} <- readIORef sr
alloca $ \sizePtr -> do
status <- c_GEOSCoordSeq_getSize_r hCtx h sizePtr
case status of
0 -> return Nothing
_ -> do
size <- peek sizePtr
return $ Just (fromIntegral size)
getX :: CoordinateSequence -> Word -> IO (Maybe Double)
getX = getOrdinate c_GEOSCoordSeq_getX_r
getY :: CoordinateSequence -> Word -> IO (Maybe Double)
getY = getOrdinate c_GEOSCoordSeq_getY_r
getZ :: CoordinateSequence -> Word -> IO (Maybe Double)
getZ = getOrdinate c_GEOSCoordSeq_getZ_r
intersection :: Geometry -> Geometry -> IO Geometry
intersection (Geometry sr0 h0) (Geometry sr1 h1) =
track sr0 (\hCtx -> c_GEOSIntersection_r hCtx h0 h1)
isEmpty :: Geometry -> IO Bool
isEmpty (Geometry sr h) = do
ContextState{..} <- readIORef sr
value <- c_GEOSisEmpty_r hCtx h
return $ value /= 0
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_finishGEOS_r 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
version :: IO String
version = c_GEOSversion >>= peekCString
withGEOS :: (Context -> IO a) -> IO a
withGEOS = 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