module GEOSTest.TransAPI (demo) where import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Maybe import Data.Geolocation.GEOS (Context, Geometry) import Data.Geolocation.GEOS.Trans import Data.Maybe check :: Bool -> MaybeT IO () check True = return () check False = error "Check failed" type Coordinate = (Double, Double) createLinearRing :: Context -> [Coordinate] -> MaybeT IO Geometry createLinearRing ctx cs = do let count = length cs coords <- createCoordSeqM ctx (fromIntegral count) 2 forM_ (zip [0..] cs) $ \(i, (x, y)) -> do setXM coords i x setYM coords i y createLinearRingM coords -- Demonstrates use of monad transformer API -- Lifetimes of GEOS objects are automatically managed by the context objects -- which guarantees that they are released when the context goes out of scope demo :: IO () demo = do result <- runGEOSEither $ \ctx -> do reader <- mkReaderM ctx writer <- mkWriterM ctx g0 <- readGeometryM reader "POLYGON (( 10 10, 10 20, 20 20, 20 10, 10 10 ))" g1 <- readGeometryM reader "POLYGON (( 11 11, 11 12, 12 12, 12 11, 11 11 ))" g2 <- intersectionM g0 g1 str0 <- writeGeometryM writer g2 lift $ putStrLn str0 coords <- createCoordSeqM ctx 10 3 size <- getSizeM coords forM_ [0..size - 2] $ \i -> do setXM coords i (fromIntegral (i + 1) * 10.0) setYM coords i (fromIntegral (i + 1) * 20.0) setZM coords i (fromIntegral (i + 1) * 30.0) setOrdinateM coords (size - 1) 0 10.0 setOrdinateM coords (size - 1) 1 20.0 setOrdinateM coords (size - 1) 2 30.0 g3 <- createLinearRingM coords str1 <- writeGeometryM writer g3 lift $ putStrLn str1 x0 <- getXM coords 0 check $ x0 == 10.0 y0 <- getYM coords 0 check $ y0 == 20.0 z0 <- getZM coords 0 check $ z0 == 30.0 x1 <- getOrdinateM coords 1 0 check $ x1 == 20.0 y1 <- getOrdinateM coords 1 1 check $ y1 == 40.0 z1 <- getOrdinateM coords 1 2 check $ z1 == 60.0 p <- createPolygonM g3 [] str2 <- writeGeometryM writer p lift $ putStrLn str2 shell <- createLinearRing ctx [(-10.0, -10.0), (-10.0, 10.0), (10.0, 10.0), (10.0, -10.0), (-10.0, -10.0)] hole <- createLinearRing ctx [(-5.0, -5.0), (-5.0, 5.0), (5.0, 5.0), (5.0, -5.0), (-5.0, -5.0)] polygon <- createPolygonM shell [hole] str3 <- writeGeometryM writer polygon lift $ putStrLn str3 case result of Left m -> error $ "TransAPI.demo failed: " ++ m Right _ -> putStrLn "TransAPI.demo succeeded"