Proposal: Add isLeft/isRight to Data.Either

Ivan Lazar Miljenovic ivan.miljenovic at gmail.com
Sat Dec 1 23:42:44 CET 2012


On 2 December 2012 08:42, Andreas Abel <andreas.abel at ifi.lmu.de> wrote:
> On 30.11.12 7:14 PM, Henning Thielemann wrote:
>>
>> Agda uses isLeft and isRight in some QuickCheck properties. And then
>> there is this application:
>>
>>     do
>>        -- ps0 :: [NamedArg ParseLHS]
>>        ps0 <- mapM classPat ps
>>        let (ps1, rest) = span (isLeft . namedArg) ps0
>>        (p2, ps3) <- uncons rest -- when (null rest): no field pattern or
>> def pattern found
>>        guard $ all (isLeft . namedArg) ps3
>>        let (f, lhs)      = fromR p2
>>            (ps', _:ps'') = splitAt (length ps1) ps
>>        return $ Right (f, LHSProj x ps' lhs ps'')
>>
>> Looks at least interesting ... :-)
>
>
> Well, maybe this code could be improved, avoiding isLeft and fromR(ight).
>
> Basically, what I want to to here is:
> - I have a list of things: ps
> - I have a classification of these things into Left and Right: classPat
> - I want to succeed if exactly one of these things is classified as a Right
> - I want to extract that Right thing, modify it a bit: lhs
> - I want to obtain all the Left things unchanged: ps' and ps''
>
> These standard functions do not do the job:
> - partitionEithers: loses the order of my things
> - lefts/rights: ditto

How do they lose the order?  Or do you mean lose the order of "This
Left is before that Right"?

>
> The crux here is that the standard list functions like filter, span, break
> etc. use "Bool" as decision type.  They would be more general with Either,
> using Left as falsehood and Right as truth.
>
>   span  :: (a -> Either b c) -> [a] -> ([c], [a])
>   break :: (a -> Either b c) -> [a] -> ([b], [a])
>   partition :: (a -> Either b c) -> [a] -> ([c], [b])

Isn't your either-based partition function just partitionEithers?

>
> etc.
>
> How would you do it?
>
> Cheers,
> Andreas
>
> --
> Andreas Abel  <><      Du bist der geliebte Mensch.
>
> Theoretical Computer Science, University of Munich
> Oettingenstr. 67, D-80538 Munich, GERMANY
>
> andreas.abel at ifi.lmu.de
> http://www2.tcs.ifi.lmu.de/~abel/
>
>
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries



-- 
Ivan Lazar Miljenovic
Ivan.Miljenovic at gmail.com
http://IvanMiljenovic.wordpress.com



More information about the Libraries mailing list