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可以多态写入数据库。我想让我的短路＆＃34;链＃34;运算符也是多态的。救命啊！

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 ())，但重要的部分是某些Maybe a的类型为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"]

我在这里使用了<$>提供的fmap（Control.Applicative）的别名。

持久模型的多态链接函数

1 个答案: