映射到字符串
我是Haskell的新手，所以也许我在这里错过了一些基本概念（或者可能找不到合适的扩展名）。 我想知道是否有一种方法来优化或进一步提取以下方案。 这段代码看起来非常冗余。
假设我有以下数据类：
data Person = Person
{ personName :: !String
, personAge :: !Int
} deriving Show
data Dog = Dog
{ dogName :: !String
, dogAge :: !Int
} deriving Show
比方说，我有一个服务，我只关心输出记录作为字符串。 实际上，这些字符串可能是JSON和从DB中获取的记录，但让我们来看一个更简单的情况。 我基本上需要一个URL标记来获取适当的对象（比如，“dog”字符串会给我一个Dog，甚至只是Haskell“show”字符串，而不会明确声明它为（value）:: Dog）。
我试图用几种方法来实现它......似乎工作的唯一一件事是：
data Creature = DogC Dog
| PersonC Person
deriving Show
fromString :: String -> Maybe Creature
fromString "dog" = Just $ DogC $ Dog "muffin" 8
fromString "person" = Just $ PersonC $ Person "John" 22
fromString _ = Nothing
main :: IO ()
main = do
putStrLn $ show $ fromString "dog"
我并不完全喜欢新类型，也不喜欢fromString声明的列表。 为了从原始数据声明中受益，我可能需要编写一个类似繁琐的表达式（例如“fromCreature”）来将Creature恢复为我的原始类型。 这些信息可能会改变，所以我可能需要TH来做一些声明......
有没有解决这个问题的方法？ 我摆弄GADT和类，但都似乎依赖于类型而不是基于值的多态（字符串标识符往往会导致模糊实例的问题）。 将构造函数映射到一个字符串（用Data.Map说）会很好，但构造函数通常有不同的类型。
更新
所以，我采取了一种与我所问的问题不完全相关的方法，但这对某个人可能有用。 我确实想保留一些记录类型，但大多数并没有增加太多价值，并且正在阻碍我。 我遵循的步骤如下所示：
toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue}如果需要，未标记的值应允许将JSON读入定义的数据类型（例如，Dog / Person）。 toJsPairs :: [ColumnDef] -> [SqlValue] -> [(Text,Value)] 代码看起来有点像这样（使用mysql-haskell）。
{-# LANGUAGE OverloadedStrings #-}
import qualified Control.Applicative as App
import Database.MySQL.Base
import qualified System.IO.Streams as Streams
import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Aeson.Types
import Data.Text.Encoding
import Data.String (fromString)
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy.Internal as BLI
import Data.HashMap.Strict (fromList)
appConnectInfo = defaultConnectInfo {
ciUser = "some_user"
, ciPassword = "some_password"
, ciDatabase = "some_db"
}
instance FromJSON ByteString where
parseJSON (String s) = pure $ encodeUtf8 s
parseJSON _ = App.empty
instance ToJSON ByteString where
toJSON = String . decodeUtf8
instance ToJSON MySQLValue where
toJSON (MySQLNull) = Null
toJSON x = genericToJSON defaultOptions
{ sumEncoding = UntaggedValue } x
-- This expression should fail on dimensional mismatch.
-- It's stupidly lenient, but really dimensional mismatch should
-- never occur...
toJsPairs :: [ColumnDef] -> [MySQLValue] -> [(Text,Value)]
toJsPairs [] _ = []
toJsPairs _ [] = []
toJsPairs (x:xs) (y:ys) = (txt x, toJSON y):toJsPairs xs ys
where
-- Implement any modifications to the key names here
txt = decodeUtf8.columnName
listRecords :: String -> IO BLI.ByteString
listRecords tbl = do
conn <- connect appConnectInfo
-- This is clearly an injection vulnerability.
-- Implemented, however, the values for 'tbl' are intensely
-- vetted. This is just an example.
(defs, is) <- query_ conn $ fromString ( "SELECT * FROM `" ++ tbl ++ "` LIMIT 100")
rcrds <- Streams.toList is
return $ encodePretty $ map (jsnobj defs) rcrds
where
jsnobj :: [ColumnDef] -> [MySQLValue] -> Value
jsnobj defs x = Object $ fromList $ toJsPairs defs x
如果最后想要使用的是json值 - 使用aeson库将结果表示为json值可能是有意义的：
{-# LANGUAGE DeriveGeneric #-}
import Data.Aeson
import GHC.Generics
data Dog = Dog Int String deriving (Show, Generic)
data Cat = Cat Int String deriving (Show, Generic)
-- here I'm using instance derived with generics, but you can write one by
-- hands
instance ToJSON Dog
instance ToJSON Cat
-- actions to get stuff from db
getDog :: Monad m => Int -> m Dog
getDog i = return (Dog i (show i))
getCat :: Monad m => Int -> m Cat
getCat i = return (Cat i (show i))
-- dispatcher - picks which action to use
getAnimal :: Monad m => String -> Int -> m (Maybe Value)
getAnimal "dog" i = Just . toJSON <$> getDog i
getAnimal "cat" i = Just . toJSON <$> getCat i
getAnimal _ _ = return Nothing
main :: IO ()
main = do
getAnimal "dog" 2 >>= print
getAnimal "cat" 3 >>= print
getAnimal "chupakabra" 12 >>= print
高能魔法版本
class Monad m => MonadAnimal m where
-- basically you want something that fetches extra argumets from HTTP or
-- whatevere, perform DB query and so on.
class Animal a where
animalName :: Proxy a -> String
animalGetter :: MonadAnimal m => m a
locateAnimals :: MonadAnimal m => Q [(String, m Value)]
locateAnimals -- implement using TH (reify function is your friend). It should look for
-- all the animal instances in scope and make a list from them with serialized
-- fetcher.
-- with that in place dispatcher should be easy to implement
上一篇: Mapping to String