Сегодня мы поучимся программировать на языке Haskell простейшие интерактивные игры. Для этих целей воспользуемся одной наработкой, которая ранее была описана мною в заметке «Утилита для работы с N-граммами». Ну а разработаем мы консольную игру «в слова» — довольно простую программу, которая будет ожидать от игрока ввода слов на ту или иную тему так, чтобы первая буква введённого слова совпадала с последней буквой того слова, которое назовёт программа.

В числе самых верхнеуровневых требований выдвинем следующие:

• Программа должна быть исполнена в виде консольного приложения с диалоговым режимом.
• Вместе с тем она должна быть в меру дружественна к пользователю.
• Программа должна позволять играть в слова на различные темы, а список тем формируется игроком в процессе использования.
• Программа должна обучаться в процессе игры, подразумевая, что игрок — человек, обладающий полным знанием естественного языка (сильное предположение, но это лучше, чем ничего :).
• Программа должна иметь несколько стратегий игры — от самой лёгкой до довольно сложной; также должна быть возможность смены стратегии в процессе игры на основании каких-либо критериев.

Вот с этим багажом и начнём. В описании, как всегда, воспоследуем принципам модульности и разработки сверху вниз.

Главный модуль программы

В главном модуле программы мы напишем только функцию main, являющуюся точкой входа в программу. Все остальные функции и другие программные сущности напишем в дополнительных модулях, которые будут описаны ниже, а в главный модуль просто включены:

import WGCommons import WGFile import WGPlay import WGType 

Что должна делать главная функция? Вроде бы вот список её действий, причём в последовательности: выводить на экран приветственное сообщение (при необходимости, запрашивая у игрока какие-либо сведения), загружать файл инициализации, загружать файл с таблицей рекордов, запускать игровой цикл и выводить прощальное сообщение. Ну прямо так и напишем:

main :: IO () main = do (userName, gameLevel) <- greetings           iniData               <- loadIniFile "wordsgame.ini"           scoreTable            <- loadScoreTableFile "scoretable.ini"           play $ GC (fst gameLevel ++ " " ++ userName) gameLevel iniData scoreTable           farewell 

Функция greetings, которая выводит приветственное сообщение, также запрашивает у игрока его имя и уровень, на котором он желал бы поиграть. Их и возвращает. Функции для чтения данных из файлов возвращают эти данные. Цикл игры ничего не возвращает, равно как и функция вывода прощального сообщения на экран.

Теперь можно перейти к описанию основных функций…

Описание «динамики» игры

Описание «динамики» (здесь под динамикой я понимаю запуск и поддержание основного игрового цикла задания игроку вопросов, получения его ответов и реакции на них) игры начнём с самой главной функции, а уж от неё будем раскручивать определения всего, что нам потребуется. Главная функция play, которая вызывается из точки входа main, выглядит так:

play :: GameConfiguration -> IO () play gc =   do putStr "Выбирайте тему - "      putStr (intercalate ", " (map fst $ iniData gc) ++ ": ")      theme <- getLine      case lookup (capitalize $ map toLower theme) (iniData gc) of        Just fn -> playAndSaveScoreTable theme fn (iniData gc)        Nothing -> do putStr "Такая тема мне неизвестна. Начнём новый сеанс обучения? "                      yesNo <- getLine                      if yesNo `isElementOf` yesWords                        then do putStr (userName gc ++                                        ", введите имя файла для сохранения данных: ")                                fn <- getLine                                let newIniData = (theme, fn) : iniData gc                                saveIniFile "wordsgame.ini" newIniData                                playAndSaveScoreTable theme fn newIniData                        else play gc   where     playAndSaveScoreTable theme' fileName' iniData' =       do score <- playOneRound theme' fileName' (snd $ gameLevel gc)          putStr ("\nБлагодарю за прекрасную игру. Вы набрали " ++ show score ++                  " " ++ setProperCase score ("очк", "о", "а", "ов") ++ ". ")          putStrLn ("Вы заняли " ++ show (place score (scoreTable gc)) ++                    " место в общем зачёте и " ++                    show (placeInTheme theme' score (scoreTable gc)) ++                    " место по теме \"" ++ theme' ++ "\".\n")          let newScoreTable = (theme', userName gc, score) : scoreTable gc          saveScoreTableFile "scoretable.ini" newScoreTable          willYouPlayAgain iniData' newScoreTable      willYouPlayAgain iniData' scoreTable' =       do putStr (userName gc ++ ", ещё будете играть? ")          yesNo <- getLine          when (yesNo `isElementOf` yesWords) $            play gc{iniData = iniData', scoreTable = scoreTable'} 

Выглядит достаточно монструозно, поэтому имеет смысл подробно разобрать каждую строку. Но начать надо с того, что функция получает на вход так называемую конфигурацию игры. Структуру конфигурации можно уже сейчас понять, если снова взглянуть на вызов функции play из функции main. В конфигурацию игры входит имя игрока, выбранный им уровень игры, таблица очков и информация из файла инициализации.

