将从命令行参数派生的真值表转换为数据类型

Question

我的问题源于真实世界的代码比下面的示例(由几个模拟函数组成)复杂得多。这个例子应该说明我的问题产生的现象:(要么)case/of语句中的一个巨大的表(或嵌套的if的巨大级联)。case/of语句包含类似于真值表的东西，它决定如何参数化结果记录的类型(称为ComposedRecord，因为它是由三个泛型记录组成)。模拟函数已经实现，但我对巨大的case/of块不满意。因此，我试图找到一个更简洁的解决方案:

-- intermediate record type 1
data SimpleRecord = SimpleRecord {
_description :: String
}
-- intermediate record type 2
data DetailedRecord = DetailedRecord {
_title :: String,
_details :: String
}
-- intermediate record type 3
data RawRecord = RawRecord {
_x :: Int,
_y :: Int,
_z :: Int
}
class AnyRecord r where
instance AnyRecord SimpleRecord
instance AnyRecord DetailedRecord
instance AnyRecord RawRecord
-- to-be-serialized record type (composed of intermediate record types 1, 2 or 3)
data ComposedRecord a b c = ComposedRecord {
_a :: a,
_b :: b,
_c :: c
}
inputToSimpleRecord :: String -> SimpleRecord
inputToSimpleRecord input = SimpleRecord {
_description = "description derived from input"
}
inputToDetailedRecord :: String -> DetailedRecord
inputToDetailedRecord input = DetailedRecord {
_title = "title derived from input",
_details = "details derived from input"
}
inputToRawRecord :: String -> RawRecord
inputToRawRecord input = RawRecord {
_x = 1, -- number derived from input string
_y = 2, -- number derived from input string
_z = 3  -- number derived from input string
}
serializeToJsonString :: (AnyRecord a, AnyRecord b, AnyRecord c) => ComposedRecord a b c -> String
serializeToJsonString composedRecord = "{}"
-- this function will also contain some post processing of the records
-- thus the "AnyRecord" type constraint is needed
commandLineArguments = ["simple", "detailed", "raw"]
-- the value of commandLineArguments will be read from the command line
inputFromCommandLine = "1, 2, 3" -- some input
main = do
let result = case commandLineArguments of
["simple", "simple", "simple"] -> serializeToJsonString ComposedRecord {
_a = inputToSimpleRecord inputFromCommandLine,
_b = inputToSimpleRecord inputFromCommandLine,
_c = inputToSimpleRecord inputFromCommandLine
}
["simple", "simple", "detailed"] -> serializeToJsonString ComposedRecord {
_a = inputToSimpleRecord inputFromCommandLine,
_b = inputToSimpleRecord inputFromCommandLine,
_c = inputToDetailedRecord inputFromCommandLine
}
["simple", "simple", "raw"] -> serializeToJsonString ComposedRecord {
_a = inputToSimpleRecord inputFromCommandLine,
_b = inputToSimpleRecord inputFromCommandLine,
_c = inputToRawRecord inputFromCommandLine
}
["simple", "detailed", "simple"] -> serializeToJsonString ComposedRecord {
_a = inputToSimpleRecord inputFromCommandLine,
_b = inputToDetailedRecord inputFromCommandLine,
_c = inputToSimpleRecord inputFromCommandLine
}
["simple", "detailed", "detailed"] -> serializeToJsonString ComposedRecord {
_a = inputToSimpleRecord inputFromCommandLine,
_b = inputToDetailedRecord inputFromCommandLine,
_c = inputToDetailedRecord inputFromCommandLine
}
["simple", "detailed", "raw"] -> serializeToJsonString ComposedRecord {
_a = inputToSimpleRecord inputFromCommandLine,
_b = inputToDetailedRecord inputFromCommandLine,
_c = inputToRawRecord inputFromCommandLine
}
["simple", "raw", "raw"] -> serializeToJsonString ComposedRecord {
_a = inputToSimpleRecord inputFromCommandLine,
_b = inputToRawRecord inputFromCommandLine,
_c = inputToRawRecord inputFromCommandLine
}
["detailed", "simple", "simple"] -> serializeToJsonString ComposedRecord {
_a = inputToDetailedRecord inputFromCommandLine,
_b = inputToSimpleRecord inputFromCommandLine,
_c = inputToSimpleRecord inputFromCommandLine
}
-- and so on...
putStrLn result

Answer 1

对我来说，这里的关键元素是serializeToJsonString的类型。该函数不显式地关心使用哪个Record，只要它是AnyRecord即可。考虑到这一点，您可以使用ExistentialQuantification来封装该想法。考虑以下内容:

data AnyRecordData = forall r. AnyRecord r => AnyRecordData r
data ComposedRecord = ComposedRecord {
_a :: AnyRecordData,
_b :: AnyRecordData,
_c :: AnyRecordData
}

inputToAnyRecord :: String -> String -> AnyRecordData
inputToAnyRecord "simple"   = AnyRecordData . inputToSimpleRecord
inputToAnyRecord "detailed" = AnyRecordData . inputToDetailedRecord
inputToAnyRecord "raw"      = AnyRecordData . inputToRawRecord
main = do
let result = case commandLineArguments of
[a,b,c] -> serializeToJsonString ComposedRecord {
_a = inputToAnyRecord a inputFromCommandLine
, _b = inputToAnyRecord b inputFromCommandLine
, _c = inputToAnyRecord c inputFromCommandLine
}
putStrLn result

Answer 2

ComposedRecord本质上是一个异构列表类型。这就是我的处理方法:

{-# LANGUAGE DataKinds #-}
import Data.HList.HList
type ComposedRecord a b c = HList '[a,b,c]

现在您可以开始对这个容器进行递归思考了，尽管需要一个catch，因为在递归过程中类型发生了变化。

class CRecSerialisable r where
serializeToJsonString :: r -> String
instance CRecSerialisable (HList '[])
instance (AnyRecord h, CRecSerialisable (HList t))
=> CRecSerialisable (HList (h ': t))
-- ▲ at this point enable any extensions the compiler demands...
serializeToJsStr_cmdDep :: [String] -> String
serializeToJsStr_cmdDep = go HNil
where go :: CRecSerialisable acc => acc -> [String] -> String
go cRec [] = serializeToJsonString cRec
go cRec ("simple" : cmdArgs)
= go (HCons (inputToSimpleRecord inputFromCommandLine) cRec)
cmdArgs
go cRec ("detailed" : cmdArgs)
= ...