Geometry Type Sample on MySQL

mysql_gis_sample2.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE TypeFamilies#-}

module Example.Example15 where

import Control.Exception.Safe (SomeException, catch)

-- my library
import DataBase.MySQLX.NodeSession
import DataBase.MySQLX.ResultSet
import DataBase.MySQLX.Statement
import DataBase.MySQLX.Util

import qualified Data.ByteString.Lazy as BL 
import qualified Data.ByteString      as B 
import qualified Data.Sequence        as Seq
import           Data.Maybe

import Data.Geometry.Geos.Geometry
import Data.Geometry.Geos.Serialize
import Data.Geometry.Geos.Types

{-
mysql-sql> create table geo_tbl (`id` int unsigned not null auto_increment, `geo` geometry not null, primary key(`id`));
mysql-sql> insert into geo_tbl (geo) values (st_GeomFromText('POINT (30 10)'));
mysql-sql> insert into geo_tbl (geo) values (st_GeomFromText('LINESTRING (30 10, 10 30, 40 40)'));
mysql-sql> insert into geo_tbl (geo) values (st_GeomFromText('POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10))'));
mysql-sql> insert into geo_tbl (geo) values (st_GeomFromText('POLYGON ((35 10, 45 45, 15 40, 10 20, 35 10),(20 30, 35 35, 30 20, 20 30))'));

*Example.Example15> example15
Geo {p = Some (PointGeometry (Point (Coordinate2 30.0 10.0)) Nothing)}
Geo {p = Some (LineStringGeometry (LineString [Coordinate2 30.0 10.0,Coordinate2 10.0 30.0,Coordinate2 40.0 40.0]) Nothing)}
Geo {p = Some (PolygonGeometry (Polygon [LinearRing [Coordinate2 30.0 10.0,Coordinate2 40.0 40.0,Coordinate2 20.0 40.0,Coordinate2 10.0 20.0,Coordinate2 30.0 10.0]]) Nothing)}
Geo {p = Some (PolygonGeometry (Polygon [LinearRing [Coordinate2 35.0 10.0,Coordinate2 45.0 45.0,Coordinate2 15.0 40.0,Coordinate2 10.0 20.0,Coordinate2 35.0 10.0],LinearRing [Coordinate2 20.0 30.0,Coordinate2 35.0 35.0,Coordinate2 30.0 20.0,Coordinate2 20.0 30.0]]) Nothing)}
Geo {p = Some (PointGeometry (Point (Coordinate2 1.5 2.5)) Nothing)}

-}


data Geo = Geo { 
--   p :: Geometry Point
   p :: Some Geometry
} deriving Show

geo:: RowFrom Geo 
geo= Geo <$> colVal 

getColGeoPoint :: Row -> Int -> Geometry Point 
getColGeoPoint row idx = getColGeoPoint' $ Seq.index row idx

getColGeoPoint' :: BL.ByteString -> Geometry Point
getColGeoPoint' x = ensurePoint $ fromJust $ readWkb (BL.toStrict $ BL.drop 4 $ getColByteString' x)

getColGeoPoint'' :: BL.ByteString -> Geometry Point
getColGeoPoint'' x = ensurePoint $ fromJust $ readWkb (BL.toStrict $ getColByteString' x)

getColSomeGeometry' :: BL.ByteString -> Some Geometry
getColSomeGeometry' x = fromJust $ readWkb (BL.toStrict $ BL.drop 4 $ getColByteString' x)

instance ColumnValuable (Some Geometry) where toColVal' = getColSomeGeometry'

example15 :: IO ()
example15 = do
    nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
    catch ( do
      result <- executeRawSql "select geo from geo_tbl" nodeSess
      mapM_ print $ resultFrom geo $ result
      ) (\(e::SomeException) -> print e)
    closeNodeSession nodeSess

example15_insert :: IO ()
example15_insert = do
    putStrLn sql
    nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
    catch ( do
      result <- executeRawSql sql nodeSess
      mapM_ print $ resultFrom geo $ result
      ) (\(e::SomeException) -> print e)
    closeNodeSession nodeSess
  where 
    p  = Point $ Coordinate2 1.5 2.5
    gp = PointGeometry p Nothing
    b  = writeWkt gp 
    sql = "insert into geo_tbl(geo) values (st_GeomFromText('" ++ (bs2s b) ++ "'))"

makeWkt :: Some Geometry -> B.ByteString 
makeWkt g = withSomeGeometry g $ \g' -> case g' of
  PointGeometry           _ _ -> writeWkt g'
  LineStringGeometry      _ _ -> writeWkt g'
  LinearRingGeometry      _ _ -> writeWkt g'
  PolygonGeometry         _ _ -> writeWkt g'
  MultiPointGeometry      _ _ -> writeWkt g'
  MultiLineStringGeometry _ _ -> writeWkt g'
  MultiPolygonGeometry    _ _ -> writeWkt g'