使用path包实现带类型安全路径的记录读写方案咨询

针对你在记录中读写Path a b类型时需要手动管理类型信息（Rel/Abs、File/Dir）易出错的问题，以下是几种可行的解决方案：

1. 自定义带类型标记的序列化格式（以JSON为例） #

将路径字符串与对应的类型标识（如AbsFile、RelDir）绑定存储，读取时根据标识自动调用对应解析函数，避免手动类型匹配。

实现步骤： #

首先定义路径类型标签，用于序列化时标记路径类型：

{-# LANGUAGE DeriveGeneric #-}

import Path
import Data.Aeson
import GHC.Generics

data PathType = AbsFile | AbsDir | RelFile | RelDir
  deriving (Show, Eq, Generic, ToJSON, FromJSON)

-- 根据Path实例推导对应的类型标签
pathType :: Path a b -> PathType
pathType p = case (isAbs p, isFile p) of
  (True, True)  -> AbsFile
  (True, False) -> AbsDir
  (False, True) -> RelFile
  (False, False) -> RelDir

然后为具体的Path类型编写JSON实例，以Path Abs File和Path Rel Dir为例：

instance ToJSON (Path Abs File) where
  toJSON p = object [ "type" .= pathType p, "path" .= toFilePath p ]

instance FromJSON (Path Abs File) where
  parseJSON v = do
    obj <- parseJSON v
    typ <- obj .: "type"
    pathStr <- obj .: "path"
    if typ == AbsFile
      then parseAbsFile pathStr
      else fail "Expected AbsFile type"

instance ToJSON (Path Rel Dir) where
  toJSON p = object [ "type" .= pathType p, "path" .= toFilePath p ]

instance FromJSON (Path Rel Dir) where
  parseJSON v = do
    obj <- parseJSON v
    typ <- obj .: "type"
    pathStr <- obj .: "path"
    if typ == RelDir
      then parseRelDir pathStr
      else fail "Expected RelDir type"

之后包含Path类型的记录即可直接生成JSON实例：

data AppRecord = AppRecord
  { configPath :: Path Abs File
  , dataDir    :: Path Rel Dir
  } deriving (Show, Generic, ToJSON, FromJSON)

2. 用Template Haskell自动生成实例 #

如果记录中包含多种Path类型，手动编写实例会重复冗余，可通过Template Haskell自动生成序列化/反序列化实例。

实现代码： #

{-# LANGUAGE TemplateHaskell #-}

import Language.Haskell.TH
import Path
import Data.Aeson
import Data.Maybe (fromMaybe)

-- 定义路径类型标签（同方案1）
data PathType = AbsFile | AbsDir | RelFile | RelDir
  deriving (Show, Eq, Generic, ToJSON, FromJSON)

pathType :: Path a b -> PathType
pathType p = case (isAbs p, isFile p) of
  (True, True)  -> AbsFile
  (True, False) -> AbsDir
  (False, True) -> RelFile
  (False, False) -> RelDir

-- 自动推导Path类型的JSON实例
derivePathJSON :: Q Type -> Q [Dec]
derivePathJSON pathType' = do
  -- 解析传入的Path类型（如Path Abs File）
  (ConT ''Path `AppT` a `AppT` b) <- pathType'
  let 
    -- 根据类型构造对应的PathType匹配逻辑
    parseCase = case (a, b) of
      (ConT ''Abs, ConT ''File) -> match (litP (StringL "AbsFile")) (normalB [| parseAbsFile pathStr |]) []
      (ConT ''Abs, ConT ''Dir)  -> match (litP (StringL "AbsDir")) (normalB [| parseAbsDir pathStr |]) []
      (ConT ''Rel, ConT ''File) -> match (litP (StringL "RelFile")) (normalB [| parseRelFile pathStr |]) []
      (ConT ''Rel, ConT ''Dir)  -> match (litP (StringL "RelDir")) (normalB [| parseRelDir pathStr |]) []
      _ -> match wildP (normalB [| fail "Unsupported Path type" |]) []

  -- 生成ToJSON实例
  toInst <- instanceD
    (cxt [])
    (appT (conT ''ToJSON) pathType')
    [funD 'toJSON [clause [varP 'p] (normalB [| object ["type" .= pathType p, "path" .= toFilePath p] |]) []]]

  -- 生成FromJSON实例
  fromInst <- instanceD
    (cxt [])
    (appT (conT ''FromJSON) pathType')
    [funD 'parseJSON [clause [varP 'v] (normalB [| do
      obj <- parseJSON v
      typ <- obj .: "type"
      pathStr <- obj .: "path"
      case typ of { $(caseE (varE 'typ) [parseCase]) }
    |]) []]]

  return [toInst, fromInst]

使用方式： #

在代码中为需要的Path类型生成实例，再定义记录：

-- 为两种Path类型自动生成JSON实例
derivePathJSON [t| Path Abs File |]
derivePathJSON [t| Path Rel Dir |]

data AppRecord = AppRecord
  { configPath :: Path Abs File
  , dataDir    :: Path Rel Dir
  } deriving (Show, Generic, ToJSON, FromJSON)

3. 结合Binary与Typeable实现二进制序列化 #

如果不需要可读的文本格式，可使用binary库结合Typeable自动序列化类型信息与路径数据，无需手动管理类型标签。

实现代码： #

{-# LANGUAGE FlexibleInstances #-}

import Data.Binary
import Path
import Data.Typeable
import Data.Proxy (Proxy(..))

instance (Typeable a, Typeable b, Parseable a, Parseable b) => Binary (Path a b) where
  put p = do
    -- 写入路径的类型信息（Abs/Rel、File/Dir）
    put (typeRep (Proxy :: Proxy a))
    put (typeRep (Proxy :: Proxy b))
    -- 写入路径字符串
    put (toFilePath p)

  get = do
    aType <- get
    bType <- get
    pathStr <- get
    -- 根据读取的类型信息调用对应解析函数
    case (eqTypeRep aType (typeRep (Proxy :: Proxy Abs)), eqTypeRep aType (typeRep (Proxy :: Proxy Rel))) of
      (True, False) -> case (eqTypeRep bType (typeRep (Proxy :: Proxy File)), eqTypeRep bType (typeRep (Proxy :: Proxy Dir))) of
        (True, False) -> parseAbsFile pathStr
        (False, True) -> parseAbsDir pathStr
        _ -> fail "Invalid file/dir type for absolute path"
      (False, True) -> case (eqTypeRep bType (typeRep (Proxy :: Proxy File)), eqTypeRep bType (typeRep (Proxy :: Proxy Dir))) of
        (True, False) -> parseRelFile pathStr
        (False, True) -> parseRelDir pathStr
        _ -> fail "Invalid file/dir type for relative path"
      _ -> fail "Invalid absolute/relative path type"

使用方式： #

包含Path类型的记录只需派生Binary实例即可：

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics

data AppRecord = AppRecord
  { configPath :: Path Abs File
  , dataDir    :: Path Rel Dir
  } deriving (Show, Generic, Binary)

方案对比 #

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