Haskell類型多態 - 映射到字符串

Question

我是Haskell的新手，所以也許我錯過了一些基本概念（或者可能找不到合適的擴展名）。我想知道是否有一種方法來優化或進一步提取以下方案。這段代碼看起來非常冗餘。

比方說，我有以下數據類：

data Person = Person 
       { personName :: !String 
       , personAge :: !Int 
       } deriving Show 

data Dog = Dog 
      { dogName :: !String 
      , dogAge :: !Int 
      } deriving Show 

比方說，我有一個服務，我只關心outputing記錄爲字符串。實際上，這些字符串可能是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說）會很好，但構造函數通常有不同的類型。

更新

於是，我又用了一種方法，是不是我問的問題正是有關，但它可能是有用的人。我確實想保留一些記錄類型，但大多數並沒有增加太多價值，並且正在阻礙我。我已經按照步驟去是這樣的：

• 使用不同的/低強度DB驅動程序，返回可行的類型（例如，[ColumnDef]和[SQLValue]，而不是元組和記錄...） 。
• 爲SQLValue創建ToJSON實例 - 除了少數ByteString類型之外，大多數類型都被覆蓋了，我必須處理SQLNull到Null的轉換。爲了保持與某些記錄類型的兼容性，我的默認處理程序如下所示：toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue}如果需要，未標記的值應允許將JSON讀入定義的數據類型（例如，Dog/Person）....
• 鑑於列名是可以從ColumnDef訪問，我寫了一個表達式，將[ColumnDef]和[SqlValue]拉到與Aeson兼容的鍵值對的列表中，例如：toJsPairs :: [ColumnDef] -> [SqlValue] -> [(Text,Value)]
• 然後，我寫了一個表達式來從表名中獲取JSON，這或多或少地起到了我的「通用調度員」的作用。它引用了授權表的列表，所以它不像聽起來那麼瘋狂。

代碼看起來有點像這樣（使用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 

Answer 1

如果你想在年底消費什麼是JSON的價值 - 它可能使用埃宋庫是有意義的 代表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