從數據庫中檢索消化函數的選項列表

Question

我有一個處理添加和編輯的地址表單（如果添加，則爲Nothing，如果編輯爲Just Address）。到目前爲止，我已經將州和國家的選擇用一些項目硬編碼。

addressForm :: Monad m => Maybe Address -> [Address] -> Form Text m Address 
addressForm a addrs = 
    Address 
     <$> "id" .: choiceWith (addrToChoice addrs) (fmap id a) 
     <*> "name" .: string (fmap name a) 
     <*> "street" .: string (fmap street a) 
     <*> "city" .: string (fmap city a) 
     <*> "state" .: choiceWith stateChoices (fmap state a) 
     <*> "country" .: choiceWith countryChoicesRequired (fmap country a) 
     <*> "zipcode" .: string (fmap zipcode a) 


stateChoices :: [(Text, (Maybe String, Text))] -- (htmlValue, (realValue, labelValue)) 
stateChoices = [("ON", (Just "ON", "Ontario")), ("NE", (Just "NE", "Nebraska"))] 

countryChoicesRequired :: [(Text, (String, Text))] 
countryChoicesRequired = [("CA", ("CA", "Canada")), ("US", ("US", "United States of America"))] 

現在我想從數據庫中檢索州和國家列表。我可以將狀態/國家/地區列表傳遞給表單，就像我已經在處理地址列表一樣，但此表單也是3或4個其他表單的形式（新的廣告客戶表單，新的客戶表單等）而且我不需要像表格之外的狀態/國家列表，就像我對地址列表所做的那樣。

這裏的新形式，我剛剛添加提取的國家信息：

addressForm' :: (HasPostgres p, Monad m) => Maybe Address -> [Address] -> p (Form Text m Address) 
addressForm' a addrs = do 
    countries <- countryChoices' 
    return $ Address 
     <$> "id" .: choiceWith (addrToChoice addrs) (fmap id a) 
     <*> "name" .: string (fmap name a) 
     <*> "street" .: string (fmap street a) 
     <*> "city" .: string (fmap city a) 
     <*> "state" .: choiceWith stateChoices (fmap state a) 
     <*> "country" .: choiceWith countries (fmap country a) 
     <*> "zipcode" .: string (fmap zipcode a) 

data Region = Region 
    { code :: String 
    , fullName :: String 
    } 

countryChoices' :: HasPostgres m => m [(Text, (String, Text))] 
countryChoices' = do 
    countries <- getCountries 
    return $ abbrToChoice countries 

abbrToChoice :: [Region] -> [(Text, (String, Text))] 
abbrToChoice regions = 
    map (\ a -> ((pack $ code a), (code a, (pack $ fullName a)))) regions 

下面是調用它的處理程序：

editAddressH :: ([(T.Text, Splice AppHandler)] -> AppHandler()) -> Addr.Address -> Maybe Int64 -> AppHandler() 
editAddressH renderer a userId = do 
    addresses <- Addr.list userId 
    (view, result) <- runForm "form" $ Addr.addressForm' (Just a) addresses -- line 233 
    case result of 
     Just x -> do 
      r <- Addr.edit x -- line 236 
      case r of 
       _ -> renderer [("success", showContents), ("dfForm", hideContents)] 
     Nothing -> renderer $ ("success", hideContents) : ("addressList", addressScriptSplice addresses) : phoneSplices ++ digestiveSplices view 

我得到的錯誤是這樣的：

src/Site.hs:233:44: 
    No instance for (HasPostgres 
         (digestive-functors-0.5.0.1:Text.Digestive.Form.Internal.FormTree 
          (Handler App App) v0 (Handler App App))) 
     arising from a use of `Addr.addressForm'' 
    Possible fix: 
     add an instance declaration for 
     (HasPostgres 
     (digestive-functors-0.5.0.1:Text.Digestive.Form.Internal.FormTree 
      (Handler App App) v0 (Handler App App))) 
    In the second argument of `($)', namely 
     `Addr.addressForm' (Just a) addresses' 
    In a stmt of a 'do' expression: 
     (view, result) <- runForm "form" 
         $ Addr.addressForm' (Just a) addresses 
    In the expression: 
     do { addresses <- Addr.list userId; 
      (view, result) <- runForm "form" 
          $ Addr.addressForm' (Just a) addresses; 
      case result of { 
      Just x -> do { ... } 
      Nothing 
       -> renderer 
       $ ("success", hideContents) 
        : ("addressList", addressScriptSplice addresses) 
        : phoneSplices ++ digestiveSplices view } } 
src/Site.hs:236:40: 
    Couldn't match expected type `Addr.Address' 
       with actual type `digestive-functors-0.5.0.1:Text.Digestive.Form.Internal.FormTree 
            m0 Text m0 Addr.Address' 
    Expected type: Addr.Address 
     Actual type: Form Text m0 Addr.Address 
    In the first argument of `Addr.edit', namely `x' 
    In a stmt of a 'do' expression: r <- Addr.edit x 

Answer 1

看起來你需要monadic功能。它可能看起來像這樣：

addressForm :: Monad m => Maybe Address -> [Address] -> Form Text m Address 
addressForm a addrs = monadic $ do 
    stateChoices <- getStatesFromDB 
    countryChoices <- getCountriesFromDB 
    return $ 
     Address 
      <$> "id" .: choiceWith (addrToChoice addrs) (fmap id a) 
      <*> "name" .: string (fmap name a) 
      <*> "street" .: string (fmap street a) 
      <*> "city" .: string (fmap city a) 
      <*> "state" .: choiceWith stateChoices (fmap state a) 
      <*> "country" .: choiceWith countryChoices (fmap country a) 
      <*> "zipcode" .: string (fmap zipcode a)