[Haskell] Arrows and XML filters
David Menendez
zednenem at psualum.com
Sat Apr 17 00:49:30 EDT 2004
I don't know if this has come up before. If it has, I'd be interested in
a link to the discussion.
Last week, I noticed that filters used in the Haskell XML Toolbox (and
elsewhere) are easily made into arrows. Specifically, for any filter
f :: a -> [b]
we can write
Kleisli f :: Kleisli [] a b
It then turns out that many of the filter combinators correspond exactly
to arrow combinators. For example:
Kleisli (g `o` f) === Kleisli f >>> Kleisli g
Kleisli (f .> g) === Kleisli f >>> Kleisli g
Kleisli (f +++ g) === Kleisli f <+> Kleisli g
Kleisli this === returnA
Kleisli none === zeroArrow
Similarly, for the functions 'cat' and 'seqF', we can write
> asum :: ArrowPlus a => [a b c] -> a b c
> asum = foldr (<+>) zeroArrow
>
> seqA :: Arrow a => [a b b] -> a b b
> seqA = foldr (>>>) returnA
And so forth.
The predicate combinators can't be made as general, but they still work
in an arrow framework.
> orElse :: Kleisli [] a b -> Kleisli [] a b -> Kleisli [] a b
> orElse (Kleisli f) (Kleisli g) =
> Kleisli (\t -> let res = f t in if null res then g t else res)
The tree filters work similarly:
> type TFilterA node = Kleisli [] (NTree node) (NTree node)
> processChildren :: TFilterA node -> TFilterA node
> processChildren (Kleisli f) =
> Kleisli (\(NTree n cs) -> [NTree n (concatMap f cs)])
I don't know if this has any practical value. (Perhaps for future XML
libraries?) If nothing else, it's given me some experience with and (I
hope) a better understanding of arrows.
--
David Menendez <zednenem at psualum.com> <http://www.eyrie.org/~zednenem/>
More information about the Haskell
mailing list