20090330

Скрипты на Хаскеле (пробую писать)

Я, кажется, созрел, чтобы переходить от чтения книжек и статей про Хаскель к попыткам что-то на нём писать самому. Вначале какую-нибудь мелочь. Скрипты, в общем. Поскольку я уже как-то публиковал здесь 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.

Но всё равно, мне понравилось. Буду рад замечаниям и вопросам. Уверен, что-то можно было написать лучше (короче, понятнее и выразительнее). Что-то, наверное, забыл объяснить.
Ярлыки: , , , ,