Функции parseQuery и remindMoves тесно связаны. В первой мы распознаём ввод пользователя, а во вто-
рой напоминаем пользователю как мы закодировали его запросы. Тут стоит остановиться и серьёзно поду-
мать. Как закодировать значения типа Query, чтобы пользователю было удобно набирать их? Но давайте
отвлечёмся от этой задачи, она слишком серьёзная. Оставим её на потом, а пока проверим не ушли ли мы
слишком далеко, возможно наша программа потеряла смысл. Проверим типы!
*Loop> :r
[1 of 2] Compiling Game
( Game. hs, interpreted )
[2 of 2] Compiling Loop
( Loop. hs, interpreted )
Ok, modules loaded: Game, Loop.
Пятнашки | 207
Приведём код в порядок
Нам осталось дописать функции распознавания запросов и несколько маленьких функций с фразами и
модуль Loop будет готов. Но перед тем как сделать это давайте упорядочим функции. Видно, что у нас выде-
лилось несколько задач по типу общения с пользователем. У нас есть задачи, в которых мы что-то показываем
пользователю, меняем состояние экрана и есть задачи, в которых мы просим от пользователя какие-то дан-
ные, ожидаем запросы функцией getLine. Также в самом верху выражения программы у нас расположены
функции, которые координируют действия остальных, это третья группа. Сгруппируем функции по этому
принципу.
Основные функции
play :: IO ()
play = greetings >> setup >>= gameLoop
gameLoop :: Game -> IO ()
gameLoop game
| isGameOver game
= showResults game >> setup >>= gameLoop
| otherwise
= showGame game >> askForMove >>= reactOnMove game
setup :: IO Game
setup = putStrLn ”Начнём новую игру?” >>
putStrLn ”Укажите сложность (положительное целое число): ” >>
getLine >>= maybe setup shuffle . readInt
Запросы от пользователя (getLine)
reactOnMove :: Game -> Query -> IO ()
reactOnMove game query = case query of
Quit
-> quit
NewGame n
-> gameLoop =<< shuffle n
Play
m
-> gameLoop $ move m game
askForMove :: IO Query
askForMove = showAsk >>
getLine >>= maybe askAgain return . parseQuery
where askAgain = wrongMove >> askForMove
parseQuery :: String -> Maybe Query
parseQuery = un
readInt :: String -> Maybe Int
readInt = un
Ответы пользователю (putStrLn)
greetings :: IO ()
greetings = un
showResults :: Game -> IO ()
showResults g = showGame g >> putStrLn ”Игра окончена.”
showGame :: Game -> IO ()
showGame = putStrLn . show
showAsk :: IO ()
showAsk = un
quit :: IO ()
quit = putStrLn ”До встречи.” >> return ()
По этим функциям видно, что нам немного осталось. Теперь вернёмся к запросам пользователя.
Формат запросов
Можно вывести с помощью deriving экземпляр класса Read для типа Query и читать их функцией read.
Но это плохая идея, потому что пользователь нашей программы может и не знать Haskell. Лучше введём
сокращённые имена для всех значений. Например такие:
208 | Глава 13: Поиграем
left
— Play Left
right
— Play Rigth
up
— Play Up
down
— Play Down
quit
— Quit
new n
— NewGame n
Можно обратить внимание на то, что все команды начинаются с разных букв. Воспользуемся этим и дадим
пользователю возможность набирать команды одной буквой. Это приводит на с к таким определениям для
функций разбора значения и напоминания ходов:
parseQuery :: String -> Maybe Query
parseQuery x = case x of
”up”
-> Just $ Play Up
”u”
-> Just $ Play Up
”down”
-> Just $ Play Down
”d”
-> Just $ Play Down
”left”
-> Just $ Play Left
”l”
-> Just $ Play Left
”right” -> Just $ Play Right
”r”
-> Just $ Play Right
”quit”
-> Just $ Quit
”q”
-> Just $ Quit
’n’:’e’:’w’:’ ’:n
-> Just . NewGame =<< readInt n
’n’:’ ’:n
-> Just . NewGame =<< readInt n
_
-> Nothing
remindMoves :: IO ()
remindMoves = mapM_ putStrLn talk
where talk = [
”Возможные ходы пустой клетки:”,
”
left
или l
— налево”,
”
right
или r
— направо”,
”
up
или u
— вверх”,
”
down
или d
— вниз”,
”Другие действия:”,
”
new int
или n int — начать новую игру, int — целое число,”,
”указывающее на сложность”,
”
quit
или q
— выход из игры”]
Проверим работоспособность:
Prelude> :l Loop
[1 of 2] Compiling Game
( Game. hs, interpreted )
[2 of 2] Compiling Loop
( Loop. hs, interpreted )
Loop. hs:46:28:
Ambiguous occurrence ‘Left’
It could refer to either ‘Prelude.Left’,
imported from ‘Prelude’ at Loop. hs:1:8—11
(and originally defined in ‘Data.Either’)
or ‘Game.Left’,
imported from ‘Game’ at Loop. hs:5:1—11
(and originally defined at Game. hs:10:25—28)
Loop. hs:47:28:
Ambiguous occurrence ‘Left’
…
…
Failed, modules loaded: Game.
*Game>
По ошибкам видно, что произошёл конфликт имён. Конструкторы Left и Right уже определены в Prelude.
Это конструкторы типа Either. Давайте скроем их, добавим в модуль такую строчку:
import Prelude hiding (Either(.. ))
Пятнашки | 209
Теперь проверим:
*Game> :r
[2 of 2] Compiling Loop
( Loop. hs, interpreted )
Ok, modules loaded: Game, Loop.
*Loop>
Всё работает, можно двигаться дальше.
Последние штрихи
В модуле Loop нам осталось определить несколько маленьких функций. Поиск по слову un говорит нам
о том, что осталось определить функции “
greetings
:: IO ()
readInt
:: String -> Maybe Int
showAsk
:: IO ()
Самая простая это функция showAsk, она приглашает игрока сделать ход: