GeoJSON communication between MySQL and Haskell

mysql_geojson_sample3.hs

{-# 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' ")")