Для начала эта функция выводит на экран вопрос игроку о том, в какую тему он хотел бы сыграть, при этом перечисляется список тем, которые упомянуты в файле инициализации. При первом запуске игры файл инициализации не будет содержать никаких тем, поэтому и список будет пуст, а игрок сможет ввести наименование произвольной темы. Игрок в любом случае сможет выбрать произвольную тему, и ежели её название не будет найдено в списке из файла инициализации, программа дополнительно спросит, надо ли начать новый сеанс обучения для такой темы. Дополнительный вопрос нужен для того, чтобы отсечь случаи, когда игрок допустил, например, орфографическую ошибку в названии темы. Если же игрок говорит программе, что надо-таки начать новую тему, то та спрашивает ещё и имя файла, в котором хранить слова по этой теме. После получения всей дополнительной информации новая тема вносится в список тем в файле инициализации, а сама игра запускается. Если же тема была найдена в файле инициализации, то игра запускается и без всяких дополнительных вопросов.

Запуск игры осуществляется при помощи вызова локальной функции playAndSaveScoreTable. Рассмотрим её также подробно. Эта функция довольно проста — она вызывает функцию playOneRound, которую мы рассмотрим позже. Эта функция запускает один раунд игры. После окончания этого раунда, рассматриваемая функция выводит на экран набранные очки, положение игрока в общем зачёте и в зачёте по выбранной теме, после чего сохраняет набранные очки в файле и предлагает игроку сыграть ещё раз. Это делается при помощи функции willYouPlayAgain.

Эта функция также определена в виде замыкания (локальной функции) в рамках функции play. Всё, что она делает, так это то, что запрашивает у игрока ответ на вопрос о том, будет ли он играть ещё один раунд. Если игрок отвечает положительно, то рекурсивно запускается функция play с обновлённой игровой информацией.

Прежде, чем перейти к рассмотрению функции playOneRound, напишем две маленькие служебные функции, которые возвращают занятое игроком место по итогам одного раунда игры. Они очень простые и в целом даже очень похожи:

place :: Int -> ScoreTableFile -> Int place score scoreTable = 1 + length (takeWhile (> score) $                                reverse $                                sort $                                map (\(_, _, r) -> r) scoreTable)  placeInTheme :: String -> Int -> ScoreTableFile -> Int placeInTheme theme score scoreTable = 1 + length (takeWhile (> score) $                                             reverse $                                             sort $                                             map (\(_, _, r) -> r) $                                             filter (\(t, _, _) -> t == theme) scoreTable) 

Тут всё просто. Берётся таблица очков (для определённой темы она для начала фильтруется по заданной теме), из неё выбираются только очки, которые сортируются. Отсортированный список очков обращается, ибо чем меньше очков, тем более низкое место занимает игрок. Потом берётся начало отсортированного и обращённого списка, пока элементы в этом начале больше, чем исследуемое количество очков игрока. Далее берётся длина полученного начала, к которой прибавляется единица. Тут есть широкие возможности для упрощения и оптимизации (собственно, как и по всему коду), однако же накладные расходы на вычисления из-за такого определения функции в рамках всей программы очень малы, поэтому оставим-ка так.

Теперь, наконец, рассмотрим функцию playOneRound. Она оказывается очередной обёрткой:

playOneRound :: String -> FilePath  -> [Char] -> IO Int playOneRound theme fileName gl = do putStr ("\nОтлично! Играем в \"" ++ theme ++ "\". ")                                     wl <- loadWordsData fileName                                     gc <- playGame gl wl                                     saveWordsData fileName (gameData gc)                                     return $ score gc 

Собственно, в том, что это обёртка, нет ничего дурного. В этом и состоит суть и смысл подхода «сверху вниз», когда на каждом этапе мы пишем нечто просто, оставляя чуть сниженную сложность для определения в следующей функции. Так и тут. Эта функция, которая отвечает за один раунд игры, выводит на экран восторженное упоминание темы игры, загружает в память соответствующий словарь и запускает саму игру (функция playGame). После игры она сохраняет новые слова в файле со словарём и возвращает набранные пользователем очки.

Функции для работы с файлами будут описаны в соответствующем разделе, так что мы сразу переходим к функции playGame, которая, собственно, и отвечает за игру. Вот её определение:

playGame :: [Char] -> WordDB -> IO RoundConfiguration playGame gl wl = do putStrLn "Начинаем игру."                     strategy <- getRandomElement strategies                     rc <- makeOneStep gl $ RC wl strategy "" [] 0                     putStrLn ("\nНазванные слова: " ++                               intercalate " - " (reverse $ namedWords rc) ++ ".")                     return rc 

