
I am new to Haskell---and also to languages with the off-side rule--and working my way through Hal Daume's tutorial. I'm a little confused by the support for code layout in Emacs' haskell-mode. Is it buggy, or am I doing something wrong. For example, here's the "Hello, world" example from the tutorial, with the indentation induced by pounding Tab in haskell-mode. test.hs: module Test where import IO main = do putStrLn "Hello, world" Prelude> :l test [1 of 1] Compiling Test ( test.hs, interpreted ) test.hs:12:0: parse error on input `main' In emacs, every line but the one with "where" reports "Sole indentation". With "where", I have the option of having it flush left or indented four spaces; "import" wants to be two spaces in from "where". Moving where doesn't change the error. But if I manually move import flush left (which is the way it's shown in the tutorial, BTW): module Test where import IO main = do putStrLn "Hello, world" Prelude> :l test [1 of 1] Compiling Test ( test.hs, interpreted ) Ok, modules loaded: Test. I have a similar problem with the layout of if-then-else... num.hs: module Num where import IO main = do putStrLn "Enter a number: " inp <- getLine let n = read inp if n == 0 then putStrLn "Zero" else putStrLn "NotZero" Prelude> :l num [1 of 1] Compiling Num ( num.hs, interpreted ) num.hs:11:2: parse error (possibly incorrect indentation) Again, if I hit tab on the "then" or "else" lines, emacs reports "Sole indentation". But if I manually change the indentation, it works. module Num where import IO main = do putStrLn "Enter a number: " inp <- getLine let n = read inp if n == 0 then putStrLn "Zero" else putStrLn "NotZero" Prelude> :l num [1 of 1] Compiling Num ( num.hs, interpreted ) Ok, modules loaded: Num. This is particularly weird because if-then-else doesn't always act this way: exp.hs: module Exp where my_exponent a n = if n == 0 then 1 else a * my_exponent a (n-1) Prelude> :l exp [1 of 1] Compiling Exp ( exp.hs, interpreted ) Ok, modules loaded: Exp. I suppose this might have something to do with the do-notation... Does haskell-mode support code layout? Are there conventions I need to know about to make it behave properly? I have haskell-mode version 2.1-1 installed from the Ubuntu feisty repository. Thanks, Chris

Hi Christopher,
I have also noticed that haskell-mode (and indeed Haskell) can be finicky
sometimes. I usually put "module [Name] where" all on the same line and
leave "import"s on the left margin, so I hadn't experienced the first
problem you mentioned. However, I do notice that if I re-arrange your
second example so that "do" and the first "putStrLn" are on the same line,
emacs offers the following indentation:
module Num where
import IO
main = do putStrLn "Enter a number: "
inp <- getLine
let n = read inp
if n == 0
then putStrLn "Zero"
else putStrLn "NotZero"
(that's with all the expressions in the do block lining up vertically, if
that doesn't show up in a fixed-width font), it works! I would think that
your original indentation gave an error in that GHC would see "then" and
"else" and assume they were new expressions, but then I would expect that
this would have the same problem. If anyone can shed some light on this,
that would be nice.
Thanks,
Nick Meyer
npmeyer@syr.edu
On 5/14/07, Christopher L Conway
I am new to Haskell---and also to languages with the off-side rule--and working my way through Hal Daume's tutorial. I'm a little confused by the support for code layout in Emacs' haskell-mode. Is it buggy, or am I doing something wrong.
For example, here's the "Hello, world" example from the tutorial, with the indentation induced by pounding Tab in haskell-mode.
test.hs: module Test where
import IO
main = do putStrLn "Hello, world"
Prelude> :l test [1 of 1] Compiling Test ( test.hs, interpreted )
test.hs:12:0: parse error on input `main'
In emacs, every line but the one with "where" reports "Sole indentation". With "where", I have the option of having it flush left or indented four spaces; "import" wants to be two spaces in from "where". Moving where doesn't change the error. But if I manually move import flush left (which is the way it's shown in the tutorial, BTW):
module Test where
import IO
main = do putStrLn "Hello, world"
Prelude> :l test [1 of 1] Compiling Test ( test.hs, interpreted ) Ok, modules loaded: Test.
I have a similar problem with the layout of if-then-else...
num.hs: module Num where
import IO
main = do putStrLn "Enter a number: " inp <- getLine let n = read inp if n == 0 then putStrLn "Zero" else putStrLn "NotZero"
Prelude> :l num [1 of 1] Compiling Num ( num.hs, interpreted )
num.hs:11:2: parse error (possibly incorrect indentation)
Again, if I hit tab on the "then" or "else" lines, emacs reports "Sole indentation". But if I manually change the indentation, it works.
module Num where
import IO
main = do putStrLn "Enter a number: " inp <- getLine let n = read inp if n == 0 then putStrLn "Zero" else putStrLn "NotZero"
Prelude> :l num [1 of 1] Compiling Num ( num.hs, interpreted ) Ok, modules loaded: Num.
This is particularly weird because if-then-else doesn't always act this way:
exp.hs: module Exp where
my_exponent a n = if n == 0 then 1 else a * my_exponent a (n-1)
Prelude> :l exp [1 of 1] Compiling Exp ( exp.hs, interpreted ) Ok, modules loaded: Exp.
I suppose this might have something to do with the do-notation...
Does haskell-mode support code layout? Are there conventions I need to know about to make it behave properly? I have haskell-mode version 2.1-1 installed from the Ubuntu feisty repository.
Thanks, Chris _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Nick Meyer wrote:
main = do putStrLn "Enter a number: " inp <- getLine let n = read inp if n == 0 then putStrLn "Zero" else putStrLn "NotZero"
(that's with all the expressions in the do block lining up vertically, if that doesn't show up in a fixed-width font), it works! I would think that your original indentation gave an error in that GHC would see "then" and "else" and assume they were new expressions, but then I would expect that this would have the same problem. If anyone can shed some light on this, that would be nice.
http://hackage.haskell.org/trac/haskell-prime/wiki/DoAndIfThenElse says "already implemented in GHC and Hugs". Zun.

