Aktualizacja zewnętrzną monady tylko w transformatorze monada

Question

mam monady dla obliczeń, które mogą zawieść i robi jakieś rejestrowanie:

f1 :: WriterT [String] (Either String) a 

Mam funkcję, która nie zawiedzie, ale robi trochę rejestrowanie:

f2 :: Writer [String] b 

Jaki jest najlepszy sposób aktualizacji monada pisarza w f1 za pomocą dziennika z f2 i przechwytywania danych wyjściowych obliczenia f2? W tej chwili robię to:

f2result <- (\(r,l) -> do {tell l; return r}) (runWriter f2) 

używam windy zaktualizować wewnętrzną monady z różnych obliczeń, więc przełączania wokół pisarza i monady albo nie rozwiąże problemu.

Answer 1

Jeśli zdefiniowano f2, najprostszy z możliwych rozwiązań może być byłaby f2 tak jest zdefiniowana wygląda następująco:

f2 :: Monad m => WriterT [String] m b 

co nie powinno być zbyt trudne, ponieważ Writer w b jest zdefiniowany jako WriterT w Identity b i Identity monada nie robi Nic ci nie da.

Następnie można je połączyć tylko wykonując f1 >> f2.

Jeśli nie można przedefiniować f2, zawsze można definiować własne z odpowiednim podpisem:

f2' :: Monad m => WriterT [String] m b 
f2' = WriterT . return $ runWriter f2 

a jeśli już kilka f2 zawijać, zawsze można zdefiniować funkcję owinąć je dla Ciebie

wrap :: Monad m => Writer w b -> WriterT w m b 
wrap = WriterT . return . runWriter 

Więc można zrobić f1 >> wrap f2a >> wrap f2b >> wrap f2c ...

Answer 2

Jako śledzić na odpowiedź zerwa użytkownika, można zamiast Opłaty aktor f2 na dowolnym MonadWriter:

f2 :: MonadWriter [String] m => m a 

powinny nie być możliwe, aby zmienić jej definicję można owinąć go podobnie jak zerwa robi:

f2' :: MonadWriter [String] m => m a 
f2' = do let (a,w) = runWriter f2 
     tell w 
     return a 

[String] argument MonadWriter wymaga to GHC pragmy:

{-# LANGUAGE FlexibleContexts #-} 

Jak zawsze, pragmas ar e umieścić na górze modułu.

W komentarzach, zerwa wydał wersję zawijania funkcję w tym ustawieniu:

wrap :: MonadWriter w m => Writer w b -> m b 
wrap = uncurry (<<) . (return *** tell) . runWriter 
    where (<<) = flip (>>)