Данный пост является попыткой добавить пару капель топлива в машину пропаганды Haskell, демонстрируя его использование в повседневных задачах.
В качестве таковых рассмотрим следующие:
- Реализуем пакет доступа к API ВКонтакте.
Код будет работать как в «native» приложениях, так и в приложениях JavaScript через GHCJS, компилятор Haskell в JavaScript - Напишем одностраничное браузерное приложение, используя наше API
Повествование носит сугубо иллюстративный характер в стиле «акын» (что вижу, то пою).
Итак, приступим.
API Вконтакте
Полный код пакета приведен здесь vk-api.
Типичное использование разрабатываемого нами API будет выглядеть следующим образом
appId :: Int appId = 123456 main :: IO () main = execVKAPI () (createSettings appId "myname" "mypass" (Just [Audio])) $ do -- ищем аудио Вконтакте (AR (Items (sar:_) _)) <- toAPI $ def{searchQ = "ABBA" , searchCount = Just 2 , searchLyrics = Just 1 } -- Ищем аудио у конкретного пользователя (AR (gar:_)) <- toAPI $ GetById [(audioOwnerId sar, audioId sar)] -- добавляем найденную запись в свою коллекцию (AR aid) <- toAPI $ Add (audioId gar) (audioOwnerId gar) Nothing Just uid <- liftState $ gets getUserId -- переименовываем добавленную запись toAPI $ def{editOwnerId = UserId uid , editAudioId = aid , editTitle = Just "My Added Record" } return () Основой для реализации API ВКонтакте послужит пакет api-builder.
Запросы и результаты мы хотим представлять в виде записей ADT. Ответы будем получать в виде JSON.
Описание операций API
На уровне типов свяжем запросы и результаты через класс Routable
class (Queryable q, Receivable a) => Routable q a | q -> a where toRoute :: q -> Route toAPI :: (MonadIO m, ErrorReceivable e) => q -> APIT s e m a toAPI = runRoute . toRoute Декларируя функциональную зависимость q -> a, мы клятвенно обещаем компилятору, что отображение типов запросов на типы результатов будет однозначно.
Конечное описание каждой операции API будет емкое и удобочитаемое, например для audio.getLyrics
-- audio.getLyrics Возвращает текст аудиозаписи instance Routable GetLyrics (ActionResponse Lyrics) where toRoute q = Route ["audio.getLyrics"] (toURLParams q) "GET"
Описание запросов
Тип запроса должен быть экземпляром класса Queryable для конвертации в список url-параметров
class Queryable a where toURLParams :: a -> [URLParam] Реализация каждого конкретного экземпляра Queryable — дело легкое, но нудное, потому создадим макрос
Template Haskell, пусть компилятор трудится за нас, а мы хотим затратить минимум усилий на описание наших запросов.
data GetLyrics = GetLyrics {getlyricsLyricsId :: !Int} deriving Show $(deriveQueryable' (standard . dropLPrefix) ''GetLyrics) Haskell в отношении макрологии далеко не Lisp, но в создании базового шаблона нам поможет интерпретатор. Попросим его показать AST для желаемого выражения.
runQ [d| instance Queryable Lyrics where toURLParams r = [("lyrics_id" =. lyricsLyricsId r), ("text" =. lyricsText r)] |]
[InstanceD [] (AppT (ConT Queryable) (ConT Lyrics)) [FunD toURLParams [Clause [VarP r_2] (NormalB (ListE [InfixE (Just (LitE (StringL "lyrics_id"))) (VarE =.) (Just (AppE (VarE lyricsLyricsId) (VarE r_2))), InfixE (Just (LitE (StringL "text"))) (VarE =.) (Just (AppE (VarE lyricsText) (VarE r_2)))])) []]]]
Далее остается находить по именам полученного AST соответсвующие функции в Language.Haskell.TH и конструировать наш макрос deriveQueryable.
Функции Haskell не имеют опциональных параметров, но мы предусмотрим значения по-умолчанию, описав для запросов экземпляры класса Default.
Пользователь сможет изменять только интересующие его атрибуты записи.
instance Default Save where def = Save 0 "" "" Nothing Nothing
Описание ответов
Связь JSON ответов с записями ADT для каждого типа результата будет определена экземпляром класса
Receivable.
С автоматизацией конвертирования JSON в записи ADT легко справляется aeson.
data Lyrics = Lyrics { lyricsLyricsId :: Int , lyricsText :: T.Text } deriving (Show, Generic) instance FromJSON Lyrics where parseJSON = genericParseJSON $ aesonPrefix snakeCase instance Receivable Lyrics where receive = useFromJSON Прерывание последовательности вычислений
Использование типов Maybe,Either в монадическом контексте или монадных трансформеров MaybeT, EitherT, ExceptT и.т.д позволяет прервать вычисление на первом «исключении», избегая утомительных проверок.
Haskell в данном подходе не одинок, так опциональные последовательности в Swift являются не чем иным, как монадой Maybe «для бедных», впиленной на уровне синтаксиса.
Пакет errors предоставляет всевозможные функции перепинывания вычислений«взад-назад» между членами этой команды. Чем мы и воспользуемся, иначе наш код загрузки аудиофайлов на сервер с множеством проверок был бы неудобочитаем.
-- | Upload audio file 'fn' to VKontakte. Register optional 'artist' -- and 'title' for it. uploadAudio :: T.Text -> Maybe T.Text -> Maybe T.Text -> API s VKError (ActionResponse SavedAudio) uploadAudio fn artist title = do (AR (UploadServer uploadURL)) <- toAPI GetUploadServer let msrv = uriToRoute <$> (parseURI $ T.unpack uploadURL) (srvURL, srvArgs, srvRoute) <- hoistEither $ note (mkError "bad upload url") msrv -- создаем запрос, файл будет послан в потоке let fnPart = partFileSource "file" $ T.unpack fn parts = Multipart $ (fnPart:srvArgs) mreq <- sendMultipart (basicBuilder "audioUpload" srvURL) srvRoute parts req <- hoistEither $ note (mkError "can't construct request") mreq -- посылаем запрос manager <- liftManager ask resp <- liftIO $ try $ httpLbs req manager res <- hoistEither $ first HTTPError resp -- парсим ответ в запрос 'Save' и добавляем файл в наш аккаунт save <- hoistEither $ receive res toAPI save{saveArtist = artist, saveTitle = title} ...
Декларативный парсинг строк
Средств работы со строками и регулярными выражениями в Haskell не меньше чем в любом другом уважаемом языке, но есть способ лучше. Генераторы парсеров в Haskell имеют ярко выраженный вкус декларативности, поэтому в нижеследующем случае мы отложим ножницы в сторону и напишем небольшой парсер на Parsec для конвертации privacy_setting API в ADT.
data Privacy = AllowAll | AllowFriends | AllowFriendsOfFriends | AllowFriendsOfFriendsOnly | AllowNobody | AllowOnlyMe | AllowList Int | AllowUser Int | DenyList Int | DenyUser Int deriving Show instance FromJSON Privacy where parseJSON = withText "Privacy" doParse where doParse txt = case parse parser "" txt of Left _ -> mempty Right v -> pure v parser = try (string "friends_of_friends_only" >> return AllowFriendsOfFriendsOnly) <|> try (string "friends_of_friends" >> return AllowFriendsOfFriends) <|> (string "friends" >> return AllowFriends) <|> (string "nobody" >> return AllowNobody) <|> (string "only_me" >> return AllowOnlyMe) <|> (string "list" >> many1 digit >>= return . AllowList . read) <|> (many1 digit >>= return . AllowUser . read) <|> (string "all" >> return AllowAll) <|> (string "-" >> ((many1 digit >>= return . DenyUser . read) <|> (string "list" >> many1 digit >>= return . DenyList . read)))
Как видим реализация по компактности и понятности мало отличается от текстового описания.
Тестирование
Для тестирования используем популярный BDD пакет HSpec.
HSpec умеет искать тесты, выполнять инициализацию и очистку, имеет простой декларативный интерфейс. Тест для проверки OAuth авторизации ВКонтакте будет выглядеть следующим образом.
spec :: Spec spec = do describe "OAuth authorization" $ do it "doesn't ask for any permissions" $ do execVKAPI () (vksettings Nothing) getAuthToken >>= (`shouldSatisfy` checkAuthToken) it "asks for some permissions" $ do execVKAPI () (vksettings $ Just [Audio, Video]) getAuthToken >>= (`shouldSatisfy` checkAuthToken) where getAuthToken = liftState $ gets _vkAuthToken checkAuthToken :: Either (APIError VKError) (Maybe AuthToken) -> Bool checkAuthToken (Right (Just (AuthToken _ _ _))) = True checkAuthToken _ = False vksettings :: Maybe [AuthPermissions] -> VKSettings vksettings scope = createSettings appId userName userPass scope
Браузерное приложение
Полный код пакета приведен здесь vk-api-example.
Наше небольшое приложение будет отображать и проигрывать в собственном плеере аудио пользователя, популярные треки, осуществлять поиск аудиозаписей.
Теперь рассмотрим насколько удобен Haskell для написания JavaScript приложений.
Haskell семейство компиляторов в JavaScript довольно велико, из наиболее популярных отметим:
- GHCJS — полноценный Haskell
- Haste — почти полный Haskell
- Fay — подмножество Haskell
- PureScript — Haskell с семантикой JavaScript
- Elm — Haskell подобный, нишевый язык для браузерных приложений
Мы будем использовать GHCJS, где наш пакет API можно использовать без изменений.
Основой для построения интерфейса послужит пакет React-Flux байндингов к React/Flux.
React-Flux сохраняет семантику и архитектуру Flux приложений и использует те же именования компонентов.
Некоторые достоинства Haskell в применении к JavaScript
Рассмотрим несколько достоинств, кроме очевидной строгой типизации, использования Haskell.
DSL для React, JSX не нужен
В силу компактности синтаксиса, использования монадического или аппликативного контекста вычислений Haskell является одним из чемпионов по производству DSL «из ниоткуда».
Сравним эквивалентные фрагменты кода AudioPlayer, портированного в наше приложение из JavaScript плеера react-audio-player, с оригиналом.
<div id={audioVolumeBarContainerId} ref="audioVolumeBarContainer" className="audio-volume-bar-container"> <Button id={toggleBtnId} ref="toggleButton" bsSize="small" onClick={this.toggle}> <Glyphicon glyph={toggleIcon}/> </Button> <div className={audioVolumeBarClasses}> <div className="audio-volume-min-max" onClick={this.volumeToMax}> <Glyphicon glyph="volume-up" /> </div> <div ref="audioVolumePercentContainer" className="audio-volume-percent-container" onClick={this.adjustVolumeTo}> <div className="audio-volume-percent" style={style}></div> </div> <div className="audio-volume-min-max" onClick={this.volumeToMin}> <Glyphicon glyph="volume-off" /> </div> </div> </div>
div_ (("className" $= "audio-volume-bar-container"):mouseLeaveHlr) $ do bootstrap_ "Button" ["bsSize" $= "small" , onClick toggleHlr ] $ bootstrap_ "Glyphicon" ["glyph" $= toggleIcon] mempty div_ ["className" $= classes] $ do div_ ["className" $= "audio-volume-min-max" , onClick (\_ _ -> dispatch st (AdjustVolume $ fromFactor (1::Int)))] $ bootstrap_ "Glyphicon" ["glyph" $= "volume-up"] mempty div_ ["className" $= "audio-volume-percent-container" , onClick adjustVolumeToHlr] $ div_ ["className" $= "audio-volume-percent" , "style" @= style] mempty div_ ["className" $= "audio-volume-min-max" , onClick (\_ _ -> dispatch st (AdjustVolume $ fromFactor (0::Int)))] $ bootstrap_ "Glyphicon" ["glyph" $= "volume-off"] mempty
Читаемость кода эквивалентна, но во втором случае мы обходимся без специализированного транслятора, не выходим за рамки языка, имеем полную поддержку от средств разработки.
При портировании плеера я старался сохранять именования и логику, так что заинтересованный читатель сможет легко провести сравнение реализаций и сделать собственные выводы.
Решение проблемы «callback hell»
Обойти кодирование в CPS стиле нам помогут следующие свойства Haskell.
- Рантайм GHCJS поддерживает весь внушительный арсенал Haskell в области параллельных/конкурентных вычислений. Мы можем писать код в обычной семантике конкурентных процессов, используя стандартные вызовы forkIO для их создания и обычные примитивы синхронизации Haskell — IORef, MVar, STM итд
- Специальный синтаксис оператора монадических вычислений do как раз и представляет собой транслятор последовательности вычислений во вложенные CPS-вызовы
- Упоминавшиеся ранее способы прерывания последовательности вычислений также помогают сделать из «лапши» красивое блюдо.
Соберем все вместе и приведем, как пример, AJAX функцию вызова операций нашего API из приложения.
runAPI :: State -> VKAction -> VK.VKAPI ApiState a -> (a -> VKAction) -> IO () runAPI State{..} action apiAction hlr = void . forkIO $ do res <- runMaybeT $ do -- авторизованы ли мы? as <- hoistMaybe apiState _ <- hoistMaybe $ if VK.isAuthorized as then Just True else Nothing lift $ do -- AJAX в работе, покажем спиннер alterStore store (SetAjaxRunning True) -- выполняем запрос (res, nas) <- VK.runVKAPI as apiAction alterStore store (SetApiState nas) -- закончили, уберем спиннер alterStore store (SetAjaxRunning False) -- покажем ошибку или передадим результат обработчику either apiError handleAction res -- нужна авторизация, авторизуемся и повторим when (isNothing res) $ alterStore store (Authorize action) where handleAction v = alterStore store (hlr v)
Маршрутизация в приложении, используем FFI
Так как приложение у нас одностраничное, то мы должны озаботиться использованием истории браузера. Создадим модуль Router.
Actions нашего приложения будут представлены типом ADT VKAction.
Для взаимного отображения URL из window.location.hash в ADT задействуем популярный пакет web-routes.
Соответсвующий макрос из пакета создаст код для такого маппинга.
$(derivePathInfo ''VKAction) Этого будет достаточно для преобразования Actions в URL, пример использования — создание линка.
a_ ["href" $= actionRoute store parentRouter (Audios $ SetAudioSelector asel)] label Для реакции на изменение window.location.hash нам нужно будет навесить обработчик на window.onhashchange. FFI в GHCJS довольно прост, следующий код вряд ли нуждается в комментариях.
foreign import javascript unsafe "window.onhashchange = function() {$1(location.hash.toString());}" js_attachtLocationHashCb :: (Callback (JSVal -> IO ())) -> IO () onLocationHashChange :: (String -> IO ()) -> IO () onLocationHashChange fn = do cb <- syncCallback1 ThrowWouldBlock (fn . JSS.unpack . unsafeCoerce) js_attachtLocationHashCb cb
Модульность приложения
React-Flux дает нам возможность создать несколько контроллеров, Store, со своими Actions и диспетчеризацией и далее организовать их совместную работу через конкурентные процессы.
Так виджет ввода поисковой строки IncrementalInput приложения использует таймер IdleTimer, который является полноценным контроллером со своими Store и Actions и работает независимо от основного контроллера приложения.
Тестирование приложения
Для тестирования приложения мы опять будем использовать HSpec и Selenium Webdriver через hspec-webdriver.
spec :: Spec spec = session "VK application tests" $ using Chrome $ do it "login to Vkontakte with user credentials" $ runWD $ do dir <- liftIO getCurrentDirectory openPage $ "file://" ++ dir ++ "/example/vk.html" cw <- getCurrentWindow findElem (ByCSS "div.authorization > div.panel-body > a.btn") >>= click liftIO $ threadDelay 3000000 ws <- windows length ws `shouldBe` 2 let Just vkW = find (/= cw) ws focusWindow vkW findElem (ByName "email") >>= sendKeys userName findElem (ByName "pass") >>= sendKeys userPass findElem (ByCSS "form input.button") >>= click authUrl <- getCurrentURL closeWindow vkW focusWindow cw findElem (ByCSS "input.form-control") >>= sendKeys (T.pack authUrl) liftIO $ threadDelay 3000000 findElem (ByCSS "button") >>= click liftIO $ threadDelay 3000000 it "selects \"AnyAudio\"" $ runWD $ do findElem (ByCSS "a[href=\"#/audios/set-audio-selector/any-audio\"]") >>= click liftIO $ threadDelay 3000000 pagerEls <- findElems (ByCSS "a[href^=\"#/audios/get-audio/\"]") length pagerEls `shouldBe` 11 activeEls <- findElems (ByCSS "li.active a[href=\"#\"]") length activeEls `shouldBe` 1
Пара скриншотов нашего скромного поделия.
Заключение
Надеюсь данный конспективный обзор послужит декларированной в начале цели.
Предваряя прогнозируемые пожелания читателей, пойду и убью себя сам о сад камней.
ссылка на оригинал статьи http://habrahabr.ru/post/272871/
Добавить комментарий