From toad3k at gmail.com Tue Mar 2 14:19:14 2021 From: toad3k at gmail.com (David McBride) Date: Tue, 2 Mar 2021 09:19:14 -0500 Subject: [Haskell-beginners] Creating a Triple List from a List In-Reply-To: References: Message-ID: If you are okay with a library, you can use the split library for this. stack exec --package split -- ghci >chunksOf 2 [1,2,3,4,5,6] [[1,2],[3,4],[5,6]] On Sat, Feb 27, 2021 at 9:08 PM A. Mc. <47dragonfyre at gmail.com> wrote: > Hello, > > What is the best way to take: > [1, 2, 3, 4 ] > > And convert it to: > > [ [ [ 1 ], [ 2 ] ], [ [3]. [4] ] ] > > so that each member pair is: > > [ [1], [2] ] > > roughly analogous to a 1x2 vector? > > Thanks in advance and thank you for your time. > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From 47dragonfyre at gmail.com Sat Mar 6 05:31:23 2021 From: 47dragonfyre at gmail.com (A. Mc.) Date: Fri, 5 Mar 2021 21:31:23 -0800 Subject: [Haskell-beginners] Alphanumerical input Message-ID: Hello, I was wondering what the best way was for tranforming a list of alphanumerical characters from main IO() such as: Enter String: A 101 E 182 and tranforming it into an Int list of [0, 101, 4, 182] Which converting A and E to 0 and 4 is easy enough with toEnum/fromEnum and simple subtraction, and using read can convert to a [Char], but recognizing 101 as a single Int from a Char string in main, and getting both converted together as part of the same function, I'm a bit less sure of without resorting to much lower level imperative methods. Thanks in advance and thank you for your time. -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Sat Mar 6 15:53:30 2021 From: borgauf at gmail.com (Galaxy Being) Date: Sat, 6 Mar 2021 09:53:30 -0600 Subject: [Haskell-beginners] Maybe problems converting back to number Message-ID: I've got this example from the Internet import Data.List import Data.Maybe firstFactorOf x | m == Nothing = x | otherwise = fromJust m where m =(find p [2..x-1]) p y = mod x y == 0 and this as a crude return the nth element of a list import Data.List import Data.Maybe -- myIndex :: [a] -> Int -> Maybe a myIndex [] _ = Nothing myIndex (x:xs) 0 = Just x myIndex (x:xs) n = myIndex xs (n-1) I would like the Just x in the second block to actually be fromJust x as in the first block, i.e., I want a number returned, not a Just typed object. I've tried changing Just x to fromJust x but get the error when I try to use it > myIndex [1,2,3,4,5] 3 * Non type-variable argument : in the constraint: Num (Maybe (Maybe a)) : (Use FlexibleContexts to permit this) : * When checking the inferred type : it :: forall a. Num (Maybe (Maybe a)) => Maybe a What am I missing here? Also, my type declaration seems to be wrong too, but I don't see why. LB -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Sat Mar 6 16:52:16 2021 From: fa-ml at ariis.it (Francesco Ariis) Date: Sat, 6 Mar 2021 17:52:16 +0100 Subject: [Haskell-beginners] Maybe problems converting back to number In-Reply-To: References: Message-ID: <20210306165216.GB2849@extensa> Il 06 marzo 2021 alle 09:53 Galaxy Being ha scritto: > I've got this example from the Internet > > import Data.List > import Data.Maybe > > firstFactorOf x > | m == Nothing = x > | otherwise = fromJust m > where m =(find p [2..x-1]) > p y = mod x y == 0 > > -- myIndex :: [a] -> Int -> Maybe a > myIndex [] _ = Nothing > myIndex (x:xs) 0 = Just x > myIndex (x:xs) n = myIndex xs (n-1) > > I would like the Just x in the second block to actually be fromJust x as in > the first block, i.e., I want a number returned, not a Just typed object. > I've tried changing Just x to fromJust x but get the error when I try to > use it What would happen in the `Nothing` case? If an error is fine with you: myUnsafeIndex :: [a] -> Int -> a myUnsafeIndex as n = case myIndex as n of Nothing -> error "Chiare, fresche et dolci acque" -- or maybe return -1? Idk Just r -> r What have you written instead > Also, my type declaration seems to be wrong too, but I don't see why. It compiles fine here, even if I remove the comment from `myIndex` signature —F From borgauf at gmail.com Sun Mar 7 04:17:26 2021 From: borgauf at gmail.com (Galaxy Being) Date: Sat, 6 Mar 2021 22:17:26 -0600 Subject: [Haskell-beginners] Maybe problems converting back to number In-Reply-To: <20210306165216.GB2849@extensa> References: <20210306165216.GB2849@extensa> Message-ID: Here's what I finally did myIndex'' l n | m == Nothing = error "No list." | otherwise = fromJust m where m = mI l n mI [] _ = Nothing mI (h:t) n | n == 0 = Just h | otherwise = mI t (n-1) but then I can't say why I went to this extra step. On Sat, Mar 6, 2021 at 10:53 AM Francesco Ariis wrote: > Il 06 marzo 2021 alle 09:53 Galaxy Being ha scritto: > > I've got this example from the Internet > > > > import Data.List > > import Data.Maybe > > > > firstFactorOf x > > | m == Nothing = x > > | otherwise = fromJust m > > where m =(find p [2..x-1]) > > p y = mod x y == 0 > > > > -- myIndex :: [a] -> Int -> Maybe a > > myIndex [] _ = Nothing > > myIndex (x:xs) 0 = Just x > > myIndex (x:xs) n = myIndex xs (n-1) > > > > I would like the Just x in the second block to actually be fromJust x as > in > > the first block, i.e., I want a number returned, not a Just typed object. > > I've tried changing Just x to fromJust x but get the error when I try to > > use it > > What would happen in the `Nothing` case? If an error is fine with you: > > myUnsafeIndex :: [a] -> Int -> a > myUnsafeIndex as n = > case myIndex as n of > Nothing -> error "Chiare, fresche et dolci acque" > -- or maybe return -1? Idk > Just r -> r > > What have you written instead > > > Also, my type declaration seems to be wrong too, but I don't see why. > > It compiles fine here, even if I remove the comment from `myIndex` > signature > —F > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Fri Mar 12 16:19:16 2021 From: borgauf at gmail.com (Galaxy Being) Date: Fri, 12 Mar 2021 10:19:16 -0600 Subject: [Haskell-beginners] Recursion with a self-defined type Message-ID: I'm trying to translate *The Little MLer *into Haskell. I've got this data Shishkebab = Skewer | Onion Shishkebab | Lamb Shishkebab | Tomato Shishkebab deriving Show Then I have this which works veggieKebab :: Shishkebab -> Bool veggieKebab Skewer = True veggieKebab (Onion (shk)) = veggieKebab shk veggieKebab (Tomato (shk)) = veggieKebab shk veggieKebab (Lamb (shk)) = False > veggieKebab (Tomato (Onion (Tomato (Onion Skewer)))) True but I'm wondering if I could do something like this veggieKebab :: Shishkebab -> Bool veggieKebab Skewer = True veggieKebab (shkb (sk)) | (shkb == Onion) || (shkb == Tomato) = veggieKebab sk | otherwise = False This doesn't work, giving a "Parse error in pattern: shkb". I've been advised that I'm trying to treat what is a data constructor like a variable, but I can't fathom what that means in this case. What I'm trying to leverage is what I've learned from dealing with lists and recursion through the consed list. So if effect I'm trying to recurse through a consed Shishkebab object. It works in the first case, but hyow could I do this in this more generic way like the second try does? LB -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlow at ualberta.ca Sat Mar 13 00:27:21 2021 From: mlow at ualberta.ca (Matthew Low) Date: Fri, 12 Mar 2021 17:27:21 -0700 Subject: [Haskell-beginners] Recursion with a self-defined type In-Reply-To: References: Message-ID: Pattern matches in Haskell are based on matching specific data constructors, with underscores `_` as a "match anything" mechanism. So one way to achieve something like what you want is veggieKebab :: Shishkebab -> Bool veggieKebab Skewer = True veggieKebab (Onion (shk)) = veggieKebab shk veggieKebab (Tomato (shk)) = veggieKebab shk veggieKebab _ = False This works because the matches are considered in top-to-bottom order, so the last case only matches if all the others fail to. I'm not sure if it helps to build insight or not, but if you look at the the types of your data constructors in GHCI, you get, for example: λ> :t Onion Onion :: Shishkebab -> Shishkebab So even if you could pattern match as you wanted (veggieKebab (shkb (sk)) | (shkb == Onion)), you'd still be stuck with the problem of trying to compare two functions for equality, which isn't easy (and not something Haskell lets you do for arbitrary functions). You could get close to what you originally wrote by using a few more helper functions: startsWithOnion :: Shishkebab -> Bool startsWithOnion (Onion _) = True startsWithOnion _ = False startsWithTomato :: Shishkebab -> Bool startsWithTomato (Tomato _) = True startsWithTomato _ = False restOfKebab :: Shishkebab -> Shishkebab restOfKebab Skewer = Skewer restOfKebab (Onion rst) = rst restOfKebab (Tomato rst) = rst restOfKebab (Lamb rst) = rst veggieKebab :: Shishkebab -> Bool veggieKebab Skewer = True veggieKebab kebab | startsWithOnion kebab || startsWithTomato kebab = veggieKebab (restOfKebab kebab) | otherwise = False On Fri, Mar 12, 2021 at 9:19 AM Galaxy Being wrote: > I'm trying to translate *The Little MLer *into Haskell. I've got this > > data Shishkebab = Skewer | Onion Shishkebab | Lamb Shishkebab | Tomato > Shishkebab deriving Show > > Then I have this which works > > veggieKebab :: Shishkebab -> Bool > veggieKebab Skewer = True > veggieKebab (Onion (shk)) = veggieKebab shk > veggieKebab (Tomato (shk)) = veggieKebab shk > veggieKebab (Lamb (shk)) = False > > > veggieKebab (Tomato (Onion (Tomato (Onion Skewer)))) > True > > but I'm wondering if I could do something like this > > veggieKebab :: Shishkebab -> Bool > veggieKebab Skewer = True > veggieKebab (shkb (sk)) | (shkb == Onion) || (shkb == Tomato) = > veggieKebab sk > | otherwise = False > > > This doesn't work, giving a "Parse error in pattern: shkb". I've been > advised that I'm trying to treat what is a data constructor like a > variable, but I can't fathom what that means in this case. What I'm trying > to leverage is what I've learned from dealing with lists and recursion > through the consed list. So if effect I'm trying to recurse through a > consed Shishkebab object. It works in the first case, but hyow could I do > this in this more generic way like the second try does? > > LB > > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Sat Mar 13 04:24:44 2021 From: borgauf at gmail.com (Galaxy Being) Date: Fri, 12 Mar 2021 22:24:44 -0600 Subject: [Haskell-beginners] Recursion with a self-defined type In-Reply-To: References: Message-ID: So because Onion Shishkebab in the type definition is technically a data constructor *function, *the (shkb == Onion) in the code is comparing function-to-function, i.e., won't work. Thanks. The light finally went on. On Fri, Mar 12, 2021 at 6:28 PM Matthew Low wrote: > Pattern matches in Haskell are based on matching specific data > constructors, with underscores `_` as a "match anything" mechanism. So one > way to achieve something like what you want is > > veggieKebab :: Shishkebab -> Bool > veggieKebab Skewer = True > veggieKebab (Onion (shk)) = veggieKebab shk > veggieKebab (Tomato (shk)) = veggieKebab shk > veggieKebab _ = False > > This works because the matches are considered in top-to-bottom order, so > the last case only matches if all the others fail to. > > I'm not sure if it helps to build insight or not, but if you look at the > the types of your data constructors in GHCI, you get, for example: > > λ> :t Onion > Onion :: Shishkebab -> Shishkebab > > So even if you could pattern match as you wanted (veggieKebab (shkb (sk)) > | (shkb == Onion)), you'd still be stuck with the problem of trying to > compare two functions for equality, which isn't easy (and not something > Haskell lets you do for arbitrary functions). You could get close to what > you originally wrote by using a few more helper functions: > > startsWithOnion :: Shishkebab -> Bool > startsWithOnion (Onion _) = True > startsWithOnion _ = False > > startsWithTomato :: Shishkebab -> Bool > startsWithTomato (Tomato _) = True > startsWithTomato _ = False > > restOfKebab :: Shishkebab -> Shishkebab > restOfKebab Skewer = Skewer > restOfKebab (Onion rst) = rst > restOfKebab (Tomato rst) = rst > restOfKebab (Lamb rst) = rst > > veggieKebab :: Shishkebab -> Bool > veggieKebab Skewer = True > veggieKebab kebab | startsWithOnion kebab || startsWithTomato kebab = > veggieKebab (restOfKebab kebab) > | otherwise = False > > > > On Fri, Mar 12, 2021 at 9:19 AM Galaxy Being wrote: > >> I'm trying to translate *The Little MLer *into Haskell. I've got this >> >> data Shishkebab = Skewer | Onion Shishkebab | Lamb Shishkebab | Tomato >> Shishkebab deriving Show >> >> Then I have this which works >> >> veggieKebab :: Shishkebab -> Bool >> veggieKebab Skewer = True >> veggieKebab (Onion (shk)) = veggieKebab shk >> veggieKebab (Tomato (shk)) = veggieKebab shk >> veggieKebab (Lamb (shk)) = False >> >> > veggieKebab (Tomato (Onion (Tomato (Onion Skewer)))) >> True >> >> but I'm wondering if I could do something like this >> >> veggieKebab :: Shishkebab -> Bool >> veggieKebab Skewer = True >> veggieKebab (shkb (sk)) | (shkb == Onion) || (shkb == Tomato) = >> veggieKebab sk >> | otherwise = False >> >> >> This doesn't work, giving a "Parse error in pattern: shkb". I've been >> advised that I'm trying to treat what is a data constructor like a >> variable, but I can't fathom what that means in this case. What I'm trying >> to leverage is what I've learned from dealing with lists and recursion >> through the consed list. So if effect I'm trying to recurse through a >> consed Shishkebab object. It works in the first case, but hyow could I do >> this in this more generic way like the second try does? >> >> LB >> >> >> >> >> >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Sat Mar 13 06:18:26 2021 From: borgauf at gmail.com (Galaxy Being) Date: Sat, 13 Mar 2021 00:18:26 -0600 Subject: [Haskell-beginners] Type * and * -> * Message-ID: I found this interesting page at Wiki Haskell. Confusing, however, is how it first establishes data Peano = Zero | Succ Peano It says Here Zero and Succ are values (constructors). Zero has type Peano, and Succ has type Peano -> Peano. but then it breaks down each member further a few lines later data Zero data Succ a and then says Zero has kind *, and Succ has kind * -> *. The natural numbers are represented by types (of kind *) Zero, Succ Zero, Succ (Succ Zero) etc. Why is it giving two separate treatments and what is meant by the * and * -> * ? There's something fundamental I'm missing. If anyone knows of a really thorough and definitive *and *understandable treatment of Haskell types, I'd appreciate it. LB -------------- next part -------------- An HTML attachment was scrubbed... URL: From bob at redivi.com Sat Mar 13 06:52:13 2021 From: bob at redivi.com (Bob Ippolito) Date: Fri, 12 Mar 2021 22:52:13 -0800 Subject: [Haskell-beginners] Type * and * -> * In-Reply-To: References: Message-ID: The first definition is only used as an analogy, it’s a way to represent Peano numbers as values. The second definition is only related to the first in that it uses the same concept. It is not a breakdown of the first one, it is a completely separate (and incompatible) way to represent Peano numbers at the type level (and only as types, notice there are no constructors). You can not define both of these in the same module with the same names. In Haskell a kind is (basically) the type of a type. In modern GHC to make it even more clear (and to free up * for type operators) you can say Type instead of *. Zero has the kind Type (or *) because it has no arguments, just like Zero has the type Peano because the constructor has no arguments. Succ has the kind Type -> Type because you pass it a Type as an argument to get a concrete Type. Maybe also has the kind Type -> Type, as does []. Generally, beginner Haskell doesn’t use any of this type level programming. If this is a topic of interest, I recommend this book: https://thinkingwithtypes.com On Fri, Mar 12, 2021 at 22:19 Galaxy Being wrote: > I found this interesting page at > Wiki Haskell. Confusing, however, is how it first establishes > > data Peano = Zero | Succ Peano > > It says > > Here Zero and Succ are values (constructors). Zero has type Peano, > and Succ has type Peano -> Peano. > > but then it breaks down each member further a few lines later > > data Zero > data Succ a > > and then says > > Zero has kind *, and Succ has kind * -> *. The natural numbers are > represented by types (of kind *) Zero, Succ Zero, Succ (Succ Zero) etc. > > Why is it giving two separate treatments and what is meant by the * and * > -> * ? There's something fundamental I'm missing. > > If anyone knows of a really thorough and definitive *and *understandable > treatment of Haskell types, I'd appreciate it. > > LB > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlow at ualberta.ca Sat Mar 13 06:53:19 2021 From: mlow at ualberta.ca (Matthew Low) Date: Fri, 12 Mar 2021 23:53:19 -0700 Subject: [Haskell-beginners] Type * and * -> * In-Reply-To: References: Message-ID: I can only answer some of your questions. To start, perhaps an analogy would help: Kinds are to types as types are to values. So in regards to the title of the thread, "Type * and * -> *" is confused in that * and * -> * are kinds, not types. That might not exactly make sense, but leaving it aside for the moment, to two treatments are at different levels - data and type level. I'll try to be explicit as to what are type constructors and what are data constructors by appending T to the type constructors: data PeanoT = Zero | Succ PeanoT In the first treatment, we define a type PeanoT. This is the type you would use in function signatures, etc. At the term / values level, we can construct values of type PeanoT through either the 'Zero' or 'Succ' data constructors. The second treatment encodes the Peano numbers at the type level, not value level - note that both lines are type constructors (both lacking corresponding data constructors): data ZeroT data SuccT a I'm a little bit at my limit of type level programming in haskell, so I'm not 100% sure about this, but in the second treatment, without any data constructors, I don't think there is any way to actually construct a run-time value with either of these types. You can only use them at the type level. Back to the analogy: In the first treatment, we can construct values of type PeanoT through either `Zero :: PeanoT` or `Succ :: PeanoT -> PeanoT`, data constructors of the given type. In the second treatment, we have two types. But similar to how we have to provide a value of type PeanoT to Succ to create the final PeanoT type, we have to provide a *type* to SuccT to get a concrete type. Now while there are a great many types, I believe at the kind level we only really care if we have a concrete type ('ZeroT, of kind *), or a type constructor that needs to be applied to concrete type to actually construct the type (kind * -> *). For example, data K3T a b has kind * -> * -> * (you have to provide two concrete types for 'a' and 'b' to get out a concrete type). I don't have any good references for formal type theory stuff, but I found https://haskellbook.com/ to be the resource that got me over the various failed attempts at learning haskell. It stops a bit short of type level programming, but does a good job distinguishing between data constructors and type constructors, and makes the analogy for how kinds arise when you take that 'one level up'. Also its not free. On Fri, Mar 12, 2021 at 11:18 PM Galaxy Being wrote: > I found this interesting page at > Wiki Haskell. Confusing, however, is how it first establishes > > data Peano = Zero | Succ Peano > > It says > > Here Zero and Succ are values (constructors). Zero has type Peano, > and Succ has type Peano -> Peano. > > but then it breaks down each member further a few lines later > > data Zero > data Succ a > > and then says > > Zero has kind *, and Succ has kind * -> *. The natural numbers are > represented by types (of kind *) Zero, Succ Zero, Succ (Succ Zero) etc. > > Why is it giving two separate treatments and what is meant by the * and * > -> * ? There's something fundamental I'm missing. > > If anyone knows of a really thorough and definitive *and *understandable > treatment of Haskell types, I'd appreciate it. > > LB > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From mlow at ualberta.ca Sat Mar 13 07:58:21 2021 From: mlow at ualberta.ca (Matthew Low) Date: Sat, 13 Mar 2021 00:58:21 -0700 Subject: [Haskell-beginners] Type * and * -> * In-Reply-To: References: Message-ID: Thanks for the book recommendation! On Fri, Mar 12, 2021 at 11:52 PM Bob Ippolito wrote: > The first definition is only used as an analogy, it’s a way to represent > Peano numbers as values. > > The second definition is only related to the first in that it uses the > same concept. It is not a breakdown of the first one, it is a completely > separate (and incompatible) way to represent Peano numbers at the type > level (and only as types, notice there are no constructors). You can not > define both of these in the same module with the same names. > > In Haskell a kind is (basically) the type of a type. In modern GHC to make > it even more clear (and to free up * for type operators) you can say Type > instead of *. > > Zero has the kind Type (or *) because it has no arguments, just like Zero > has the type Peano because the constructor has no arguments. > > Succ has the kind Type -> Type because you pass it a Type as an argument > to get a concrete Type. Maybe also has the kind Type -> Type, as does []. > > Generally, beginner Haskell doesn’t use any of this type level > programming. If this is a topic of interest, I recommend this book: > https://thinkingwithtypes.com > > On Fri, Mar 12, 2021 at 22:19 Galaxy Being wrote: > >> I found this interesting page >> at Wiki Haskell. Confusing, however, is how it first establishes >> >> data Peano = Zero | Succ Peano >> >> It says >> >> Here Zero and Succ are values (constructors). Zero has type Peano, >> and Succ has type Peano -> Peano. >> >> but then it breaks down each member further a few lines later >> >> data Zero >> data Succ a >> >> and then says >> >> Zero has kind *, and Succ has kind * -> *. The natural numbers are >> represented by types (of kind *) Zero, Succ Zero, Succ (Succ Zero) etc. >> >> Why is it giving two separate treatments and what is meant by the * and * >> -> * ? There's something fundamental I'm missing. >> >> If anyone knows of a really thorough and definitive *and *understandable >> treatment of Haskell types, I'd appreciate it. >> >> LB >> _______________________________________________ >> Beginners mailing list >> Beginners at haskell.org >> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners >> > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From erik.dominikus71 at gmail.com Sun Mar 14 10:41:45 2021 From: erik.dominikus71 at gmail.com (Erik Dominikus) Date: Sun, 14 Mar 2021 17:41:45 +0700 Subject: [Haskell-beginners] Type * and * -> * In-Reply-To: References: Message-ID: > There's something fundamental I'm missing. It is not necessarily true, but useful, to think that: - A *type is* a set of values. - A *kind* as a set of types. - The *kind* * is the set of all types. - The *kind* * -> * is the set of every function with domain * and codomain *. - The *type* T -> U is the set of every function with domain T and codomain U, if each of T and U is a type (a set of values). For example: - The type *Bool* is the set {False, True}. - The type *Maybe Bool* is the set {Nothing, Just False, Just True}. - *Maybe* is a function such that Maybe(T) = { Nothing } union { Just t | t in T }. - *Maybe* is not a type; *Maybe Bool* is a type. - *a -> a* is the set { \ x -> x }. Currying and application can happen at both the value level and the type level: - The kind of *Either* is ** -> * -> **. - The kind of *Either a* is ** -> **, if the kind of *a* is ***. - The kind of *Either a b* is ***, if the kind of *a* is *** and the kind of *b* is ***. - The type of *Just* is *a -> Maybe a*. - The type of *Just x* is *Maybe a*, if the type of *x* is *a*. > Why is it giving two separate treatments? It is to show the various ways one *can* implement/represent/realize/concretize/encode/model a mathematical construction in Haskell. You *can* (do type-level programming in Haskell, use all features of C++, eat spaghetti with a straw, etc.), but the real question has always been: *should* you? > If anyone knows of a really thorough and definitive *and *understandable treatment of Haskell types, I'd appreciate it. If you mean Haskell 98, then the Haskell 98 Report [1] (especially Chapter 4) seems "thorough and definitive", but I don't know whether you will find it "understandable". If you mean the latest Haskell as implemented by GHC, I don't know. [1] https://www.haskell.org/onlinereport/ -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Tue Mar 16 19:12:06 2021 From: borgauf at gmail.com (Galaxy Being) Date: Tue, 16 Mar 2021 14:12:06 -0500 Subject: [Haskell-beginners] Type * and * -> * In-Reply-To: References: Message-ID: This is great stuff. I thank everybody. On Sun, Mar 14, 2021 at 5:42 AM Erik Dominikus wrote: > > There's something fundamental I'm missing. > > It is not necessarily true, but useful, to think that: > > - A *type is* a set of values. > - A *kind* as a set of types. > - The *kind* * is the set of all types. > - The *kind* * -> * is the set of every function with domain * and > codomain *. > - The *type* T -> U is the set of every function with domain T and > codomain U, if each of T and U is a type (a set of values). > > For example: > > - The type *Bool* is the set {False, True}. > - The type *Maybe Bool* is the set {Nothing, Just False, Just True}. > - *Maybe* is a function such that Maybe(T) = { Nothing } union { Just t | > t in T }. > - *Maybe* is not a type; *Maybe Bool* is a type. > - *a -> a* is the set { \ x -> x }. > > Currying and application can happen at both the value level and the type > level: > > - The kind of *Either* is ** -> * -> **. > - The kind of *Either a* is ** -> **, if the kind of *a* is ***. > - The kind of *Either a b* is ***, if the kind of *a* is *** and the kind > of *b* is ***. > - The type of *Just* is *a -> Maybe a*. > - The type of *Just x* is *Maybe a*, if the type of *x* is *a*. > > > Why is it giving two separate treatments? > > It is to show the various ways one *can* implement/represent/realize/concretize/encode/model > a mathematical construction in Haskell. > > You *can* (do type-level programming in Haskell, use all features of C++, > eat spaghetti with a straw, etc.), but the real question has always been: > *should* you? > > > If anyone knows of a really thorough and definitive *and *understandable > treatment of Haskell types, I'd appreciate it. > > If you mean Haskell 98, then the Haskell 98 Report [1] (especially Chapter > 4) seems "thorough and definitive", but I don't know whether you will find > it "understandable". > > If you mean the latest Haskell as implemented by GHC, I don't know. > > [1] https://www.haskell.org/onlinereport/ > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Tue Mar 16 19:34:26 2021 From: borgauf at gmail.com (Galaxy Being) Date: Tue, 16 Mar 2021 14:34:26 -0500 Subject: [Haskell-beginners] Product/tuple type vs. ... Message-ID: Reading this I'm a bit confused but think I understand what is meant by a *product *or *tuple *type constructor such as data Point a b = Pt a b Because Point has no "logical or," (|) of more than one possible value set such as data Color = Red | Green | Blue it is automatically a tuple type? Also, it has no possible "consing" -- does that play a role? data Things a = T1 a (Things a) | T2 a (Things a) | LastT a Things is also parameterized just like Point, but, again, Things is not a tuple type for the reasons above, e.g., just having one parameterized constructor means automatically a tuple type, right? LB -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Fri Mar 26 17:20:55 2021 From: borgauf at gmail.com (Galaxy Being) Date: Fri, 26 Mar 2021 12:20:55 -0500 Subject: [Haskell-beginners] How to include {-# LANGUAGE LambdaCase #-} at the ghci prompt Message-ID: I've got this code I've entered into the ghci by hand between :{ and :} :{ {-# LANGUAGE LambdaCase #-} data List a = Empty | Cons a (List a) deriving (Eq, Ord, Show) infixr 5 `Cons` subst_c :: (a -> Bool) -> (a, MyList a) -> MyList a subst_c pred = \ case (_, Empty) -> Empty (n, Cons e t) | pred e -> Cons n $ subst_c pred (n, t) | otherwise -> Cons e $ subst_c pred (n, t) :} but I keep getting the error Illegal lambda-case (use -XLambdaCase) This works fine inside an .hs file and :load and run at the prompt. However, I'm using Emacs org-mode and need to keep everything limited to a version of hand-entered :{ ... :}. Any suggestions? LB -------------- next part -------------- An HTML attachment was scrubbed... URL: From fa-ml at ariis.it Fri Mar 26 17:31:53 2021 From: fa-ml at ariis.it (Francesco Ariis) Date: Fri, 26 Mar 2021 18:31:53 +0100 Subject: [Haskell-beginners] How to include {-# LANGUAGE LambdaCase #-} at the ghci prompt In-Reply-To: References: Message-ID: <20210326173152.GA9876@extensa> Il 26 marzo 2021 alle 12:20 Galaxy Being ha scritto: > I've got this code I've entered into the ghci by hand between :{ and :} > > :{ > {-# LANGUAGE LambdaCase #-} > data List a = Empty | Cons a (List a) deriving (Eq, Ord, Show) > infixr 5 `Cons` > > subst_c :: (a -> Bool) -> (a, MyList a) -> MyList a > subst_c pred = \ case > (_, Empty) -> Empty > (n, Cons e t) > | pred e -> Cons n $ subst_c pred (n, t) > | otherwise -> Cons e $ subst_c pred (n, t) > :} > λ> :set -XLambdaCase From borgauf at gmail.com Fri Mar 26 21:17:19 2021 From: borgauf at gmail.com (Galaxy Being) Date: Fri, 26 Mar 2021 16:17:19 -0500 Subject: [Haskell-beginners] How to include {-# LANGUAGE LambdaCase #-} at the ghci prompt In-Reply-To: <20210326173152.GA9876@extensa> References: <20210326173152.GA9876@extensa> Message-ID: Exactly. Thanks. On Fri, Mar 26, 2021 at 12:33 PM Francesco Ariis wrote: > Il 26 marzo 2021 alle 12:20 Galaxy Being ha scritto: > > I've got this code I've entered into the ghci by hand between :{ and :} > > > > :{ > > {-# LANGUAGE LambdaCase #-} > > data List a = Empty | Cons a (List a) deriving (Eq, Ord, Show) > > infixr 5 `Cons` > > > > subst_c :: (a -> Bool) -> (a, MyList a) -> MyList a > > subst_c pred = \ case > > (_, Empty) -> Empty > > (n, Cons e t) > > | pred e -> Cons n $ subst_c pred (n, t) > > | otherwise -> Cons e $ subst_c pred (n, t) > > :} > > > > λ> :set -XLambdaCase > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > -------------- next part -------------- An HTML attachment was scrubbed... URL: From borgauf at gmail.com Fri Mar 26 21:32:01 2021 From: borgauf at gmail.com (Galaxy Being) Date: Fri, 26 Mar 2021 16:32:01 -0500 Subject: [Haskell-beginners] Closure: exact wording Message-ID: I've got this addTwo x y = x + y aT5 = addTwo 5 > aT5 3 8 Is it right to say aT5 is a closure over 5, or a closure over addTwo 5? LB -------------- next part -------------- An HTML attachment was scrubbed... URL: From amindfv at mailbox.org Sat Mar 27 19:52:35 2021 From: amindfv at mailbox.org (amindfv at mailbox.org) Date: Sat, 27 Mar 2021 13:52:35 -0600 Subject: [Haskell-beginners] How to include {-# LANGUAGE LambdaCase #-} at the ghci prompt In-Reply-To: <20210326173152.GA9876@extensa> References: <20210326173152.GA9876@extensa> Message-ID: <20210327195235.GA21057@painter.painter> On Fri, Mar 26, 2021 at 06:31:53PM +0100, Francesco Ariis wrote: > Il 26 marzo 2021 alle 12:20 Galaxy Being ha scritto: > > I've got this code I've entered into the ghci by hand between :{ and :} > > > > :{ > > {-# LANGUAGE LambdaCase #-} > > data List a = Empty | Cons a (List a) deriving (Eq, Ord, Show) > > infixr 5 `Cons` > > > > subst_c :: (a -> Bool) -> (a, MyList a) -> MyList a > > subst_c pred = \ case > > (_, Empty) -> Empty > > (n, Cons e t) > > | pred e -> Cons n $ subst_c pred (n, t) > > | otherwise -> Cons e $ subst_c pred (n, t) > > :} > > > > λ> :set -XLambdaCase You can also start GHCi with it: $ ghci -XLambdaCase Tom From vitaly.dolgov at posteo.net Mon Mar 29 10:18:49 2021 From: vitaly.dolgov at posteo.net (Vitaly Dolgov) Date: Mon, 29 Mar 2021 13:18:49 +0300 Subject: [Haskell-beginners] Problem with Graphics.SOE Message-ID: <20210329131849.75725a7b@yoga> Hi, everybody! I'm trying to do an example from the book "The Haskell School of Expression", which originally uses `SOEGraphics`, I use `Graphics.SOE` instead, but I get the following error on each run: `user error (loadQueryFont)` I have no idea how to approach the problem... `:trace` outputs an empty exception :( Could you please help me to solve this? My environment is: Linux, ghc 8.10.4, HGL 3.2.3.2 The code is quite basic: ``` import Graphics.SOE main = runGraphics $ do w <- openWindow "Hello World!" (300, 300) drawInWindow w (text (100, 200) "Hello World!") k <- getKey w closeWindow w ``` Thank you, Vitaly From hallgren at chalmers.se Mon Mar 29 12:32:38 2021 From: hallgren at chalmers.se (Thomas Hallgren) Date: Mon, 29 Mar 2021 14:32:38 +0200 Subject: [Haskell-beginners] Problem with Graphics.SOE In-Reply-To: <20210329131849.75725a7b@yoga> References: <20210329131849.75725a7b@yoga> Message-ID: Hi, I did a quick grep in the HGL source code, and it looks like it is trying to use a font called "9x15", which is one of the traditional X Windows fonts, and they are not always installed by default on modern Linux systems. You can see which X fonts are installed by running the xlsfonts command. In Ubuntu / Debian, the "9x15" font is included in a package called xfonts-base, which is installed by default however, so my best guess is that you are using another flavour of Linux where you need to install some additional font package to get that font... Hope this helps, Thomas H On 2021-03-29 12:18, Vitaly Dolgov wrote: > Hi, everybody! > > I'm trying to do an example from the book "The Haskell > School of Expression", which originally uses `SOEGraphics`, I use > `Graphics.SOE` instead, but I get the following error on each run: > > `user error (loadQueryFont)` > > I have no idea how to approach the problem... `:trace` outputs an empty > exception :( Could you please help me to solve this? > > My environment is: Linux, ghc 8.10.4, HGL 3.2.3.2 > The code is quite basic: > > ``` > import Graphics.SOE > > main > = runGraphics $ > do w <- openWindow "Hello World!" (300, 300) > drawInWindow w (text (100, 200) "Hello World!") > k <- getKey w > closeWindow w > ``` > > Thank you, > Vitaly > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > From vitaly.dolgov at posteo.net Mon Mar 29 16:10:05 2021 From: vitaly.dolgov at posteo.net (Vitaly Dolgov) Date: Mon, 29 Mar 2021 19:10:05 +0300 Subject: [Haskell-beginners] Problem with Graphics.SOE In-Reply-To: References: <20210329131849.75725a7b@yoga> Message-ID: <20210329191005.0dccb015@yoga> Thanks, Thomas! This was exactly the case. In Fedora the package is `xorg-x11-fonts-misc`. Vitaly On Mon, 29 Mar 2021 14:32:38 +0200 Thomas Hallgren wrote: > Hi, > > I did a quick grep in the HGL source code, and it looks like it is > trying to use a font called "9x15", which is one of the traditional X > Windows fonts, and they are not always installed by default on modern > Linux systems. You can see which X fonts are installed by running the > xlsfonts command. In Ubuntu / Debian, the "9x15" font is included in > a package called xfonts-base, which is installed by default however, > so my best guess is that you are using another flavour of Linux where > you need to install some additional font package to get that font... > > Hope this helps, > Thomas H > > On 2021-03-29 12:18, Vitaly Dolgov wrote: > > Hi, everybody! > > > > I'm trying to do an example from the book "The Haskell > > School of Expression", which originally uses `SOEGraphics`, I use > > `Graphics.SOE` instead, but I get the following error on each run: > > > > `user error (loadQueryFont)` > > > > I have no idea how to approach the problem... `:trace` outputs an > > empty exception :( Could you please help me to solve this? > > > > My environment is: Linux, ghc 8.10.4, HGL 3.2.3.2 > > The code is quite basic: > > > > ``` > > import Graphics.SOE > > > > main > > = runGraphics $ > > do w <- openWindow "Hello World!" (300, 300) > > drawInWindow w (text (100, 200) "Hello World!") > > k <- getKey w > > closeWindow w > > ``` > > > > Thank you, > > Vitaly > > _______________________________________________ > > Beginners mailing list > > Beginners at haskell.org > > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners > > > > > _______________________________________________ > Beginners mailing list > Beginners at haskell.org > http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners