如何在不使用求和类型或副本的情况下创建异构数据类型的列表

Question

用例：跨多个消息服务跟踪用户的应用程序。有一个TwitterAccount数据类型，一个FacebookAccount数据类型等等。这些可以很容易地与一个Account sum-type连接在一起，但层次结构的下一级导致我的问题。

一个TwitterAccount有TwitterPost个列表，FacebookAccount有FacebookPost S，列表等

我的任务：我希望能够把所有的职位在过去10天内所有帐户放入单个列表中，并从中提取常用时间和消息正文字段以供显示。

我没办法：我想，如果每个类的Post实现的类型类像SimplePost曝光功能messageBody和messageTime这可能会解决我的问题，但我不能创建的[SimpleMessage]列表。

我要保持不变，一个TwitterAccount只能包含TwitterPost S，等等，所以我不能使用和类型。我不想创建对象的副本来执行此操作。

这个问题最好，最干净，最Haskell-ish设计是什么？

UPDATE 这不是一个答案，但作为替代由recursion.ninja和埃尔德·佩雷拉我一直在想，如果我可以用幻影类型的满足我的不变量提供了四种解决方案，并Account和Post类型，它包含所有提供者所需的所有可能的信息。然而元组的使用和尴尬的逻辑意味着它不能很好地扩展;也许这应该是一个不同的问题。