И опять обёртка :). Теперь здесь производятся такие действия (про восторженные отображения на экран уже не пишу). Выбирается одна стратегия игры (и об этом позже, как обо всех стратегиях, реализованных в описываемой программе). Далее запускается функция для выполнения одного шага игры (функция makeOneStep), которая отвечает за вывод слова роботом и получение слова от игрока. После игры на экран выводится полный список введённых в процессе игры слов. Ну и результат (текущая конфигурация) игры возвращается наверх для обработки. Рассмотрим же функцию makeOneStep, которая, по сути, является «сердцем» этого модуля. Вот её определение:

makeOneStep :: [Char] -> RoundConfiguration -> IO RoundConfiguration makeOneStep gl rc =   do (myWN, newStrategy) <- generateWordName gl rc      if myWN == ""        then do putStr ("У меня нет вариантов. Научите (слово на букву " ++                        [lastLetter $ currentWord rc] ++"): ")                getUserAnswer newStrategy (currentWord rc) (namedWords rc) 2        else do putStr ("Мой вариант - " ++ map toUpper myWN ++                        ". Называйте слово на букву " ++ [lastLetter myWN] ++ ": ")                getUserAnswer newStrategy myWN (myWN : namedWords rc) 1   where     getUserAnswer ns s nl dp =       do userWN <- getUserWordName $ lastLetter s          if userWN `elem` nl            then do putStr "Такое слово уже называлось. Попробуйте ещё раз: "                    getUserAnswer ns s nl dp            else if userWN `isElementOf` surrenderWords                   then return rc{currentWord = s, namedWords = nl}                   else makeOneStep gl $ RC (updateWordList (gameData rc) userWN)                                            ns                                            userWN                                            (userWN:nl)                                            (score rc + dp) 

Что здесь происходит? Вызывается функция для генерации нового слова создаваемым ботом (generateWordName, которую мы рассмотрим позже). Ей передаётся на вход список символов, на которые может заканчиваться слово (этот список зависит от уровня игры и определяется стратегией), а также конфигурация игры, сложившаяся после предыдущего раунда. На выходе у этой функции пара — новое слово и новая стратегия игры. Если слово, которое придумал бот, пустое, то это значит, что у бота нет ответа, и игра предлагает уже игроку назвать слово, начисляя ему за это 2 очка (за просто называние слова — 1 очко). Если же слово у бота имеется, то оно выводится на экран, а игроку теперь надо назвать слово, оканчивающееся на последнюю букву слова, названного ботом.

Получение слова от игрока осуществляется в локальной функции getUserAnswer, которая получает на вход новую стратегию, по которой играет бот, текущее названное слово, список всех названных ранее слов и приращение к количеству очков игрока. Как уже сказано выше — если у бота есть вариант, то приращение равно 1, а если нет, то 2. В этой локальной функции у игрока запрашивается слово на определённую букву, после чего проверяется выполнение двух условий: названное игроком слово ещё не называлось и пользователь не ввёл какое-нибудь из специальных слов, свидетельствующих о том, что он сдаётся (и после этого игра заканчивается). Если всё нормально, то из этой локальной функции вновь рекурсивно запускается основная функция makeOneStep с обновлённой конфигурацией игры.

Для начала рассмотрим функцию getUserWordName, которая запрашивает слово у игрока. Вот её определение:

getUserWordName :: Char -> IO WordName getUserWordName ' ' = getLine getUserWordName fl  = do userWN' <- getLine                          let userWN = capitalize $ map toLower userWN'                          if userWN `isElementOf` surrenderWords ||                             userWN /= "" && head userWN == toUpper fl                            then return userWN                            else do putStr ("Будьте внимательны. Назовите слово на букву " ++                                            [fl] ++ " или сдавайтесь: ")                                    getUserWordName fl 

Она получает на вход символ, на который должно начинаться слово. Функция запрашивает у игрока слово, проверяет его по условию, что оно не является одним из слов, которые свидетельствуют о том, что игрок сдаётся (такие слова обрабатываются уровнем выше), а потом проверяет условие, что введённое слово начинается на заданную букву. Если это не так, функция выводит на экран предупреждение и заново вызывает саму себя.

Так, получение слова от игрока рассмотрели, так что теперь можно перейти к изучение того, как уже бот выбирает очередное слово для игры. Тут мы сделаем немного искусственного интеллекта, совсем небольшого. Заключаться он будет в том, что у бота (как уже многие догадались) будет выбранная стратегия игры. Всего стратегий может быть много, и позже мы их рассмотрим, а вдумчивые читатели смогут придумать (и предложить в комментариях) новые варианты стратегий. Искусственность интеллекта бота будет заключаться в том, что если текущая стратегия не будет позволять найти ему очередное слово, то он будет стараться выбрать новую стратегию из доступных ему на текущем уровне игры.

Начнём:

