Proposal: Add bool to Data.Bool

Hello, I would like to propose that the following is added to Data.Bool in base: bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t (Aka, bool f t b = if b then t else f) The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor. I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here. A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages. Thoughts? - ocharles --- [1]: https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09

just to add a bit of bikeshedding, wouldn't it better be called something
like boolElim ?
On Tue, Sep 10, 2013 at 6:02 PM, Oliver Charles
Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

Not when we have maybe and either with those names already. On Wed, Sep 11, 2013 at 12:05 AM, Carter Schonwald < carter.schonwald@gmail.com> wrote:
just to add a bit of bikeshedding, wouldn't it better be called something like boolElim ?
On Tue, Sep 10, 2013 at 6:02 PM, Oliver Charles
wrote: Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Tue, Sep 10, 2013 at 11:05 PM, Carter Schonwald
just to add a bit of bikeshedding, wouldn't it better be called something like boolElim ?
As we already have 'maybe' and 'either', calling it 'boolElim' inconsistent. Hence I stick to the suggestion of calling this function 'bool'. - ocharles

Eh, no. Basic functions — simple names.
Besides, it might be my faulty memory, but I doubt I would be able to
remember boolElim. It’s somewhat cryptic.
On Wed, 11 Sep 2013 02:05:15 +0400, Carter Schonwald
just to add a bit of bikeshedding, wouldn't it better be called something like boolElim ?
On Tue, Sep 10, 2013 at 6:02 PM, Oliver Charles
wrote: Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a
bool f _ False = f
bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find
myself reaching for this in cases similar to where I would use 'maybe' -
often when I'm working with 'fmap' and don't want to start introducing
names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this
doesn't exist, and would like to see it happen - hopefully they will
voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent
functions on the first page - and I'm sure there are more on subsequent
pages.
Thoughts?
- ocharles
---
[1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________
Libraries mailing list
Libraries@haskell.org

+1, I‘ve often wanted this but don’t want to add a dependency just for bool,
so I end up writing it myself, locally in a where every time, which doesn't
feel very Haskelly to do!
I would even like it in Prelude, but I expect that to get much more
opposition so this proposal should probably not discuss that possibility at
all.
On Wed, Sep 11, 2013 at 12:02 AM, Oliver Charles
Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

+1 for it without bikeshedding
-Ed
On Sep 10, 2013, at 6:07 PM, Dag Odenhall
+1, I‘ve often wanted this but don’t want to add a dependency just for bool, so I end up writing it myself, locally in a where every time, which doesn't feel very Haskelly to do!
I would even like it in Prelude, but I expect that to get much more opposition so this proposal should probably not discuss that possibility at all.
On Wed, Sep 11, 2013 at 12:02 AM, Oliver Charles
wrote: Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]: https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On 2013-09-11 00:02, Oliver Charles wrote:
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
+1 The main argument I've heard against it is that this function 'would mean we have to add "if'" to the library and then all other permutations of the arguments'. Seeing how that argument is void modulo rhetoric, I can't see a reason for not adding it. I'm against Prelude because I think we should really separate the Prelude into the "necessary Prelude" and the KitchenSink before adding anything else to it. David

+1 with the name as bool.
Anthony
On Tue, Sep 10, 2013 at 6:02 PM, Oliver Charles
Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]: https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

+1 I use: bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b which is better for point-free programming, but I'll go along with yours because bool :: a -> a -> Bool -> a is also useful.

Hm, maybe:
bool :: a -> a -> Bool -> a
cond :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b
On 11 September 2013 00:36, Christopher Done
+1
I use:
bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b
which is better for point-free programming, but I'll go along with yours because bool :: a -> a -> Bool -> a is also useful.

+1 for bool sans bikeshedding, à la maybe and either.
Christopher Done
+1 I use:bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b
This "bool ft ff fb" is just "join (bool ft ff . fb)" using the non- bikeshedded 'bool'. Or "bool <$> ft <*> ff <*> fb" as others have pointed out.

