[Haskell(？)] FizzBuzz クイズ

（ジョーク記事です。ご注意下さい）

はじめに

「FizzBuzzクイズ」クイズ－Ruby編 に対する解答として Haskell でコードを書いた。

目標

元記事で出題されているように、メソッドチェーンに応じて "Fizz", "Buzz", "Pezz" の文字列が連結されたものを返すような関数、fizz, buzz, pezz を実装する。

ただし、以下の点に注意する

これらの関数の戻り値は文字列である。数値を返し、文字列を標準出力に出力するような関数はNG。

グローバル変数は使わない。

元記事から引用した、Rubyで書かれた以下のテストコードを、
「「なるべく書き変えずにそのまま実行できるもの」」
をつくるヾ(´∀｀)ﾉｷｬｯｷｬ

p 7.fizz.buzz.pezz #=> "Pezz"
p 21.fizz.buzz.pezz #=> "FizzPezz"
p 35.fizz.buzz.pezz #=> "BuzzPezz"
p 105.fizz.buzz.pezz #=> "FizzBuzzPezz"
p 105.fizz.pezz.buzz #=> "FizzPezzBuzz"
p 105.pezz.buzz.fizz #=> "PezzBuzzFizz"

# 以下も念のため
p 1.fizz.buzz.pezz #=> 1
p 3.fizz.buzz.pezz #=> "Fizz"
p 5.fizz.buzz.pezz #=> "Buzz"
p 15.fizz.buzz.pezz #=> "FizzBuzz"
p 15.buzz.fizz.pezz #=> "BuzzFizz"
p 104.fizz.buzz.pezz #=> 104

|＼○ﾋｬｯ ε=＼＿○ﾉ ﾎｰｳ!!

……がんばります。

今回書いたコード

最初に、今回書いたコードの全文を載せてから、細かい説明をしていくことにする。
main関数内で、引用したコードがほとんど書き換えられずに使われていることを確認してほしい。

FizzBuzz.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RebindableSyntax #-}

import Prelude hiding (Num(..),(.))
import Control.Monad.RWS

fromInteger :: Integer -> Int
fromInteger = fromIntegral

ifThenElse :: Bool -> a -> a -> a
ifThenElse True x _ = x
ifThenElse False _ y = y



newtype Message = Msg (RWS Int [Char] () ())
newtype WrappedInt = Wrap Int


class Chainable a b where
  type Return a b :: *
  infixr 1 .
  (.) :: a -> b -> Return a b

instance Chainable Int Message where
  type Return Int Message = [Char]
  x . (Msg rws) = let (_, w) = evalRWS rws x () in
                     if w == [] then show x else w

instance Chainable WrappedInt Message where
  type Return WrappedInt Message = IO String
  (Wrap x) . (Msg rws) = let (_, w) = evalRWS rws x () in
                           if w == []
                             then let ret = show x in putStrLn ret >> return ret
                             else putStrLn w >> return w

instance Chainable Message Message where
  type Return Message Message = Message
  (Msg a) . (Msg b) = Msg $ a >> b



fizz :: Message
fizz = Msg $ do
  x <- ask
  if x `mod` 3 == 0
    then tell "Fizz"
    else return ()

buzz :: Message
buzz = Msg $ do
  x <- ask
  if x `mod` 5 == 0
    then tell "Buzz"
    else return ()

pezz :: Message
pezz = Msg $ do
  x <- ask
  if x `mod` 7 == 0
    then tell "Pezz"
    else return ()

p :: Int -> WrappedInt
p = Wrap


