【修正前】 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)

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

【初稿】　224バイト

main=getLine>>=g.f
f(a:b:'x':c)=[read(a:b:"")-1,read c-1]
g[a,b]=mapM putStrLn[["+|-"!!h x y a b|x<-[0..a]]|y<-[0..b]]
y%b=min(max(y-1)0)(-y+b)
y#[a,b]=max(y+a-b)(-y+a)
h x y a b|x<y%b||x>y#[a,b]=1|x==y%b||x==y#[a,b]=0|1>0=2

アマゴルファーとしては、まずはこんなもの。
入力にｘの文字が入るため、その処理に打数が取られてしまう。。。
現在、プロゴルファーと約50打差だが、まだ　やりようはありそう。

【修正1】　215バイト

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

プロゴルファーとの差は、66打差と引き離されたが
着実に縮められてきた。アマゴルとしては、200が目標ラインかな。

【修正2】　207バイト

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

【修正3】　181バイト

main=do a:b:c:d<-getLine;f$map read[a:[b],d]
f[a,b]=mapM putStrLn[["+|-"!!h(max(y+a-b)(a-y+1))x(min(max(y-1)1)(b+1-y))y|x<-[1..a]]|y<-[1..b]]
h s x t y|x<t||x>s=1|x==t||x==s=0|1>0=2

【修正4】　179バイト

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

【修正5】　178バイト

main=do a:b:c:d<-getLine;f$map read[a:[b],d]
f[a,b]=mapM putStrLn[["+|-"!!h(max(y+a-b)(a-y+1))x(min(max(y-1)1)(b+1-y))|x<-[1..a]]|y<-[1..b]]
h s x t|x<t||x>s=1|x==t||x==s=0|1>0=2

小細工せずにyの引数を削ったら、178になった。
しかし、ここいらが限界ではないだろうか…
ここから29バイトとか、考え方が違うんじゃないかと思ってきた…

【修正5】　175バイト

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

俺頑張った感が出てきた。
あと２，３バイトは何とかなるかもしれないけど、その先はどうしようもなく手詰まりになりそう。。。

【修正6】　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