持久模型的多态链接函数

Question

考虑以下代码：

import Database.Persist
import Database.Persist.TH
import Database.Persist.Sqlite

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Model1
  fieldA Int
  fieldB String

Model2
  fieldC String
  fieldD Double Maybe
|]

(>->) :: Maybe a -> Maybe a -> Maybe a
(>->) (Just x) _ = Just x
(>->) _ b        = b

heavyComputation1 :: [String] -> Maybe Model1
heavyComputation1 input = undefined

heavyComputation2 :: [String] -> Maybe Model1
heavyComputation2 input = undefined

heavyComputation3 :: [String] -> Maybe Model2
heavyComputation3 input = undefined

heavyComputation4 :: [String] -> Maybe Model2
heavyComputation4 input = undefined

doTheWork :: [String] -> IO ()
doTheWork input = do
  let result = (heavyComputation1 input)
               >-> (heavyComputation2 input)
               >-> (heavyComputation3 input)
               >-> (heavyComputation4 input)
  case result of
    Just x  -> runSqlite "base.db" $ do insert x; return ()
    Nothing -> return ()

它不编译（当然）。对于给定的输入，只有 heavyComputation 中的一个会产生值。 (>->) 应该在生成第一个值时停止 CPU 繁重的计算。

问题：

有没有像我的(>->)这样的东西已经定义了？
(>->) 应该有什么类型？我试图做类似 (>->) :: forall a. PersistEntity a => Maybe a -> Maybe a -> Maybe a 的事情，但我显然不理解 forall，因为它似乎没有帮助。

也许我所有的设计都是错误的。这个想法是从输入中获取 Model 之一，并跳过不必要的计算而不会出现这种情况：

doTheWorkUgly :: [String] -> IO ()
doTheWorkUgly input = do
  case heavyComputation1 input of
    Just x -> runSqlite "abc.db" $ do insert x; return ()
    Nothing -> case heavyComputation2 input of
                 Just x -> runSqlite "abc.db" $ do insert x; return ()
                 Nothing -> case heavyComputation3 input of
                              Just x -> runSqlite "abc.db" $ do insert x; return ()
                              Nothing -> case heavyComputation4 input of
                                           Just x -> runSqlite "abc.db" $ do insert x; return ()
                                           Nothing -> return ()

我的想法是 result 成为任何一个模型。 insert 可以多态写入数据库。我想让我的短路 "chain" 运算符也具有多态性。求助！

Answer 1

在我的评论中，我没有完全看出你的问题是你试图组合两种不同的类型，Maybe Model1 和 Maybe Model2。

那行不通 - 您找不到将它们很好地结合起来的函数。（您可以将它们与令人讨厌的分支 Either 混乱结合起来，但我假设您不希望这样）

但是，因为这两个模型共享相同的 PersistentEntityBackend，所以这些表达式都具有相同的类型：

fmap insert_ (heavyComputation1 input)
fmap insert_ (heavyComputation2 input)
fmap insert_ (heavyComputation3 input)
fmap insert_ (heavyComputation4 input)

那个类型是(MonadIO m) => Maybe (ReaderT SqlBackend m ())，但重要的是部分a的类型是Maybe a，而且它们并不代表实际做了任何SQL 还没有持久化，只是代表动作做了一些SQL 持久化。现在它们是同一类型，我们可以将它们与 <|> 联系在一起，如：

{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

import Database.Persist
import Database.Persist.TH
import Database.Persist.Sqlite
import Control.Applicative
import Data.Foldable (mapM_)
import Prelude hiding (mapM_)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Model1
  fieldA Int
  fieldB String

Model2
  fieldC String
  fieldD Double Maybe
|]

heavyComputation1 :: [String] -> Maybe Model1
heavyComputation1 input = undefined

heavyComputation2 :: [String] -> Maybe Model1
heavyComputation2 input = undefined

heavyComputation3 :: [String] -> Maybe Model2
heavyComputation3 input = undefined

heavyComputation4 :: [String] -> Maybe Model2
heavyComputation4 input = undefined

doTheWork :: [String] -> IO ()
doTheWork input =
  mapM_ (runSqlite "base.db") $
    (insert_ <$> heavyComputation1 input)
    <|> (insert_ <$> heavyComputation2 input)
    <|> (insert_ <$> heavyComputation3 input)
    <|> (insert_ <$> heavyComputation4 input)

main :: IO ()
main = doTheWork ["hi"]

这里我使用了 Control.Applicative 提供的 fmap (<$>) 的别名。

持久模型的多态链接函数

Polymorphic chaining function for Persistent models

haskell

persistent