すごい Haskell 読書会 in 大阪 #7

Main.hs

{-
小問1
------

(選択肢文字列,値)のリストをとって、ユーザーに選択肢を提示し、番号を入力して選んでもらった値を返す関数

``` {haskell}
choice :: [(String, a)] -> IO a
```

を作ってください。


小問2
------

`choice`を使って次のような一連の処理をするプログラムを作ってください。

1. 苗字を聞く。
2. 名前を聞く。
3. ミドルネームを持っているかどうかの選択肢を提示し、ある場合は入力してもらった上で、フルネームを組み立てて表示する。


小問3
------

次のような愉快なゲーム記述言語っぽいものが作れるよう、`choice` を書き換えてみてください。

``` {haskell}
main = do
  putStrLn "どこへ行く？"
  choice [ ("宿屋" , inn)
         , ("野外" , outdoor) ]

inn = do
  putStrLn "あなたはぐっすり眠った。"
  main

outdoor = do
  putStrLn "マネジメント上の問題が現れた!!どうする？"
  choice [ ("殴る" , fight)
         , ("メラ" , magic) ]
```

https://gist.github.com/nushio3/5253230
-}

import Control.Monad (forM_)
import Control.Applicative ((<$>))

{-
-- 小問1, 2
choice :: [(String, a)] -> IO a
choice bs = do
    let nbs = zip [0..] bs
    forM_ nbs $ \(n, (s, a)) ->
        putStrLn $ (show n) ++ ": " ++ s
    c <- read <$> getLine
    return $ snd $ bs !! c
-}

{-
-- 小問1
main = do
    let branchs = [("Hokkaido", 'h'),
                   ("Tohoku",   't'),
                   ("Kanto",    'e'),
                   ("Hokuriku", 'r'),
                   ("Tokai",    'a'),
                   ("Kansai",   'i'),
                   ("Chugoku",  'c'),
                   ("Shikoku",  's'),
                   ("Kyushu",   'y')]
    b <- choice branchs
    print b
-}
 
-- 小問2
{-
main = do
    putStrLn "Give me your family name."
    fam <- getLine
    putStrLn "Give me your first name."
    fir <- getLine
    putStrLn "Do you have middle name?"
    m <- choice [("No",  False), ("Yes", True)]
    if m
        then do
            putStrLn "Give me your a middle name."
            mid <- getLine
            putStrLn $ "Your name is " ++ fir ++ " " ++ mid ++ " " ++ fam ++ "."
        else do
            putStrLn $ "Your name is " ++ fir ++ " " ++ fam ++ "."
-}

-- 小問3
choice :: [(String, IO ())] -> IO ()
choice bs = do
    let nbs = zip [0..] bs
    forM_ nbs $ \(n, (s, a)) ->
        putStrLn $ (show n) ++ ": " ++ s
    c <- read <$> getLine
    snd $ bs !! c
    return ()

-- https://gist.github.com/nushio3/5253576
main :: IO ()
main = top 10
 
top :: Int -> IO ()
top mp = do
  putStrLn $ "あなたのMPは:" ++ show mp
  putStrLn "どこへ行く？"
  choice [ ("宿屋" , inn)
         , ("野外" , outdoor mp) ]
 
inn = do
  putStrLn "あなたはぐっすり眠った。"
  top 10
 
outdoor mp = do
  putStrLn "マネジメント上の問題が現れた!!どうする？"
  choice [ ("殴る" , fight)
         , ("メラ" , magic 3 mp) 
         , ("イオナズン", magic 100 mp) ]
 
fight = do
  putStrLn "_人人人人人人人_"
  putStrLn "> 突然の突き指 <"
  putStrLn "￣Y^Y^Y^Y^Y^Y^Y￣"
  putStrLn "あなたは死にました・・・"
 
magic costMp mp 
 | costMp > mp = do
     putStrLn "MPが足りない"
     putStrLn "あなたは死にました・・・"
 | otherwise = do
     putStrLn "炎上マーケティング！！"
     putStrLn "マネジメント上の問題を解決した"
     top (mp - costMp)