generateWordName :: [Char] -> RoundConfiguration -> IO (WordName, GameStrategy) generateWordName gl rc   | null $ currentWord rc = do wordPair <- getRandomElement $ gameData rc                                wn <- getRandomElement $ snd wordPair                                return (wn, strategy rc)   | null $ gameData rc    = return ("", strategy rc)   | null wl'              = return ("", strategy rc)   | null wl''             = return ("", strategy rc)   | otherwise             = do wn <- strategy rc (currentWord rc) wl''                                if null wn                                  then do newStrategy <- getRandomElement strategies                                          generateWordName gl rc{strategy = newStrategy}                                  else return (wn, strategy rc)   where     wl'  = filter (\x -> fst x == lastLetter (currentWord rc)) (gameData rc)     wl'' = [wn | wn <- snd $ head wl',                  wn `notElem` namedWords rc,                  lastLetter wn `elem` gl] 

Это функция для выбора очередного слова ботом. Она формирует список слов, начинающихся с заданной буквы, после чего запускает функцию, реализующую текущую игровую стратегию, для выбора слова из сформированного списка. Если запущенная стратегия не смогла найти слова, то происходит случайный выбор другой стратегии. Новая стратегия возвращается в паре с называемым роботом словом. Здесь также необходимо отметить, что первое слово всегда выбирается случайно.

Первое охранное выражение как раз выбирает самое первое слово. Второе охранное выражение соответствует ситуации, когда у бота ещё совсем пуста база данных слов, тогда он просто сразу говорит, что он слов не знает и предлагает игроку ввести слово. Третье охранное выражение соответствует случаю, когда у бота есть слова в базе, но нет слов, начинающихся на заданную букву. В этом случае он тоже сдаётся. Четвёртое охранное выражение соответствует случаю, когда и база данных слов не пуста, и слова на такую букву есть, но все они уже назывались (печаль же). И боту опять не остаётся ничего, как сдаться и предложить ввести игроку слово, чтобы тот получил 2 очка.

Последнее охранное выражение соответствует случаю, когда слова есть, и необходимо выбрать вариант. В этом случае запускается функция, реализующая текущую стратегию бота. Если эта функция не смогла найти слова, то запускается процесс выбора новой стратегии, после чего опять рекурсивно запускается эта же функция. Может получиться так, что выберется та же самая стратегия — в этом случае рекурсия уйдёт ещё на один уровень вниз, но ничего страшного в этом нет — она хвостовая.

Перейдём же, наконец, к функциям, описывающим стратегии игры для бота. Сразу приведём определения всех функций:

firstWordStrategy :: GameStrategy firstWordStrategy _ = return . head  randomWordStrategy :: GameStrategy randomWordStrategy _ = getRandomElement  sameLetterStrategy :: GameStrategy sameLetterStrategy wn wl | wn  == "" = return ""                          | wl' == [] = return ""                          | otherwise = getRandomElement wl'   where     ll  = last wn     wl' = filter (\l -> lastLetter l == ll) wl  certainLetterStrategy :: Char -> GameStrategy certainLetterStrategy c _ wl = do let wl' = filter (\l -> lastLetter l == c) wl                                   if wl' == []                                     then return ""                                     else getRandomElement wl'  hardLetterStrategy :: GameStrategy hardLetterStrategy _ wl = do let wl' = filter (\l -> lastLetter l `elem` hardLetters) wl                              if wl' == []                                then return ""                                else getRandomElement wl'   where     hardLetters = "ёйы"  strategies :: [GameStrategy] strategies = firstWordStrategy :                randomWordStrategy :                sameLetterStrategy :                hardLetterStrategy :                map certainLetterStrategy ['А'..'Я'] 

Как видно, в списке strategies определено 33 + 4 = 37 стратегий. Вот их описания:

1. firstWordStrategy — наипростейшая стратегия. Просто выбирает самое первое слово из списка возможных слов.
2. randomWordStrategy — простая стратегия. Выбирает случайное слово из списка возможных слов.
3. sameLetterStrategy — хитрая стратегия. Выбирает слово так, чтобы оно оканчивалось на ту же самую букву, что и начинается, то есть даёт игроку задачу назвать слово на ту же букву, что и игрок дал боту.
4. certainLetterStrategy — наглая стратегия. Всегда даёт игроку задачу называть слова на одну и ту же букву. Если буква обычная в начале слова, то игра может быть длительной и занимательной. Если же боту взбрело в его искусственный разум давать игроку задачи называть слова на такую букву, как, например, «Щ», то игра закончится довольно быстро в пользу бота.
5. hardLetterStrategy — убийственная стратегия. Ну а эта стратегия выбирает одну из самых неприятных букв русского языка и даёт игроку задачу назвать слово на эту букву.

Теперь осталось дать определения ещё двух сервисных функций. Первая добавляет новое слово, которое бот ещё не знал, в его базу данных. Вот несложное определение:

updateWordList :: WordDB -> WordName -> WordDB updateWordList []                wn                      = [(toUpper $ head wn, [wn])] updateWordList (wl@(wlf, _):wls) wn@(wnh:_) | wlf == wnh = updateWordList' wl wn : wls                                             | otherwise  = wl : updateWordList wls wn   where     updateWordList' (fl, [])  wn'                  = (fl, [wn'])     updateWordList' (fl, wl') wn' | wn' `elem` wl' = (fl, wl')                                   | otherwise      = (fl, wn':wl') 

