📜 ⬆️ ⬇️

Haskell for VK, Javascript and ReactJS, Or Alien vs. The Simpsons

This post is an attempt to add a couple of drops of fuel to the Haskell propaganda car, demonstrating its use in everyday tasks.



As such, consider the following:
')

The narrative is purely illustrative character in the style of "akyn" (what I see, I sing).

So let's get started.

API Vkontakte


The complete package code is here vk-api .

A typical use of the API we are developing will be as follows.

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 () 

The basis for implementing the VKontakte API is the api-builder package.

We want to present the queries and results as ADT records. We will receive answers in the form of JSON.

Description of API operations


At the type level, we associate queries and results through the class Routable

 class (Queryable q, Receivable a) => Routable qa | q -> a where toRoute :: q -> Route toAPI :: (MonadIO m, ErrorReceivable e) => q -> APIT sema toAPI = runRoute . toRoute 

Declaring the functional dependence q -> a , we solemnly promise the compiler that the mapping of query types to types of results will be unique.

The final description of each API operation will be succinct and readable, for example, for audio.getLyrics

 -- audio.getLyrics    instance Routable GetLyrics (ActionResponse Lyrics) where toRoute q = Route ["audio.getLyrics"] (toURLParams q) "GET" 

Request Description


The request type must be an instance of the Queryable class to be converted to a list of url parameters.

 class Queryable a where toURLParams :: a -> [URLParam] 

Implementing each specific instance of Queryable is easy but tedious, so we will create a macro.
Template Haskell , let the compiler work for us, and we want to spend a minimum of effort on the description of our requests.

 data GetLyrics = GetLyrics {getlyricsLyricsId :: !Int} deriving Show $(deriveQueryable' (standard . dropLPrefix) ''GetLyrics) 

Haskell is far from Lisp in relation to macrology, but an interpreter will help us in creating the basic template. Ask him to show AST for the desired expression.

  runQ [d| instance Queryable Lyrics where toURLParams r = [("lyrics_id" =. lyricsLyricsId r), ("text" =. lyricsText r)] |] 

AST
 [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)))])) []]]] 


Then it remains to find the corresponding functions in Language.Haskell.TH by the names of the received AST and construct our deriveQueryable macro.

Haskell functions do not have optional parameters, but we will provide default values ​​by describing instances of the Default class for queries.

The user will be able to change only the attributes of his record.

 instance Default Save where def = Save 0 "" "" Nothing Nothing 

Description of the answers


The association of JSON responses with ADT entries for each type of result will be determined by an instance of the class.
Receivable .

The automation of converting JSON to ADT records is easily handled by 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 


Abort Computation Sequence


Using Maybe , Either types in a monadic context or monodic Transformers MaybeT , EitherT , ExceptT, etc. allows you to interrupt the calculation at the first “exception”, avoiding tedious checks.

Haskell is not alone in this approach, so the optional sequences in Swift are nothing more than a Maybe monad for the poor, synced at the syntax level.

The errors package provides all sorts of rewinding back and forth calculations between members of this team. What we use, otherwise our code for uploading audio files to the server with many checks would be inconvenient.

uploadAudio
 -- | 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} ... 


Declarative string parsing


There are no fewer tools for working with strings and regular expressions in Haskell than in any other respected language, but there is a better way. The Haskell parser generators have a pronounced taste of declarativeness, so in the following case we will set aside scissors and write a small parser on Parsec to convert the privacy_setting API to ADT.

ADT and parser
 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))) 


As we see, the implementation in terms of compactness and intelligibility differs little from the text description.

Testing


For testing, use the popular BDD package HSpec .

HSpec can search for tests, perform initialization and cleanup, and has a simple declarative interface. The test for checking OAuth authorization VKontakte will look like this.

Test to check OAuth VK authentication
 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 


Browser application


The complete package code is shown here vk-api-example .

Our small application will display and play the user's audio player, popular tracks, and search for audio recordings.

Now consider how convenient Haskell is for writing JavaScript applications.
The Haskell family of compilers in JavaScript is quite large. Of the most popular, we note:


We will use GHCJS, where our API package can be used without modification.

The basis for building the interface will be a package of React-Flux banding to React / Flux .

React-Flux preserves the semantics and architecture of Flux applications and uses the same component naming.

Some advantages of Haskell as applied to JavaScript


Consider a few advantages, besides the obvious strong typing, using Haskell.

DSL for React, JSX is not needed


Due to the compactness of the syntax, the use of monadic or applicative context computing, Haskell is one of the champions for the production of DSL "from nowhere."

Let's compare the equivalent fragments of AudioPlayer code ported to our application from the react-audio-player JavaScript player with the original.

Jsx
 <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> 


Haskell
 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 


The readability of the code is equivalent, but in the second case we do without a specialized translator, do not go beyond the language, we have full support from the development tools.

When porting the player, I tried to keep the naming and logic, so that the interested reader could easily make a comparison of the implementations and draw their own conclusions.

Solving the problem "callback hell"


The following Haskell properties will help us bypass coding in CPS style.


Let's put it all together and give, as an example, the AJAX function to call operations of our API from an application.

runAPI
 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) 


Routing in the application, we use FFI


Since the application is one-page, we should take care of using the browser history. Create a module Router .

Actions of our application will be represented by the type ADT VKAction .

For mutual mapping of the URL from window.location.hash to ADT, we use the popular web-routes package.

The corresponding macro from the package will create code for such a mapping.

 $(derivePathInfo ''VKAction) 

This will be enough to convert Actions to a URL, an example of using is creating a link.

 a_ ["href" $= actionRoute store parentRouter (Audios $ SetAudioSelector asel)] label 

To react to the change of window.location.hash, we will need to hang the handler on window.onhashchange . FHI in GHCJS is pretty simple, the following code hardly needs comment.

 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 

Application modularity


React-Flux gives us the opportunity to create several controllers, the Store , with their Actions and dispatching and further organize their joint work through competitive processes.

So the input entry widget of the IncrementalInput application uses the IdleTimer timer, which is a full-fledged controller with its own Store and Actions and works independently of the main application controller.

Application Testing


To test the application, we will again use HSpec and Selenium Webdriver via hspec-webdriver .

Application Tests
 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 


A couple of screenshots of our modest share.

Authorization screen


Main screen


Conclusion


I hope this summary review will serve the stated goal at the beginning.

Anticipating the predictable wishes of readers, I will go and kill myself about the rock garden.

Source: https://habr.com/ru/post/272871/


All Articles