ハスケル型多態性 - 文字列へのマッピング

Question

私はハスケルを新しくしていますので、ここでいくつかの基本的な概念が欠けているかもしれません（または適切な拡張子が見つからない可能性があります）。次のシナリオを最適化したり、さらに抽象化する方法があるかどうかは疑問でした。このコードは非常に冗長なようです。

のは、私は、次のデータクラスを持っているとしましょう：

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

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

はのは、私がサービスを持っていると私は文字列としてレコードをoutputingを持つ唯一の心配としましょう。実際には、文字列はおそらくJSONであり、レコードはDBからフェッチされますが、単純なケースを考えてみましょう。私は基本的に適切なオブジェクトをフェッチするためにURLトークンを必要とします（例えば、 "dog"という文字列は、（value）:: Dogとして明示的に宣言することなく、Dogを取得するか、単にHaskell "show"

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」）を書いて、元のタイプに戻すことが必要になるでしょう。この情報は変更される可能性がありますので、宣言のいくつかにTHが必要なのかもしれません...

いくつかの方法がありますか？私はGADTとクラスを使いこなしましたが、どちらも価値ベースの多型よりも型に依存しているようです（文字列識別子はあいまいなインスタンスで問題を引き起こす傾向があります）。コンストラクタを文字列（Say、Data.Map）にマップすると良いでしょうが、コンストラクタにはさまざまな種類があることがよくあります。

更新

だから、私は私が求めていたの質問に正確に関連していないアプローチで行きましたが、それは誰にも有用です。私はいくつかのレコードタイプを維持したいと思っていましたが、大部分は価値を追加せず、私の方法でやっていました。 （... [ColumnDef]例えば、および[[SQLValue]]の代わりにタプルとレコード）

• 実行可能なタイプを返す異なる/低レベルDBドライバを使用します：私は続いていた手順は次のようなものを行ってきました。
• SQLValueのToJSONインスタンスを作成する - ほとんどの型はByteString型を除いてカバーされており、SQLNullからNullへの変換を処理する必要がありました。いくつかのレコードタイプとの互換性を維持するために、私のデフォルトのハンドラは次のようになります：toJSON = genericToJSON defaultOptions { sumEncoding = UnTaggedValue}タグなしの値は、必要に応じてJSONを定義されたデータ型（Dog/Personなど）に読み込むことができます。 ColumnDefからアクセスできるように、[ColumnDef]と[SqlValue]をAeson互換のキーと値のペアのリストにzipする式を書きました。例：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