В целом, описывать то, что она делает, смысла особого нет. Ну просто добавляет новую строку в некую хеш-таблицу.

И вот ещё предикат, который используется один раз в функции, запускающей игровой цикл:

isKnown :: String -> IniFile -> Bool isKnown theme = any (\(t, fp) -> t == theme) 

Он возвращает значение True, если введённая игроком тема игры известна боту. Но, вроде бы, этот предикат даже и не используется в программе. Кто первый найдёт эту закладку и напишет в комментарии — тому приз. Всё.

Операции с файлами

В модуле WGFile собраны все функции, которые работают с файлами. Сюда же внесены функции, осуществляющие синтаксический анализ файлов. Рассмотрим их все более или менее подробно.

В программе используется три вида файлов: файл инициализации, файл с таблицей рекордов и файл с базой данных для игры (по той или иной теме). Как ни странно, все эти типы файлов можно будет прочитать одной и той же функцией (высшего порядка, само собой разумеется). Опишем её:

loadFile :: FilePath -> FileManager a -> IO a loadFile filePath fm = catch readContents                              (\e -> do putStrLn (msgIOError fm ++ "\n")                                        return $ parser fm "")   where     readContents = do cnt <- readFile filePath                       let {                             fileData = parser fm cnt;                             qnt      = quantifier fm fileData                           }                       if validator fm fileData                         then putStrLn (msgParseError fm ++ "\n")                         else putStrLn (msgSuccess fm ++ show qnt ++ " " ++                                        setProperCase qnt (unit fm) ++ ".\n")                       return fileData 

Эта функция является обобщённой и осуществляет чтение информации из файла, после чего возвращает её в некотором виде. Получает на вход функции для обработки текста из файла, возвращает структуру данных, полученную из обработанного текста. Здесь есть тонкий момент — структура данных FileManager, которая содержит все необходимые функции и данные (описание этой структуры в разделе ниже).

Теперь представим конкретизированные функции для чтения трёх упомянутых ранее типов файлов. Они определяются категорически просто:

loadIniFile :: FilePath -> IO IniFile loadIniFile filePath = loadFile filePath iniFileManager   where     iniFileManager = FM 	                 {                        parser        = parseIniFile,                        validator     = null,                        quantifier    = length,                        unit          = ("тем", "а", "ы", ""),                        msgIOError    = "ОШИБКА: Невозможно открыть файл инициализации. " ++                                        "Всё моё обучение начинается с самого начала " ++                                        "(либо Вам необходимо вручную восстановить " ++                                        "файл инициализации).",                        msgParseError = "ОШИБКА: Файл инициализации повреждён. " ++                                        "Всё моё обучение начинается с самого начала " ++                                        "(либо Вам необходимо вручную восстановить " ++                                        "файл инициализации).",                        msgSuccess    = "Файл инициализации обработан. Загружено "                      }  loadScoreTableFile :: FilePath -> IO ScoreTableFile loadScoreTableFile filePath = loadFile filePath stFileManager   where     stFileManager = FM                     {                        parser        = parseScoreTableFile,                        validator     = null,                        quantifier    = length,                        unit          = ("запис", "ь", "и", "ей"),                        msgIOError    = "ОШИБКА: Невозможно открыть файл с таблицей " ++                                        "рекордов. Ведение рекордов начинается с самого начала.",                        msgParseError = "ОШИБКА: Файл с таблицей рекордов повреждён. " ++                                        "Ведение рекордов начинается с самого начала.",                        msgSuccess    = "Файл с таблицей рекордов обработан. Загружено "                     }  loadWordsData :: FilePath -> IO WordDB loadWordsData filePath = loadFile filePath dataFileManager   where     dataFileManager = FM 	                  {                         parser        = parseWordsData,                         validator     = null,                         quantifier    = numberOfWords,                         unit          = ("слов", "о", "а", ""),                         msgIOError    = "ОШИБКА: Невозможно открыть файл с данными. " ++                                         "Моё обучение по выбранной теме начинается " ++                                         "с самого начала.",                         msgParseError = "ОШИБКА: Файл с данными повреждён. Моё " ++                                         "обучение по выбранной теме начинается с " ++                                         "самого начала.",                         msgSuccess    = "Файл с данными прочитан успешно. Загружено "                       } 

Как видно, здесь просто создаётся структура FileManager, которая передаётся на вход обобщённой функции loadFile. Да, и здесь надо отметить, что запись validator = null не обозначает, что валидатор для такого-то типа файла отсутствует :). Валидатор присутствует и равен предикату null из стандартного модуля Prelude, и предикат этот возвращает значение True для пустых списков.