(#=>) :: a -> b -> a
(#=>) = const

main :: IO ()
main = do
  p 7.fizz.buzz.pezz #=> "Pezz"
  p 21.fizz.buzz.pezz #=> "FizzPezz"
  p 35.fizz.buzz.pezz #=> "BuzzPezz"
  p 105.fizz.buzz.pezz #=> "FizzBuzzPezz"
  p 105.fizz.pezz.buzz #=> "FizzPezzBuzz"
  p 105.pezz.buzz.fizz #=> "PezzBuzzFizz"

  p 1.fizz.buzz.pezz #=> 1
  p 3.fizz.buzz.pezz #=> "Fizz"
  p 5.fizz.buzz.pezz #=> "Buzz"
  p 15.fizz.buzz.pezz #=> "FizzBuzz"
  p 15.buzz.fizz.pezz #=> "BuzzFizz"
  p 104.fizz.buzz.pezz #=> 104

  putStrLn (15 . fizz . buzz) -- "FizzBuzz"

メソッドチェーン（っぽく見えるもの）

まず、 7.fizz.buzz.pezz のように(.)演算子をユーザー定義で使えるようにするため、 Prelude から (.) 演算子を除外してインポートした。

7.fizz.buzz.pezz というメソッドチェーンを見ると、(.) を左結合として定義すると、どうやら上手く型を決めるのが難しそうだ。

そこで、(.)を右結合で定義して、Chainable型クラスを定義して（MultiParamClasses拡張が必要）そのメソッドとして実装することで、最後に左からInt型の値を渡すことでString型の値を返すようにした。

fizz, buzz, pezzの型をMessageとすると、(.)の型は Int -> Message -> String もしくは、 Message -> Message -> Message である。
引数の型によって返り値の型が決まるので、TypeFamilies拡張を使っている。

Message型をどうするか

Message型は、Message -> Message -> Messageという関数が定義できて、また、最初の引数のIntを伝達しStringを合成していくことができる必要がある。

そのため、Massage型はRWSモナドをラッピングして使うことにした。
Writer変数としてString、Reader変数としてInt、戻り値と状態変数は必要ないので()とした。

(.) = (>>)と（ラッピング以外は）同じ意味になるように定義して、最後にIntが引数になると、evalRWSを呼び出し、文字列を返り値にするように定義した。

あとはfizz、buzz、pezzをそれぞれMessage型として定義すればOK

リテラルに型注釈を書きたくない

(.)はポリモーフィックに定義されているので、7.fizz.buzz.pezzのように書いても7の型を型推論で決定できない。

(7 :: Int).fizz.buzz.pezzと書けば済むだけの話だが、どうしても元のコードを書き換えずにそのまま実行したくてたまらないので、数値リテラルには単相的になってもらう。

そもそもリテラルの数値が多相的なのは、7がPrelude.fromInteger 7のように展開されるからである。

なので、RebindableSyntax拡張（参考1,2）を使って、fromIntegerを自前のものと挿げ替えた。

自前のfromIntegerにはInteger -> Intと型をつけることで、数値リテラルは全て型注釈を書かなくてもInt型になる。

pってなんだよ

これで、7.fizz.buzz.pezzは無事、"Pezz"を返すようになった。

しかし、これがp 7.fizz.buzz.pezzとなると話は違う。
p = putStrLn と定義すると、Haskellでは関数適用が最強の結合順位をもつので、 (p 7).fizz.buzz.pezz と評価されてしまう。

p $ 7.fizz.buzz.pezzと書けばいいだけの話だが、やっぱりどうしても元のコードを書き換えずにそのまま実行したくてたまらない。

仕方がないのでpはIntをWrappedInt型にラップする関数と定義して、(.)にWrappedIntを適用すると、戻り値の文字列を出力するところまでやってくれるIO String型の関数として(.)の定義に書き足した。

（IO ()ではなくIO Stringにしたのは、一応、返り値を文字列っぽくしておきたかったから）

もはや要件を満たしているのかすら少し怪しくなってきたが、背に腹は変えられない。

コメント

元コードでは#=> "Pezz"のように#でコメントを書いているが、Haskellではコメントは--であるため、このままでは実行できない。

そのため、#=>をconst関数と同じ意味の演算子として定義した。

まとめ

以上で無事、fizzbuzzが完成した。

# 以下も念のためというコメントだけはどうしても再現できなかったのが残念。

悪ノリでリテラルの多相性まで殺したこれが本当にHaskellと呼べるのかは謎が残るため、タイトルは[Haskell(？)]とさせてもらった。

悪ふざけが行き過ぎた感が否めないけど、あんまり怒らずにフフッってしてもらえたら嬉しいです。