FWIW I've added this to data-extra
http://chrisdone.com/data-extra/Data-Bool-Extra.html for the meanwhile.
On 11 September 2013 00:02, Oliver Charles
Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

+1 for Data.Bool.bool :: a -> a -> Bool -> a. It doesn't seem very
important but it does add symmetry with maybe and either, and is mostly
harmless residing in Data.Bool as long as it is not re-exported by Prelude.
On a tangent... as usual, the Applicative instance of (a ->) comes in handy
for pointless programming:
cond = liftA3 bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b
-- Dan Burton
On Tue, Sep 10, 2013 at 4:01 PM, Christopher Done
FWIW I've added this to data-extra http://chrisdone.com/data-extra/Data-Bool-Extra.html for the meanwhile.
On 11 September 2013 00:02, Oliver Charles
wrote: Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

+1 for bool +1/2 for cond but with its signature generalized to Applicative:
cond :: Applicative f => f a -> f a -> f Bool -> f a cond = liftA3 bool
-- Conal
On Tue, Sep 10, 2013 at 5:17 PM, Dan Burton
+1 for Data.Bool.bool :: a -> a -> Bool -> a. It doesn't seem very important but it does add symmetry with maybe and either, and is mostly harmless residing in Data.Bool as long as it is not re-exported by Prelude.
On a tangent... as usual, the Applicative instance of (a ->) comes in handy for pointless programming:
cond = liftA3 bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b
-- Dan Burton
On Tue, Sep 10, 2013 at 4:01 PM, Christopher Done
wrote: FWIW I've added this to data-extra http://chrisdone.com/data-extra/Data-Bool-Extra.html for the meanwhile.
On 11 September 2013 00:02, Oliver Charles
wrote: Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

so for the record, i'm +1 on bool (just to clarify my eariler email)
On Wed, Sep 11, 2013 at 6:18 PM, Conal Elliott
+1 for bool
+1/2 for cond but with its signature generalized to Applicative:
cond :: Applicative f => f a -> f a -> f Bool -> f a cond = liftA3 bool
-- Conal
On Tue, Sep 10, 2013 at 5:17 PM, Dan Burton
wrote: +1 for Data.Bool.bool :: a -> a -> Bool -> a. It doesn't seem very important but it does add symmetry with maybe and either, and is mostly harmless residing in Data.Bool as long as it is not re-exported by Prelude.
On a tangent... as usual, the Applicative instance of (a ->) comes in handy for pointless programming:
cond = liftA3 bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b
-- Dan Burton
On Tue, Sep 10, 2013 at 4:01 PM, Christopher Done
wrote: FWIW I've added this to data-extra http://chrisdone.com/data-extra/Data-Bool-Extra.html for the meanwhile.
On 11 September 2013 00:02, Oliver Charles
wrote: Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]:
https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