Теперь перейдём к определению комбинаторов синтаксического анализа. Как ни странно, сделаем это вручную, без использования каких-либо стандартных библиотек. Это потому, что форматы файлов настолько просты, что намного проще быстро и на коленке изобрести велосипед. Это потом уже, в процессе рефакторинга можно переписать определения, использовав какую-нибудь библиотеку, типа Parsec. Но сейчас будет так:

parseIniFile :: String -> IniFile parseIniFile = map parseIniPair . lines  parseIniPair :: String -> (WordName, FilePath) parseIniPair s = (theme, dropWhile (not . Data.Char.isAlpha) rest)   where     (theme, rest) = break (== ':') s 

Эти функции производят синтаксический разбор файла инициализации. Весь файл представляет собой список пар, первым элементом которых является наименование темы, а вторым — путь к файлу, в котором находится база слов по это теме. Всё просто. А вот синтаксический анализатор для файла с таблицей рекордов:

parseScoreTableFile :: String -> ScoreTableFile parseScoreTableFile = map parseScoreTableLine . lines  parseScoreTableLine :: String -> (WordName, String, Int) parseScoreTableLine s = (theme, name, result)   where     (theme, rest) = break (== ':') s     (name, rest') = break (== ':') $ dropWhile (not . Data.Char.isAlpha) rest     result        = read $ dropWhile (not . Data.Char.isDigit) rest' 

Файл с таблицей рекордов содержит уже список троек, каждая из которых представляет собой кортеж вида (тема, имя игрока, очки). Разделителем здесь является символ (:). Ну и, наконец, синтаксические анализаторы для файла с базой слов:

parseWordsData :: String -> WordDB parseWordsData = map parseWordsList . lines  parseWordsList :: String -> WordList parseWordsList (w:ws) = (w, parseWords $ dropWhile (not . isGoodSymbol) ws)  parseWords :: String -> [WordName] parseWords "" = [] parseWords wl = word : parseWords (dropWhile (not . isGoodSymbol) rest)   where     (word, rest) = break (== ',') wl 

Немного сложнее, но всё равно тривиально. База слов представляет собой список списков, каждый из которых представляет собой слова на какую-либо одну букву. По этому списку списков строится простенькая хеш-таблица, в которой потом и осуществляется поиск в процессе игры.

Теперь в этом же модуле напишем функции, которые сохраняют файлы. Воспользуемся той же самой техникой — сначала обобщённая функция, а потом три её конкретизации. Вот обобщённая:

saveFile :: FilePath -> String -> IO () saveFile = writeFile 

Не густо :). Тем не менее, пусть будет так. Стандартная же функция writeFile получает на вход путь к файлу и строку, которая становится содержимым файла. Ну а вот конкретизированные функции для трёх типов файлов:

saveIniFile :: FilePath -> IniFile -> IO () saveIniFile filePath iniData   = saveFile filePath              (concatMap (\(theme, path) -> theme ++ ": " ++ path ++ "\n") $       sortBy (comparing fst) iniData)  saveScoreTableFile :: FilePath -> ScoreTableFile -> IO () saveScoreTableFile filePath scoreTable   = saveFile filePath              (concatMap (\(theme, userName, score) -> theme ++ ": " ++ userName ++                                                       ": " ++ show score ++ "\n") $       sortBy themeAndScore scoreTable)   where     themeAndScore (theme1, _, score1) (theme2, _, score2)       | theme1 == theme2 = reverseOrder $ compare score1 score2       | otherwise        = compare theme1 theme2     reverseOrder LT = GT     reverseOrder EQ = EQ     reverseOrder GT = LT   saveWordsData :: FilePath -> WordDB -> IO () saveWordsData filePath wl   = saveFile filePath              (convertToString $ sortBy (comparing fst) $ improve wl) 

Как видно, все эти функции работают примерно одинаково — они получают на вход структуру и преобразуют её в строку. Преобразование структуры производится в полном соответствии с форматом файла, в котором эта структура хранится. Здесь нет особой надобности в детальном описании таких преобразований — внимательное изучение тел функций говорит об этом всё.

Осталось привести определение двух небольших сервисных функций:

improve :: WordDB -> WordDB improve = map (second sort) 

Эта функция сортирует слова во всех списках слов в заданной хеш-таблице. Как уже было сказано, база слов представляет собой список списков. Вот эти внутренние списки и сортируются. Зачем? Просто так.

convertToString :: WordDB -> String convertToString = concatMap wordLine   where     wordLine (c, wl) = c : (": " ++ intercalate ", " wl ++ "\n") 

Ну а эта функция преобразует хеш-таблицу с базой слов в одну длинную строку, которая и записывается в файл.

Различные утилитарные функции

В модуле WGCommons находятся определения всех сервисных функций, которые так или иначе требуются в программе. Просто сборная солянка. Например, вот константная функция, которая возвращает список возможных уровней игры:

