In Search Of a clue... (Defining and making use of a type)

So, I'm approaching a problem which I think I understand pretty well. I'm a novice to Haskell, though, and I'm having difficulty even getting started with e.g. data types and building more complex structures. Here's what I'm trying to do; this is an xmonad customization/extension. My end goal is thus: Innermost: a 'Screen Tuple' , which I'm calling a 'ScrUple'. This represents a statement like 'screen 0 is displaying workspace "mail"'. Next: A variable-length list of these, I'm calling 'ScrConfig'. It means something like 'display this workspace on screen 0, that one on 1, etc'. Next: [ haven't gotten here ] a hash, or something: pairs of 'label : ScrConfig'. I don't know if the most haskelly way to do that is to build another type, and then another aggregate of that type.. In PERL, it'd be something vaguely like: $configs = { 'initial' => { \(0,"mail"), \(1,"web"), \(2,"jabber") } 'project' => { \(4,"editor"), \(1,"compile"), \(2,"jabber") } }; Here's what I'm doing so far, ---------------- data ScrUple = ScrUple { xineramascreen :: Integer , workspace :: String } deriving (Show) data ScrConfig = ScrConfig [ ScrUple ] deriving (Show) s1 = ScrUple 0 "mail" s2 = ScrUple 1 "web" ScrConfig sc1 =ScrConfig( [s2 s1] ) ; main = putStrLn $ show sc1[1] ------------------ and I get errors like: play.hs:17:27: Couldn't match expected type `ScrUple -> ScrUple' against inferred type `ScrUple' In the expression: s2 s1 In the first argument of `ScrConfig', namely `([s2 s1])' In the expression: ScrConfig ([s2 s1]) play.hs:21:19: Couldn't match expected type `[t] -> String' against inferred type `String' In the second argument of `($)', namely `show sc1 [1]' In the expression: putStrLn $ show sc1 [1] In the definition of `main': main = putStrLn $ show sc1 [1] ------------------- ... I feel like I'm thinking about the problem wrong, because this kind of "Here's how you build up a data structure" doesn't seem to be in the tutorials. I've been working through LYAH and Gentle Introduction, but so far haven't found things that feel related. I'd be delighted with pointers to the right parts of the Fine Manual, and similarly pleased with discursion on how to think about this data storage problem from a haskelly point of view. - Allen S. Rout

Your main problem and the only reason I can see why what you have
wouldn't work is that you have created a list of ScrUple's, but then
you tried to access it with [1] notation, which works in like every
other language, but not haskell. That notation is for creating a
list, so when you type [1] that is basically of type Integral n =>
[n], so ghc has no clue what you are trying to do and blows up. The
way to access by index is to use the !! operator. You will have to
import Data.List to get that.
main = putStrLn $ show $ sc1 !! 1
should work. Just keep in mind that it is unsafe in that
On Mon, Dec 12, 2011 at 4:31 PM, Allen S. Rout
So, I'm approaching a problem which I think I understand pretty well. I'm a novice to Haskell, though, and I'm having difficulty even getting started with e.g. data types and building more complex structures.
Here's what I'm trying to do; this is an xmonad customization/extension.
My end goal is thus:
Innermost: a 'Screen Tuple' , which I'm calling a 'ScrUple'. This represents a statement like 'screen 0 is displaying workspace "mail"'.
Next: A variable-length list of these, I'm calling 'ScrConfig'. It means something like 'display this workspace on screen 0, that one on 1, etc'.
Next: [ haven't gotten here ] a hash, or something: pairs of 'label : ScrConfig'. I don't know if the most haskelly way to do that is to build another type, and then another aggregate of that type..
In PERL, it'd be something vaguely like:
$configs = { 'initial' => { \(0,"mail"), \(1,"web"), \(2,"jabber") }
'project' => { \(4,"editor"), \(1,"compile"), \(2,"jabber") }
};
Here's what I'm doing so far,
----------------
data ScrUple = ScrUple { xineramascreen :: Integer , workspace :: String } deriving (Show)
data ScrConfig = ScrConfig [ ScrUple ] deriving (Show)
s1 = ScrUple 0 "mail" s2 = ScrUple 1 "web"
ScrConfig sc1 =ScrConfig( [s2 s1] ) ;
main = putStrLn $ show sc1[1]
------------------
and I get errors like:
play.hs:17:27: Couldn't match expected type `ScrUple -> ScrUple' against inferred type `ScrUple' In the expression: s2 s1 In the first argument of `ScrConfig', namely `([s2 s1])' In the expression: ScrConfig ([s2 s1])
play.hs:21:19: Couldn't match expected type `[t] -> String' against inferred type `String' In the second argument of `($)', namely `show sc1 [1]' In the expression: putStrLn $ show sc1 [1] In the definition of `main': main = putStrLn $ show sc1 [1]
-------------------
... I feel like I'm thinking about the problem wrong, because this kind of "Here's how you build up a data structure" doesn't seem to be in the tutorials. I've been working through LYAH and Gentle Introduction, but so far haven't found things that feel related.
I'd be delighted with pointers to the right parts of the Fine Manual, and similarly pleased with discursion on how to think about this data storage problem from a haskelly point of view.
- Allen S. Rout
_______________________________________________ Beginners mailing list Beginners@haskell.org http://www.haskell.org/mailman/listinfo/beginners

Hi Allen,
Here's what I'm doing so far,
----------------
data ScrUple = ScrUple { xineramascreen :: Integer , workspace :: String } deriving (Show)
data ScrConfig = ScrConfig [ ScrUple ] deriving (Show)
s1 = ScrUple 0 "mail" s2 = ScrUple 1 "web"
ScrConfig sc1 =ScrConfig( [s2 s1] ) ;
sc1 = ScrConfig [s2, s1]
main = putStrLn $ show sc1[1]
main = putStrLn $ show sc1 To print just parts of a ScrConfig you'll probably want a helper function. Maybe something like: scPrint (ScrConfig sus) nth = show (sus !! nth) (it will make problems on out-of-bounds-indexes!) HTH, Thomas

On Mon, Dec 12, 2011 at 04:31:02PM -0500, Allen S. Rout wrote:
----------------
data ScrUple = ScrUple { xineramascreen :: Integer , workspace :: String } deriving (Show)
data ScrConfig = ScrConfig [ ScrUple ] deriving (Show)
s1 = ScrUple 0 "mail" s2 = ScrUple 1 "web"
ScrConfig sc1 =ScrConfig( [s2 s1] ) ;
main = putStrLn $ show sc1[1]
Looks OK so far except for the problems of syntax already pointed out by others. Proceeding from this point, to build an association between labels and ScrConfigs, you would use Data.Map. Something like this: import qualified Data.Map as M type ScrConfigs = M.Map String ScrConfig myScrConfigs :: ScrConfigs myScrConfigs = M.fromList [ ("initial", [ ScrUple 0 "mail" , ScrUple 1 "web" , ScrUple 2 "jabber" ] ) , ("project", [ ScrUple 0 "editor" , ScrUple 1 "compile" , ScrUple 2 "jabber ] ) ] However, I should point out that this is essentially already implemented in XMonad.Actions.DynamicWorkspaceGroups. It may not currently do exactly what you want -- for example, there's currently no function provided to initialize the list of workspace configs. But it should not be too hard to add. I'd be happy to help walk you through the code or help you figure out how to add the features you want. -Brent

Hello, If you define your constructor like this:
data ScrConfig = ScrConfig [ ScrUple ] deriving (Show)
it means that you need to give a list to the data constructor ScrConfig. It will then return the type ScrConfig, which is what you want. In GHCi: Main*>:t ScrConfig ScrConfig :: [ScrUple] -> ScrConfig This means that you do not have to declare sc1 as type ScrConfig, it is inferred by the compiler. So the declaration :
ScrConfig sc1 =ScrConfig( [s2 s1] ) ;
should be: sc1 =ScrConfig( [s2 s1] ) ; The second point is that you do not give a list to ScrConfig, as list elements are separated with a comma in Haskell: [s2, s1]. So sc1 becomes: sc1 =ScrConfig( [s2, s1] ) ; and this will fix your first error. By the way, you do not need to add parens around the list, nor a semicolon at the end of the line. They do no harm here, but I find it clearer without. So I would write sc1 like this: sc1 = ScrConfig [s2, s1] Hope that helps, Adrien
participants (5)
-
Adrien Haxaire
-
Allen S. Rout
-
Brent Yorgey
-
David McBride
-
Thomas