在类型级别捕获 json 树结构

Question

我正在实施Fibre 协议。协议的工作方式是您收到一个 json 对象，该对象代表您可以对远程对象执行的操作和值。下面是这样一个 json 的示例。

{
  "name": "properties",
  "type": "object",
  "members": [
    {
      "name": "foo",
      "id": 1,
      "type": "uint32",
      "access": "rw"
    },
    {
      "name": "bar",
      "id": 2,
      "type": "uint32[]",
      "access": "r"
    },
    {
      "name": "bar",
      "type": "object",
      "members": [
        {
          "name": "baz",
          "id": 3,
          "type": "float",
          "access": "rw"
        },
        {
          "name": "some_function",
          "id": 4,
          "type": "function",
          "inputs": [
            {
              "name": "param1",
              "id": 5,
              "type": "float",
              "access": "rw"
            },
            {
              "name": "param2",
              "id": 6,
              "type": "bool",
              "access": "rw"
            }
          ],
          "outputs": [
            {
              "name": "result",
              "id": 7,
              "type": "bool",
              "access": "rw"
            }
          ]
        }
      ]
    }
  ]
}

可以看出，它本质上是一棵树，具有某些类型的属性和功能。有些属性只能读取，访问权限为r，有些属性可以读取/写入，访问权限为rw。通过一些数据定义，在 Haskell 中捕获这种结构很简单：

data FibreType
   = FibreInt8  | FibreUInt8
   | FibreInt16 | FibreUInt16
   | FibreInt32 | FibreUInt32
   | FibreInt64 | FibreUInt64
   | FibreFloat
   | FibreBool
   | FibreJSON
   | FibreList FibreType
  deriving (Show, Eq, Ord)

data FibreAccess = FibreReadable | FibreReadWriteable
  deriving (Show, Eq, Ord)

data FibreObject
   = FibreValue
       { _fibreValueName     :: String
       , _fibreValueEndpoint :: Word16
       , _fibreValueType     :: FibreType
       , _fibreValueAccess   :: FibreAccess
       }
   | FibreFunction
       { _fibreFunctionName     :: String
       , _fibreFunctionEndpoint :: Word16
       , _fibreFunctionArgs     :: [FibreType]
       , _fibreFunctionResult   :: [FibreType]
       }
   | FibreObject
       { _fibreObjectName    :: String
       , _fibreObjectMembers :: [FibreObject]
       }
  deriving (Show, Eq, Ord)

getProperty :: FibreObject -> IO ByteString
getProperty FibreObject{} = error "Cannot get property of FibreObject"
getProperty FibreFunction{} = error "Cannot get property of FibreFunction"
getProperty FibreValue{} = undefined -- Implementation removed for brevity

setProperty :: FibreObject -> ByteString -> IO ByteString
setProperty FibreObject{} = error "Cannot set property of FibreObject"
setProperty FibreFunction{} = error "Cannot set property of FibreFunction"
setProperty FibreValue{_fibreValueAccess = FibreReadWriteable} = undefined -- Implementation removed for brevit
setProperty FibreValue{} = error "Cannot set property of read-only FibreValue" 

callFunction :: FibreObject -> [ByteString] -> IO [ByteString]
callFunction FibreObject{} _ = error "Cannot call function for FibreObject"
callFunction FibreValue{} _ = error "Cannot call function for FibreObject"
callFunction FibreFunction{} args = undefined -- Implementation removed for brevit

但是我真的不喜欢这样，一旦我创建了函数 getProperty 或 callFunction 我就失去了所有类型安全性，我基本上必须通过使所有输入和输出 ByteString 来解决这个问题（或者我可以定义sum 类型），然后反序列化为某些具体值。所以我想知道是否有可能将此结构提升到类型级别，即使该 json 定义仅在运行时可用。

目标是我能写出这样的东西：

getProperty :: FibreValue type access -> IO type
getProperty FibreValue{} = undefined -- Implementation removed for brevity

setProperty :: FibreValue type FibreReadWriteable -> IO () 
setProperty FibreValue{} = undefined

callFunction :: FibreFunction [argTys] [resTys] -> argTys -> IO [resTys]
callFunction FibreValueFunction args = undefined -- Implementation removed for brevity

这将提供完整的类型安全性，而不必匹配实际上只能是单个值的结果类型。我发布了我为callFunction 给出的函数定义存在问题，但它更能说明这一点。

这在 Haskell 中可行吗？任何帮助表示赞赏。

Answer 1

一种可能的 API 设计是

data SFibreAccess :: FibreAccess -> Type where
    SFibreReadable :: SFibreAccess FibreReadable 
    SFibreReadWriteable :: SFibreAccess FibreReadWriteable