On 14/05/07, Christopher L Conway
For example, here's the "Hello, world" example from the tutorial, with the indentation induced by pounding Tab in haskell-mode.
test.hs: module Test where
import IO
main = do putStrLn "Hello, world"
Prelude> :l test [1 of 1] Compiling Test ( test.hs, interpreted )
Are you learning from YAHT, by any chance? That's the only place I've seen the weird convention of placing the 'where' of the 'module X' bit on a separate line. By far the most common convention in normal Haskell is to do as follows: module X where [rest of module] Things should work better if you follow this convention. What you describe still sounds like a bug, though.
Again, if I hit tab on the "then" or "else" lines, emacs reports "Sole indentation". But if I manually change the indentation, it works.
This too looks like a bug. As you remark, if statements within do-blocks have different indentation to everywhere else, confusingly.
Does haskell-mode support code layout? Are there conventions I need to know about to make it behave properly? I have haskell-mode version 2.1-1 installed from the Ubuntu feisty repository.
You should install 2.3 from the haskell-mode page [1]. Isaac Jones, maintainer of the Debian haskell-mode package has been contacted in order to get the latest version in the Debian repository, so it should happen soon, but in the mean time you could download and install the latest version yourself. It features quite a few bugfixes and new features that I imagine are documented on the aforementioned page. haskell-mode's indentation engine is still one thing I'm yet to get my head around, and its being written in Emacs Lisp doesn't help the matter! Still, it's on my todo list. [1]: http://haskell.org/haskell-mode -- -David House, dmhouse@gmail.com

On 5/14/07, David House
You should install 2.3 from the haskell-mode page [1]. Isaac Jones, maintainer of the Debian haskell-mode package has been contacted in order to get the latest version in the Debian repository, so it should happen soon, but in the mean time you could download and install the latest version yourself. It features quite a few bugfixes and new features that I imagine are documented on the aforementioned page.
I've installed 2.3 and it exhibits the same indentation behavior: any entity appearing on a new line immediately after "module X where" wants to be indented 4 spaces, including function definitions and variable bindings. "if-then-else" want to be lined up with one another, although both GHC and Hugs reject this layout. Here's the result of indent-region on the prior example: module Num where import IO main = do putStrLn "Enter a number: " inp <- getLine let n = read inp if n == 0 then putStrLn "Zero" else putStrLn "NotZero" This is distressing, because I've gotten rather used to letting Emacs worry about indentation for me. (This works well in tuareg-mode for OCaml. But, as I said earlier, I am a layout-sensitive-language newbie.) Chris

Christopher L Conway wrote:
I've installed 2.3 and it exhibits the same indentation behavior: any entity appearing on a new line immediately after "module X where" wants to be indented 4 spaces, including function definitions and variable bindings.
Yes, it does do that. And it's correct syntax too. But I tend to override it by putting the first line flush-left. After that, it knows.
"if-then-else" want to be lined up with one another, although both GHC and Hugs reject this layout.
I'll leave that issue for now, it's fiddly. I thought it was fixed in recent GHCs, but it's not something haskell-mode has ever got right.
Here's the result of indent-region on the prior example:
No! No! You can't use indent-region on haskell code. Why not? Because indentation involves *semantic* choices! And how can haskell-mode possibly guess the semantics of your code? indent-region just chooses the 'first choice' in the fairly arbitrary list of choices for each line, I think. You could argue that it could have better heuristics, and guess better more often. Alternatively (and perhaps this makes more sense) you could argue that indent-region should never change the semantics; rather it should just normalise the indentation. I.e. it should be merely a pretty-printer.
module Num where
import IO
main = do putStrLn "Enter a number: " inp <- getLine let n = read inp if n == 0 then putStrLn "Zero" else putStrLn "NotZero"
This is distressing, because I've gotten rather used to letting Emacs worry about indentation for me. (This works well in tuareg-mode for OCaml. But, as I said earlier, I am a layout-sensitive-language newbie.)
You need to get used to hitting <tab> until you see the indentation you want. There are choices to make and emacs can't make them (all) for you. For example, consider the fragment after the 'let'. What you have written is equivalent to this: let n = read inp (if n == 0 then putStrLn "Zero" "NotZero") I.e. you are treating read as a two-argument function, and the second argument is the entire if expression. Haskell layout is really quite simple, when you get used to it. The problem is it's not that easy to explain to someone from an imperative background; because you have to cross two bridges at once - the 'imperative' bridge and the 'layout' bridge. Layout isn't active 'everywhere' in haskell. In fact, arguably, it isn't even active in 'most' haskell. The two contexts in which layout mode applies most often are do expressions and declarations. Declarations is 'mostly' the top level of the file (it also applies if you define more than one name in a let or a where, but that's a relatively advanced technique). Do expressions are introduced by 'do' as you can see. I urge you to experiment more in the REPL (ghci/hugs) and less with loading files, and find lots of examples on the web, and hopefully this will all become clear. Jules
participants (5)
-
Christopher L Conway
-
David House
-
Jules Bean
-
Nick Meyer
-
Roberto Zunino