Я, кажется, созрел, чтобы переходить от чтения книжек и статей про Хаскель к попыткам что-то на нём писать самому. Вначале какую-нибудь мелочь. Скрипты, в общем. Поскольку я уже как-то публиковал здесь bash-скрипт
rss2lj (кросспост RSS в ЖЖ), то решил в качестве упражнения его переписать и улучшить. Думаю, получилось. В этой заметке расскажу о том, как писал. Ну и о впечатлениях. Скрипт выложен
на BitBucket и
на Hackage.
Содержание:
Задача состоит из кучи рутинных операций. Я думаю, именно поэтому, будет полезно и мне на будущее, и другим начинающим и пробующим, увидеть, как они выполняются на Хаскеле. В частности, по ходу дела я разобрался как
- обрабатывать аргументы коммандной строки,
- читать и писать файлы,
- использовать регулярные выражения,
- отсылать HTTP-запросы,
- выполнять ввод-вывод в уникоде (UTF-8),
- получать системное время.
Писать буду
как начинающий — начинающим. На словах получается довольно долго, но
сам код получился гораздо короче, чем эта статья (около 200 строк, считая комментарии, необязательные декларации типов, пустые строки и декларации импорта внешних модулей).
Хотя Хаскель язык компилируемый и строго типизированный, использовать его для таких дел вполне можно. Код получается примерно такой же, если не более, краткий, как на Python, а компилируется даже на лету достаточно быстро. Есть и особенности. Во-первых, вместо беззаботного
duck-typing здесь — строгая типизация. Поэтому писать надо аккуратнее (но и ошибок при исполнении меньше). Однако в Хаскеле эта строгая типизация сделана на основе
системы типов Хиндли–Миллнера и, в отличие от C++, под ногами не путается. Во-вторых, чтобы использовать преимущества функционального подхода (например,
отложенные вычисления, частичное применение функций) нужно отделять чисто функциональную часть программы от императивных фрагментов. В простейшем случае, это означает необходимость отделить операции ввода-вывода от вычислений (преобразования информации). Переводя на Хаскель: функции ввода-вывода будут иметь монадный тип
IO a, остальные же будут чистыми (без
IO в типе).
Предварительное описание задачи и подхода
В моём примере можно выделить следущие операции ввода-вывода:
- получение URL из аргументов командной строки,
- чтение содержимого RSS или Atom фида по заданному URL,
- чтение (и потом запись) файла со списком уже обработанных записей,
- чтение файла с настройками доступа к учётной записи ЖЖ,
- получение системного времени,
- коммуникация с ЖЖ по установленному протоколу.
И соответственно следующие преобразования данных:
- извлечение идентификаторов всех записей в фиде,
- отсев уже обработанных записей,
- извлечение заголовков, ссылок и текста оставшихся записей,
- форматирование записей по заданному шаблону,
- разбор файла с настройками.
Для разбора произвольных фидов я велосипед изобретать не стал, а воспользовался библиотекой
feed. А для всех коммуникаций по HTTP протоколу использовал библиотеку
curl (мне понравился её интерфейс). Обе библиотечки нашёл на
Hoogle, а установил с помощью
cabal. Из остальных зависимостей: нужен модуль
Codec.Binary.UTF8.String (в убунту и дебиан он помещён в пакет
libghc6-utf8-string-dev), модуль
Text.Regex.Posix (соответственно, пакет
libghc6-regex-posix-dev). Потом я сейчас заметил, что использовал
urlEncode из
Network.HTTP (у меня в
~/.cabal), хотя можно было обойтись пакетным
escapeURIString (из
Network.URI). То есть одна зависимость могла бы быть попроще.
В отдельный модуль я выделил всё, что касается связи связи с ЖЖ и его протокола (файл
LjPost.hs). Собственно всю логику скрипта я поместил в другом файле (
Feed2Lj.hs). Вспомогательную утилитку для тестирования модуля
LjPost я поместил в
RunLjPost.hs. Для использования скрипта она не нужна, я её использовал при его написании.
Модуль отправки сообщений в ЖЖ (LjPost)
Использование библиотеки Curl
Как я уже сказал, для работы по HTTP протоколу я использовал библиотечку
curl. Соответственно, помещаю в списке импортов
import Network.Curl
а основную функцию оформляю так, всё это достаточно «императивно»:
postToLj ljuser ljpass subj msg = withCurlDo $ do
curl <- initialize
...
Функция
withCurlDo должна охватывать все вызовы к
curl и отвечает за инициализацию и деинициализацию библиотеки;
initialize собственно и позволяет к библиотеке потом обращаться. Собственно HTTP запрос делается так (запрашиваю аутентификационный токен ЖЖ):
r <- do_curl_ curl ljFlatUrl getChallengeOpts :: IO CurlResponse
Т.е. используем
do_curl_, чтобы получить данные HTTP-ответа; результат (HTTP-ответ) связываю (
<-) с переменной
r; аргументы
do_curl_ были определены мной ранее, URL
ЖЖ-API ljFlatUrl = "www.livejournal.com/interface/flat"
и собственно параметры запроса:
getChallengeOpts = CurlPostFields ["mode=getchallenge"] : postFlags
postFlags = [CurlPost True]
Дальнейшие действия определяются логикой протокола ЖЖ.
Разбор ответа ЖЖ
Во flat-протоколе, ответ сервера выглядит так:
ключ_1
значение_1
ключ_2
значение_2
...
Нужно, во-первых, проверять значение ключа
success, во-вторых извлекать значения других ключей, для начала ключа
challenge.
Поскольку здесь никакого ввода-вывода уже нет, эту часть кода вполне можно написать «функционально». Самый простой и универсальный сделать это, мне кажется, разбить тело ответа (
respBody) на строчки (
lines), преобразовать их в ассоциативный список (
list2alist) и поискать в нём нужный ключ (
lookup), получив, может быть (монада
Maybe), значение:
lookupLjKey :: String -> CurlResponse -> Maybe String
lookupLjKey k = ( lookup k . list2alist . lines . respBody )
При этом функция преобразования списка в ассоциативный список простая двухстрочная рекурсия:
list2alist :: [a] -> [(a,a)]
list2alist (k:v:rest) = (k,v) : list2alist rest
list2alist _ = []
Всё, мы написали всё необходимое, чтобы разбирать ответы сервера.
Вспомогательная функция, проверяем, успешен ли был запрос (тогда и только тогда, когда в ответе есть ключ
success со значением
OK):
isSuccess :: CurlResponse -> Bool
isSuccess = (=="OK") . fromMaybe "" . lookupLjKey "success"
Мы определили
isSuccess композицией трёх функций.
lookupLjKey возвращает монаду
Maybe String. Функция
fromMaybe достаёт из неё строковое значение. Функция сравнения
(==) записана в префиксной форме и сравнивает значение со строкой «
OK».
Прошу заметить, что вытащить из монады
Maybe собственно значение всегда можно с помощью
fromJust, но если там ничего нет (
Nothing), то будет возбуждена ошибка. Здесь функция
fromMaybe возвращает в такой ситуации значение по умолчанию (пустую строку), но в других местах скрипта я часто использую
fromJust без проверок (т.е. при отсутствии значения скрипт будет прерываться). В программах посерьёзнее, я думаю, лучше всегда использовать функции
maybe или
fromMaybe, позволяющие использовать
Maybe-значения, указав для них значения по-умолчанию.
Отправка сообщения в ЖЖ
Возвращаемся к функции
postToLj и пишем, что если аутентификационный токе был успешно получен (
isSuccess r), взять текущее время (
timeopts <- currentTimeOpts, об этом ниже), подготовить запрос для публикациии сообщения (
let opts = postOpts ...) и отправить. Результатом функции будет ответ на последний выполненный запрос:
if (isSuccess r)
then do
let challenge = fromJust $ lookupLjKey "challenge" r
timeopts <- currentTimeOpts
let opts = postOpts ljuser ljpass challenge subj msg timeopts
r <- do_curl_ curl ljFlatUrl opts :: IO CurlResponse
return r
else return r
Как всегда в Хаскеле, если сказал
if — then, говори и
else (с тем же типом).
Ещё одно «новичковое» замечание: в блоке
do мы
связываем переменные с монадным значением с помощью
(<-) (это соответствует присваиванию в императивных языках), но
определяем переменные чистыми выражениями с помощью
(=). Вообще,
(=) в Хаскеле почти всегда можно читать как «равно по определению». Как только я это понял — жить стало проще ;-)
Теперь подробности. Чтобы отправить сообщение, нужно сформировать POST-запрос согласно протоколу. В моём примере этим занимается функция
postOpts u p c subj msg topts =
CurlPostFields ("mode=postevent" : (authOpts u p c)
++ ["event=" ++ quoteOpt msg, "subject=" ++ quoteOpt subj,
"lineendings=unix", "ver=1"]
++ topts ) : postFlags
которая аналогичная
getChallengeOpts, только список полей, которые нужно отослать, гораздо больше. И есть некоторые тонкости.
Во-первых, нужно защищать («квотировать») некоторые символы в отсылаемых значениях. Их немного, на помощь приходит определение функции с помощью шаблонов аргумента:
quoteOpt ('=':xs) = "%3d" ++ quoteOpt xs
quoteOpt ('&':xs) = "%26" ++ quoteOpt xs
quoteOpt (x:xs) = x : quoteOpt xs
quoteOpt [] = []Одно дело сделано. Во-вторых, нужно по имени пользователя, паролю и аутентификационному токену подготовить все поля запроса, касающиеся аутентификации:
authOpts u p c = [ "user=" ++ quoteOpt u, "auth_method=challenge",
"auth_challenge=" ++ quoteOpt c,
"auth_response=" ++ quoteOpt (evalResponse c p) ]
Собственно ответ на токен рассчитывается в одну строчку:
evalResponse c p = smd5 ( c ++ (smd5 p) ) where smd5 = md5sum . fromString
Кроме этого нужно импортировать соответствующие функции преобразования уникодной строки в байт-строку UTF-8 и функцию вычисления MD5-суммы:
import Data.ByteString.UTF8 (fromString)
import Data.Digest.OpenSSL.MD5 (md5sum)
И в-третьих, нужно заполнить в запросе поля, касающиеся времени публикации (текущего времени). Импортируем:
import Data.Time
import System.Locale (defaultTimeLocale)
Берём текущее время:
currentTime = do
t <- getCurrentTime
tz <- getCurrentTimeZone
return $ utcToLocalTime tz t
Заметим, что функция эта связана с вводом-выводом и не является «чистой» (не возвращает одно и то же значение всякий раз). По этой причине я предпочёл не вызывать её из «чистой»
postOpts, а передать уже готовый список опций, касающихся времени в
postOpts из
postToLj. Там, напомню, я писал:
timeopts <- currentTimeOpts
а
currentTimeOpts определил так:
currentTimeOpts :: IO [String]
currentTimeOpts = do
t <- currentTime
let opts = [ "year=%Y", "mon=%m", "day=%d", "hour=%H", "min=%M" ]
return $ map (flip showTime t) opts
Т.е. взял текущее время и подставил его в каждый из списка форматов (ЖЖ хочет в таков виде). Вспомогательная функция преобразования времени в строку по формату выглядит так:
showTime = formatTime defaultTimeLocale
Эта функция двух (неуказанных) аргументов получена
каррированием функции
formatTime. В
map я меняю местами её аргументы (
flip), чтобы формат передавался последним, и «перчу» ещё раз текущим временем.
Всё, у нас уже есть всё необходимое для отправки любых сообщений в любой ЖЖ. Нужно только знать логин и пароль.
Чтение файла конфигурации
Где-то логин и пароль хранить надо, и самое простое, что приходит в голову, поместить его в файле настроек, написанном в виде
username=мойлогин
password=мойпароль
В коде скрипта указываю путь по-умолчанию к этому файлу:
ljPassFile = "~/.ljpass"
Читаем этот файл и делаем из него знакомый и удобный ассоциативный список:
readPassFile f = do
ljpass <- readFile f
return $ map (\(f,s) -> (f,tail s)) $ map (break (== '=')) $ lines ljpass
Поскольку файл заведомо небольшой, можно использовать простую в обращении
readFile. Далее как обычно: режем на строки (
lines), каждую строку разбиваем по первому знаку «равно» (
map (break (== '='))), правим получившийся ассоциативный список список, откидывая знаки «равно» (λ-функция во втором
map). Результат заворачиваем в
IO-монаду (
return) как того требует тип функции.
Почти готово. Для пущего удобства сделаем себе раскрытие тильды в пути к файлу:
expandhome ('~':'/':p) = do h <- getHomeDirectory ; return (h ++ "/" ++ p)
expandhome p = return pи собственно функцию, которая, будет нам давать значение любого ключа из файла конфигурации:
readLjSetting key = do
passfile <- expandhome ljPassFile
s <- readPassFile passfile
return (lookup key s)
В этот раз нам надо добавить ещё две декларации импорта:
import IO
import System.Directory (getHomeDirectory)
Последний штрих: в объявлении модуля перечисляем экспортируемые вовне функции, а вспомогательные замалчиваем:
module LjPost (readLjSetting, postToLj, isSuccess, lookupLjKey, putLjKey) where
Наш модуль готов к использованию. Он позволяет нам задавать настройки доступа в файле конфигурации, понимает ЖЖ-протокол, поддерживает challenge-response аутентификацию и позволяет публиковать в ЖЖ сообщения. Меньше 100 строк кода, если не считать комментарии.
Обработка RSS/Atom фида (Feed2Lj)
Переходим к заключительной части рассказа. Скрипт
Feed2Lj.hs берёт URL фида из командной строки, настройки ЖЖ из файла с настройками (для него там добавляем третью настройку, имя файла со списком уже обработанных записей), скачивает фид и отсеивает уже обработанные, необработанные преобразует в plain-text, форматирует по образцу и отсылает в ЖЖ, обновляя список обработанных записей. Теперь подробно.
Получение аргументов командной строки
Получить список аргументов просто, его даёт функция
getArgs из
System.Environment. У нас аргумент один, адрес фида, поэтому может сразу связать нужную переменную (
url) с первым элементом списка, проигнорировав остальные:
url:_ <- getArgs
Такое связывание по шаблону мне кажется очень элегантным приёмом.
Скачивание фида
На помощь опять приходит библиотечка
curl. И опять связывание по шаблону, чтобы взять только интересующую нас часть результата:
(_,rawfeed) <- curlGetString url []
Используем модуль LjPost для чтения настроек
В общем-то вся работа уже сделана, осталось только использовать функцию
readLjSetting. У неё тип
[Char] -> IO (Maybe [Char]), т.е. по строке она возвращает IO-монаду, внутри которой, может быть строка (значения настройки найдено и считано), а может и не быть (настройка не найдена). Поскольку у нас тут сразу две монады (
IO и
Maybe), одна в другой, то, чтобы вытащить просто (
Just) значение, я поступаю так:
ljuser <- return fromJust `ap` readLjSetting "username"
т.е. функцию
fromJust применяю внутри монады
IO (
ap из
Control.Monad). Аналогично с остальными значениями из файла настроек. Кажется немного громоздно с непривычки, но не так уж сложно потом. Уверен, можно написать короче.
Чтение списка обработанных записей
Мой старый bash-скрипт писал ID записей в файл, одно на строчку, поэтому новый скрипт использует тот же формат (и тот же файл). Читаем файл и преобразуем в список строк:
sent_ids <- (return . lines) =<< readFile sentfile
Здесь, чтобы не вводить временную переменную, я явно указал функцию связывания вычислений (
=<<).
return требуется типом
(=<<). Результат эквивалентен записи
tmp <- readFile sentFile
let sent_ids = lines tmp
Отсеиваем обработанные записи
Для начала разберём содержимое фида и подготовим список всех записей. Благодаря библиотечке
feed это легко:
let feed = fromJust $ parseFeedString rawfeed
let items = feedItems feed
Ну а отсеять уже обработанные можно с помощью
filter:
let newitems = reverse $ filter (isNotSent sent_ids) items
Функция-предикат получилась за счёт каррирования
isNotSent:
isNotSent sent i = ((snd . fromJust . getItemId) i) `notElem` sent
Буквально: взять просто ID элемента (возможна ошибка), проверить, что не входит в список
sent. Сразу подготовим список ID подлежащих обработке записей:
let new_ids = map ( snd . fromJust . getItemId) newitems
Отправляем запись в ЖЖ
Тупо используем уже написанный модуль
LjPost. Если даны имя пользователя, пароль, шаблон записи для отправки и собственно запись:
postItem u p t i = do
let message = renderItem t i
let subj = fromJust $ getItemTitle i
r <- postToLj u p subj message
if isSuccess r
then putLjKey "url" r
else putLjKey "errmsg" r
Стоп-стоп-стоп! Какой ещё такой шаблон записи (
t) и что делает
renderItem? Объясняю: отослать запись нам надо в HTML-е, и хорошо бы можно было менять формат записи, не переделывая весь код. В общем,
renderItem — это маленькая template engine,
t — её шаблон. Я её опишу в следующих разделах статьи.
Вызываем из
main для каждой записи из списка необработанных:
let t = encodeString "<p>%text%</p><p>( <a href=\"%link%\" title=\"%title%\">дальше</a> )</p>"
mapM_ (postItem ljuser ljpass t) newitems
Здесь мы формируем список IO-действий и их последовательно исполняем (
mapM_). То есть последовательно отсылаем все записи из нашего списка. Обратим ещё внимание на
encodeString из
Codec.Binary.UTF8.String, которая кодирует строку в UTF-8.
Форматирование по шаблону (маленькая template engine)
Напишем нашу маленькую функцию форматирования по шаблону. Пусть, допустим, все параметры шаблона будут представлены как «%параметр%», а спецсимвол «%» будет представлен в шаблоне как «%%». Параметры будет передавать ассоциативным списком, а шаблон — строчкой. На выходе — строчка с подставленными в шаблон параметрами:
renderTemplate _ [] = []
renderTemplate alist s =
let (b,t,a) = s =~ "%[a-z0-9]*%" :: (String,String,String)
tagval t
| t == "%%" = Just "%"
| otherwise = let inner = take (length t - 2) $ drop 1 t
in lookup inner alist
val = tagval t
in if isJust val
then b ++ (fromJust val) ++ renderTemplate alist a
else b ++ t ++ renderTemplate alist a
Функция форматирования сообщения по шаблону готова. В ней мы последовательно «раскусываем» шаблон с помощью регулярных выражений на «текст-до», «тег» и «текст-после». Подставляем на место «тега» (
t) значение соответствующего параметра, если есть, или буквальный «%», если тэг пустой. Продолжаем, пока не кончится шаблон.
О регулярных выражениях. Включаем импортом
import Text.Regex.Posix ((=~))
После этого можем в любой строчке искать регулярное выражение:
строка =~ выражение :: возвращаемый тип
Регулярные выражения ведут себя по-разному в зависимости от возвращаемого типа. Мне пока что пригождаются больше всего два из них:
Bool для проверки соотвествия строки выражению и тройной кортеж
(String,String,String), разрезающий строчку на три части.
Функция форматирования по шаблону готова. Она просто работает со строками (шаблонами) и ассоциативными списками (словарями). А где же обещанная
renderItem?
Форматируем запись по шаблону
Итак,
renderItem должна получать шаблон и запись из фида, а возвращать строчку. Всё, что делает эта функция — просто достаёт нужные параметры записи, помещает их в ассоциативный список и вызывает функцию форматирования по шаблону
renderTemplate. В виде кода это выглядит гораздо понятнее:
renderItem :: String -> Item -> String
renderItem t i =
let title = ( fromJust . getItemTitle ) i
link = ( fromJust . getItemLink ) i
summary = ( takeSentences 5 . eatTags . fromJust . getItemSummary) i
tags = zip [ "title","link","text" ]
[ title, urlEncode link,summary ]
in renderTemplate tags t
Нетривиальна здесь только функция подготовки текста сообщения (
summary).
Поскольку я весь текст пересылать не хочу, а хочу только первые несколько предложений, то я вначале преобразую HTML в простой текст (в котором уже нет HTML-тэгов), а затем просто берую первые пять предложений. Таким образом, мне не нужно заботиться о предолжения будут гарантировано законченными.
Функция
eatTags использует тот же приём рекурсивного раскусывания строки с помощью регулярных выражений, что и
renderTemplate:
eatTags [] = []
eatTags s =
let (b,t,a) = s =~ "</?[^>]*/?>" :: (String,String,String)
in b ++ eatTags a
Все HTML и XHTML теги должны быть этой функцией вырезаны.
Упражнение: изменить функцию так, чтобы тег
<img/> выразался не бесследно, а заменялся содержимым его аттрибута
alt.
Теперь осталось лишь взять первые
n предложений. Возьмём вначале одно:
takeSentence s =
let ends = ".?!;"
(first,rest) = break (`elem` ends) s
in if not (null rest)
then (first ++ [head rest],tail rest)
else (first,[])
Тут я обошёлся без регулярных выражений, просто задав список разделителей (
ends) и раскусывая строку по символу из их числа (
break (`elem` ends)). Напоследок присоединяю разделитель, если он есть, к «откушенному» предложению (
break прикрепляет его к «остатку»).
Осталось лишь взять первые
n штук:
takeSentences n s
| n > 0 = let (s',r) = takeSentence s
in s' ++ takeSentences (n-1) r
| otherwise = ""
Теперь любая запись может быть представлена так, как мы захотим.
Обновляем список обработанных записей
Записи получены, отобраны, отформатированы, отправлены. Осталось только обновить список обработанных. Вначале сохраним предыдущую версию файла (переименованием), а потом запишем на его место новый список:
renameFile sentfile (sentfile ++ "~")
writeFile sentfile $ unlines (sent_ids ++ new_ids)
Здесь использована функция
renameFile из
System.Directory.
Заключение
Вот вроде и всё. Можно вызывать получившийся скрипт:
$ runhaskell Feed2Lj.hs URL-вашего-фида
Пробовал пока только с GHC, но, думаю, и с Hugs должно работать. Я, кстати, осознал, что у интерпретатора Hugs есть важное преимущество перед GHC: установка GHC тянет около 100 МБ, а Hugs — всего порядка 10 МБ. Так что как разберусь с Hugs, буду стараться проверять свои скрипты и на нём.
В целом впечатления от опыта «написать на Хаскеле» очень положительные. Во-первых, очень приятно, когда удаётся написать полезную функцию в одну-две строчки. Во-вторых, интересно думать о программе
иначе, писать более декларативно. В третьих, очень приятно, когда раз — и работает! (Ну это с любым языком). В четвёртых, мне нравится «математичный» синтаксис Хаскеля, он, по-моему, очень выразителен. Поначалу, пока не знакомо, конечно долго и непривычно, но когда входишь во вкус, получается быстрее и легче.
Кроме, понятно, гугла, большой подмогой является Hoogle. Сообщения GHC довольно подробные и понятные (разбирать ошибки C++-компиляторов про шаблоны гораздо труднее). Радует, что уже сейчас коллекция библиотек весьма богата (кажется, сопоставима с набором библиотек Python в то время, когда я с ним впервые познакомился). С уникодом, опять же, никаких проблем.
Есть и всякие «но»: но в коде других людей мне ещё далеко не всё понятно, но пихать ввод-вывод в любую точку кода в Хаскеле неудобно и не нужно (сделано намеренно, для отладки служит
trace из
Debug.Trace), но представить порядок ленивых вычислений не всегда легко, но документированы библиотеки в Hackage весьма лаконично (строго, по делу, но не так доходчиво и очевидно для новичков, как, например в Python), но
cabal до сих пор нет ни в Debian, ни в Ubuntu.
Но всё равно, мне понравилось. Буду рад замечаниям и вопросам. Уверен, что-то можно было написать лучше (короче, понятнее и выразительнее). Что-то, наверное, забыл объяснить.
