Question

Good day, i have mongodb database filled with some data, i ensured that data stored in correct charset, to fetch data i use following snippet:

{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Data.Enumerator (Iteratee (..))
import Data.Either (either)
import Control.Monad (join)
import Data.Maybe (fromMaybe)
import Network.HTTP.Types (statusOK, status404)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Char8 (unpack)
import Data.ByteString.Lazy.Char8 (pack)
import qualified Data.Text.Lazy as T
import Data.Text (Text(..))
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Aeson (encode)
import qualified Data.Map as Map
import qualified Database.MongoDB as DB

application dbpipe req = do
  case unpack $ rawPathInfo req of
    "/items" -> itemsJSON dbpipe req
    _ ->  return $ responseLBS status404 [("Content-Type", "text/plain")] "404"

indexPage :: Iteratee B.ByteString IO Response
indexPage = do
  page <- liftIO $ processTemplate "templates/index.html" []
  return $ responseLBS statusOK [("Content-Type", "text/html; charset=utf-8")] page

processTemplate f attrs = do
  page <- L.readFile f
  return page

itemsJSON :: DB.Pipe -> Request -> Iteratee B.ByteString IO Response
itemsJSON dbpipe req = do
  dbresult <- liftIO $  rundb dbpipe $ DB.find (DB.select [] $ tu "table") >>= DB.rest
  let docs = either (const []) id dbresult
--  liftIO $ L.putStrLn $ encode $ show $ map docToMap docs
  return $ responseLBS statusOK [("Content-Type", "text/plain; charset=utf-8")]
    (encode $ map docToMap docs)

docToMap doc = Map.fromList $ map (\f -> (T.dropAround (== '"') $ T.pack $ show $ DB.label f, T.dropAround (== '"') $ T.pack $ show $ DB.value f)) doc


main =  do
  pipe <- DB.runIOE $ DB.connect $ DB.host "127.0.0.1"
  run 3000 $ application pipe

rundb pipe act = DB.access pipe DB.master database act

tu :: B.ByteString -> UString
tu = DB.u . C8.unpack

Then the result is suprprising, DB.label works well, but DB.value giving me native characters as some escape codes, so the result is look like:

curl http://localhost:3000/items gives:

[{"Марка": "\1058\1080\1087 \1087\1086\1076",
  "Model": "BD-W LG BP06LU10 Slim \1058\1080\1087 \1087\1086\1076\1082\1083\1102\1095\1077\1085\1080\1103"},
 ...
]

This happens in case i trying to print data and also in case i return data encoded as JSON
Any idea how correctly extract values from MongoDB driver ?

Answer 1

The following line confirms that aeson’s encoding works properly (using the utf8-string library to read utf8 data off the lazy bytestring back to a haskell string:

> putStrLn $ Data.ByteString.Lazy.UTF8.toString $ encode $ ("\1058\1080\1087 \1087\1086\1076",12)
["Тип под",12]

Looking at your code more closely I see the real problem. You’re calling T.pack $ show $ DB.value — this will render out as literal codepoints, and then pack those into a text object. The fix is to switch from show to something smarter. Look at this (untested)

smartShow :: DB.Value -> Text
smartShow (String s) = Data.Text.Encoding.decodeUtf8 $ Data.CompactString.UTF8.toByteString s
smartShow x = T.pack $ show x

Obviously to handle the recursive cases, etc. you need to be smarter than that, but that’s the general notion…

In fact, the “best” thing to do is to write a function of BSON -> JSON directly, rather than go through any intermediate structures at all.