【前回までのベスト】98バイト

n#[x]=show n++[x]
n#(x:s)|x==s!!0=(n+1)#s|1>0=n#[x]++1#s
main=interact$unlines.take 12.iterate(1#)

【修正後1】97バイト

n#[x]=shows n[x]
n#(x:s)|x==s!!0=(n+1)#s|1>0=n#[x]++1#s
main=interact$unlines.take 12.iterate(1#)

知っていた技を使っただけなので、斬新な気持ちにはならず。。。
最近、答え落ちてないかなと思って検索すると、自分のブログが引っかかる．．． orz

【修正後2】95バイト

import List
main=interact$unlines.take 12.iterate(concat.map(\x->show(length x)++[x!!0]).group)

group 関数を使うことで、一気に２文字縮んだ。
しかし、甘くないなあ．．．
まだまだ、先があるのか．．．

【修正後3】 94バイト

import List
main=interact$unlines.take 12.iterate(concat.map(\x->shows(length x)[x!!0]).group)

shows は、いつも golf で使うもんだなーと思うようになってきた。


【修正後3】 93バイト
import List
main=interact$unlines.take 12.iterate(concatMap(\x->shows(length x)[x!!0]).group)

http://d.hatena.ne.jp/notogawa/20101011/1286814280

ゴルフ辞典を見て、concat.map f からリストモナド(>>=)につなげることが
キーだと思ったが、なかなかコンパイルが通らない．．．
一週間くらい考えればなんとかなるだろうか。

【修正前】 236 バイト

s n=show n++take(n*2+9)" shinichiroes"++" of hamaji"
w n=s n++" on the wall"
a#b=a++", "++b++".\n"
f 1="Go to the store and buy some more"#w 99
f x="Take one down and pass it around"#w(x-1)
main=mapM putStrLn[w n#s n++f n|n<-[99,98..1]]

【修正後】 235 バイト

s n=shows n" shinichiro"++drop(4-2*n)"es of hamaji"
w n=s n++" on the wall"
a#b=a++", "++b++".\n"
f 1="Go to the store and buy some more"#w 99
f x="Take one down and pass it around"#w(x-1)
main=mapM putStrLn[w n#s n++f n|n<-[99,98..1]]

ついに、２３５バイト！！

【その他 1】 237 バイト

s n=shows n" shinichiro"++drop(4-2*n)"es of hamaji"
w n=s n++" on the wall"
a#b=a++", "++b++".\n"
f 1="Go to the store and buy some more"#w 99
f x="Take one down and pass it around"#w(x-1)
g n|n>0=putStrLn(w n#s n++f n)>>g(n-1)
main=g 99

multiples　の解答が解禁されたこともあって、書き直してみた ♪

【初稿】　86バイト

main=mapM print$[1..999]%cycle[3,5,7]
(a:b)%(c:d)|mod a c==0=a:b%d|1>0=b%(c:d)
[]%x=[]

【修正1】　78バイト

main=mapM print$[1..999]%cycle[3,5,7]
(a:b)%(c:d)|mod a c==0=a:b%d|1>0=b%(c:d)

エラー止めしたら、縮んだ。。。
トップが短すぎるんじゃないかと思って書いてみたけれど
ここから２０バイト以上縮むとか、全くわからないことが分かった。。。

【修正2】　75バイト

main=mapM print$[1..999]%3
(a:b)%n|mod a n==0=a:b%f n|1>0=b%n
f 7=3
f n=n+2

3,5,7 の繰り返しを素直に書くと、3バイト縮んだ。
しかし、僕の中で　これが限界かも。。。

【修正3】　74バイト

main=mapM print$[1..999]%3
(a:b)%n|mod a n<1=a:b%f n|1>0=b%n
f 7=3
f n=n+2

【番外編1】 169バイト

main=do a:b:c:d<-getLine;read(a:[b])%read d
a%b=mapM putStrLn[["|-+"!!((x-a-max(1-y)(y-b))#(min(b+1-y)(max(y-1)1)-x))|x<-[1..a]]|y<-[1..b]]
a#b=sum[0^(a*b)+1|a<=0&&b<=0]

教えてもらった技をふんだんに使ったが、長くなってしまった。。。


【番外編2】 169バイト

main=do a:b:c:d<-getLine;read(a:[b])%read d
a%b=mapM putStrLn[["|-+"!!((a-x+max(1-y)(y-b))#(x-min(b+1-y)(max(y-1)1)))|x<-[1..a]]|y<-[1..b]]
a#b=sum[0^(a*b)+1|min a b>=0]

【修正前】　171バイト

main=do a:b:c:d<-getLine;read(a:[b])%read d
a%b=mapM putStrLn[["+|-"!!((x-max(y+a-b)(a+1-y))#(x-min(max(y-1)1)(b+1-y)))|x<-[1..a]]|y<-[1..b]]
a#b|a>0||b<0=1|a*b==0=0|1>0=2

【修正1】　169バイト

main=do a:b:c:d<-getLine;read(a:[b])%read d
a%b=mapM putStrLn[["-+|"!!((x-max(y+a-b)(a+1-y))#(x-min(max(y-1)1)(b+1-y)))|x<-[1..a]]|y<-[1..b]]
a#b|a>0||b<0=2|1>0=0^(-a*b)

相当頑張ったが、これ以上先は見えない。。。

【修正2】　168バイト

main=do a:b:c:d<-getLine;read(a:[b])%read d
a%b=mapM putStrLn[["-+|"!!((x-max(a+1-y)(y+a-b))#(min(b+1-y)(max(y-1)1)-x))|x<-[1..a]]|y<-[1..b]]
a#b|a>0||b>0=2|1>0=0^(a*b)

【修正3】 166バイト

main=do a:b:c:d<-getLine;read(a:[b])%read d
a%b=mapM putStrLn[["-+|"!!((x-a-max(1-y)(y-b))#(min(b+1-y)(max(y-1)1)-x))|x<-[1..a]]|y<-[1..b]]
a#b|a>0||b>0=2|1>0=0^(a*b)

コメントのおかげでピッタリ２打削減。
しかし、逆に言うと、ここから先は　そのままでは削れませんよというアナウンスでもあるのかな。。。
しかし、直球でよく削れたと思う。