[Haskell-beginners] Mapping list over datatype using Traversable and State monad.

Dmitriy Matrosov sgf.dma at gmail.com
Mon Sep 24 21:15:49 CEST 2012


Hi.

I have a data type

    data Line a         = Line [a] [a]

which groups elements into "ordered" (first list) and "other" (second list)
ones. And i want a functions representing Line, which actually has two
heads (one from 1st list and one from 2nd), as single-headed. In other words,
i want to map a list over Line (preserving Line structure), i.e. implement a
function with type

    f :: [a -> b] -> Line a

I have done this using Traversable

    import Data.Monoid
    import qualified Data.Foldable as F
    import qualified Data.Traversable as T
    import Control.Applicative
    import Control.Monad.State

    instance Functor Line where
	fmap f (Line xs ys) = Line (map f xs) (map f ys)
    instance F.Foldable Line where
	foldMap f (Line xs ys)  = (F.foldMap f xs) `mappend` (F.foldMap f ys)
    instance T.Traversable Line where
	traverse f (Line xs ys) = Line <$> (T.traverse f xs) <*> (T.traverse f ys)

and my function (which actually used for adding separators (sp ++) into (Line
String), and i don't want to add separator before the first element,
regardless of whether first element is "ordered" or "other") looks like

    inlineSeps :: (a -> a) -> Line a -> Line a
    inlineSeps g        = fst . flip runState (id : repeat g) . T.mapM f
      where
	f x             = do
			    (f : fs) <- get
			    put fs
			    return (f x)

It works, but i'm not sure whether using state monad here is good? And whether
this is good solution for such problem at all?




More information about the Beginners mailing list