Happy new year!
-Iavor
On Thu, Dec 30, 2010 at 3:52 AM, <
oleg@okmij.org> wrote:
>
> William Murphy wrote:
>> I've spent a lot of time trying to write a version of concat, which
>> concatenates lists of any "depth":
>
> It is a little bit more involved, but quite possible. The code is not
> much longer than the one you wrote (essentially, three lines: one
> class and two instance declarations). Here is the complete code:
>
>
> {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
> {-# LANGUAGE TypeFamilies, FlexibleInstances #-}
> {-# LANGUAGE UndecidableInstances #-}
> {-# LANGUAGE OverlappingInstances #-}
>
> module DeepFlat where
>
>
> class DeepFlat a b | a -> b where
> dflat :: [a] -> [b]
>
> -- If we flatten a list of lists
> instance DeepFlat a b => DeepFlat [a] b where
> dflat = concatMap dflat
>
> -- If we are given a list of non-lists
> instance a ~ b => DeepFlat a b where
> dflat = id
>
> test1 = dflat "abracadabra"
> -- "abracadabra"
>
> test2 = dflat ["abra","cadabra"]
>
> test3 = dflat [["ab","ra"],["cad","abra"]]
> test4 = dflat [[["a","b"],["ra"]],[["cad","abra"]]]
>
>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
>
Haskell-Cafe@haskell.org>
http://www.haskell.org/mailman/listinfo/haskell-cafe
>