[Haskell-beginners] ListT + Writer
aquagnu
aquagnu at gmail.com
Thu May 25 18:37:03 UTC 2017
David, many thanks for such a detailed answer and explanation!!
So, if I know that I'll iterate over list (vs abstract "m"'s bind), can
I replace "m" with Identity, to get list instead of abstract "ListT m"?
And last question: what is more canonical (Haskelish) way to iterate
over list with state? Fold*/State/Writer? Actually my ultimate goal was
to process list items with some state and possible IO (REST calls,
something else)... Is the usage of ListT + Writer (or ListT + State) a
good solution or better is to make all logic in one function and to
pass it to fold* (so state will be accumulating value)? I will iterate
over items of items of this list too: some of them are also lists,
so ListT looks more naturally IMHO, but I'm not sure...
David, in all cases - many thanks!!
В Thu, 25 May 2017 12:55:00 -0400
David McBride <toad3k at gmail.com> пишет:
> To start all these types with T at the end are transformers. They are
> a type that is wrapped around some inner m. StateT s m, ErrorT e m a,
> and so on.
>
> In order to use do notation, you must be in a type which is an
> instance of Monad.
>
> newtype ListT (m :: * -> *) a = ListT {runListT :: m [a]}
> instance [safe] Monad m => Monad (ListT m)
>
> newtype WriterT w (m :: * -> *) a = WriterT {runWriterT :: m (a, w)}
> instance [safe] (Monoid w, Monad m) => MonadWriter w (WriterT w m)
>
> These types and their instances say the following:
> ListT m a is a Monad if m is a Monad.
> WriterT w m a is a Monad if m is a Monad and w is a Monoid.
>
> So in order to use do notation in a WriterT String (ListT m) a, I must
> add the Monad m contstraint to proc, and also ensure that the writer's
> w is a monoid (it is because it is a string).
>
> Now to pass in a ListT as an argument, I must construct one. Remember
> that in order to use the return function, m must be in a monad, so I
> must add the Monad constraint.
>
> foo :: Monad m => ListT m Int
> foo = ListT (return [1,2,3])
>
> test = (runListT $ runWriterT (proc3 foo)) >>= print
>
> proc3 :: Monad m => ListT m Int -> WriterT String (ListT m) Int
> proc3 foo = do
> tell ("started: " :: String)
> x <- lift foo
> y <- lift $ ListT (return [3,4,5])
> lift $ guard (y /= 5)
> tell ("x:" ++ show x)
> tell ("y:" ++ show y)
> return (x * y)
>
> As you saw in the other comment in this thread, most people use a type
> alias to make it more palatable.
>
> type MyApp m a = WriterT String (ListT m) Int
> -- or type MyApp a = WriterT String (ListT IO) Int
>
> proc3 :: Monad m =>ListT m a -> MyApp m Int
> -- or proc3 :: ListT m a -> MyApp Int
>
> On Thu, May 25, 2017 at 12:11 PM, Baa <aquagnu at gmail.com> wrote:
> > В Thu, 25 May 2017 11:52:01 -0400
> > David McBride <toad3k at gmail.com> пишет:
> >
> > Hello, David! Am I right that "WriterT ... ListT" is "list of
> > writers"? As I understand, internal representation is "m (a, w)"
> > where m is a-la List? So, this is list of "writers"? I am confused
> > only of this "m" in your "proc1" function, because I suppose this
> > must be Identity and type becomes "WriterT String [Int]" ? Or?
> >
> > Can this function "proc1" be modified in the way to get input list
> > and to "iterate" over its elements with "do el <- ..." but to can
> > call Writer's tell in the same time? This is the problem for my
> > mind - I can not understand how to pass input list and to have
> > writer inside :) You call ListT's bind but over internal hardcoded
> > list values...
> >
> >
> >> ListT is a bit weird in that it affects whatever monad is
> >> underneath it, so the order of your types in your Transformer
> >> stack matters. Both ways have different meanings and each have
> >> legitimate uses. In any case you must use the lift function to
> >> get to the monad below the one you are at.
> >>
> >> import Control.Monad.List
> >> import Control.Monad.Writer
> >>
> >> test :: IO ()
> >> test = do
> >> (runListT $ runWriterT proc1) >>= print
> >> (runWriterT $ runListT proc2) >>= print
> >> return ()
> >>
> >>
> >> proc1 :: Monad m => WriterT String (ListT m) Int
> >> proc1 = do
> >> tell ("started: " :: String)
> >> x <- lift $ ListT (return [1,2])
> >> y <- lift $ ListT (return [3,4,5])
> >> lift $ guard (y /= 5)
> >> tell ("x:" ++ show x)
> >> tell ("y:" ++ show y)
> >> return (x * y)
> >>
> >>
> >> proc2 :: Monad m => ListT (WriterT String m) Int
> >> proc2 = do
> >> lift $ tell ("started: " :: String)
> >> x <- ListT (return [1,2])
> >> y <- ListT (return [3,4,5])
> >> guard (y /= 5)
> >> lift $ tell (" x:" ++ show x)
> >> lift $ tell (" y:" ++ show y)
> >>
> >> return (x * y)
> >>
> >> On Thu, May 25, 2017 at 11:10 AM, Baa <aquagnu at gmail.com> wrote:
> >> > Hello, everybody!
> >> >
> >> > I can process list in monad style with "do" syntax and to use
> >> > "guard" function in the body. Something like:
> >> >
> >> > fn :: [a] -> [a]
> >> > fn lst = do
> >> > el <- lst
> >> > guard $ condition el
> >> > ...
> >> > return $ change el
> >> >
> >> > How can I do the same but with possibility to call "tell" of
> >> > "Write" monad in the fn's body? As I understand it should be:
> >> >
> >> > ListT (Writer w) Int
> >> >
> >> > for this example?
> >> >
> >> > - but how to write it?
> >> > - how to call (run) it?
> >> > - and how is it safe ("transformers" package has bug in ListT, so
> >> > "mtl" must be used?)?
> >> > - is there other canonical way to do it without to use fold*,
> >> > recursive calls/fix, State/RWS ?
> >> >
> >> >
> >> > /Cheers
> >> > _______________________________________________
> >> > Beginners mailing list
> >> > Beginners at haskell.org
> >> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
> >> _______________________________________________
> >> Beginners mailing list
> >> Beginners at haskell.org
> >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
> >
> > _______________________________________________
> > Beginners mailing list
> > Beginners at haskell.org
> > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
--
Best regards,
Paul a.k.a. 6apcyk
More information about the Beginners
mailing list