如何创建具有yesod-persistent的单个列的列表?

时间:2019-11-21 18:09:11

标签: haskell yesod haskell-persistent

鉴于用户,我试图选择与该用户所在的组织相关的事件的列表。UserOrg表描述了哪些OrgId对应于给定的UserId。

我有这些表:

User
    email Text
    name Text
    UniqueUser email
    deriving Typeable
Event
    name Text
    description Text
    dateTime UTCTime
    userId UserId
    orgId OrgId
    deriving Show
Org
    name Text
    description Text
    deriving Show
UserOrg
    userId UserId
    orgId OrgId

目前我正在尝试:

getEventR :: Handler Html
getEventsR = do
    muser <- maybeAuth
    eventList <- runDB $ 
        case muser of
            Nothing -> []
            (Just euser) -> selectList [ EventOrgId <-. (userOrgIds $ entityKey euser) ] []
    defaultLayout $ do
        setTitle "Events"
        $(widgetFile "events")

userOrgIds :: UserId -> [OrgId]
userOrgIds userid = do
    rows <- liftHandler $ runDB $ selectList [ UserOrgUserId ==. userid ] []
    return $ [ userOrgOrgId $ entityVal $ erow | erow <- rows ]

但是我收到一个类型错误,说返回userOrgIds返回一个[[OrgId]]而不是[OrgId],并且concat在这里不起作用

我要解决这个问题吗?在这种情况下,我应该只使用rawQuery吗?

1 个答案:

答案 0 :(得分:0)

这是一个好的开始,但是我发现很多错误。

getEventR :: Handler Html
getEventsR = do

这些函数名称不匹配。

    muser <- maybeAuth
    eventList <- runDB $ 
        case muser of
            Nothing -> []
            (Just euser) -> selectList [ EventOrgId <-. (userOrgIds $ entityKey euser) ] []

我不确定这是否行得通;您可能希望您的Nothing分支机构提供pure []

    defaultLayout $ do
        setTitle "Events"
        $(widgetFile "events")

这看起来不错。

userOrgIds :: UserId -> [OrgId]
userOrgIds userid = do
    rows <- liftHandler $ runDB $ selectList [ UserOrgUserId ==. userid ] []
    return $ [ userOrgOrgId $ entityVal $ erow | erow <- rows ]

这绝对是行不通的。在类型签名中,您已经说过这是一个纯函数;它需要一个UserId(它是Key User的同义词),并返回一个OrgId(同样是Key Org)值的列表。但是,在您的实现中,您使用的是liftHandlerrunDBselectList。这些都是有效的东西!

这就是我编写您的处理程序的方式。

getEventsR :: Handler Html
getEventsR = do
  mUser <- maybeAuth
  eventList <- case mUser of
    Nothing -> pure []
    Just user -> runDB $ do
      orgs <- selectList [ UserOrgUserId ==. entityKey user ] []
      selectList [ EventOrgId <-. map entityKey orgs ] []
  defaultLayout $ do
    setTitle "Events"
    $(widgetFile "events")

我写的是没有编译器的,但是应该是正确的。