{-# LANGUAGE EmptyDataDecls #-} 

-- Some FSharpisms 
(|>) = flip ($) 
(<|) = ($) 
infixr 0 <| 


data Twitter 
data Facebook 
data LinkedIn 

data Post a = Post{ 
    postBody :: String, 
    postDate :: UTCTime, 
    postForwarded :: Bool, 
    postFriendMentions :: [UserName] 
    } deriving (Show, Eq) 

data Account a = Account { 
    accountName :: String, 
    accountPosts :: [Post a] 
    } deriving (Show, Eq) 

data User = User { 
    userName :: String, 
    userTweets :: Account Twitter, 
    userFaces :: Account Facebook, 
    userLinks :: Account LinkedIn 
    } 

prettyShowUtc :: UTCTime -> String 
prettyShowUtc utc = ... 

prettyShow :: Post a -> String 
prettyShow p = prettyShowUtc (postDate p) ++ " : " ++ show (postBody p) 

showOrderedOf2 :: ([Post a], [Post b]) -> [String] 
showOrderedOf2 ([], []) = [] 
showOrderedOf2 (ls, []) = map prettyShow ls 
showOrderedOf2 ([], rs) = map prettyShow rs 
showOrderedOf2 ((l:ls), (r:rs)) = 
    if postDate l < postDate r 
    then prettyShow l : showOrderedOf2 (ls, (r:rs)) 
    else prettyShow r : showOrderedOf2 ((l:ls), rs) 

showOrderedOf3 :: ([Post a], [Post b], [Post c]) -> [String] 
showOrderedOf3 ([], [], []) = [] 
showOrderedOf3 (as, [], []) = map postBody as 
showOrderedOf3 ([], bs, []) = map postBody bs 
showOrderedOf3 ([], [], cs) = map postBody cs 
showOrderedOf3 (as, bs, []) = showOrderedOf2 (as, bs) 
showOrderedOf3 ([], bs, cs) = showOrderedOf2 (bs, cs) 
showOrderedOf3 (as, [], cs) = showOrderedOf2 (as, cs) 
showOrderedOf3 ((a:as), (b:bs), (c:cs)) = 
    let (adate, bdate, cdate) = (postDate a, postDate b, postDate c) 
     minDate = minimum [adate, bdate, cdate] 
    in 
    if adate == minDate 
    then prettyShow a : showOrderedOf3 (as, (b:bs), (c:cs)) 
    else (if bdate == minDate 
     then prettyShow b : showOrderedOf3 ((a:as), bs, (c:cs)) 
     else prettyShow c : showOrderedOf3 ((a:as), (b:bs), cs)) 

createAndShowSample :: IO() 
createAndShowSample = 
    let faceAc = Account {...} :: Account Facebook 
     twitAc = Account {...} :: Account Twitter 
     linkAc = Account {...} :: Account LinkedIn 
    in 
    showOrderedOf3 (accountPosts faceAc, accountPosts twitAc, accountPosts linkAc) 
     |> intercalate "\n" 
     |> putStrLn 

Answer 1

你应该抽象FaceBookAccount和TwitterAccount到SocialMediaAccount

Haskell代码的实例：

import Control.Applicative ((<$>)) 
import Data.List 
import Data.Ord 
import Data.Time 

data FaceBookAccount = FaceBookAccount [FaceBookPost] 
data TwitterAccount = TwitterAccount [TwitterPost] 
data FaceBookPost = FaceBookPost String UTCTime 
data TwitterPost  = TwitterPost String UTCTime 

data SocialMediaAccount 
    = SocialMediaAccount 
    { accountPosts :: [SocialMediaPost] 
    } 
data SocialMediaPost 
    = SocialMediaPost 
    { postBody :: String 
    , postTime :: UTCTime 
    } 

class SocialMedia a where 
    simpleAccount :: a -> SocialMediaAccount 

instance SocialMedia FaceBookAccount where 
    simpleAccount (FaceBookAccount xs) = SocialMediaAccount $ f <$> xs 
    where 
     f (FaceBookPost text time) = SocialMediaPost text time 

instance SocialMedia TwitterAccount where 
    simpleAccount (TwitterAccount xs) = SocialMediaAccount $ f <$> xs 
    where 
     f (TwitterPost text time) = SocialMediaPost text time 

getAllMessages :: (SocialMedia a, SocialMedia b) => a -> b -> [SocialMediaPost] 
getAllMessages xs ys = sortBy (comparing postTime) 
        $ extract xs 
        ++ extract ys 
    where 
    extract :: SocialMedia a => a -> [SocialMediaPost] 
    extract = accountPosts . simpleAccount 

Answer 2

我实现了三种可能的解决方案，可以帮助你决定什么最符合您的要求。

解决方案1：Existential Types

{-# LANGUAGE ExistentialQuantification #-} 

import Data.Time 

data FacebookAccount = FacebookAccount [FacebookPost] 
data TwitterAccount = TwitterAccount [TwitterPost] 

data FacebookPost = FacebookPost String UTCTime 
    deriving Show 
data TwitterPost = TwitterPost String UTCTime 
    deriving Show 

-- Account 

class Account a where 
    posts :: a -> [AnyPost] 

data AnyAccount = forall a . Account a => AnyAccount a 

instance Account AnyAccount where 
    posts (AnyAccount a) = posts a 

instance Account FacebookAccount where 
    posts (FacebookAccount ps) = map AnyPost ps 

instance Account TwitterAccount where 
    posts (TwitterAccount ps) = map AnyPost ps 

-- Post 

class Show p => Post p where 
    text :: p -> String 
    date :: p -> UTCTime 

data AnyPost = forall a . Post a => AnyPost a 

instance Show AnyPost where 
    show (AnyPost p) = show p 

instance Post AnyPost where 
    text (AnyPost p) = text p 
    date (AnyPost p) = date p 

instance Post FacebookPost where 
    text (FacebookPost t _) = t 
    date (FacebookPost _ d) = d 

instance Post TwitterPost where 
    text (TwitterPost t _) = t 
    date (TwitterPost _ d) = d 


allPostsSince :: UTCTime -> [AnyAccount] -> [AnyPost] 
allPostsSince d as = filter (\p -> date p >= d) $ concatMap posts as 

facebook = FacebookAccount 
    [ FacebookPost "Hello" $ UTCTime (fromGregorian 2015 8 14) (secondsToDiffTime 0) 
    , FacebookPost "Olá" $ UTCTime (fromGregorian 2015 8 12) (secondsToDiffTime 0) 
    ] 

twitter = TwitterAccount 
    [ TwitterPost "Bonjour" $ UTCTime (fromGregorian 2015 8 13) (secondsToDiffTime 0) 
    , TwitterPost "Hola" $ UTCTime (fromGregorian 2015 8 10) (secondsToDiffTime 0) 
    ] 

main :: IO() 
main = do today <- getCurrentTime 
      let fiveDays = 5 * 24 * 60 * 60 
       fiveDaysAgo = (-fiveDays) `addUTCTime` today 
       posts = allPostsSince fiveDaysAgo [AnyAccount facebook, AnyAccount twitter] 
      mapM_ print posts 

---

解决方案2：Universal Type

{-# LANGUAGE DeriveDataTypeable #-} 

import Control.Applicative 
import Data.Dynamic 
import Data.Maybe 
import Data.Time 

data FacebookAccount = FacebookAccount [FacebookPost] 
    deriving Typeable 
data TwitterAccount = TwitterAccount [TwitterPost] 
    deriving Typeable 

data FacebookPost = FacebookPost String UTCTime 
    deriving (Show, Typeable) 
data TwitterPost = TwitterPost String UTCTime 
    deriving (Show, Typeable) 

getPosts :: Dynamic -> [Dynamic] 
getPosts dyn = fromJust $ (\ (FacebookAccount ps) -> map toDyn ps) <$> fromDynamic dyn 
         <|> (\ (TwitterAccount ps) -> map toDyn ps) <$> fromDynamic dyn 
         <|> error "Type mismatch" 

getDate :: Dynamic -> UTCTime 
getDate dyn = fromJust $ (\ (FacebookPost _ d) -> d) <$> fromDynamic dyn 
         <|> (\ (TwitterPost _ d) -> d) <$> fromDynamic dyn 
         <|> error "Type mismatch" 

toString :: Dynamic -> String 
toString dyn = fromJust $ (\ p@(FacebookPost _ _) -> show p) <$> fromDynamic dyn 
         <|> (\ p@(TwitterPost _ _) -> show p) <$> fromDynamic dyn 
         <|> error "Type mismatch" 

allPostsSince :: UTCTime -> [Dynamic] -> [Dynamic] 
allPostsSince d as = filter (\p -> getDate p >= d) $ concatMap getPosts as 

facebook = FacebookAccount 
    [ FacebookPost "Hello" $ UTCTime (fromGregorian 2015 8 14) (secondsToDiffTime 0) 
    , FacebookPost "Olá" $ UTCTime (fromGregorian 2015 8 12) (secondsToDiffTime 0) 
    ] 

twitter = TwitterAccount 
    [ TwitterPost "Bonjour" $ UTCTime (fromGregorian 2015 8 13) (secondsToDiffTime 0) 
    , TwitterPost "Hola" $ UTCTime (fromGregorian 2015 8 10) (secondsToDiffTime 0) 
    ] 

main :: IO() 
main = do today <- getCurrentTime 
      let fiveDays = 5 * 24 * 60 * 60 
       fiveDaysAgo = (-fiveDays) `addUTCTime` today 
       posts = allPostsSince fiveDaysAgo [toDyn facebook, toDyn twitter] 
      mapM_ (putStrLn . toString) posts 

---

解决方案3：回到基础

这是一个极简主义的解决方案，甚至不强制一个帐户中的所有帖子都拥有该帐户的类型。

import Data.Time 

data AccountType = Facebook 
       | Twitter 
    deriving Show 

data Account = Account AccountType [Post] 

data Post = Post AccountType String UTCTime 
    deriving Show 

allPostsSince :: UTCTime -> [Account] -> [Post] 
allPostsSince d as = filter (\ (Post _ _ pd) -> pd >= d) $ concatMap (\ (Account _ ps) -> ps) as 

facebook = Account Facebook 
    [ Post Facebook "Hello" $ UTCTime (fromGregorian 2015 8 14) (secondsToDiffTime 0) 
    , Post Facebook "Olá" $ UTCTime (fromGregorian 2015 8 12) (secondsToDiffTime 0) 
    ] 

twitter = Account Twitter 
    [ Post Twitter "Bonjour" $ UTCTime (fromGregorian 2015 8 13) (secondsToDiffTime 0) 
    , Post Twitter "Hola" $ UTCTime (fromGregorian 2015 8 10) (secondsToDiffTime 0) 
    ] 

main :: IO() 
main = do today <- getCurrentTime 
      let fiveDays = 5 * 24 * 60 * 60 
       fiveDaysAgo = (-fiveDays) `addUTCTime` today 
       posts = allPostsSince fiveDaysAgo [facebook, twitter] 
      mapM_ print posts