如何使用Haskell将XML读取为对象并写入MySQL数据库

我来帮你一步步搞定这个需求——用HXT解析XML文件，再通过HDBC把数据存入MySQL。下面是完整的实现方案，涵盖从依赖准备到整合运行的全流程：

1. 准备依赖 #

首先确保你的项目包含所需库，比如在stack.yaml中添加：

extra-deps:
  - hxt-9.3.1.22
  - HDBC-2.4.0.3
  - HDBC-mysql-0.7.1.0

或者在cabal文件的build-depends里加入：

base >= 4.14 && < 5,
hxt,
HDBC,
HDBC-mysql,
bytestring,
text

2. 定义对应的数据类型 #

先写好和数据库表结构匹配的Haskell数据类型：

data Group = Group
  { groupNo :: String
  , groupName :: String
  , members :: [Member]
  } deriving (Show)

data Member = Member
  { memberNo :: String
  , memberName :: String
  } deriving (Show)

3. 用HXT解析XML文件 #

HXT基于箭头（Arrow）处理XML，我们写一个解析器从文件读取Group列表：

import Text.XML.HXT.Core

parseGroups :: FilePath -> IO [Group]
parseGroups filePath = do
  runX (readDocument [withValidate no, withRemoveWS yes] filePath >>> getGroups)
  where
    getGroups = multi (hasName "Group" >>> parseGroup)
    parseGroup = do
      gNo <- getText $ hasName "Group_No"
      gName <- getText $ hasName "Group_Name"
      mems <- multi (hasName "Member" >>> parseMember)
      return $ Group gNo gName mems
    parseMember = do
      mNo <- getText $ hasName "Member_No"
      mName <- getText $ hasName "Member_Name"
      return $ Member mNo mName
    getText selector = selector >>> getChildren >>> getText

这里关闭了XML验证并移除空白节点，让解析更顺畅；multi用来处理多个同类型节点（比如多个Group或Member）。

4. 用HDBC操作MySQL数据库 #

接下来实现数据库连接和数据插入逻辑：

4.1 建立数据库连接 #

import Database.HDBC
import Database.HDBC.MySQL

connectDB :: IO Connection
connectDB = connectMySQL MySQLConnectInfo
  { mysqlHost = "localhost"
  , mysqlPort = 3306
  , mysqlDatabase = "group_member_db"
  , mysqlUser = "your_username"  -- 替换成你的数据库用户名
  , mysqlPassword = "your_password"  -- 替换成你的数据库密码
  , mysqlUnixSocket = ""
  }

4.2 插入Group并获取自增ID #

因为Group表的Group ID是自增主键，插入后需要获取这个ID来关联Member：

insertGroup :: Connection -> Group -> IO Int
insertGroup conn group = do
  stmt <- prepare conn "INSERT INTO `Group` (Group_No, Group_Name) VALUES (?, ?)"
  execute stmt [toSql (groupNo group), toSql (groupName group)]
  commit conn
  -- 获取刚插入的自增Group ID
  [Only groupId] <- quickQuery' conn "SELECT 848013" []
  return $ fromSql groupId

4.3 插入Member（关联Group） #

这里要注意：你的数据库结构里Member表缺少关联Group的外键字段，建议先给Member表添加Group_ID（Int类型，外键关联Group表的Group ID），否则无法标记Member所属的Group。添加后插入逻辑如下：

insertMember :: Connection -> Int -> Member -> IO ()
insertMember conn groupId member = do
  stmt <- prepare conn "INSERT INTO Member (Member_No, Member_Name, Group_ID) VALUES (?, ?, ?)"
  execute stmt [toSql (memberNo member), toSql (memberName member), toSql groupId]
  commit conn

5. 整合流程：批量处理XML并插入数据库 #

最后写主函数，遍历指定路径下的所有XML文件，解析后批量插入数据库：

import System.Directory (listDirectory)
import System.FilePath ((</>))

processXMLFiles :: FilePath -> IO ()
processXMLFiles dirPath = do
  conn <- connectDB
  files <- listDirectory dirPath
  let xmlFiles = filter (\f -> takeExtension f == ".xml") files
  mapM_ (processFile conn dirPath) xmlFiles
  disconnect conn
  where
    processFile conn dir filePath = do
      let fullPath = dir </> filePath
      putStrLn $ "Processing file: " ++ fullPath
      groups <- parseGroups fullPath
      mapM_ (insertGroupWithMembers conn) groups
    insertGroupWithMembers conn group = do
      groupId <- insertGroup conn group
      mapM_ (insertMember conn groupId) (members group)
      putStrLn $ "Inserted group '" ++ groupName group ++ "' with " ++ show (length $ members group) ++ " members"

main :: IO ()
main = processXMLFiles "/path/to/your/xml/files"  -- 替换成你的XML文件存放路径

额外提示 #

• 确保MySQL服务正常运行，且你拥有目标数据库的读写权限
• 生产环境建议添加错误处理（比如用Either或ExceptT捕获解析/数据库异常）
• 可以用withTransaction把单个Group的插入操作包裹成事务，保证原子性（要么全成功，要么全回滚）

内容的提问来源于stack exchange，提问作者harshainfo