I'm +1 for bool, but find cond doesn't hit the Fairbairn threshold for me.
-Edward
On Sep 11, 2013, at 6:18 PM, Conal Elliott
+1 for bool
+1/2 for cond but with its signature generalized to Applicative:
cond :: Applicative f => f a -> f a -> f Bool -> f a cond = liftA3 bool
-- Conal
On Tue, Sep 10, 2013 at 5:17 PM, Dan Burton
wrote: +1 for Data.Bool.bool :: a -> a -> Bool -> a. It doesn't seem very important but it does add symmetry with maybe and either, and is mostly harmless residing in Data.Bool as long as it is not re-exported by Prelude.
On a tangent... as usual, the Applicative instance of (a ->) comes in handy for pointless programming:
cond = liftA3 bool :: (a -> b) -> (a -> b) -> (a -> Bool) -> a -> b
-- Dan Burton
On Tue, Sep 10, 2013 at 4:01 PM, Christopher Done
wrote: FWIW I've added this to data-extra http://chrisdone.com/data-extra/Data-Bool-Extra.html for the meanwhile.
On 11 September 2013 00:02, Oliver Charles
wrote: Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
The purpose of this is hopefully evident from its definition. I find myself reaching for this in cases similar to where I would use 'maybe' - often when I'm working with 'fmap' and don't want to start introducing names for the function I am using to map over some functor.
I suggested this in #haskell and other people also seem frustrated this doesn't exist, and would like to see it happen - hopefully they will voice their support as a reply here.
A quick search on FPComplete's Hoogle [1] shows five equivalent functions on the first page - and I'm sure there are more on subsequent pages.
Thoughts? - ocharles
--- [1]: https://www.fpcomplete.com/hoogle?q=Bool+-%3E+a+-%3E+a+-%3E+a&env=ghc-7.4.2-stable-13.09
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Tue, 10 Sep 2013, Oliver Charles wrote:
Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
There is already the ifThenElse function (and I have if' in utility-ht). Their argument order is optimal for writing kinds of 'case': http://www.haskell.org/haskellwiki/Case But 'bool' would be consistent with 'maybe' and 'either' and should be in Data.Bool, not Prelude.

On 2013-09-11 at 00:02:19 +0200, Oliver Charles wrote:
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
(Aka, bool f t b = if b then t else f)
+1 (btw, somewhat related: http://www.haskell.org/haskellwiki/If-then-else )

I'd prefer something more like:
mux :: Enum b => [a] -> b -> a
mux xs x = xs !! fromEnum x
so then 'bool' could be implemented as:
bool :: a -> a -> Bool -> a
bool f t = mux [f, t]
but 'mux' needs a stronger type signature. The size of the enum is
known at compile-time. Is there any way to constrain the input list
to be the same size?
Thanks,
Greg
On Wed, Sep 11, 2013 at 2:18 AM, Simon Hengel
On Tue, Sep 10, 2013 at 11:02:19PM +0100, Oliver Charles wrote:
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
+1 _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Wed, 11 Sep 2013, Greg Fitzgerald wrote:
I'd prefer something more like:
mux :: Enum b => [a] -> b -> a mux xs x = xs !! fromEnum x
so then 'bool' could be implemented as:
bool :: a -> a -> Bool -> a bool f t = mux [f, t]
but 'mux' needs a stronger type signature. The size of the enum is known at compile-time. Is there any way to constrain the input list
I don't like a total function to be implemented using a non-total function (!!). Additionally your implementation relies on fromEnum True == 1, which is a bad thing.

I'm also rather against `mux`, not only on partiality grounds, but also on the grounds that it is not very easily optimized away. On Wed, Sep 11, 2013 at 2:23 PM, Henning Thielemann < lemming@henning-thielemann.de> wrote:
On Wed, 11 Sep 2013, Greg Fitzgerald wrote:
I'd prefer something more like:
mux :: Enum b => [a] -> b -> a mux xs x = xs !! fromEnum x
so then 'bool' could be implemented as:
bool :: a -> a -> Bool -> a bool f t = mux [f, t]
but 'mux' needs a stronger type signature. The size of the enum is known at compile-time. Is there any way to constrain the input list
I don't like a total function to be implemented using a non-total function (!!). Additionally your implementation relies on fromEnum True == 1, which is a bad thing.
______________________________**_________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/**mailman/listinfo/librarieshttp://www.haskell.org/mailman/listinfo/libraries

+1 for the original proposal.
On Wed, Sep 11, 2013 at 2:26 PM, Edward Kmett
I'm also rather against `mux`, not only on partiality grounds, but also on the grounds that it is not very easily optimized away.
On Wed, Sep 11, 2013 at 2:23 PM, Henning Thielemann < lemming@henning-thielemann.de> wrote:
On Wed, 11 Sep 2013, Greg Fitzgerald wrote:
I'd prefer something more like:
mux :: Enum b => [a] -> b -> a mux xs x = xs !! fromEnum x
so then 'bool' could be implemented as:
bool :: a -> a -> Bool -> a bool f t = mux [f, t]
but 'mux' needs a stronger type signature. The size of the enum is known at compile-time. Is there any way to constrain the input list
I don't like a total function to be implemented using a non-total function (!!). Additionally your implementation relies on fromEnum True == 1, which is a bad thing.
______________________________**_________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/**mailman/listinfo/librarieshttp://www.haskell.org/mailman/listinfo/libraries
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

You'd need GHC extensions to pull that off, Greg, but it could be done.
Something like
data Vect (size :: Nat) (a :: *) where
Cons :: a -> Vect n a -> Vect (Succ n) a
Nil :: Vect Zero a
data NatUpTo (n :: Nat) where
Here :: NatUpTo n -- "Here" means 0
There :: NatUpTo n -> NatUpTo (S n) -- "There x" means 1 + x
vectIndex :: Vect (S n) a -> NatUpTo n -> a
vectIndex (Cons x _) Here = a
vectIndex (Cons _ xs) (There i) = vectIndex xs i
class (Enum a) => EnumSize (size :: Nat) a where
enumerateAll :: Vect size a
-- law: (enumerateAll `asTypeOf` [x]) `vectIndex` unsafeIntToNatUpTo
(fromEnum x)
It gets tedious, though, dealing with all of that safety. LiquidHaskell is
perhaps a more viable option for such a thing. It would be nice to have
standard libraries written with LiquidHaskell so that we have a more
rigorously proven code base.
-- Dan Burton
On Wed, Sep 11, 2013 at 10:57 AM, Greg Fitzgerald
I'd prefer something more like:
mux :: Enum b => [a] -> b -> a mux xs x = xs !! fromEnum x
so then 'bool' could be implemented as:
bool :: a -> a -> Bool -> a bool f t = mux [f, t]
but 'mux' needs a stronger type signature. The size of the enum is known at compile-time. Is there any way to constrain the input list to be the same size?
Thanks, Greg
On Tue, Sep 10, 2013 at 11:02:19PM +0100, Oliver Charles wrote:
I would like to propose that the following is added to Data.Bool in
On Wed, Sep 11, 2013 at 2:18 AM, Simon Hengel
wrote: base: bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
+1 _______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On 09/10/2013 11:02 PM, Oliver Charles wrote:
Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
OK, I think this has got enough support from the community to be deemed worth having, with this exact name and type signature. cond has also been suggested, but I'm going to leave that as it wasn't part of my original proposal and seems less critical. Unless people really think I should consider 'cond' too, I will start learning how to contribute this patch to base and doing the rest of the necessary work. Thanks for all the feedback! - ocharles

That sounds like a plan. 'bool' received overwhelming support, but 'cond'
received a somewhat more lukewarm reception.
-Edward
On Thu, Sep 12, 2013 at 5:31 AM, Oliver Charles
On 09/10/2013 11:02 PM, Oliver Charles wrote:
Hello,
I would like to propose that the following is added to Data.Bool in base:
bool :: a -> a -> Bool -> a bool f _ False = f bool _ t True = t
OK, I think this has got enough support from the community to be deemed worth having, with this exact name and type signature. cond has also been suggested, but I'm going to leave that as it wasn't part of my original proposal and seems less critical.
Unless people really think I should consider 'cond' too, I will start learning how to contribute this patch to base and doing the rest of the necessary work.
Thanks for all the feedback! - ocharles
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries
participants (17)
-
Anthony Cowley
-
Artyom Kazak
-
Carter Schonwald
-
Christopher Done
-
Conal Elliott
-
Dag Odenhall
-
Dan Burton
-
David Luposchainsky
-
Edward Kmett
-
Greg Fitzgerald
-
Henning Thielemann
-
Herbert Valerio Riedel
-
Jake McArthur
-
John Wiegley
-
Liyang HU
-
Oliver Charles
-
Simon Hengel