Guest User

Untitled

a guest
Mar 3rd, 2018
87
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.47 KB | None | 0 0
  1. {-# LANGUAGE ScopedTypeVariables #-}
  2. {-# LANGUAGE ConstraintKinds #-}
  3. {-# LANGUAGE FlexibleInstances #-}
  4. {-# LANGUAGE TypeFamilies #-}
  5.  
  6. module Example.Example16 where
  7.  
  8. import Control.Exception.Safe (SomeException, catch)
  9.  
  10. -- my library
  11. import DataBase.MySQLX.CRUD
  12. import DataBase.MySQLX.Model
  13. import DataBase.MySQLX.NodeSession
  14. import DataBase.MySQLX.ExprParser
  15. import DataBase.MySQLX.ResultSet
  16. import DataBase.MySQLX.Statement
  17. import DataBase.MySQLX.Util
  18.  
  19. import qualified Data.ByteString.Lazy as BL
  20. import qualified Data.ByteString as B
  21. import qualified Data.Sequence as Seq
  22. import Data.Maybe
  23.  
  24. import Data.Aeson
  25. import Data.Geospatial -- GeoJSON
  26.  
  27. {-
  28. mysql-sql> create table geo_tbl (`id` int unsigned not null auto_increment, `geo` geometry not null, primary key(`id`));
  29. mysql-sql> insert into geo_tbl (geo) values (st_GeomFromText('POINT (30 10)'));
  30. mysql-sql> insert into geo_tbl (geo) values (st_GeomFromText('LINESTRING (30 10, 10 30, 40 40)'));
  31. mysql-sql> insert into geo_tbl (geo) values (st_GeomFromText('POLYGON ((30 10, 40 40, 20 40, 10 20, 30 10))'));
  32. 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))'));
  33.  
  34. *Example.Example16> example16
  35. Geo {geoJSON = Point (GeoPoint {_unGeoPoint = [30.0,10.0]})}
  36. Geo {geoJSON = Line (GeoLine {_unGeoLine = [[30.0,10.0],[10.0,30.0],[40.0,40.0]]})}
  37. 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]]]})}
  38. 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]]]})}
  39.  
  40. -}
  41.  
  42. 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
  43. example16_test_02 = fromJust $ decode "{\"type\": \"Point\", \"coordinates\": [9, 9]}" :: GeospatialGeometry
  44.  
  45. data Geo = Geo {
  46. geoJSON :: GeospatialGeometry
  47. } deriving Show
  48.  
  49. geoJson :: RowFrom Geo
  50. geoJson = Geo <$> colVal
  51.  
  52. getColGeoJSON :: Row -> Int -> GeospatialGeometry
  53. getColGeoJSON row idx = getColGeoJSON' $ Seq.index row idx
  54.  
  55. getColGeoJSON' :: BL.ByteString -> GeospatialGeometry
  56. getColGeoJSON' x = fromJust $ decode $ getColByteString' x
  57.  
  58. instance ColumnValuable (GeospatialGeometry) where toColVal' = getColGeoJSON'
  59.  
  60. example16 :: IO ()
  61. example16 = do
  62. nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
  63. catch ( do
  64. result <- executeRawSql "select st_asGeojson(geo) from geo_tbl" nodeSess
  65. mapM_ print $ resultFrom geoJson $ result
  66. ) (\(e::SomeException) -> print e)
  67. closeNodeSession nodeSess
  68.  
  69. example16_insert_crud :: IO ()
  70. example16_insert_crud = do
  71. nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
  72. catch ( do
  73. print row
  74. ret <- insert create nodeSess
  75. print ret
  76. return ()
  77. ) (\(e::SomeException) -> print e)
  78. closeNodeSession nodeSess
  79. where
  80. create = getTableModel `setCollection` (mkCollection "x_protocol_test" "geo_tbl")
  81. `setColumns` [column "geo"] -- col
  82. `setTypedRow'` [parseCriteria' row] -- val
  83. row = BL.toStrict $ (s2bs' "ST_GeomFromGeoJSON(") `BL.append` (encode example16_test_01) `BL.append` (s2bs' ")")
Add Comment
Please, Sign In to add comment