-- contructors (and record fields) should be hidden
data FibreValue s a
   = FibreValue
       { fibreValueName     :: String
       , fibreValueEndpoint :: Word16
       , fibreValueType     :: FibreType
       , fibreValueAccess   :: SFibreAccess a
       }
data FibreFunction s
   = FibreFunction
       { fibreFunctionName     :: String
       , fibreFunctionEndpoint :: Word16
       , fibreFunctionArgs     :: [FibreType]
       , fibreFunctionResult   :: [FibreType]
       }
data FibreObject s
   = FibreObject
       { fibreObjectName    :: String
       , fibreObjectMembers :: [FibreSpec s]
       }
data FibreSpec s
   = forall a. FibreSpecValue (FibreValue s a)
   | FibreSpecFunction (FibreFunction s)
   | FibreSpecObject (FibreObject s)

data FibreAPI s
   = FibreAPI
       { fibreAPISpec :: FibreSpec s
       , fibreAPIGet :: FibreValue s a -> IO ByteString
       , fibreAPISet :: FibreValue s FibreReadWriteable -> ByteString -> IO ByteString
       , fibreAPICall :: FibreFunction s -> [ByteString] -> IO [ByteString] -- further type safety for function calls possible but tedious and not done here
       }

-- internal
data SomeFibreSpec = forall s. SomeFibreSpec (FibreSpec s)
getAndParseFibreSpec :: URL -> IO SomeFibreSpec
-- exposed
withFibreAPI :: URL -> (forall s. FibreAPI s -> r) -> IO r
withFibreAPI url cont = do
    SomeFibreSpec spec <- getAndParseFibreSpec url
    return $ cont FibreAPI
        { fibreAPISpec = spec
        , fibreAPIGet = \_ -> throwIO $ userError "unimplemented"
        , fibreAPISet = \_ -> throwIO $ userError "unimplemented"
        , fibreAPICall = \_ -> throwIO $ userError "unimplemented"
        }

FibreSpec 的幻像参数意味着，在调用/在withFibreAPI 的延续中，get、set 和 call 函数的参数保证来自将 fibreAPISpec 对象分开。 （构造函数和记录字段是不可触及的，并且将 FibreAPIs 与对 withFibreAPI 的不同调用混合在一起是一种类型错误。）这可以防止突然创建 FibreValue 或 FibreFunction 并期望函数正常工作。 FibreValues 也带有他们的访问控制标签。检查传递给 fibreAPISet 的属性是否可以访问仍然需要由 someone 完成（您可以通过获取 fibreValueAccess 和 caseing 来完成），但是现在，一旦您检查它一次（并获得证据a ~ FibreReadWriteable）每个电话都会让你通过，而不是反复给你Maybe或其他什么。

编辑：使函数类型安全：

data SFibreType :: FibreType -> Type where
    SFibreInt8 :: SFibreType FibreInt8
    -- etc.
    -- if it isn't obvious
    SFibreList :: SFibreType a -> SFibreType (FibreList a)
-- other names: HList, Product, HMapList, etc.
-- SList is really only correct for the combined type SList s where s is a singleton family, but whatever
data SList :: (a -> Type) -> [a] -> Type where
    SNil :: SList s '[]
    SCons :: s x -> SList s xs -> SList s (x : xs)
-- replace FibreFunction, FibreSpec
data FibreFunction s args ress
   = FibreFunction
   { fibreFunctionName     :: String
   , fibreFunctionEndpoint :: Word16
   , fibreFunctionArgs     :: SList SFibreType args
   , fibreFunctionResult   :: SList SFibreType ress
   }
data FibreSpec s =
   = forall a. FibreSpecValue (FibreValue s a)
   | forall args ress. FibreSpecFunction (FibreFunction s args res)
   | FibreSpecObject (FibreObject s)

data family ValueOf (t :: FibreType) :: Type
newtype instance ValueOf FibreInt8 = MkInt8 { getInt8 :: Int8 }
-- etc.

-- modify FibreAPI
data FibreAPI s
   = FibreAPI
       { fibreAPISpec :: FibreSpec s
       , fibreAPIGet :: FibreValue s a -> IO ByteString
       , fibreAPISet :: FibreValue s FibreReadWriteable -> ByteString -> IO ByteString
       , fibreAPICall ::
            forall args ress.
            FibreFunction s args ress ->
            SList ValueOf argss ->
            IO (SList ValueOf ress)
       }

获取属性的类型安全性类似：将FibreType 放入规范部分类型的参数中，将SFibreType 放入实际值中以代替FibreType，将存在性放入FibreSpec 并放入FibreAPI 中的普遍性。