Данный пост является попыткой добавить пару капель топлива в машину пропаганды 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
Пара скриншотов нашего скромного поделия.
Заключение
Надеюсь данный конспективный обзор послужит декларированной в начале цели.
Предваряя прогнозируемые пожелания читателей, пойду и убью себя сам о сад камней.
Автор: eryx67