gameLevels :: [GameLevel] gameLevels = [("Неофит",   "АБВГДЗИКЛМНОПРСТФХ"),               ("Адепт",    "АБВГДЕЖЗИКЛМНОПРСТУФХЦЧШЩЭЮЯ"),               ("Апологет", "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЫЭЮЯ")] 

Описание уровня игры представляет собой пару, первым элементом которой является наименование уровня игры, вторым элементом является перечень символов, на которые может заканчиваться слово, называемое ботом на данном уровне.

Или вот, к примеру, функция, которая возвращает случайный элемент заданного списка. Типовая функция, которая уже неоднократно встречалась в моих статьях:

getRandomElement :: [a] -> IO a getRandomElement l = fmap (l !!) $ randomRIO (0, length l - 1) 

А вот предикат, который определяет состав множества символов, из которых может состоять слово (все буквы и дефис):

isGoodSymbol :: Char -> Bool isGoodSymbol c = Data.Char.isAlpha c  || c `elem` "чё-ЧЁ" 

Тут есть какая-то особенность обработки Unicode в GHC. Почему-то GHC плохо относится к буквам «Ё», «Ч» и «Я» русского алфавита. Возможно, что в последней версии GHC и Haskell Platform Эта проблема давно уже решена, но в те времена, когда писалась эта игра, приходилось делать такие вот костыли. В том числе и такие:

toUpper :: Char -> Char toUpper c | Data.Char.isAlpha c = Data.Char.toUpper c           | c == 'ё'            = 'Ё'           | c == 'ч'            = 'Ч'           | c == 'я'            = 'Я'           | otherwise           = c  toLower :: Char -> Char toLower c | Data.Char.isAlpha c = Data.Char.toLower c           | c == 'Ё'            = 'ё'           | c == 'Ч'            = 'ч'           | c == 'Я'            = 'я'           | otherwise           = c 

С чем связано такое поведение, я теперь сказать не могу. Было найдено эмпирическим путём.

Ну и так далее. В этом модуле полно всяких мелких функций, описание которых расширило бы эту и без того огромную статью до невообразимых размеров. К тому же, там все функции настолько просты, что и описывать их особо смысла нет — их код полностью самоочевиден.

Единственная функция, которую интересно упомянуть, так это функция выбора правильного падежа для имени существительного для согласования с заданным числом («1 запись», «2 записи», «5 записей»). Вот её определение:

setProperCase :: Int -> WordParadigm -> String setProperCase i (root, ns, gs, gp) | iMod100 > 10 && iMod100 < 20 = root ++ gp                                    | iMod10 == 1                  = root ++ ns 								   | iMod10 >= 2 && iMod10 <= 4   = root ++ gs 								   | otherwise                    = root ++ gp   where     iMod10  = i `mod` 10     iMod100 = i `mod` 100 

Слово передаётся в функцию в виде парадигмы (см. описание типа WordParadigm в следующем разделе). Все числительные, оканчивающиеся на 1, кроме 11 и основанных на нём, требуют слова в именительном падеже единственного числа. Все числительные, оканчивающиеся на 2, 3 или 4, кроме 12, 13 и 14 и основанных на них, требуют слова в родительном падеже единственного числа. Остальные числительные, в том числе и 11, 12, 13 и 14, требуют слова в родительном падеже множественного числа. Таков русский язык.

Все типы, используемые в программе

Выносить определения всех типов, используемых в программе, в отдельный модуль — это негодная практика. Однако тогда, когда писалась эта игра, мне казалось, что так оно должно быть. Так что теперь рассмотрим все типы, которые используются в коде.

Для начала куча синонимов, которые используются просто повсеместно. Вот, например, синонимы для описания структуры файла инициализации и файла с таблицей рекордов:

type IniFile = [(WordName, FilePath)]  type ScoreTableFile = [(WordName, String, Int)] 

Сразу видно, что файл инициализации — это список наименований тем и соответствующих им путей к файлам, а файл с таблицей рекордов — это список троек (тема, имя игрока, количество очков). Как, собственно, это и было описано ранее в разделе про функции работы с файлами.

А вот три синонима для работы с базами слов:

type WordName = String  type WordList = (Char, [WordName])  type WordDB = [WordList] 

Слово — это просто строка. Список слов — это пара, первым элементом которой является символ, с которого начинается каждое слово в списке, который является вторым элементом пары. Это базовый элемент хеш-таблицы. Ну а сама хеш-таблица есть ничто иное, как просто список. Тут надо бы подумать над тем, чтобы использовать какое-либо готовое решение для этого. Тот же тип Data.Map был бы лучшим решением для этих целей.

Далее, нам нужен синоним для представления парадигмы слова в нашей небольшой лингвистической функции, которая возвращает правильный падеж заданного слова для сопряжения его с числительным. Вот примерно такой:

type WordParadigm = (String, String, String, String) 

