Yesod: Tips & Tricks

Общие слова

Решил посмотреть, чем занимаются нынче фрилансеры. И наткнулся на типовую задачу, на которую ранее как-то не обращал внимания: парсеры. Требовалось реализовать парсер via HTTP, встроенный в веб-сервер со страницей отображения прогресса парсинга. Т.е. тут и трёхзвенка, и парсер. Объёмы данные большие, интересно. Думаю, почему бы и нет…

Выбор технологий

• Поскольку ранее уже проходил туториал по Yesod, то решил чуть углубиться в него и посмотреть поближе, что же это такое, и с чем это едят. Тем более, придётся всё равно иметь дело с базой. Сервер выбран.
• А с парсингом не работал. Посмотрел в Hackage: тут и http-client, wreq, и hxt, и parsec, на котором можно написать свой парсер чего угодно. Но я остановился на tagsoup.

Итак, технологии выбраны, поехали.

Tagsoup

Вкратце, всё просто.

• Импортируем модуль и упрощаем себе жизнь для получения страницы.

import Network.HTTP as H
import Text.HTML.TagSoup

openURL :: String -> IO String
openURL x =  do 
  y <- H.simpleHTTP (H.getRequest x)
  fmap (decodeString UTF8) (H.getResponseBody y)

• Заводим требуемый нам тип данных: объект с нужными нам атрибутами.

Company = Company 
    { name :: Text
    , url :: Text
    , response_url :: (Maybe Text)
    , city :: Text
    , phone :: (Maybe Text)
    , good_responses :: (Maybe Text)
    } deriving Show

• Задаём шаблон строки, по которой мы будем дробить страницу на юниты с объектами.

  let forParsing = "<div class=\"b-grids\">" :: String

• Открываем URL и парсим страницу в список Tag.

tags <- fmap parseTags $ openURL a

• Группируем теги по шаблону forParsing.

let groups = partitions (~== forParsing) tags

• Используя repl, определяем местоположение атрибутов, устанавливаем тип атрибута: статический или динамический. Если статический, то находим индекс элемента в списке. Если динамический, то находим шаблоны начала и конца тегов, содержащих искомый атрибут. По итогам исследования пишем преобразование тегов в объект типа Company:

toCompany tags = Company n u r c p gr o
    where n  = strip $ pack $ fromTagText $ tags !! 9
          u  = pack $ fromAttrib "href" $ tags !! 8
          r  = case (isTagOpen $ tags !! 26) of 
                 True -> Just (pack $ fromAttrib "href" $ tags !! 26)
                 False -> Nothing
          gr = case (isTagOpen $ tags !! 26) of
                 True -> Just (strip $ pack $ drop 1 $ fromTagText $ tags !! 29)
                 False -> Nothing
          c  = strip $ pack $ innerText $ takeWhile (~/= p1) $ dropWhile (~/= p2) tags
          p  = Just (strip $ pack $ innerText $ takeWhile (~/= p3) $ dropWhile (~/= p4) tags)
          o  = Nothing
          p1 = "</div>" :: String
          p2 = "<div class=\"b-iconed-text__text-holder\" itemprop=\"addressLocality\">" :: String
          p3 = "</table>" :: String
          p4 = "<table class=\"b-contact-table h-mv-10\">" :: String

И теперь, чтобы не плодить лишних параметров, можно переписать код без создания групп:

let companies = fmap toCompany $ partitions (~== forParsing) tags

С парсером разобрались. Идём дальше.

Взаимодействие с PostgreSQL

• Чтобы не вводить искусственные типы данных руками, как выше это было сделано с Company, можно использовать config/models, тогда компания свернётся в такой код. При компиляции этот код раскрывается в нечто куда большее, подробнее можно узнать здесь:

Company
    name Text
    url Text
    response_url Text Maybe
    city Text
    phone Text Maybe
    good_responses Text Maybe
    options Text Maybe
    UniqueCompany url
    deriving Show

• Выборка данных из базы по собственному запросу осуществляется так:

count' = do
  let sql = "select count(1) cntr from category" :: Text
  [(Single cntr)] :: [(Single Int)] <- runDB $ rawSql sql []
  return cntr

• Если колонок несколько, то тогда следует вернуть список “простых значений” ([Single a]) и “избавиться от простоты” (unSingle). Важно, чтобы между топовыми select и from не было лишних знаков вопроса, иначе запрос скомпилируется, но в рантайме будут досадные ошибки. Такова прелесть Raw SQL. Ну а если существует необходимость конкатенировать результат запроса со строкой, содержащей символ знака вопроса (модификация url в базе), то тогда можно обернуть результат конкатенации в подзапрос, вопрос исчезнет из топа.

• Причина тому в заложенной возможности выборки сущностей через два вопросительных знака:

  let sql= "select ??, ?? from category ca, company co where ca.id = co.category_id"
  objs :: [(Entity Category, Entity Company)] <- runDB $ rawSql sql []

Другие хитрости Yesod

• Работая с обработчиками, следует держать во внимании, что вместо монады IO, тут используется (YesodPersist site, YesodPersistBackend site ~ SqlBackend) => HandlerT site IO. Для того, чтобы осуществлять действия с побочными эффектами, нужно использовать liftIO. Она смещает акцент из IO в нужную монаду. Парсинг в обработчике станет выглядеть так:

    do tags <- liftIO $ fmap parseTags $ openURL $ unpack a
       let obs = fmap (toObj c) $ sections (~== b) $ tail tags
       runDB $ mapM_ insertUnique obs

• Для создания форков в Yesod нужно пойти обратным путём:

    innerHandler <- handlerToIO
    _ <- liftIO $ forkIO $ innerHandler $ parseAction

• Для добавления статического контента в область видимости сервера нужно выполнить очистку пакета и пересобрать его.

cabal clean
yesod devel # cabal install