Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE ScopedTypeVariables #-}
- {-# LANGUAGE ConstraintKinds #-}
- {-# LANGUAGE FlexibleInstances #-}
- {-# LANGUAGE TypeFamilies #-}
- module Example.Example16 where
- import Control.Exception.Safe (SomeException, catch)
- -- my library
- import DataBase.MySQLX.CRUD
- import DataBase.MySQLX.Model
- import DataBase.MySQLX.NodeSession
- import DataBase.MySQLX.ExprParser
- 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.Aeson
- import Data.Geospatial -- GeoJSON
- {-
- 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.Example16> example16
- Geo {geoJSON = Point (GeoPoint {_unGeoPoint = [30.0,10.0]})}
- Geo {geoJSON = Line (GeoLine {_unGeoLine = [[30.0,10.0],[10.0,30.0],[40.0,40.0]]})}
- Geo {geoJSON = Polygon (GeoPolygon {_unGeoPolygon = [[[30.0,10.0],[40.0,40.0],[20.0,40.0],[10.0,20.0],[30.0,10.0]]]})}
- Geo {geoJSON = Polygon (GeoPolygon {_unGeoPolygon = [[[35.0,10.0],[45.0,45.0],[15.0,40.0],[10.0,20.0],[35.0,10.0]],[[20.0,30.0],[35.0,35.0],[30.0,20.0],[20.0,30.0]]]})}
- -}
- example16_test_01 = fromJust $ decode "{\"type\": \"Polygon\", \"coordinates\": [[[35, 10], [45, 45], [15, 40], [10, 20], [35, 10]], [[20, 30], [35, 35], [30, 20], [20, 30]]]}" :: GeospatialGeometry
- example16_test_02 = fromJust $ decode "{\"type\": \"Point\", \"coordinates\": [9, 9]}" :: GeospatialGeometry
- data Geo = Geo {
- geoJSON :: GeospatialGeometry
- } deriving Show
- geoJson :: RowFrom Geo
- geoJson = Geo <$> colVal
- getColGeoJSON :: Row -> Int -> GeospatialGeometry
- getColGeoJSON row idx = getColGeoJSON' $ Seq.index row idx
- getColGeoJSON' :: BL.ByteString -> GeospatialGeometry
- getColGeoJSON' x = fromJust $ decode $ getColByteString' x
- instance ColumnValuable (GeospatialGeometry) where toColVal' = getColGeoJSON'
- example16 :: IO ()
- example16 = do
- nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
- catch ( do
- result <- executeRawSql "select st_asGeojson(geo) from geo_tbl" nodeSess
- mapM_ print $ resultFrom geoJson $ result
- ) (\(e::SomeException) -> print e)
- closeNodeSession nodeSess
- example16_insert_crud :: IO ()
- example16_insert_crud = do
- nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
- catch ( do
- print row
- ret <- insert create nodeSess
- print ret
- return ()
- ) (\(e::SomeException) -> print e)
- closeNodeSession nodeSess
- where
- create = getTableModel `setCollection` (mkCollection "x_protocol_test" "geo_tbl")
- `setColumns` [column "geo"] -- col
- `setTypedRow'` [parseCriteria' row] -- val
- row = BL.toStrict $ (s2bs' "ST_GeomFromGeoJSON(") `BL.append` (encode example16_test_01) `BL.append` (s2bs' ")")
Add Comment
Please, Sign In to add comment