Hemoji between MySQL and Haskell

emoji_btw_MySQL_and_Haskell.hs

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

module Example.Example18 where

import Control.Exception.Safe (SomeException, catch)

-- my library
import DataBase.MySQLX.CRUD
import DataBase.MySQLX.Model
import DataBase.MySQLX.NodeSession
import DataBase.MySQLX.Statement

import           Data.Text

{-

* case 1 **********

** crate table

mysql-sql> create table non_ascii_tbl (str varchar(10), text varchar(10));
Query OK, 0 rows affected (0.03 sec)

** insert japanese characters by Haskell client.

 > example18_insert_crud
1

** select by Haskell client

 > example18
ああ
 >

** select by mysql-shell

mysql-sql> select * from non_ascii_tbl;
+--------+--------+
| str    | text   |
+--------+--------+
| ああ   | げげ   |
+--------+--------+
1 row in set (0.00 sec)

** insert emoji by Haskell client.

 > example18_insert_crud
XProtocolError (Error {severity = Just ERROR, code = 1366, sql_state = "HY000", msg = "Incorrect string value: '\\xF0\\x9F\\x98\\x8A\\xF0\\x9F...' for column 'str' at row 1"})
 >


* case 2 **********

** create table

mysql-sql> create table non_ascii_tbl (str varchar(10), text varchar(10)) default charset=utf8mb4;
Query OK, 0 rows affected (0.05 sec)

** insert emoji by Haskell client

 > example18_insert_crud
1

** select by Haskell client

 >

 > example18
😊😱
 >

** select by mysql-shell

mysql-sql> select * from non_ascii_tbl;
+----------+--------+
| str      | text   |
+----------+--------+
| 😊😱     | げげ   |
+----------+--------+
1 row in set (0.00 sec)

-}

data Foo = Foo { 
    strVal  :: String 
  , textVal :: Text
} deriving Show

foo :: RowFrom Foo 
foo = Foo <$> colVal <*> colVal 

example18 :: IO ()
example18 = do
    nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
    catch ( do
      result <- executeRawSql "select *  from non_ascii_tbl" nodeSess
      mapM_ (putStrLn . strVal) $ resultFrom foo $ result
      ) (\(e::SomeException) -> print e)
    closeNodeSession nodeSess

example18_insert_crud :: IO ()
example18_insert_crud = do
    nodeSess <- openNodeSession $ defaultNodeSesssionInfo {database = "x_protocol_test", user = "root", password="root", port=8000}
    catch ( do
      ret <- insert create nodeSess
      print ret
      return ()
      ) (\(e::SomeException) -> print e)
    closeNodeSession nodeSess
  where 
    create = getTableModel `setCollection` (mkCollection "x_protocol_test" "non_ascii_tbl") 
                           `setColumns`    (columns ["str", "text"])      -- col 
                           -- `setTypedRow'`  [expr ("ああ"::String), expr ("げげ"::String)]  -- val
                           `setTypedRow'`  [expr ("😊😱"::String), expr ("げげ"::String)]  -- val