module Data.Geolocation.GEOS
( Context ()
, CoordinateSequence ()
, Geometry ()
, GeometryType (..)
, Reader ()
, Writer ()
, area
, envelope
, geomTypeId
, getCoordSeq
, getErrorMessage
, getExteriorRing
, 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
, hReaders :: [GEOSWKTReaderPtr]
, hWriters :: [GEOSWKTWriterPtr]
, hGeometries :: [GEOSGeometryPtr]
, hCoordinateSequences :: [GEOSCoordSequencePtr]
}
type ContextStateRef = IORef ContextState
data CoordinateSequence = CoordinateSequence ContextStateRef GEOSCoordSequencePtr
data GeometryType =
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)
checkAndDoNotTrack :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry)
checkAndDoNotTrack sr f = do
ContextState{..} <- readIORef sr
h <- f hCtx
return $ if isNullPtr h
then Nothing
else Just $ Geometry sr h
checkAndTrack :: ContextStateRef -> (GEOSContextHandle -> IO GEOSGeometryPtr) -> IO (Maybe Geometry)
checkAndTrack sr f = do
ContextState{..} <- readIORef sr
h <- f hCtx
if isNullPtr h
then return Nothing
else do
modifyIORef' sr $ (\p@ContextState{..} -> p { hGeometries = h : hGeometries })
return $ Just (Geometry sr h)
envelope :: Geometry -> IO (Maybe Geometry)
envelope (Geometry sr h) =
checkAndTrack sr (\hCtx -> c_GEOSEnvelope_r hCtx h)
geomTypeId :: Geometry -> IO (Maybe GeometryType)
geomTypeId (Geometry sr h) = do
ContextState{..} <- readIORef sr
value <- c_GEOSGeomTypeId_r hCtx h
return $ if value == 1
then Nothing
else Just $ toEnum (fromIntegral value)
getCoordSeq :: Geometry -> IO (Maybe CoordinateSequence)
getCoordSeq (Geometry sr hGeometry) = do
ContextState{..} <- readIORef sr
h <- c_GEOSGeom_getCoordSeq_r hCtx hGeometry
return $ if isNullPtr h
then Nothing
else Just $ CoordinateSequence sr h
getErrorMessage :: IO String
getErrorMessage = c_getErrorMessage >>= peekCString
getExteriorRing :: Geometry -> IO (Maybe Geometry)
getExteriorRing (Geometry sr h) =
checkAndDoNotTrack sr (\hCtx -> c_GEOSGetExteriorRing_r hCtx h)
getGeometry :: Geometry -> Int -> IO (Maybe Geometry)
getGeometry (Geometry sr h) index =
checkAndDoNotTrack sr (\hCtx -> c_GEOSGetGeometryN_r hCtx h (fromIntegral index))
getNumGeometries :: Geometry -> IO (Maybe Int)
getNumGeometries (Geometry sr h) = do
ContextState{..} <- readIORef sr
value <- c_GEOSGetNumGeometries_r hCtx h
return $ if value == 1
then Nothing
else Just $ fromIntegral value
getOrdinate :: (GEOSContextHandle -> 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 (Maybe Geometry)
intersection (Geometry sr0 h0) (Geometry sr1 h1) =
checkAndTrack sr0 (\hCtx -> c_GEOSIntersection_r hCtx h0 h1)
isEmpty :: Geometry -> IO (Maybe Bool)
isEmpty (Geometry sr h) = do
ContextState{..} <- readIORef sr
value <- c_GEOSisEmpty_r hCtx h
return $ case value of
0 -> Just False
1 -> Just True
_ -> Nothing
mkContext :: IO Context
mkContext = do
hCtx <- c_initializeGEOSWithHandlers
sr <- newIORef $ ContextState hCtx [] [] [] []
return $ Context sr
mkReader :: Context -> IO (Maybe Reader)
mkReader (Context sr) = do
ContextState{..} <- readIORef sr
h <- c_GEOSWKTReader_create_r hCtx
if isNullPtr h
then return Nothing
else do
modifyIORef' sr (\p@ContextState{..} -> p { hReaders = h : hReaders })
return $ Just (Reader sr h)
mkWriter :: Context -> IO (Maybe Writer)
mkWriter (Context sr) = do
ContextState{..} <- readIORef sr
h <- c_GEOSWKTWriter_create_r hCtx
if isNullPtr h
then return Nothing
else do
modifyIORef' sr (\p@ContextState{..} -> p { hWriters = h : hWriters })
return $ Just (Writer sr h)
readGeometry :: Reader -> String -> IO (Maybe Geometry)
readGeometry (Reader sr h) str = withCString str $ \cs -> do
checkAndTrack 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
version :: IO String
version = c_GEOSversion >>= peekCString
withGEOS :: (Context -> IO a) -> IO a
withGEOS = bracket mkContext releaseContext
writeGeometry :: Writer -> Geometry -> IO (Maybe String)
writeGeometry (Writer sr hWriter) (Geometry _ hGeometry) = do
ContextState{..} <- readIORef sr
bracket
(c_GEOSWKTWriter_write_r hCtx hWriter hGeometry)
(c_GEOSFree_r_CString hCtx)
(\cs -> if cs == nullPtr then return Nothing else Just <$> peekCString cs)