Полиморфные функции цепочки для постоянных моделей

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 s будет выдавать значение для данного входа. Ожидается, что (>->) прекратит вычисление CPU, когда будет произведено первое значение.

Вопросы:

1. Есть что-нибудь, как мой (>->) уже определен?
2. Какой тип должен иметь (>->)? Я пытался сделать что-то вроде (>->) :: 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 может полиморфно записывать в БД. Я бы хотел, чтобы мой короткозамкнутый «цепной» оператор тоже был полиморфным. Помогите!

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"] 

Здесь я использовал псевдоним для БПМЖ (<$>), что обеспечивает Control.Applicative.