summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSergeyMironov <>2016-08-22 20:18:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-08-22 20:18:00 (GMT)
commit2790da159bdfaea2cc891ff12ed6783c9cc1af88 (patch)
treedee01684a04dcdcad40384cd9fb4b852c6a866ad
parentc7f3edc4179926436f4a6a36c6c537201a2f6021 (diff)
version 1.7.21.7.2
-rw-r--r--CHANGELOG.md8
-rw-r--r--README.md61
-rw-r--r--VKHS.cabal3
-rw-r--r--src/Web/VKHS.hs44
-rw-r--r--src/Web/VKHS/Imports.hs14
5 files changed, 74 insertions, 56 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index e8bb047..78e5089 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,10 +1,14 @@
TODO
----
-
* Decrypt 'RepeatedForm' errors
* Show capchas to users if required
-* Support simplified runhaskell-style scripting
+* Re-implement VK monad as a Free monad special case
+* Runhaskell: handle some standard command line arguments
+* Support storing access-tokens in a temp file
+Version 1.7.2
+-------------
+* Initial support for runhaskell mode
Version 1.7.1
-------------
diff --git a/README.md b/README.md
index 735625c..18521fe 100644
--- a/README.md
+++ b/README.md
@@ -97,39 +97,30 @@ For example, lets call ausio.search method to get some Beatles records:
...
-VKHS library
-============
+VKHS library/Runhaskell mode
+============================
-Please, consult the source code of the vkq application.
+Starting from 1.7.2 there are initial support for RunHaskell-mode. Consider the
+following example:
-_Note: Outdated content below_
-Following example illustrates basic usage (please fill client\_id, email and
-password with correct values):
+ #!/usr/bin/env runhaskell
+ {-# LANGUAGE RecordWildCards #-}
- import Web.VKHS.Login
- import Web.VKHS.API
+ import Prelude ()
+ import Web.VKHS
+ import Web.VKHS.Imports
- main = do
- let client_id = "111111"
- let e = env client_id "user@example.com" "password" [Photos,Audio,Groups]
- (Right at) <- login e
+ main :: IO ()
+ main = runVK_ defaultOptions $ do
+ Sized cnt cs <- getCountries
+ forM_ cs $ \Country{..} -> do
+ liftIO $ putStrLn co_title
- let user_of_interest = "222222"
- (Right ans) <- api e at "users.get" [
- ("uids",user_of_interest)
- , ("fields","first_name,last_name,nickname,screen_name")
- , ("name_case","nom")
- ]
- putStrLn ans
-
-client\_id is an application identifier, provided by vk.com. Users receive it
-after registering their applications after SMS confirmation. Registration form is
-located [here](http://vk.com/editapp?act=create).
-
-Internally, library uses small curl-based HTTP automata and tagsoup for jumping
-over relocations and submitting various 'Yes I agree' forms. Curl .so library is
-required for vkhs to work. I am using curl-7.26.0 on my system.
+When executed, the program should ask for login and password and output list of
+countries known to VK. Consider reviewing Web.VKHS.API.Simple where
+`getCountries` and several other methods are defined. Also, check the source
+code of the `vkq` application for more elaborated usage example.
Debugging
=========
@@ -138,22 +129,6 @@ Debugging
data, but the form appears again. Typically, that means that the password wa
invalid or captcha is required.
-_Note: Outdated content below_
-
-To authenticate the user, vkhs acts like a browser: it analyzes html but fills
-all forms by itself instead of displaying pages. Of cause, would vk.com change
-html design, things stop working.
-
-To deal with that potential problem, Ive included some debugging facilities:
-changing:
-
-writing
-
- (Right at) <- login e { verbose = Debug }
-
-will trigger curl output plus html dumping to the current directory. Please,
-mail those .html to me if problem appears.
-
Limitations
===========
* Implicit-flow authentication, see [documentation in
diff --git a/VKHS.cabal b/VKHS.cabal
index a589b91..e6c3119 100644
--- a/VKHS.cabal
+++ b/VKHS.cabal
@@ -1,6 +1,6 @@
name: VKHS
-version: 1.7.1
+version: 1.7.2
synopsis: Provides access to Vkontakte social network via public API
description:
Provides access to Vkontakte API methods. Library requires no interaction
@@ -34,6 +34,7 @@ library
Web.VKHS.Client
Web.VKHS.Login
Web.VKHS.Error
+ Web.VKHS.Imports
Web.VKHS.API
Web.VKHS.API.Types
Web.VKHS.API.Base
diff --git a/src/Web/VKHS.hs b/src/Web/VKHS.hs
index 12f8c1f..bf932e5 100644
--- a/src/Web/VKHS.hs
+++ b/src/Web/VKHS.hs
@@ -1,10 +1,21 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
-module Web.VKHS where
+module Web.VKHS (
+ module Web.VKHS
+ , module Web.VKHS.Client
+ , module Web.VKHS.Types
+ , module Web.VKHS.Error
+ , module Web.VKHS.Monad
+ , module Web.VKHS.Login
+ , module Web.VKHS.API.Base
+ , module Web.VKHS.API.Types
+ , module Web.VKHS.API.Simple
+ ) where
import Data.List
import Data.Maybe
@@ -26,17 +37,19 @@ import System.IO
import Web.VKHS.Error
import Web.VKHS.Types
-import Web.VKHS.Client as Client
-import Web.VKHS.Monad
+import Web.VKHS.Client hiding (Error, Response)
+import qualified Web.VKHS.Client as Client
+import Web.VKHS.Monad hiding (catch)
+import qualified Web.VKHS.Monad as VKHS
import Web.VKHS.Login (MonadLogin, LoginState(..), ToLoginState(..), printForm, login)
import qualified Web.VKHS.Login as Login
-import Web.VKHS.API (MonadAPI, APIState(..), ToAPIState(..), api)
-import qualified Web.VKHS.API as API
+import Web.VKHS.API.Base (MonadAPI, APIState(..), ToAPIState(..), api)
+import qualified Web.VKHS.API.Base as API
+import Web.VKHS.API.Types
+import Web.VKHS.API.Simple
import Debug.Trace
-{- Test -}
-
data State = State {
cs :: ClientState
, ls :: LoginState
@@ -79,14 +92,14 @@ instance MonadLogin (VK r) r State
instance MonadAPI VK r State
-- | Run the VK script, return final state and error status
-runVK :: VK r r -> StateT State (ExceptT String IO) r
-runVK m = runContT (runReaderT (unVK (catch m)) undefined) return
+stepVK :: VK r r -> StateT State (ExceptT String IO) r
+stepVK m = runContT (runReaderT (unVK (VKHS.catch m)) undefined) return
defaultSuperviser :: (Show a) => VK (R VK a) (R VK a) -> StateT State (ExceptT String IO) a
defaultSuperviser = go where
go m = do
GenericOptions{..} <- toGenericOptions <$> get
- res <- runVK m
+ res <- stepVK m
res_desc <- pure (describeResult res)
case res of
Fine a -> return a
@@ -113,6 +126,7 @@ runLogin go = do
evalStateT (defaultSuperviser (login >>= return . Fine)) s
+runAPI :: Show b => GenericOptions -> VK (R VK b) b -> ExceptT String IO b
runAPI go@GenericOptions{..} m = do
s <- initialState go
flip evalStateT s $ do
@@ -123,3 +137,13 @@ runAPI go@GenericOptions{..} m = do
False -> do
modify $ modifyAPIState (\as -> as{api_access_token = l_access_token})
defaultSuperviser (m >>= return . Fine)
+
+runVK :: Show a => GenericOptions -> VK (R VK a) a -> IO (Either String a)
+runVK go = runExceptT . runAPI go
+
+runVK_ :: Show a => GenericOptions -> VK (R VK a) a -> IO ()
+runVK_ go = do
+ runVK go >=> \case
+ Left e -> fail e
+ Right _ -> return ()
+
diff --git a/src/Web/VKHS/Imports.hs b/src/Web/VKHS/Imports.hs
new file mode 100644
index 0000000..d489476
--- /dev/null
+++ b/src/Web/VKHS/Imports.hs
@@ -0,0 +1,14 @@
+module Web.VKHS.Imports (
+ module Web.VKHS.Imports
+ , module Control.Monad
+ , module Control.Monad.Trans
+ , module Data.Text
+ , module Data.Text.IO
+ , module Prelude
+ ) where
+
+import Control.Monad
+import Control.Monad.Trans
+import Data.Text
+import Data.Text.IO
+import Prelude (($), IO(..), Bool(..))