Описание уровня игры:

type GameLevel = (WordName, [Char]) 

Ну и, наконец, синоним для типа, представляющего собой тип функции, реализующей стратегию игры:

type GameStrategy = WordName -> [WordName] -> IO WordName 

Такая функция стратегии получает на вход названное слово и список слов, из которых необходимо выбрать слово для ответа ботом. После этого данная функция делает выбор, основываясь на своих критериях. Ну а некоторые функции, реализующие различные стратегии мы уже рассмотрели.

Теперь перейдём к алгебраическим типам данных. Их всего-то три.

Первый — это описание структуры данных для обработки файла в функциях загрузки конкретных видов файлов (инициализации, данных и др.). Используется для сокрытия такой структуры из аргументов функций-загрузчиков. Вот его определение:

data FileManager a = FM                      {                        parser        :: String -> a,                        validator     :: a -> Bool,                        quantifier    :: a -> Int,                        unit          :: WordParadigm,                        msgIOError    :: String,                        msgParseError :: String,                        msgSuccess    :: String 					 } 

Здесь parser представляет функцию для синтаксического анализа содержимого файла. Поле validator представляет предикат, который проверяет семантическую правильность прочитанных данных. Поле quantifier также является функцией и представляет способ подсчёта некоторого количественного параметра (например, для файла инициализации это длина списка, то есть количество тем, известных боту; а для базы слов — количество слов в базе, но считать это количество надо иначе, нежели просто в виде длины списка). Поле unit представляет единицу измерения того, что записано в файле, в том числе и для правильного склонения. Три поля с префиксом msg — это строки для вывода сообщений об ошибке ввода-вывода, ошибке синтаксического анализа и сообщения об успешном чтении файла.

Следующий АТД — это тип для представления конфигурации игры. Вот его определение:

data GameConfiguration = GC                          {                            userName   :: String,                            gameLevel  :: GameLevel,                            iniData    :: IniFile,                            scoreTable :: ScoreTableFile                          } 

Здесь поля структуры последовательно представляют: имя пользователя, уровень игры, описания файла инициализации и описание файла с таблицей рекордов.

И, наконец, АТД для представления конфигурации одного раунда:

data RoundConfiguration = RC                           {                             gameData    :: WordDB,                             strategy    :: GameStrategy,                             currentWord :: WordName,                             namedWords  :: [WordName],                             score       :: Int                           } 

Поля опять же последовательно представляют: базу слов для текущей выбранной темы, текущую стратегию игры бота, текущее слово, список уже названных в процессе игры слов и текущее количество очков.

Заключение

Описание игры в целом закончено. Если у кого-либо возникают вопросы или осталось непонимание — милости прошу высказываться в комментариях. А мне осталось лишь дать ссылки на разработанные модули:

• Модуль WordsGame.hs — модуль с главной функцией, являющейся точкой входа.
• Модуль WGPlay.hs — описание игровой динамики.
• Модуль WGFile.hs — набор функций для работы с файлами.
• Модуль WGCommons.hs — общие утилитарные функции.
• Модуль WGType.hs — сборник типов данных для программы.

Здесь надо отметить, что данная программа создавалась довольно давно, и вот только теперь у меня дошли руки описать её. Именно поэтому оформление исходных кодов, представленных по ссылкам выше, выглядит не так, как обычно. Тем не менее, стиль написания кода сохранён.

Вдумчивым читателям предлагается подумать на досуге над следующими задачами, связанными с представленным кодом:

1. В этой программе само собой разумеющимся будет использование монады State для передачи состояния из функции в функцию. Было бы неплохо переделать код так, чтобы использовалась эта монада.
2. Хорошо бы, конечно, использовать какую-либо готовую библиотеку комбинаторов синтаксического анализа для чтения данных из файлов. Это хорошо и для обработки ошибок.
3. Также хорошо бы для формирования файлов использовать какую-либо библиотеку для «приятной печати» (pretty printing combinators).
4. Проверить, как ведёт себя последняя версия GHC с буквами «Ё», «Ч» и «Я» русского алфавита. Если обработка осуществляется правильно, то убрать из кода костыли, написанные в модуле WGCommons.
5. Использовать для представления хеш-таблицы базы слов какое-либо стандартное решение (например, тип Data.Map).

Ну и как обычно, хочу поблагодарить всех читателей, кто нашёл в себе силы прочитать этот текст более или менее внимательно. Пишите комментарии, письма и т. д. :).

Мои предыдущие статьи на Хаброхабре про язык Haskell:

• Генерация естественно-языковых фраз при помощи языка Haskell на основе порождающих грамматик и расширенных цепей Маркова
• Реализация конструирования N-грамм и генерации псевдо ЕЯ-текста на их основе на языке Haskell
• Фреймворк для генерации рекурсивных сказок на языке Haskell
• Утилита для работы с N-граммами
• Решение (несложных) криптографических задач на языке Haskell