diff --git a/VKHS.cabal b/VKHS.cabal
--- a/VKHS.cabal
+++ b/VKHS.cabal
@@ -1,6 +1,6 @@
 
 name:                VKHS
-version:             0.5.7
+version:             1.6.0
 synopsis:            Provides access to Vkontakte social network via public API
 description:
     Provides access to Vkontakte API methods. Library requires no interaction
@@ -16,78 +16,48 @@
 cabal-version:       >=1.6
 homepage:            http://github.com/grwlf/vkhs
 
-source-repository head
-    type:     git
-    location: https://github.com/grwlf/vkhs.git
-
-executable vknews
-  extra-libraries: curl
-  hs-source-dirs:    src
-  main-is:           VKNews.hs
-  build-tools:     hsc2hs
-  ghc-options:     -Wall -fwarn-tabs
-
-executable vkq
-  hs-source-dirs:    src
-  main-is:           VKQ.hs
-
 library
   hs-source-dirs:    src
-  other-modules:     Test.Debug, Test.Data, Test.API, Network.Shpider.Forms,
-    Network.Protocol.Uri, Network.Protocol.Mime, Network.Protocol.Http,
-    Network.Protocol.Cookie, Network.Protocol.Uri.Remap,
-    Network.Protocol.Uri.Query, Network.Protocol.Uri.Printer,
-    Network.Protocol.Uri.Path, Network.Protocol.Uri.Parser,
-    Network.Protocol.Uri.Encode, Network.Protocol.Uri.Data,
-    Network.Protocol.Uri.Chars, Network.Protocol.Http.Status,
-    Network.Protocol.Http.Printer, Network.Protocol.Http.Parser,
-    Network.Protocol.Http.Headers, Network.Protocol.Http.Data, Text.Namefilter,
-    Text.PFormat,
-    Text.HTML.TagSoup.Parsec,
-    Data.Label.Abstract,
-    Data.Label.Derive,
-    Data.Label.Maybe,
-    Data.Label.MaybeM,
-    Data.Label.Pure,
-    Data.Label.PureM,
-    Data.Label
-
-  -- maybe not elegant, but convenient during tests
-  -- if os(windows)
-  --   include-dirs:   .\curl-7.25.0-devel-mingw32\include
-  --   extra-lib-dirs: .\curl-7.25.0-devel-mingw32\bin
+  other-modules:
 
-  exposed-modules:   Web.VKHS
-                     Web.VKHS.API
-                     Web.VKHS.API.Aeson
-                     Web.VKHS.API.Base
-                     Web.VKHS.API.Types
-                     Web.VKHS.API.Monad
-                     Web.VKHS.Curl
-                     Web.VKHS.Login
+  exposed-modules:
+                     Web.VKHS
                      Web.VKHS.Types
+                     Web.VKHS.Monad
+                     Web.VKHS.Client
+                     Web.VKHS.Login
+                     Web.VKHS.API
 
   build-depends:     base >=4.6 && <5,
                      containers,
                      mtl,
                      bytestring,
-                     tagsoup,
-                     failure,
-                     curlhs,
-                     safe,
+                     http-client,
+                     http-client-tls,
+                     network-uri,
+                     pipes,
+                     pipes-http,
+                     time,
+                     data-default-class,
                      parsec,
+                     tagsoup,
+                     case-insensitive,
+                     http-types,
                      split,
                      utf8-string,
-                     bimap,
-                     template-haskell,
-                     transformers,
+                     clock,
                      optparse-applicative,
                      aeson,
-                     filepath,
-                     directory,
-                     regexpr,
-                     pretty-show,
+                     EitherT,
                      vector,
-                     text,
-                     time
+                     filepath,
+                     directory
+
+
+executable vkq
+  hs-source-dirs:    app/vkq, app/aux, src
+  main-is:           Main.hs
+  build-depends:     regexpr,
+                     text
+
 
diff --git a/app/vkq/Main.hs b/app/vkq/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/vkq/Main.hs
@@ -0,0 +1,252 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main where
+
+import Control.Exception (SomeException(..),catch,bracket)
+import Control.Monad
+import Control.Monad.Trans
+import Control.Monad.Trans.Either
+import Data.Maybe
+import Data.List
+import Data.Char
+import Data.Text(Text(..),pack)
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import Options.Applicative
+import System.Environment
+import System.Exit
+import System.IO
+import Text.RegexPR
+import Text.Printf
+
+import Web.VKHS
+import Web.VKHS.Types
+import Web.VKHS.Client as Client
+import Web.VKHS.Monad hiding (catch)
+import Web.VKHS.API as API
+import Web.VKHS.API.Types as API
+
+import Util
+
+env_access_token = "VKQ_ACCESS_TOKEN"
+
+data APIOptions = APIOptions {
+    a_method :: String
+  , a_args :: String
+  } deriving(Show)
+
+data LoginOptions = LoginOptions {
+    l_eval :: Bool
+  } deriving(Show)
+
+data Options
+  = Login GenericOptions LoginOptions
+  | API GenericOptions APIOptions
+  | Music GenericOptions MusicOptions
+  | UserQ GenericOptions UserOptions
+  | WallQ GenericOptions WallOptions
+  | GroupQ GenericOptions GroupOptions
+  deriving(Show)
+
+toMaybe :: (Functor f) => f String -> f (Maybe String)
+toMaybe = fmap (\s -> if s == "" then Nothing else Just s)
+
+opts m =
+  let
+
+      -- genericOptions_ :: Parser GenericOptions
+      genericOptions_ puser ppass = GenericOptions
+        <$> (pure $ o_login_host defaultOptions)
+        <*> (pure $ o_api_host defaultOptions)
+        <*> (pure $ o_port defaultOptions)
+        <*> flag False True (long "verbose" <> help "Be verbose")
+        <*> (pure $ o_use_https defaultOptions)
+        <*> fmap read (strOption (value (show $ o_max_request_rate_per_sec defaultOptions) <> long "req-per-sec" <> metavar "N" <> help "Max number of requests per second"))
+        <*> flag True False (long "interactive" <> help "Allow interactive queries")
+
+        <*> (AppID <$> strOption (long "appid" <> metavar "APPID" <> value "3128877" <> help "Application ID, defaults to VKHS" ))
+        <*> puser
+        <*> ppass
+        <*> strOption (short 'a' <> m <> metavar "ACCESS_TOKEN" <>
+              help ("Access token. Honores " ++ env_access_token ++ " environment variable"))
+
+      genericOptions = genericOptions_
+        (strOption (value "" <> long "user" <> metavar "USER" <> help "User name or email"))
+        (strOption (value "" <> long "pass" <> metavar "PASS" <> help "User password"))
+
+      genericOptions_login = genericOptions_
+        (argument str (metavar "USER" <> help "User name or email"))
+        (argument str (metavar "PASS" <> help "User password"))
+
+
+      api_cmd = (info (API <$> genericOptions <*> (APIOptions
+        <$> argument str (metavar "METHOD" <> help "Method name")
+        <*> argument str (metavar "PARAMS" <> help "Method arguments, KEY=VALUE[,KEY2=VALUE2[,,,]]")))
+        ( progDesc "Call VK API method" ))
+
+  in subparser (
+       command "login" (info (Login <$> genericOptions_login <*> (LoginOptions
+      <$> flag False True (long "eval" <> help "Print in shell-friendly format")
+      ))
+      ( progDesc "Login and print access token" ))
+    <> command "call" api_cmd
+    <> command "api" api_cmd
+    <> command "music" (info ( Music <$> genericOptions <*> (MusicOptions
+      <$> switch (long "list" <> short 'l' <> help "List music files")
+      <*> strOption
+        ( metavar "STR"
+        <> long "query" <> short 'q' <> value [] <> help "Query string")
+      <*> strOption
+        ( metavar "FORMAT"
+        <> short 'f'
+        <> value "%o_%i %U\t%t"
+        <> help "Listing format, supported tags: %i %o %a %t %d %u"
+        )
+      <*> strOption
+        ( metavar "FORMAT"
+        <> short 'F'
+        <> value "%o_%i %U\t%t"
+        <> help ("Output format, supported tags:" ++ (listTags mr_tags))
+        )
+      <*> toMaybe (strOption (metavar "DIR" <> short 'o' <> help "Output directory" <> value ""))
+      <*> many (argument str (metavar "RECORD_ID" <> help "Download records"))
+      <*> flag False True (long "skip-existing" <> help "Don't download existing files")
+      ))
+      ( progDesc "List or download music files"))
+
+    <> command "user" (info ( UserQ <$> genericOptions <*> (UserOptions
+      <$> strOption (long "query" <> short 'q' <> help "String to query")
+      ))
+      ( progDesc "Extract various user information"))
+
+    <> command "wall" (info ( WallQ <$> genericOptions <*> (WallOptions
+      <$> strOption (long "id" <> short 'i' <> help "Owner id")
+      ))
+      ( progDesc "Extract wall information"))
+
+    <> command "group" (info ( GroupQ <$> genericOptions <*> (GroupOptions
+      <$> strOption (long "query" <> short 'q' <> value [] <> help "Group search string")
+      <*> strOption
+        ( metavar "FORMAT"
+        <> short 'F'
+        <> value "%o_%i %U\t%t"
+        <> help ("Output format, supported tags:" ++ (listTags gr_tags))
+        )
+      ))
+      ( progDesc "Extract groups information"))
+    )
+
+main :: IO ()
+main = ( do
+  m <- maybe (value "") (value) <$> lookupEnv env_access_token
+  o <- execParser (info (helper <*> opts m) (fullDesc <> header "VKontakte social network tool"))
+  r <- runEitherT (cmd o)
+  case r of
+    Left err -> do
+      hPutStrLn stderr err
+      exitFailure
+    Right _ -> do
+      return ()
+  )`catch` (\(e::SomeException) -> do
+    putStrLn $ (show e)
+    exitFailure
+  )
+
+{-
+  ____ _     ___
+ / ___| |   |_ _|
+| |   | |    | |
+| |___| |___ | |
+ \____|_____|___|
+
+ -}
+
+cmd :: Options -> EitherT String IO ()
+
+-- Login
+cmd (Login go LoginOptions{..}) = do
+  AccessToken{..} <- runLogin go
+  case l_eval of
+    True -> liftIO $ putStrLn $ printf "export %s=%s\n" env_access_token at_access_token
+    False -> liftIO $ putStrLn at_access_token
+
+-- API
+cmd (API go APIOptions{..}) = do
+  runAPI go (apiJ a_method (splitFragments "," "=" a_args))
+  return ()
+
+cmd (Music go@GenericOptions{..} mo@MusicOptions{..})
+
+  -- Query music files
+  |not (null m_search_string) = do
+    runAPI go $ do
+      API.Response _ (SizedList len ms) <- api "audio.search" [("q",m_search_string)]
+      forM_ ms $ \m -> do
+        io $ printf "%s\n" (mr_format m_output_format m)
+      io $ printf "total %d\n" len
+
+  -- List music files
+  |m_list_music = do
+    runAPI go $ do
+      (API.Response _ (ms :: [MusicRecord])) <- api "audio.get" [("q",m_search_string)]
+      forM_ ms $ \m -> do
+        io $ printf "%s\n" (mr_format m_output_format m)
+
+  -- Download music files
+  |not (null m_records_id) = do
+    let out_dir = fromMaybe "." m_out_dir
+    runAPI go $ do
+      (API.Response _ (ms :: [MusicRecord])) <- api "audio.getById" [("audios", concat $ intersperse "," m_records_id)]
+      forM_ ms $ \mr@MusicRecord{..} -> do
+        (f, mh) <- liftIO $ openFileMR mo mr
+        case mh of
+          Just h -> do
+            u <- ensure (pure $ Client.urlFromString mr_url_str)
+            r <- Client.downloadFileWith u (BS.hPut h)
+            io $ printf "%d_%d\n" mr_owner_id mr_id
+            io $ printf "%s\n" mr_title
+            io $ printf "%s\n" f
+          Nothing -> do
+            io $ hPutStrLn stderr ("File " ++ f ++ " already exist, skipping")
+        return ()
+
+
+-- Download audio files
+-- cmd (Options v (Music (MO act False [] _ ofmt odir rid sk))) = do
+--   let e = (envcall act) { verbose = v }
+--   Response (ms :: [MusicRecord]) <- api_ e "audio.getById" [("audios", concat $ intersperse "," rid)]
+--   forM_ ms $ \m -> do
+--     (fp, mh) <- openFileMR odir sk ofmt m
+--     case mh of
+--       Just h -> do
+--         r <- vk_curl_file e (url m) $ \ bs -> do
+--           BS.hPut h bs
+--         checkRight r
+--         printf "%d_%d\n" (owner_id m) (aid m)
+--         printf "%s\n" (title m)
+--         printf "%s\n" fp
+--       Nothing -> do
+--         hPutStrLn stderr (printf "File %s already exist, skipping" fp)
+--     return ()
+
+-- Query groups files
+cmd (GroupQ go (GroupOptions{..}))
+
+  |not (null g_search_string) = do
+
+    runAPI go $ do
+
+      API.Response _ (Many cnt (grs :: [GroupRecord])) <-
+        api "groups.search"
+          [("q",g_search_string),
+           ("v","5.44"),
+           ("fields", "can_post,members_count"),
+           ("count", "1000")]
+
+      forM_ grs $ \gr -> do
+        liftIO $ printf "%s\n" (gr_format g_output_format gr)
+
diff --git a/src/Data/Label.hs b/src/Data/Label.hs
deleted file mode 100644
--- a/src/Data/Label.hs
+++ /dev/null
@@ -1,166 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-{- |
-This package provides first class labels that can act as bidirectional record
-fields. The labels can be derived automatically using Template Haskell which
-means you don't have to write any boilerplate yourself. The labels are
-implemented as lenses and are fully composable. Labels can be used to /get/,
-/set/ and /modify/ parts of a datatype in a consistent way.
--}
-
-module Data.Label
-(
-
--- * Working with @fclabels@.
-
-{- |
-The lens datatype, conveniently called `:->', is an instance of the
-"Control.Category" type class: meaning it has a proper identity and
-composition. The library has support for automatically deriving labels from
-record selectors that start with an underscore.
-
-To illustrate this package, let's take the following two example datatypes.
--}
-
--- |
--- >{-# LANGUAGE TemplateHaskell, TypeOperators #-}
--- >import Control.Category
--- >import Data.Label
--- >import Prelude hiding ((.), id)
--- >
--- >data Person = Person
--- >  { _name   :: String
--- >  , _age    :: Int
--- >  , _isMale :: Bool
--- >  , _place  :: Place
--- >  } deriving Show
--- >
--- >data Place = Place
--- >  { _city
--- >  , _country
--- >  , _continent :: String
--- >  } deriving Show
-
-{- |
-Both datatypes are record types with all the labels prefixed with an
-underscore. This underscore is an indication for our Template Haskell code to
-derive lenses for these fields. Deriving lenses can be done with this simple
-one-liner:
-
->mkLabels [''Person, ''Place]
-
-For all labels a lens will created.
-
-Now let's look at this example. This 71 year old fellow, my neighbour called
-Jan, didn't mind using him as an example:
-
->jan :: Person
->jan = Person "Jan" 71 True (Place "Utrecht" "The Netherlands" "Europe")
-
-When we want to be sure Jan is really as old as he claims we can use the `get`
-function to get the age out as an integer:
-
->hisAge :: Int
->hisAge = get age jan
-
-Consider he now wants to move to Amsterdam: what better place to spend your old
-days. Using composition we can change the city value deep inside the structure:
-
->moveToAmsterdam :: Person -> Person
->moveToAmsterdam = set (city . place) "Amsterdam"
-
-And now:
-
->ghci> moveToAmsterdam jan
->Person "Jan" 71 True (Place "Amsterdam" "The Netherlands" "Europe")
-
-Composition is done using the @(`.`)@ operator which is part of the
-"Control.Category" module. Make sure to import this module and hide the default
-@(`.`)@, `id` function from the Haskell "Prelude".
-
--}
-
--- * Pure lenses.
-
-  (:->)
-, lens
-, get
-, set
-, modify
-
--- * Views using @Applicative@.
-
-{- |
-
-Now, because Jan is an old guy, moving to another city is not a very easy task,
-this really takes a while. It will probably take no less than two years before
-he will actually be settled. To reflect this change it might be useful to have
-a first class view on the `Person` datatype that only reveals the age and
-city.  This can be done by using a neat `Applicative` functor instance:
-
->import Control.Applicative
-
->ageAndCity :: Person :-> (Int, String)
->ageAndCity = Lens $
->  (,) <$> fst `for` age
->      <*> snd `for` city . place
-
-Because the applicative type class on its own is not very capable of expressing
-bidirectional relations, which we need for our lenses, the actual instance is
-defined for an internal helper structure called `Point`. Points are a bit more
-general than lenses. As you can see above, the `Label` constructor has to be
-used to convert a `Point` back into a `Label`. The `for` function must be used
-to indicate which partial destructor to use for which lens in the applicative
-composition.
-
-Now that we have an appropriate age+city view on the `Person` datatype (which
-is itself a lens again), we can use the `modify` function to make Jan move to
-Amsterdam over exactly two years:
-
->moveToAmsterdamOverTwoYears :: Person -> Person
->moveToAmsterdamOverTwoYears = modify ageAndCity (\(a, _) -> (a+2, "Amsterdam"))
-
->ghci> moveToAmsterdamOverTwoYears jan
->Person "Jan" 73 True (Place "Amsterdam" "The Netherlands" "Europe")
-
--}
-
-, Lens (Lens)
-
--- * Working with bijections and isomorphisms.
--- 
--- | This package contains a bijection datatype that encodes bidirectional
--- functions. Just like lenses, bijections can be composed using the
--- "Control.Category" type class. Bijections can be used to change the type of
--- a lens. The `Iso` type class, which can be seen as a bidirectional functor,
--- can be used to apply bijections to lenses.
--- 
--- For example, when we want to treat the age of a person as a string we can do
--- the following:
--- 
--- > ageAsString :: Person :-> String
--- > ageAsString = Bij show read `iso` age
-
-, Bijection (..)
-, Iso (..)
-, for
-
--- * Derive labels using Template Haskell.
---
--- | We can either derive labels with or without type signatures. In the case
--- of multi-constructor datatypes some fields might not always be available and
--- the derived labels will be partial. Partial labels are provided with an
--- additional type context that forces them to be only usable using the
--- functions from "Data.Label.Maybe".
-
-, mkLabels
-, mkLabel
-, mkLabelsWith
-, mkLabelsMono
-, mkLabelsNoTypes
-)
-where
-
-import Data.Label.Abstract (Bijection(..), Iso(..), for, Lens(..))
-import Data.Label.Pure
-import Data.Label.Derive
-
diff --git a/src/Data/Label/Abstract.hs b/src/Data/Label/Abstract.hs
deleted file mode 100644
--- a/src/Data/Label/Abstract.hs
+++ /dev/null
@@ -1,133 +0,0 @@
-{-# LANGUAGE
-    TypeOperators
-  , Arrows
-  , TupleSections
-  , FlexibleInstances
-  , MultiParamTypeClasses
-  #-}
-module Data.Label.Abstract where
-
-import Control.Arrow
-import Prelude hiding ((.), id)
-import Control.Applicative
-import Control.Category
-
-{-# INLINE _modify #-}
-{-# INLINE lens    #-}
-{-# INLINE get     #-}
-{-# INLINE set     #-}
-{-# INLINE modify  #-}
-{-# INLINE bimap   #-}
-{-# INLINE for     #-}
-{-# INLINE liftBij #-}
-
--- | Abstract Point datatype. The getter and setter functions work in some
--- arrow.
-
-data Point arr f i o = Point
-  { _get :: f `arr` o
-  , _set :: (i, f) `arr` f
-  }
-
--- | Modification as a compositon of a getter and setter. Unfortunately,
--- `ArrowApply' is needed for this composition.
-
-_modify :: ArrowApply arr => Point arr f i o -> (o `arr` i, f) `arr` f
-_modify l = proc (m, f) -> do i <- m . _get l -<< f; _set l -< (i, f)
-
--- | Abstract Lens datatype. The getter and setter functions work in some
--- arrow. Arrows allow for effectful lenses, for example, lenses that might
--- fail or use state.
-
-newtype Lens arr f a = Lens { unLens :: Point arr f a a }
-
--- | Create a lens out of a getter and setter.
-
-lens :: (f `arr` a) -> ((a, f) `arr` f) -> Lens arr f a
-lens g s = Lens (Point g s)
-
--- | Get the getter arrow from a lens.
-
-get :: Arrow arr => Lens arr f a -> f `arr` a
-get = _get . unLens
-
--- | Get the setter arrow from a lens.
-
-set :: Arrow arr => Lens arr f a -> (a, f) `arr` f
-set = _set . unLens
-
--- | Get the modifier arrow from a lens.
-
-modify :: ArrowApply arr => Lens arr f o -> (o `arr` o, f) `arr` f
-modify = _modify . unLens
-
-instance ArrowApply arr => Category (Lens arr) where
-  id = lens id (arr fst)
-  Lens a . Lens b = lens (_get a . _get b) (_modify b . first (curryA (_set a)))
-    where curryA f = arr (\i -> f . arr (i,))
-  {-# INLINE id #-}
-  {-# INLINE (.) #-}
-
-instance Arrow arr => Functor (Point arr f i) where
-  fmap f x = Point (arr f . _get x) (_set x)
-  {-# INLINE fmap #-}
-
-instance Arrow arr => Applicative (Point arr f i) where
-  pure a  = Point (arr (const a)) (arr snd)
-  a <*> b = Point (arr app . (_get a &&& _get b)) (_set b . (arr fst &&& _set a))
-  {-# INLINE pure #-}
-  {-# INLINE (<*>) #-}
-
--- | Make a 'Point' diverge in two directions.
-
-bimap :: Arrow arr => (o' `arr` o) -> (i `arr` i') -> Point arr f i' o' -> Point arr f i o
-bimap f g l = Point (f . _get l) (_set l . first g)
-
-infix 8 `for`
-
-for :: Arrow arr => (i `arr` o) -> Lens arr f o -> Point arr f i o
-for p = bimap id p . unLens
-
--- | The bijections datatype, an arrow that works in two directions. 
-
-infix 8 `Bij`
-
-data Bijection arr a b = Bij { fw :: a `arr` b, bw :: b `arr` a }
-
--- | Bijections as categories.
-
-instance Category arr => Category (Bijection arr) where
-  id = Bij id id
-  Bij a b . Bij c d = a . c `Bij` d . b
-  {-# INLINE id #-}
-  {-# INLINE (.) #-}
-
--- | Lifting 'Bijection's.
-
-liftBij :: Functor f => Bijection (->) a b -> Bijection (->) (f a) (f b)
-liftBij a = fmap (fw a) `Bij` fmap (bw a)
-
--- | The isomorphism type class is like a `Functor' but works in two directions.
-
-infixr 8 `iso`
-
-class Iso arr f where
-  iso :: Bijection arr a b -> f a `arr` f b
-
--- | Flipped isomorphism.
-
-osi :: Iso arr f => Bijection arr b a -> f a `arr` f b
-osi (Bij a b) = iso (Bij b a)
-
--- | We can diverge 'Lens'es using an isomorphism.
-
-instance Arrow arr => Iso arr (Lens arr f) where
-  iso bi = arr ((\a -> lens (fw bi . _get a) (_set a . first (bw bi))) . unLens)
-  {-# INLINE iso #-}
-
--- | We can diverge 'Bijection's using an isomorphism.
-
-instance Arrow arr => Iso arr (Bijection arr a) where
-  iso = arr . (.)
-  {-# INLINE iso #-}
-
diff --git a/src/Data/Label/Derive.hs b/src/Data/Label/Derive.hs
deleted file mode 100644
--- a/src/Data/Label/Derive.hs
+++ /dev/null
@@ -1,214 +0,0 @@
-{-# OPTIONS -fno-warn-orphans #-}
-{-# LANGUAGE
-    TemplateHaskell
-  , OverloadedStrings
-  , FlexibleContexts
-  , FlexibleInstances
-  , TypeOperators
-  , CPP
-  #-}
-module Data.Label.Derive
-( mkLabels
-, mkLabel
-, mkLabelsWith
-, mkLabelsMono
-, mkLabelsNoTypes
-) where
-
-import Control.Arrow
-import Control.Category
-import Control.Monad
-import Data.Char
-import Data.Function (on)
-import Data.Label.Abstract
-import Data.Label.Pure ((:->))
-import Data.Label.Maybe ((:~>))
-import Data.List
-import Data.Ord
-import Data.String
-import Language.Haskell.TH
-import Language.Haskell.TH.Syntax
-import Prelude hiding ((.), id)
-
--- Throw a fclabels specific error.
-
-fclError :: String -> a
-fclError err = error ("Data.Label.Derive: " ++ err)
-
--- | Derive lenses including type signatures for all the record selectors for a
--- collection of datatypes. The types will be polymorphic and can be used in an
--- arbitrary context.
-
-mkLabels :: [Name] -> Q [Dec]
-mkLabels = mkLabelsWith defaultMakeLabel
-
--- | Derive lenses including type signatures for all the record selectors in a
--- single datatype. The types will be polymorphic and can be used in an
--- arbitrary context.
-
-mkLabel :: Name -> Q [Dec]
-mkLabel = mkLabels . return
-
--- | Generate the label name from the record field name.
--- For instance, @drop 1 . dropWhile (/='_')@ creates a label @val@ from a
--- record @Rec { rec_val :: X }@.
-
-mkLabelsWith :: (String -> String) -> [Name] -> Q [Dec]
-mkLabelsWith makeLabel = liftM concat . mapM (derive1 makeLabel True False)
-
--- | Derive lenses including type signatures for all the record selectors in a
--- datatype. The signatures will be concrete and can only be used in the
--- appropriate context.
-
-mkLabelsMono :: [Name] -> Q [Dec]
-mkLabelsMono = liftM concat . mapM (derive1 defaultMakeLabel True True)
-
--- | Derive lenses without type signatures for all the record selectors in a
--- datatype.
-
-mkLabelsNoTypes :: [Name] -> Q [Dec]
-mkLabelsNoTypes = liftM concat . mapM (derive1 defaultMakeLabel False False)
-
--- Helpers to generate all labels for one datatype.
-
-derive1 :: (String -> String) -> Bool -> Bool -> Name -> Q [Dec]
-derive1 makeLabel signatures concrete datatype =
- do i <- reify datatype
-    let -- Only process data and newtype declarations, filter out all
-        -- constructors and the type variables.
-        (tyname, cons, vars) =
-          case i of
-            TyConI (DataD    _ n vs cs _) -> (n, cs,  vs)
-            TyConI (NewtypeD _ n vs c  _) -> (n, [c], vs)
-            _                             -> fclError "Can only derive labels for datatypes and newtypes."
-
-        -- We are only interested in lenses of record constructors.
-        recordOnly = groupByCtor [ (f, n) | RecC n fs <- cons, f <- fs ]
-
-    concat `liftM`
-        mapM (derive makeLabel signatures concrete tyname vars (length cons))
-            recordOnly
-
-    where groupByCtor = map (\xs -> (fst (head xs), map snd xs))
-                      . groupBy ((==) `on` (fst3 . fst))
-                      . sortBy (comparing (fst3 . fst))
-                      where fst3 (a, _, _) = a
-
--- Generate the code for the labels.
-
--- | Generate a name for the label. If the original selector starts with an
--- underscore, remove it and make the next character lowercase. Otherwise,
--- add 'l', and make the next character uppercase.
-defaultMakeLabel :: String -> String
-defaultMakeLabel field =
-  case field of
-    '_' : c : rest -> toLower c : rest
-    f : rest       -> 'l' : toUpper f : rest
-    n              -> fclError ("Cannot derive label for record selector with name: " ++ n)
-
-derive :: (String -> String)
-       -> Bool -> Bool -> Name -> [TyVarBndr] -> Int
-       -> (VarStrictType, [Name]) -> Q [Dec]
-derive makeLabel signatures concrete tyname vars total ((field, _, fieldtyp), ctors) =
-  do (sign, body) <-
-       if length ctors == total
-       then function derivePureLabel
-       else function deriveMaybeLabel
-
-     return $
-       if signatures
-       then [sign, inline, body]
-       else [inline, body]
-
-  where
-
-    -- Generate an inline declaration for the label.
-    --
-    -- Type of InlineSpec removed in TH-2.8.0 (GHC 7.6)
-#if MIN_VERSION_template_haskell(2,8,0)
-    inline = PragmaD (InlineP labelName Inline FunLike (FromPhase 0))
-#else
-    inline = PragmaD (InlineP labelName (InlineSpec True True (Just (True, 0))))
-#endif
-    labelName = mkName (makeLabel (nameBase field))
-
-    -- Build a single record label definition for labels that might fail.
-    deriveMaybeLabel = (if concrete then mono else poly, body)
-      where
-        mono = forallT prettyVars (return []) [t| $(inputType) :~> $(return prettyFieldtyp) |]
-        poly = forallT forallVars (return [])
-          [t| (ArrowChoice $(arrow), ArrowZero $(arrow))
-              => Lens $(arrow) $(inputType) $(return prettyFieldtyp) |]
-        body = [| lens (fromRight . $(getter)) (fromRight . $(setter)) |]
-          where
-            getter    = [| arr (\    p  -> $(caseE [|p|] (cases (bodyG [|p|]      ) ++ wild))) |]
-            setter    = [| arr (\(v, p) -> $(caseE [|p|] (cases (bodyS [|p|] [|v|]) ++ wild))) |]
-            cases b   = map (\ctor -> match (recP ctor []) (normalB b) []) ctors
-            wild      = [match wildP (normalB [| Left () |]) []]
-            bodyS p v = [| Right $( record p field v ) |]
-            bodyG p   = [| Right $( varE field `appE` p ) |]
-
-    -- Build a single record label definition for labels that cannot fail.
-    derivePureLabel = (if concrete then mono else poly, body)
-      where
-        mono = forallT prettyVars (return []) [t| $(inputType) :-> $(return prettyFieldtyp) |]
-        poly = forallT forallVars (return [])
-          [t| Arrow $(arrow) => Lens $(arrow) $(inputType) $(return prettyFieldtyp) |]
-        body = [| lens $(getter) $(setter) |]
-          where
-            getter = [| arr $(varE field) |]
-            setter = [| arr (\(v, p) -> $(record [| p |] field [| v |])) |]
-
-    -- Compute the type (including type variables of the record datatype.
-    inputType = return $ foldr (flip AppT) (ConT tyname) (map tvToVarT (reverse prettyVars))
-
-    -- Convert a type variable binder to a regular type variable.
-    tvToVarT (PlainTV  tv     ) = VarT tv
-    tvToVarT (KindedTV tv kind) = SigT (VarT tv) kind
-
-    -- Prettify type variables.
-    arrow          = varT (mkName "arr")
-    prettyVars     = map prettyTyVar vars
-    forallVars     = PlainTV (mkName "arr") : prettyVars
-    prettyFieldtyp = prettyType fieldtyp
-
-    -- Q style record updating.
-    record rec fld val = val >>= \v -> recUpdE rec [return (fld, v)]
-
-    -- Build a function declaration with both a type signature and body.
-    function (s, b) = liftM2 (,)
-        (sigD labelName s)
-        (funD labelName [ clause [] (normalB b) [] ])
-
-fromRight :: (ArrowChoice a, ArrowZero a) => a (Either b d) d
-fromRight = zeroArrow ||| returnA
-
--------------------------------------------------------------------------------
-
--- Helper functions to prettify type variables.
-
-prettyName :: Name -> Name
-prettyName tv = mkName (takeWhile (/='_') (show tv))
-
-prettyTyVar :: TyVarBndr -> TyVarBndr
-prettyTyVar (PlainTV  tv   ) = PlainTV (prettyName tv)
-prettyTyVar (KindedTV tv ki) = KindedTV (prettyName tv) ki
-
-prettyType :: Type -> Type
-prettyType (ForallT xs cx ty) = ForallT (map prettyTyVar xs) (map prettyType cx) (prettyType ty)
-prettyType (VarT nm         ) = VarT (prettyName nm)
-prettyType (AppT ty tx      ) = AppT (prettyType ty) (prettyType tx)
-prettyType (SigT ty ki      ) = SigT (prettyType ty) ki
-prettyType ty                 = ty
-
--- IsString instances for TH types.
-
-instance IsString Exp where
-  fromString = VarE . mkName
-
-instance IsString (Q Pat) where
-  fromString = varP . mkName
-
-instance IsString (Q Exp) where
-  fromString = varE . mkName
-
diff --git a/src/Data/Label/Maybe.hs b/src/Data/Label/Maybe.hs
deleted file mode 100644
--- a/src/Data/Label/Maybe.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE TypeOperators, TupleSections #-}
-module Data.Label.Maybe
-( (:~>)
-, lens
-, get
-, set
-, set'
-, modify
-, modify'
-, embed
-)
-where
-
-import Control.Arrow
-import Control.Category
-import Control.Monad.Identity
-import Control.Monad.Trans.Maybe
-import Data.Maybe
-import Prelude hiding ((.), id)
-import qualified Data.Label.Abstract as A
-
-type MaybeLens f a = A.Lens (Kleisli (MaybeT Identity)) f a
-
--- | Lens type for situations in which the accessor functions can fail. This is
--- useful, for example, when accessing fields in datatypes with multiple
--- constructors.
-
-type f :~> a = MaybeLens f a
-
-run :: Kleisli (MaybeT Identity) f a -> f -> Maybe a
-run l = runIdentity . runMaybeT . runKleisli l
-
--- | Create a lens that can fail from a getter and a setter that can themselves
--- potentially fail.
-
-lens :: (f -> Maybe a) -> (a -> f -> Maybe f) -> f :~> a
-lens g s = A.lens (kl g) (kl (uncurry s))
-  where kl a = Kleisli (MaybeT . Identity . a)
-
--- | Getter for a lens that can fail. When the field to which the lens points
--- is not accessible the getter returns 'Nothing'.
-
-get :: (f :~> a) -> f -> Maybe a
-get l = run (A.get l)
-
--- | Setter for a lens that can fail. When the field to which the lens points
--- is not accessible this function returns 'Nothing'.
-
-set :: f :~> a -> a -> f -> Maybe f
-set l v = run (A.set l . arr (v,))
-
--- | Like 'set' but return behaves like the identity function when the field
--- could not be set.
-
-set' :: (f :~> a) -> a -> f -> f
-set' l v f = f `fromMaybe` set l v f
-
--- | Modifier for a lens that can fail. When the field to which the lens points
--- is not accessible this function returns 'Nothing'.
-
-modify :: (f :~> a) -> (a -> a) -> f -> Maybe f
-modify l m = run (A.modify l . arr (arr m,))
-
--- | Like 'modify' but return behaves like the identity function when the field
--- could not be set.
-
-modify' :: (f :~> a) -> (a -> a) -> f -> f
-modify' l m f = f `fromMaybe` modify l m f
-
--- | Embed a pure lens that points to a `Maybe` field into a lens that might
--- fail.
-
-embed :: A.Lens (->) f (Maybe a) -> f :~> a
-embed l = lens (A.get l) (\a f -> Just (A.set l (Just a, f)))
-
diff --git a/src/Data/Label/MaybeM.hs b/src/Data/Label/MaybeM.hs
deleted file mode 100644
--- a/src/Data/Label/MaybeM.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-module Data.Label.MaybeM
-(
--- * 'MonadState' lens operations.
-  gets
-
--- * 'MonadReader' lens operations.
-, asks
-)
-where
-
-import Control.Monad
-import Data.Label.Maybe ((:~>))
-import qualified Control.Monad.Reader as M
-import qualified Control.Monad.State  as M
-import qualified Data.Label.Maybe     as L
-
--- | Get a value out of state, pointed to by the specified lens that might
--- fail.  When the lens getter fails this computation will fall back to
--- `mzero'.
-
-gets :: (M.MonadState f m, MonadPlus m) => (f :~> a) -> m a
-gets l = (L.get l `liftM` M.get) >>= (mzero `maybe` return)
-
--- | Fetch a value, pointed to by a lens that might fail, out of a reader
--- environment. When the lens getter fails this computation will fall back to
--- `mzero'.
-
-asks :: (M.MonadReader f m, MonadPlus m) => (f :~> a) -> m a
-asks l = (L.get l `liftM` M.ask) >>= (mzero `maybe` return)
-
diff --git a/src/Data/Label/Pure.hs b/src/Data/Label/Pure.hs
deleted file mode 100644
--- a/src/Data/Label/Pure.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-module Data.Label.Pure
-( (:->)
-, lens
-, get
-, set
-, modify
-)
-where
-
-import qualified Data.Label.Abstract as A
-
-type PureLens f a = A.Lens (->) f a
-
--- | Pure lens type specialized for pure accessor functions.
-
-type (f :-> a) = PureLens f a
-
--- | Create a pure lens from a getter and a setter.
---
--- We expect the following law to hold:
---
--- > get l (set l a f) == a
---
--- Or, equivalently:
---
--- > set l (get l f) f == f
-
-lens :: (f -> a) -> (a -> f -> f) -> f :-> a
-lens g s = A.lens g (uncurry s)
-
--- | Getter for a pure lens.
-
-get :: (f :-> a) -> f -> a
-get = A.get
-
--- | Setter for a pure lens.
-
-set :: (f :-> a) -> a -> f -> f
-set = curry . A.set
-
--- | Modifier for a pure lens.
-
-modify :: (f :-> a) -> (a -> a) -> f -> f
-modify = curry . A.modify
-
diff --git a/src/Data/Label/PureM.hs b/src/Data/Label/PureM.hs
deleted file mode 100644
--- a/src/Data/Label/PureM.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# LANGUAGE TypeOperators  #-}
-module Data.Label.PureM
-(
--- * 'MonadState' lens operations.
-  gets
-, puts
-, modify
-, modifyAndGet
-, (=:)
-, (=.)
-
--- * 'MonadReader' lens operations.
-, asks
-, local
-)
-where
-
-import Control.Monad
-import Data.Label.Pure ((:->))
-import qualified Control.Monad.Reader as M
-import qualified Control.Monad.State  as M
-import qualified Data.Label.Pure      as L
-
--- | Get a value out of the state, pointed to by the specified lens.
-
-gets :: M.MonadState s m => s :-> a -> m a
-gets = M.gets . L.get
-
--- | Set a value somewhere in the state, pointed to by the specified lens.
-
-puts :: M.MonadState s m => s :-> a -> a -> m ()
-puts l = M.modify . L.set l
-
--- | Modify a value with a function somewhere in the state, pointed to by the
--- specified lens.
-
-modify :: M.MonadState s m => s :-> a -> (a -> a) -> m ()
-modify l = M.modify . L.modify l
-
--- | Alias for `puts' that reads like an assignment.
-
-infixr 2 =:
-(=:) :: M.MonadState s m => s :-> a -> a -> m ()
-(=:) = puts
-
--- | Alias for `modify' that reads more or less like an assignment.
-
-infixr 2 =.
-(=.) :: M.MonadState s m => s :-> a -> (a -> a) -> m ()
-(=.) = modify
-
--- | Fetch a value pointed to by a lens out of a reader environment.
-
-asks :: M.MonadReader r m => (r :-> a) -> m a
-asks = M.asks . L.get
-
--- | Execute a computation in a modified environment. The lens is used to
--- point out the part to modify.
-
-local :: M.MonadReader r m => (r :-> b) -> (b -> b) -> m a -> m a
-local l f = M.local (L.modify l f)
-
--- | Modify a value with a function somewhere in the state, pointed to by the
--- specified lens. Additionally return a separate value based on the
--- modification.
-
-modifyAndGet :: M.MonadState s m => (s :-> a) -> (a -> (b, a)) -> m b
-modifyAndGet l f =
-  do (b, a) <- f `liftM` gets l
-     puts l a
-     return b
-
diff --git a/src/Network/Protocol/Cookie.hs b/src/Network/Protocol/Cookie.hs
deleted file mode 100644
--- a/src/Network/Protocol/Cookie.hs
+++ /dev/null
@@ -1,238 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-
-{-# LANGUAGE TemplateHaskell, TypeOperators #-}
-module Network.Protocol.Cookie
-(
-
--- | For more information:
---   http://tools.ietf.org/html/rfc6265
-
--- * Cookie datatype.
-  Cookie (Cookie)
-, emptyShort
-, empty
-, cookie
-, setCookie
-
-, CookieShort (CookieShort)
-, toShort
-
--- * Accessing cookies.
-, name
-, value
-, comment
-, commentURL
-, discard
-, domain
-, maxAge
-, expires
-, path
-, port
-, secure
-, version
-
--- * Collection of cookies.
-, Cookies
-, unCookies
-, gather
-, pickCookie
-)
-where
-
-import Prelude hiding ((.), id)
-import Control.Category
-import Control.Monad (join)
-import Data.Label
-import qualified Data.Label.Abstract as A
-import Data.Maybe
-import Data.Char
-import Data.Monoid
-import Safe
-import Data.List
-import Network.Protocol.Uri.Query
-import qualified Data.Map as M
-
--- | The `Cookie` data type containg one key/value pair with all the
--- (potentially optional) meta-data.
-
-data Cookie =
-  Cookie
-    { _name       :: String
-    , _value      :: String
-    , _comment    :: Maybe String
-    , _commentURL :: Maybe String
-    , _discard    :: Maybe String
-    , _domain     :: Maybe String
-    , _maxAge     :: Maybe Int
-    , _expires    :: Maybe String
-    , _path       :: Maybe String
-    , _port       :: [Int]
-    , _secure     :: Bool
-    , _version    :: Int
-    } deriving(Show, Read, Eq)
-
-$(mkLabels [''Cookie])
-
-
--- | Short notation for cookies
-
-data CookieShort =
-  CookieShort
-    { _s_name  :: String
-    , _s_value   :: String
-    } deriving (Show, Eq)
-
-$(mkLabels [''CookieShort])
-
--- | Convert Cookie to CookieShort
-toShort :: Cookie -> CookieShort
-toShort c = CookieShort (get name c) (get value c)
-
-emptyShort :: CookieShort
-emptyShort = CookieShort "" ""
-
--- | Create an empty cookie.
-
-empty :: Cookie
-empty = Cookie "" "" Nothing Nothing Nothing Nothing Nothing Nothing Nothing [] False 0
-
--- | Show a semicolon separated list of attribute/value pairs. Only meta pairs
--- with significant values will be pretty printed.
-
-showSetCookie :: Cookie -> ShowS
-showSetCookie c =
-    pair (get name c) (get value c)
-  . opt  "comment"    (get comment c)
-  . opt  "commentURL" (get commentURL c)
-  . opt  "discard"    (get discard c)
-  . opt  "domain"     (get domain c)
-  . opt  "maxAge"     (fmap show $ get maxAge c)
-  . opt  "expires"    (get expires c)
-  . opt  "path"       (get path c)
-  . lst  "port"       (map show $ get port c)
-  . bool "secure"     (get secure c)
-  . opt  "version"    (optval $ get version c)
-  where
-    attr a       = showString a
-    val v        = showString ("=" ++ v)
-    end          = showString "; "
-    single a     = attr a . end
-    pair a v     = attr a . val v . end
-    opt a        = maybe id (pair a)
-    lst _ []     = id
-    lst a xs     = pair a $ intercalate "," xs
-    bool _ False = id
-    bool a True  = single a
-    optval 0     = Nothing
-    optval i     = Just (show i)
-
-(!$) a b = b $ a
-infixr 0 !$
-
-parseSetCookie :: String -> Cookie
-parseSetCookie s =
-  let p = fw (keyValues ";" "=") s
-  in Cookie
-    { _name       = p !$ headMay >>> fmap fst >>> fromMaybe ""
-    , _value      = p !$ headMay >>> fmap snd >>> fromMaybe ""
-    , _comment    = p !$ lookup "comment"
-    , _commentURL = p !$ lookup "commentURL"
-    , _discard    = p !$ lookup "discard"
-    , _domain     = p !$ lookup "domain"
-    , _maxAge     = p !$ lookup "maxAge" >>> fmap readMay >>> join
-    , _expires    = p !$ lookup "expires"
-    , _path       = p !$ lookup "path"
-    , _port       = p !$ lookup "port" >>> maybe [] (readDef [-1])
-    , _secure     = p !$ lookup "secure" >>> maybe False (const True)
-    , _version    = p !$ lookup "version" >>> maybe 1 (readDef 1)
-    }
-
-showCookie :: CookieShort -> String
-showCookie c = _s_name c ++ "=" ++ _s_value c
-
-parseCookie :: String -> CookieShort
-parseCookie s =
-  let p = fw (values "=") s
-  in emptyShort
-       { _s_name  = atDef "" p 0
-       , _s_value = atDef "" p 1
-       }
-
--- | Cookie parser and pretty printer as a lens. To be used in combination with
--- the /Set-Cookie/ header field.
-
-setCookie :: Bijection (->) String Cookie
-setCookie = Bij parseSetCookie (flip showSetCookie "")
-
--- cookieShort :: Bijection (->) String [CookieShort]
--- cookieShort = Bij parseCookie showCookie
-
--- | Cookie parser and pretty printer as a lens. To be used in combination with
--- the /Cookie/ header field.
-
-cookie :: Bijection (->) String [CookieShort]
-cookie = (A.liftBij $ Bij parseCookie showCookie) . values ";"
-
--- | A collection of multiple cookies. These can all be set in one single HTTP
--- /Set-Cookie/ header field.
-
-data Cookies = Cookies { _unCookies :: M.Map String Cookie }
-  deriving (Eq, Show, Read)
-
-emptyC = Cookies M.empty
-
-instance Monoid Cookies where
-    mempty = emptyC
-    mappend (Cookies a) (Cookies b) = Cookies (a`mappend`b)
-
-$(mkLabels [''Cookies])
-
--- | Case-insensitive way of getting a cookie out of a collection by name.
-
-pickCookie :: String -> Cookies :-> Maybe Cookie
-pickCookie n = lookupL (map toLower n) . unCookies where
-    lookupL k = lens (M.lookup k) (flip M.alter k . const)
-
--- | Convert a list to a cookies collection.
-
-fromList :: [Cookie] -> Cookies
-fromList = Cookies . M.fromList . map (\a -> (map toLower $ get name a, a))
-
--- | Get the cookies as a list.
-
-toList :: Cookies -> [Cookie]
-toList = map snd . M.toList . get unCookies
-
--- | Converts to/from cookie collection using a list
-
-gather :: Bijection (->) [Cookie] Cookies
-gather = Bij fromList toList
-
diff --git a/src/Network/Protocol/Http.hs b/src/Network/Protocol/Http.hs
deleted file mode 100644
--- a/src/Network/Protocol/Http.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-module Network.Protocol.Http
-  (
-
-  -- * HTTP message data types.
-
-    Method (..)
-  , Version
-  , Key
-  , Value
-  , Headers (..)
-  , Request (Request)
-  , Response (Response)
-  , Http (Http)
-
-  -- * Creating (parts of) messages.
-
-  , http10
-  , http11
-  , emptyHeaders
-  , emptyRequest
-  , emptyResponse
-
-  -- * Accessing fields.
-
-  , methods
-  , major
-  , minor
-  , headers
-  , version
-  , headline
-  , method
-  , uri
-  , asUri
-  , status
-  , normalizeHeader
-  , header
-
-  -- * Accessing specific header fields.
-
-  , contentLength
-  , connection
-  , accept
-  , acceptEncoding
-  , acceptLanguage
-  , cacheControl
-  , keepAlive
-  , setCookies
-  , cookiesShort
-  , location
-  , contentType
-  , date
-  , hostname
-  , server
-  , userAgent
-  , upgrade
-  , lastModified
-  , acceptRanges
-  , eTag
-
-  -- * Parsing HTTP messages.
-
-  , parseRequest
-  , parseResponse
-  , parseResponseHead
-  , parseHeaders
-
-  -- * Exposure of internal parsec parsers.
-
-  , pRequest
-  , pResponse
-  , pHeaders
-  , pVersion
-  , pMethod
-
-  -- * Parser helper methods.
-
-  , versionFromString
-  , methodFromString
-
-  -- * Printer helper methods.
-
-  , showRequestLine
-  , showResponseLine
-  , printResponse
-  , printRequest
-
-  -- * Handling HTTP status codes.
-
-  , Status (..)
-  , statusFailure
-  , statusFromCode
-  , codeFromStatus
-
-  ) where
-
-import Network.Protocol.Http.Data
-import Network.Protocol.Http.Parser
-import Network.Protocol.Http.Printer
-import Network.Protocol.Http.Headers
-import Network.Protocol.Http.Status
-
diff --git a/src/Network/Protocol/Http/Data.hs b/src/Network/Protocol/Http/Data.hs
deleted file mode 100644
--- a/src/Network/Protocol/Http/Data.hs
+++ /dev/null
@@ -1,176 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE TemplateHaskell, TypeOperators, KindSignatures #-}
-module Network.Protocol.Http.Data where
-
-import Control.Category
-import Data.Char
-import Data.List
-import Data.List.Split
-import Data.Label
-import Network.Protocol.Http.Status
-import Network.Protocol.Uri
-import Prelude hiding ((.), id, lookup, mod)
-
--- | List of HTTP request methods.
-
-data Method =
-    OPTIONS
-  | GET
-  | HEAD
-  | POST
-  | PUT
-  | DELETE
-  | TRACE
-  | CONNECT
-  | OTHER String
-  deriving (Read, Show, Eq)
-
--- | HTTP protocol version.
-
-data Version = Version {_major :: Int, _minor :: Int}
-  deriving (Read, Show, Eq, Ord)
-
-type Key   = String
-type Value = String
-
--- | HTTP headers as mapping from keys to values.
-
-newtype Headers = Headers { unHeaders :: [(Key, Value)] } -- order seems to matter
-  deriving (Read, Show, Eq)
-
--- | Request specific part of HTTP messages.
-
-data Request = Request  { __method :: Method, __uri :: String }
-  deriving (Read, Show, Eq)
-
--- | Response specific part of HTTP messages.
-
-data Response = Response { __status :: Status }
-  deriving (Read, Show, Eq)
-
--- | An HTTP message. The message body is *not* included.
-
-data Http a = Http
-  { _headline :: a
-  , _version  :: Version
-  , _headers  :: Headers
-  } deriving (Read, Show, Eq)
-
--- | All recognized method constructors as a list.
-
-methods :: [Method]
-methods = [OPTIONS, GET, HEAD, POST, PUT, DELETE, TRACE, CONNECT]
-
--- | Create HTTP 1.0 version.
-
-http10 :: Version
-http10 = Version 1 0
-
--- | Create HTTP 1.1 version.
-
-http11 :: Version
-http11 = Version 1 1
-
--- | Create an empty set of headers.
-
-emptyHeaders :: Headers
-emptyHeaders = Headers []
-
--- | Create an empty HTTP request message.
-
-emptyRequest :: Http Request
-emptyRequest = Http (Request GET "") http11 emptyHeaders
-
--- | Create an empty HTTP response message.
-
-emptyResponse :: Http Response
-emptyResponse = Http (Response OK) http11 emptyHeaders
-
-$(mkLabels [''Version, ''Request, ''Response, ''Http])
-
--- | Label to access the method part of an HTTP request message.
-
-method :: Http Request :-> Method
-method = _method . headline
-
--- | Label to access the URI part of an HTTP request message.
-
-uri :: Http Request :-> String
-uri = _uri . headline
-
--- | Label to access the URI part of an HTTP request message and access it as a
--- true URI data type.
-
-asUri :: Http Request :-> Uri
-asUri = (Bij toUri showUri) `iso` uri
-
--- | Label to access the status part of an HTTP response message.
-
-status :: Http Response :-> Status
-status = _status . headline
-
--- | Normalize the capitalization of an HTTP header key.
-
-normalizeHeader :: Key -> Key
-normalizeHeader = intercalate "-" . map casing . splitOn "-"
-  where
-  casing ""     = ""
-  casing (x:xs) = toUpper x : map toLower xs
-
--- | Generic label to access an HTTP header field by key. Returns first matching
--- field
-
-header :: Key -> Http a :-> Maybe Value
-header key = lens
-  (lookup (normalizeHeader key) . unHeaders . get headers)
-  (\x -> modify headers (Headers . alter (normalizeHeader key) x . unHeaders))
-  where
-  alter :: Eq a => a -> Maybe b -> [(a, b)] -> [(a, b)]
-  alter k v []                      = maybe [] (\w -> (k, w):[]) v
-  alter k v ((x, y):xs) | k == x    = maybe xs (\w -> (k, w):xs) v
-                        | otherwise = (x, y) : alter k v xs
-
--- | Label to access HTTP header fields, return a list of matching fields
-
-headerMany :: Key -> Http a :-> [Value]
-headerMany key = lens
-  (map snd . filter (key_is (normalizeHeader key)) . unHeaders . get headers)
-  (\x -> modify headers (Headers . alter (normalizeHeader key) x . unHeaders))
-  where
-  alter :: Eq a => a -> [b] -> [(a, b)] -> [(a, b)]
-  alter k []     []                      = []
-  alter k []     ((x, y):xs) | k == x    =          alter k [] xs
-                             | otherwise = (x, y) : alter k [] xs
-  alter k (v:vs) []                      = (k, v) : alter k vs []
-  alter k (v:vs) ((x, y):xs) | k == x    = (k, v) : alter k vs xs
-                             | otherwise = (x, y) : alter k (v:vs) xs
-  key_is k' (k,v) = k==k'
-
diff --git a/src/Network/Protocol/Http/Headers.hs b/src/Network/Protocol/Http/Headers.hs
deleted file mode 100644
--- a/src/Network/Protocol/Http/Headers.hs
+++ /dev/null
@@ -1,153 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
-
--}
-{-# LANGUAGE TypeOperators #-}
-module Network.Protocol.Http.Headers where {- doc ok -}
-
-import Control.Category
-import Control.Monad
-import Data.Label as L
-import Data.Monoid
-import Data.Label.Abstract as A
-import Network.Protocol.Http.Data
-import Network.Protocol.Uri.Query
-import Network.Protocol.Uri
-import Network.Protocol.Cookie
-import Prelude hiding ((.), id)
-import Safe
-
--- | Access the /Content-Length/ header field.
-
-contentLength :: (Show i, Read i, Integral i) => Http a :-> Maybe i
-contentLength = (Bij (join . fmap readMay) (fmap show)) `iso` header "Content-Length"
-
--- | Access the /Connection/ header field.
-
-connection :: Http a :-> Maybe String
-connection = header "Connection"
-
--- | Access the /Accept/ header field.
-
-accept :: Http a :-> Maybe Parameters
-accept = liftBij (keyValues "," ";") `iso` header "Accept"
-
--- | Access the /Accept-Encoding/ header field.
-
-acceptEncoding :: Http a :-> Maybe [String]
-acceptEncoding = liftBij (values ",") `iso` header "Accept-Encoding"
-
--- | Access the /Accept-Language/ header field.
-
-acceptLanguage :: Http a :-> Maybe [String]
-acceptLanguage = liftBij (values ",") `iso` header "Accept-Language"
-
--- | Access the /Connection/ header field.
-
-cacheControl :: Http a :-> Maybe String
-cacheControl = header "Cache-Control"
-
--- | Access the /Keep-Alive/ header field.
-
-keepAlive :: (Show i, Read i, Integral i) => Http a :-> Maybe i
-keepAlive = (Bij (join . fmap readMay) (fmap show)) `iso` header "Keep-Alive"
-
-maybe2list :: Bijection (->) b [c] -> (a :-> (Maybe b)) -> (a :-> [c])
-maybe2list b l = L.lens g s where
-   g x = maybe [] (fw b) (L.get l x)
-   s [] x = L.set l (Nothing) x
-   s c x = L.set l (Just $ bw b c) x
-
--- | Access the /Cookie/ header field.
-
-cookiesShort :: Http Request :-> [CookieShort]
-cookiesShort = maybe2list (cookie) (header "Cookie")
-
--- | Access the /Set-Cookie/ fields.
-
-setCookies :: Http Response :-> Cookies
-setCookies = (gather . liftBij setCookie) `iso` (headerMany "Set-Cookie")
-
--- | Access the /Location/ header field.
-
-location :: Http a :-> Maybe Uri
-location = liftBij (Bij toUri showUri) `iso` (header "Location")
-
--- | Access the /Content-Type/ header field. The content-type will be parsed
--- into a mimetype and optional charset.
-
-contentType :: Http a :-> Maybe (String, String)
-contentType = 
-        liftBij (Bij parser printer)
-  `iso` liftBij (keyValues ";" "=")
-  `iso` header "Content-Type"
-  where 
-    printer (x, y) = (x, "") : ("charset", y) : []
-    parser ((m, _):("charset", c):_) = (m, c)
-
--- | Access the /Date/ header field.
-
-date :: Http a :-> Maybe String
-date = header "Date"
-
--- | Access the /Host/ header field.
-
-hostname :: Http a :-> Maybe String
-hostname = header "Host"
-
--- | Access the /Server/ header field.
-
-server :: Http a :-> Maybe String
-server = header "Server"
-
--- | Access the /User-Agent/ header field.
-
-userAgent :: Http a :-> Maybe String
-userAgent = header "User-Agent"
-
--- | Access the /Upgrade/ header field.
-
-upgrade :: Http a :-> Maybe String
-upgrade = header "Upgrade"
-
--- | Access the /Last-Modified/ header field.
-
-lastModified :: Http a :-> Maybe Value
-lastModified = header "Last-Modified"
-
--- | Access the /Accept-Ranges/ header field.
-
-acceptRanges :: Http a :-> Maybe Value
-acceptRanges = header "Accept-Ranges"
-
--- | Access the /ETag/ header field.
-
-eTag :: Http a :-> Maybe Value
-eTag = header "ETag"
-
diff --git a/src/Network/Protocol/Http/Parser.hs b/src/Network/Protocol/Http/Parser.hs
deleted file mode 100644
--- a/src/Network/Protocol/Http/Parser.hs
+++ /dev/null
@@ -1,174 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE TypeOperators, FlexibleContexts #-}
-module Network.Protocol.Http.Parser
-(
-
--- * Top level message parsers.
-
-  parseRequest
-, parseResponseHead
-, parseResponse
-, parseHeaders
-
--- * Exposure of internal parsec parsers.
-
-, pRequest
-, pResponse
-, pHeaders
-, pVersion
-, pMethod
-
--- * Helper methods.
-
-, versionFromString
-, methodFromString
-
-)
-where
-
-import Control.Applicative hiding (empty)
-import Data.Char
-import Data.List hiding (insert)
-import Network.Protocol.Http.Data
-import Network.Protocol.Http.Status
-import Text.Parsec hiding (many, (<|>))
-import Text.Parsec.String
-
--- | Parse a string as an HTTP request message. This parser is very forgiving.
-
-parseRequest :: String -> Either String (Http Request)
-parseRequest = either (Left . show) (Right . id) . parse pRequest ""
-
--- | Parse a string as an HTTP response header message. This parser is very forgiving.
-
-parseResponseHead :: String -> Either String (Http Response)
-parseResponseHead = either (Left . show) (Right . id) . parse pResponse ""
-
--- | Parse a string as an HTTP response header and body. This parser is very forgiving.
-
-parseResponse :: String -> Either String (Http Response, String)
-parseResponse = either (Left . show) (Right . id) . parse fp ""
-    where fp = (\a b->(a,b)) <$> pResponse <*> manyTill anyChar eof
-
--- | Parse a string as a list of HTTP headers.
-
-parseHeaders :: String -> Either String Headers
-parseHeaders = either (Left . show) (Right . id) . parse pHeaders ""
-
--- | Parsec parser to parse the header part of an HTTP request.
-
-pRequest :: GenParser Char st (Http Request)
-pRequest =
-      (\m u v h -> Http (Request m u) v h)
-  <$> (pMethod <* many1 (oneOf ls))
-  <*> (many1 (noneOf ws) <* many1 (oneOf ls))
-  <*> (pVersion <* eol)
-  <*> (pHeaders <* eol)
-
--- | Parsec parser to parse the header part of an HTTP response.
-
-pResponse :: GenParser Char st (Http Response)
-pResponse =
-      (\v s h -> Http (Response (statusFromCode $ read s)) v h)
-  <$> (pVersion <* many1 (oneOf ls))
-  <*> (many1 digit <* many1 (oneOf ls) <* many1 (noneOf lf) <* eol)
-  <*> (pHeaders <* eol)
-
--- | Parsec parser to parse one or more, possibly multiline, HTTP header lines.
-
-pHeaders :: GenParser Char st Headers
-pHeaders = Headers <$> p
-  where
-    p = (\k v -> ((k, v):))
-        <$> many1 (noneOf (':':ws)) <* string ":"
-        <*> (intercalate ws <$> (many $ many1 (oneOf ls) *> many1 (noneOf lf) <* eol))
-        <*> option [] p
-
--- | Parsec parser to parse HTTP versions. Recognizes X.X versions only.
-
-pVersion :: GenParser Char st Version
-pVersion = 
-      (\h l -> Version (ord h - ord '0') (ord l  - ord '0'))
-  <$> (istring "HTTP/" *> digit)
-  <*> (char '.'       *> digit)
-
--- | Parsec parser to parse an HTTP method. Parses arbitrary method but
--- actually recognizes the ones listed as a constructor for `Method'.
-
-pMethod :: GenParser Char st Method
-pMethod =
-     choice
-   $ map (\a -> a <$ (try . istring . show $ a)) methods
-  ++ [OTHER <$> many (noneOf ws)]
-
--- | Recognizes HTTP protocol version 1.0 and 1.1, all other string will
--- produce version 1.1.
-
-versionFromString :: String -> Version
-versionFromString "HTTP/1.1" = http11
-versionFromString "HTTP/1.0" = http10
-versionFromString _          = http11
-
--- | Helper to turn fully capitalized string into request method.
-
-methodFromString :: String -> Method
-methodFromString "OPTIONS" = OPTIONS
-methodFromString "GET"     = GET 
-methodFromString "HEAD"    = HEAD
-methodFromString "POST"    = POST
-methodFromString "PUT"     = PUT 
-methodFromString "DELETE"  = DELETE
-methodFromString "TRACE"   = TRACE
-methodFromString "CONNECT" = CONNECT
-methodFromString xs        = OTHER xs
-
--- Helpers.
-
-lf, ws, ls :: String
-lf = "\r\n"
-ws = " \t\r\n"
-ls = " \t"
-
--- Optional parser with maybe result.
-
-pMaybe :: GenParser Char st a -> GenParser Char st (Maybe a)
-pMaybe a = option Nothing (Just <$> a)
-
--- Parse end of line, \r, \n or \r\n.
-
-eol :: GenParser Char st ()
-eol = () <$ ((char '\r' <* pMaybe (char '\n')) <|> char '\n')
-
--- Case insensitive string parser.
-
-istring :: String -> GenParser Char st String
-istring s = sequence (map (\c -> satisfy (\d -> toUpper c == toUpper d)) s)
-
diff --git a/src/Network/Protocol/Http/Printer.hs b/src/Network/Protocol/Http/Printer.hs
deleted file mode 100644
--- a/src/Network/Protocol/Http/Printer.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE FlexibleInstances #-}
-module Network.Protocol.Http.Printer where
-
-import Network.Protocol.Http.Data
-import Network.Protocol.Http.Status
-
--- instance Show (Http Request) where
---   showsPrec _ r@(Http Request {} _ hs) =
---     showRequestLine r . shows hs . eol
-
-printRequest :: Http Request -> String
-printRequest r@(Http Request {} _ hs) = (showRequestLine r . showHeaders hs . eol) ""
-
--- instance Show (Http Response) where
---   showsPrec _ r@(Http Response {} _ hs) =
---     showResponseLine r . shows hs . eol
-
-printResponse :: Http Response -> String
-printResponse r@(Http Response {} _ hs) = (showResponseLine r . showHeaders hs . eol) ""
-
--- | Show HTTP request status line.
-
-showRequestLine :: Http Request -> String -> String
-showRequestLine (Http (Request m u) v _) =
-    shows m . ss " " . ss u . ss " "
-  . showVersion v . eol
-
--- | Show HTTP response status line.
-
-showResponseLine :: Http Response -> String -> String
-showResponseLine (Http (Response s) v _) =
-    showVersion v . ss " "
-  . shows (codeFromStatus s)
-  . ss " " . shows s . eol
-
-showHeaders :: Headers -> ShowS
-showHeaders =
-      foldr (\a b -> a . eol . b) id
-    . map (\(k, a) -> ss k . ss ": " . ss a)
-    . unHeaders
-
--- instance Show Headers where
---   showsPrec _ =
---       foldr (\a b -> a . eol . b) id
---     . map (\(k, a) -> ss k . ss ": " . ss a)
---     . unHeaders
-
-showVersion :: Version -> ShowS
-showVersion (Version a b) = ss "HTTP/" . shows a . ss "." . shows b
-
--- instance Show Version where
---   showsPrec _ (Version a b) = ss "HTTP/" . shows a . ss "." . shows b
-
-eol :: ShowS
-eol = ss "\r\n"
-
-ss :: String -> ShowS
-ss = showString
-
diff --git a/src/Network/Protocol/Http/Status.hs b/src/Network/Protocol/Http/Status.hs
deleted file mode 100644
--- a/src/Network/Protocol/Http/Status.hs
+++ /dev/null
@@ -1,193 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-module Network.Protocol.Http.Status where {- doc ok -}
-
-import Data.Bimap
-import Data.Maybe
-import Prelude hiding (lookup)
-
-{- | HTTP status codes. -}
-
-data Status =
-    Continue                     -- ^ 100
-  | SwitchingProtocols           -- ^ 101
-  | OK                           -- ^ 200
-  | Created                      -- ^ 201
-  | Accepted                     -- ^ 202
-  | NonAuthoritativeInformation  -- ^ 203
-  | NoContent                    -- ^ 204
-  | ResetContent                 -- ^ 205
-  | PartialContent               -- ^ 206
-  | MultipleChoices              -- ^ 300
-  | MovedPermanently             -- ^ 301
-  | Found                        -- ^ 302
-  | SeeOther                     -- ^ 303
-  | NotModified                  -- ^ 304
-  | UseProxy                     -- ^ 305
-  | TemporaryRedirect            -- ^ 307
-  | BadRequest                   -- ^ 400
-  | Unauthorized                 -- ^ 401
-  | PaymentRequired              -- ^ 402
-  | Forbidden                    -- ^ 403
-  | NotFound                     -- ^ 404
-  | MethodNotAllowed             -- ^ 405
-  | NotAcceptable                -- ^ 406
-  | ProxyAuthenticationRequired  -- ^ 407
-  | RequestTimeOut               -- ^ 408
-  | Conflict                     -- ^ 409
-  | Gone                         -- ^ 410
-  | LengthRequired               -- ^ 411
-  | PreconditionFailed           -- ^ 412
-  | RequestEntityTooLarge        -- ^ 413
-  | RequestURITooLarge           -- ^ 414
-  | UnsupportedMediaType         -- ^ 415
-  | RequestedRangeNotSatisfiable -- ^ 416
-  | ExpectationFailed            -- ^ 417
-  | InternalServerError          -- ^ 500
-  | NotImplemented               -- ^ 501
-  | BadGateway                   -- ^ 502
-  | ServiceUnavailable           -- ^ 503
-  | GatewayTimeOut               -- ^ 504
-  | HTTPVersionNotSupported      -- ^ 505
-  | CustomStatus Int String
-  deriving (Show, Read, Eq, Ord)
-
--- | rfc2616 sec6.1.1 Status Code and Reason Phrase.
-
-printStatus :: Status -> String
-printStatus Continue                     = "Continue"
-printStatus SwitchingProtocols           = "Switching Protocols"
-printStatus OK                           = "OK"
-printStatus Created                      = "Created"
-printStatus Accepted                     = "Accepted"
-printStatus NonAuthoritativeInformation  = "Non-Authoritative Information"
-printStatus NoContent                    = "No Content"
-printStatus ResetContent                 = "Reset Content"
-printStatus PartialContent               = "Partial Content"
-printStatus MultipleChoices              = "Multiple Choices"
-printStatus MovedPermanently             = "Moved Permanently"
-printStatus Found                        = "Found"
-printStatus SeeOther                     = "See Other"
-printStatus NotModified                  = "Not Modified"
-printStatus UseProxy                     = "Use Proxy"
-printStatus TemporaryRedirect            = "Temporary Redirect"
-printStatus BadRequest                   = "Bad Request"
-printStatus Unauthorized                 = "Unauthorized"
-printStatus PaymentRequired              = "Payment Required"
-printStatus Forbidden                    = "Forbidden"
-printStatus NotFound                     = "Not Found"
-printStatus MethodNotAllowed             = "Method Not Allowed"
-printStatus NotAcceptable                = "Not Acceptable"
-printStatus ProxyAuthenticationRequired  = "Proxy Authentication Required"
-printStatus RequestTimeOut               = "Request Time-out"
-printStatus Conflict                     = "Conflict"
-printStatus Gone                         = "Gone"
-printStatus LengthRequired               = "Length Required"
-printStatus PreconditionFailed           = "Precondition Failed"
-printStatus RequestEntityTooLarge        = "Request Entity Too Large"
-printStatus RequestURITooLarge           = "Request-URI Too Large"
-printStatus UnsupportedMediaType         = "Unsupported Media Type"
-printStatus RequestedRangeNotSatisfiable = "Requested range not satisfiable"
-printStatus ExpectationFailed            = "Expectation Failed"
-printStatus InternalServerError          = "Internal Server Error"
-printStatus NotImplemented               = "Not Implemented"
-printStatus BadGateway                   = "Bad Gateway"
-printStatus ServiceUnavailable           = "Service Unavailable"
-printStatus GatewayTimeOut               = "Gateway Time-out"
-printStatus HTTPVersionNotSupported      = "HTTP Version not supported"
-printStatus (CustomStatus _ s)           = s
-
-{- |
-RFC2616 sec6.1.1 Status Code and Reason Phrase.
-
-Bidirectional mapping from status numbers to codes.
--}
-
-statusCodes :: Bimap Int Status
-statusCodes = fromList [
-    (100, Continue)
-  , (101, SwitchingProtocols)
-  , (200, OK)
-  , (201, Created)
-  , (202, Accepted)
-  , (203, NonAuthoritativeInformation)
-  , (204, NoContent)
-  , (205, ResetContent)
-  , (206, PartialContent)
-  , (300, MultipleChoices)
-  , (301, MovedPermanently)
-  , (302, Found)
-  , (303, SeeOther)
-  , (304, NotModified)
-  , (305, UseProxy)
-  , (307, TemporaryRedirect)
-  , (400, BadRequest)
-  , (401, Unauthorized)
-  , (402, PaymentRequired)
-  , (403, Forbidden)
-  , (404, NotFound)
-  , (405, MethodNotAllowed)
-  , (406, NotAcceptable)
-  , (407, ProxyAuthenticationRequired)
-  , (408, RequestTimeOut)
-  , (409, Conflict)
-  , (410, Gone)
-  , (411, LengthRequired)
-  , (412, PreconditionFailed)
-  , (413, RequestEntityTooLarge)
-  , (414, RequestURITooLarge)
-  , (415, UnsupportedMediaType)
-  , (416, RequestedRangeNotSatisfiable)
-  , (417, ExpectationFailed)
-  , (500, InternalServerError)
-  , (501, NotImplemented)
-  , (502, BadGateway)
-  , (503, ServiceUnavailable)
-  , (504, GatewayTimeOut)
-  , (505, HTTPVersionNotSupported)
-  ]
-
--- | Every status greater-than or equal to 400 is considered to be a failure.
-statusFailure :: Status -> Bool
-statusFailure st = codeFromStatus st >= 400
-
--- | Conversion from status numbers to codes.
-statusFromCode :: Int -> Status
-statusFromCode num =
-    fromMaybe (CustomStatus num "Unknown Status")
-  $ lookup num statusCodes
-
--- | Conversion from status codes to numbers.
-codeFromStatus :: Status -> Int
-codeFromStatus (CustomStatus i _) = i
-codeFromStatus st =
-    fromMaybe 0 -- function is total, should not happen.
-  $ lookupR st statusCodes
-
diff --git a/src/Network/Protocol/Mime.hs b/src/Network/Protocol/Mime.hs
deleted file mode 100644
--- a/src/Network/Protocol/Mime.hs
+++ /dev/null
@@ -1,695 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-
-module Network.Protocol.Mime where
-
-import Data.Map
-
-
-{- |
-Handling mime types. This module contains a mapping from file extensions to
-mime-types taken from the Apache webserver project.
--}
-
-type Mime = String
-
-{- | Get the mimetype for the specified extension. -}
-
-mime :: String -> Maybe Mime
-mime ext = Data.Map.lookup ext extensionToMime
-
-{- | The default mimetype is text/plain. -}
-
-defaultMime :: Mime
-defaultMime = "text/plain"
-
-{- | The mapping from extension to mimetype. -}
-
-extensionToMime :: Map String Mime
-extensionToMime = fromList
-  [ ("123",       "application/vnd.lotus-1-2-3")
-  , ("3dml",      "text/vnd.in3d.3dml")
-  , ("3g2",       "video/3gpp2")
-  , ("3gp",       "video/3gpp")
-  , ("ace",       "application/x-ace-compressed")
-  , ("acu",       "application/vnd.acucobol")
-  , ("acutc",     "application/vnd.acucorp")
-  , ("aep",       "application/vnd.audiograph")
-  , ("afp",       "application/vnd.ibm.modcap")
-  , ("ai",        "application/postscript")
-  , ("aif",       "audio/x-aiff")
-  , ("aifc",      "audio/x-aiff")
-  , ("aiff",      "audio/x-aiff")
-  , ("ami",       "application/vnd.amiga.ami")
-  , ("apr",       "application/vnd.lotus-approach")
-  , ("asc",       "application/pgp-signature")
-  , ("asf",       "application/vnd.ms-asf")
-  , ("asf",       "video/x-ms-asf")
-  , ("asm",       "text/x-asm")
-  , ("aso",       "application/vnd.accpac.simply.aso")
-  , ("asx",       "video/x-ms-asf")
-  , ("atc",       "application/vnd.acucorp")
-  , ("atom",      "application/atom+xml")
-  , ("atomcat",   "application/atomcat+xml")
-  , ("atomsvc",   "application/atomsvc+xml")
-  , ("atx",       "application/vnd.antix.game-component")
-  , ("au",        "audio/basic")
-  , ("bat",       "application/x-msdownload")
-  , ("bcpio",     "application/x-bcpio")
-  , ("bdm",       "application/vnd.syncml.dm+wbxml")
-  , ("bh2",       "application/vnd.fujitsu.oasysprs")
-  , ("bin",       "application/octet-stream")
-  , ("bmi",       "application/vnd.bmi")
-  , ("bmp",       "image/bmp")
-  , ("box",       "application/vnd.previewsystems.box")
-  , ("boz",       "application/x-bzip2")
-  , ("bpk",       "application/octet-stream")
-  , ("btif",      "image/prs.btif")
-  , ("bz",        "application/x-bzip")
-  , ("bz2",       "application/x-bzip2")
-  , ("c",         "text/x-c")
-  , ("c4d",       "application/vnd.clonk.c4group")
-  , ("c4f",       "application/vnd.clonk.c4group")
-  , ("c4g",       "application/vnd.clonk.c4group")
-  , ("c4p",       "application/vnd.clonk.c4group")
-  , ("c4u",       "application/vnd.clonk.c4group")
-  , ("cab",       "application/vnd.ms-cab-compressed")
-  , ("cc",        "text/x-c")
-  , ("ccxml",     "application/ccxml+xml")
-  , ("cdbcmsg",   "application/vnd.contact.cmsg")
-  , ("cdf",       "application/x-netcdf")
-  , ("cdkey",     "application/vnd.mediastation.cdkey")
-  , ("cdx",       "chemical/x-cdx")
-  , ("cdxml",     "application/vnd.chemdraw+xml")
-  , ("cdy",       "application/vnd.cinderella")
-  , ("cer",       "application/pkix-cert")
-  , ("cgm",       "image/cgm")
-  , ("chat",      "application/x-chat")
-  , ("chm",       "application/vnd.ms-htmlhelp")
-  , ("chrt",      "application/vnd.kde.kchart")
-  , ("cif",       "chemical/x-cif")
-  , ("cii",       "application/vnd.anser-web-certificate-issue-initiation")
-  , ("cil",       "application/vnd.ms-artgalry")
-  , ("cla",       "application/vnd.claymore")
-  , ("class",     "application/octet-stream")
-  , ("clkk",      "application/vnd.crick.clicker.keyboard")
-  , ("clkp",      "application/vnd.crick.clicker.palette")
-  , ("clkt",      "application/vnd.crick.clicker.template")
-  , ("clkw",      "application/vnd.crick.clicker.wordbank")
-  , ("clkx",      "application/vnd.crick.clicker")
-  , ("clp",       "application/x-msclip")
-  , ("cmc",       "application/vnd.cosmocaller")
-  , ("cmdf",      "chemical/x-cmdf")
-  , ("cml",       "chemical/x-cml")
-  , ("cmp",       "application/vnd.yellowriver-custom-menu")
-  , ("cmx",       "image/x-cmx")
-  , ("com",       "application/x-msdownload")
-  , ("conf",      "text/plain")
-  , ("cpio",      "application/x-cpio")
-  , ("cpp",       "text/x-c")
-  , ("cpt",       "application/mac-compactpro")
-  , ("crd",       "application/x-mscardfile")
-  , ("crl",       "application/pkix-crl")
-  , ("crt",       "application/x-x509-ca-cert")
-  , ("csh",       "application/x-csh")
-  , ("csml",      "chemical/x-csml")
-  , ("csp",       "application/vnd.commonspace")
-  , ("css",       "text/css")
-  , ("cst",       "application/vnd.commonspace")
-  , ("csv",       "text/csv")
-  , ("curl",      "application/vnd.curl")
-  , ("cww",       "application/prs.cww")
-  , ("cxx",       "text/x-c")
-  , ("daf",       "application/vnd.mobius.daf")
-  , ("davmount",  "application/davmount+xml")
-  , ("dcr",       "application/x-director")
-  , ("dd2",       "application/vnd.oma.dd2+xml")
-  , ("ddd",       "application/vnd.fujixerox.ddd")
-  , ("def",       "text/plain")
-  , ("der",       "application/x-x509-ca-cert")
-  , ("dfac",      "application/vnd.dreamfactory")
-  , ("dic",       "text/x-c")
-  , ("dir",       "application/x-director")
-  , ("dis",       "application/vnd.mobius.dis")
-  , ("dist",      "application/octet-stream")
-  , ("distz",     "application/octet-stream")
-  , ("djv",       "image/vnd.djvu")
-  , ("djvu",      "image/vnd.djvu")
-  , ("dll",       "application/x-msdownload")
-  , ("dmg",       "application/octet-stream")
-  , ("dms",       "application/octet-stream")
-  , ("dna",       "application/vnd.dna")
-  , ("doc",       "application/msword")
-  , ("dot",       "application/msword")
-  , ("dp",        "application/vnd.osgi.dp")
-  , ("dpg",       "application/vnd.dpgraph")
-  , ("dsc",       "text/prs.lines.tag")
-  , ("dtd",       "application/xml-dtd")
-  , ("dump",      "application/octet-stream")
-  , ("dvi",       "application/x-dvi")
-  , ("dwf",       "model/vnd.dwf")
-  , ("dwg",       "image/vnd.dwg")
-  , ("dxf",       "image/vnd.dxf")
-  , ("dxp",       "application/vnd.spotfire.dxp")
-  , ("dxr",       "application/x-director")
-  , ("ecelp4800", "audio/vnd.nuera.ecelp4800")
-  , ("ecelp7470", "audio/vnd.nuera.ecelp7470")
-  , ("ecelp9600", "audio/vnd.nuera.ecelp9600")
-  , ("ecma",      "application/ecmascript")
-  , ("edm",       "application/vnd.novadigm.edm")
-  , ("edx",       "application/vnd.novadigm.edx")
-  , ("efif",      "application/vnd.picsel")
-  , ("ei6",       "application/vnd.pg.osasli")
-  , ("elc",       "application/octet-stream")
-  , ("eml",       "message/rfc822")
-  , ("eol",       "audio/vnd.digital-winds")
-  , ("eot",       "application/vnd.ms-fontobject")
-  , ("eps",       "application/postscript")
-  , ("es3",       "application/vnd.eszigno3+xml")
-  , ("esf",       "application/vnd.epson.esf")
-  , ("et3",       "application/vnd.eszigno3+xml")
-  , ("etx",       "text/x-setext")
-  , ("exe",       "application/x-msdownload")
-  , ("ext",       "application/vnd.novadigm.ext")
-  , ("ez",        "application/andrew-inset")
-  , ("ez2",       "application/vnd.ezpix-album")
-  , ("ez3",       "application/vnd.ezpix-package")
-  , ("f",         "text/x-fortran")
-  , ("f77",       "text/x-fortran")
-  , ("f90",       "text/x-fortran")
-  , ("fbs",       "image/vnd.fastbidsheet")
-  , ("fdf",       "application/vnd.fdf")
-  , ("fe_launch", "application/vnd.denovo.fcselayout-link")
-  , ("fg5",       "application/vnd.fujitsu.oasysgp")
-  , ("fgd",       "application/x-director")
-  , ("fli",       "video/x-fli")
-  , ("flo",       "application/vnd.micrografx.flo")
-  , ("flw",       "application/vnd.kde.kivio")
-  , ("flx",       "text/vnd.fmi.flexstor")
-  , ("fly",       "text/vnd.fly")
-  , ("fm",        "application/vnd.framemaker")
-  , ("fnc",       "application/vnd.frogans.fnc")
-  , ("for",       "text/x-fortran")
-  , ("fpx",       "image/vnd.fpx")
-  , ("frame",     "application/vnd.framemaker")
-  , ("fsc",       "application/vnd.fsc.weblaunch")
-  , ("fst",       "image/vnd.fst")
-  , ("ftc",       "application/vnd.fluxtime.clip")
-  , ("fti",       "application/vnd.anser-web-funds-transfer-initiation")
-  , ("fvt",       "video/vnd.fvt")
-  , ("fzs",       "application/vnd.fuzzysheet")
-  , ("g3",        "image/g3fax")
-  , ("gac",       "application/vnd.groove-account")
-  , ("gdl",       "model/vnd.gdl")
-  , ("ghf",       "application/vnd.groove-help")
-  , ("gif",       "image/gif")
-  , ("gim",       "application/vnd.groove-identity-message")
-  , ("gph",       "application/vnd.flographit")
-  , ("gqf",       "application/vnd.grafeq")
-  , ("gqs",       "application/vnd.grafeq")
-  , ("gram",      "application/srgs")
-  , ("grv",       "application/vnd.groove-injector")
-  , ("grxml",     "application/srgs+xml")
-  , ("gtar",      "application/x-gtar")
-  , ("gtm",       "application/vnd.groove-tool-message")
-  , ("gtw",       "model/vnd.gtw")
-  , ("h",         "text/x-c")
-  , ("h261",      "video/h261")
-  , ("h263",      "video/h263")
-  , ("h264",      "video/h264")
-  , ("hbci",      "application/vnd.hbci")
-  , ("hdf",       "application/x-hdf")
-  , ("hh",        "text/x-c")
-  , ("hlp",       "application/winhlp")
-  , ("hpgl",      "application/vnd.hp-hpgl")
-  , ("hpid",      "application/vnd.hp-hpid")
-  , ("hps",       "application/vnd.hp-hps")
-  , ("hqx",       "application/mac-binhex40")
-  , ("htke",      "application/vnd.kenameaapp")
-  , ("htm",       "text/html")
-  , ("html",      "text/html")
-  , ("hvd",       "application/vnd.yamaha.hv-dic")
-  , ("hvp",       "application/vnd.yamaha.hv-voice")
-  , ("hvs",       "application/vnd.yamaha.hv-script")
-  , ("ico",       "image/vnd.microsoft.icon")
-  , ("ics",       "text/calendar")
-  , ("ief",       "image/ief")
-  , ("ifb",       "text/calendar")
-  , ("ifm",       "application/vnd.shana.informed.formdata")
-  , ("iges",      "model/iges")
-  , ("igl",       "application/vnd.igloader")
-  , ("igs",       "model/iges")
-  , ("igx",       "application/vnd.micrografx.igx")
-  , ("iif",       "application/vnd.shana.informed.interchange")
-  , ("imp",       "application/vnd.accpac.simply.imp")
-  , ("ims",       "application/vnd.ms-ims")
-  , ("in",        "text/plain")
-  , ("ipk",       "application/vnd.shana.informed.package")
-  , ("irm",       "application/vnd.ibm.rights-management")
-  , ("irp",       "application/vnd.irepository.package+xml")
-  , ("iso",       "application/octet-stream")
-  , ("itp",       "application/vnd.shana.informed.formtemplate")
-  , ("ivp",       "application/vnd.immervision-ivp")
-  , ("ivu",       "application/vnd.immervision-ivu")
-  , ("jad",       "text/vnd.sun.j2me.app-descriptor")
-  , ("jam",       "application/vnd.jam")
-  , ("java",      "text/x-java-source")
-  , ("jisp",      "application/vnd.jisp")
-  , ("jlt",       "application/vnd.hp-jlyt")
-  , ("jpe",       "image/jpeg")
-  , ("jpeg",      "image/jpeg")
-  , ("jpg",       "image/jpeg")
-  , ("jpgm",      "video/jpm")
-  , ("jpgv",      "video/jpeg")
-  , ("jpm",       "video/jpm")
-  , ("js",        "application/javascript")
-  , ("json",      "application/json")
-  , ("kar",       "audio/midi")
-  , ("karbon",    "application/vnd.kde.karbon")
-  , ("kfo",       "application/vnd.kde.kformula")
-  , ("kia",       "application/vnd.kidspiration")
-  , ("kml",       "application/vnd.google-earth.kml+xml")
-  , ("kmz",       "application/vnd.google-earth.kmz")
-  , ("kne",       "application/vnd.kinar")
-  , ("knp",       "application/vnd.kinar")
-  , ("kon",       "application/vnd.kde.kontour")
-  , ("kpr",       "application/vnd.kde.kpresenter")
-  , ("kpt",       "application/vnd.kde.kpresenter")
-  , ("ksp",       "application/vnd.kde.kspread")
-  , ("ktr",       "application/vnd.kahootz")
-  , ("ktz",       "application/vnd.kahootz")
-  , ("kwd",       "application/vnd.kde.kword")
-  , ("kwt",       "application/vnd.kde.kword")
-  , ("latex",     "application/x-latex")
-  , ("lbd",       "application/vnd.llamagraphics.life-balance.desktop")
-  , ("lbe",       "application/vnd.llamagraphics.life-balance.exchange+xml")
-  , ("les",       "application/vnd.hhe.lesson-player")
-  , ("lha",       "application/octet-stream")
-  , ("list",      "text/plain")
-  , ("list3820",  "application/vnd.ibm.modcap")
-  , ("listafp",   "application/vnd.ibm.modcap")
-  , ("log",       "text/plain")
-  , ("lrm",       "application/vnd.ms-lrm")
-  , ("ltf",       "application/vnd.frogans.ltf")
-  , ("lvp",       "audio/vnd.lucent.voice")
-  , ("lwp",       "application/vnd.lotus-wordpro")
-  , ("lzh",       "application/octet-stream")
-  , ("m13",       "application/x-msmediaview")
-  , ("m14",       "application/x-msmediaview")
-  , ("m1v",       "video/mpeg")
-  , ("m2a",       "audio/mpeg")
-  , ("m2v",       "video/mpeg")
-  , ("m3a",       "audio/mpeg")
-  , ("m3u",       "audio/x-mpegurl")
-  , ("m4u",       "video/vnd.mpegurl")
-  , ("ma",        "application/mathematica")
-  , ("mag",       "application/vnd.ecowin.chart")
-  , ("maker",     "application/vnd.framemaker")
-  , ("man",       "text/troff")
-  , ("mathml",    "application/mathml+xml")
-  , ("mb",        "application/mathematica")
-  , ("mbk",       "application/vnd.mobius.mbk")
-  , ("mbox",      "application/mbox")
-  , ("mc1",       "application/vnd.medcalcdata")
-  , ("mcd",       "application/vnd.mcd")
-  , ("mdb",       "application/x-msaccess")
-  , ("mdi",       "image/vnd.ms-modi")
-  , ("me",        "text/troff")
-  , ("mesh",      "model/mesh")
-  , ("mfm",       "application/vnd.mfmp")
-  , ("mgz",       "application/vnd.proteus.magazine")
-  , ("mid",       "audio/midi")
-  , ("midi",      "audio/midi")
-  , ("mif",       "application/vnd.mif")
-  , ("mime",      "message/rfc822")
-  , ("mj2",       "video/mj2")
-  , ("mjp2",      "video/mj2")
-  , ("mlp",       "application/vnd.dolby.mlp")
-  , ("mmd",       "application/vnd.chipnuts.karaoke-mmd")
-  , ("mmf",       "application/vnd.smaf")
-  , ("mmr",       "image/vnd.fujixerox.edmics-mmr")
-  , ("mny",       "application/x-msmoney")
-  , ("mov",       "video/quicktime")
-  , ("mp2",       "audio/mpeg")
-  , ("mp2a",      "audio/mpeg")
-  , ("mp3",       "audio/mpeg")
-  , ("mp4",       "video/mp4")
-  , ("mp4a",      "audio/mp4")
-  , ("mp4s",      "application/mp4")
-  , ("mp4v",      "video/mp4")
-  , ("mpc",       "application/vnd.mophun.certificate")
-  , ("mpe",       "video/mpeg")
-  , ("mpeg",      "video/mpeg")
-  , ("mpg",       "video/mpeg")
-  , ("mpg4",      "video/mp4")
-  , ("mpga",      "audio/mpeg")
-  , ("mpkg",      "application/vnd.apple.installer+xml")
-  , ("mpm",       "application/vnd.blueice.multipass")
-  , ("mpn",       "application/vnd.mophun.application")
-  , ("mpp",       "application/vnd.ms-project")
-  , ("mpt",       "application/vnd.ms-project")
-  , ("mpy",       "application/vnd.ibm.minipay")
-  , ("mqy",       "application/vnd.mobius.mqy")
-  , ("mrc",       "application/marc")
-  , ("ms",        "text/troff")
-  , ("mscml",     "application/mediaservercontrol+xml")
-  , ("mseq",      "application/vnd.mseq")
-  , ("msf",       "application/vnd.epson.msf")
-  , ("msh",       "model/mesh")
-  , ("msi",       "application/x-msdownload")
-  , ("msl",       "application/vnd.mobius.msl")
-  , ("mts",       "model/vnd.mts")
-  , ("mus",       "application/vnd.musician")
-  , ("mvb",       "application/x-msmediaview")
-  , ("mwf",       "application/vnd.mfer")
-  , ("mxf",       "application/mxf")
-  , ("mxl",       "application/vnd.recordare.musicxml")
-  , ("mxml",      "application/xv+xml")
-  , ("mxs",       "application/vnd.triscape.mxs")
-  , ("mxu",       "video/vnd.mpegurl")
-  , ("n-gage",    "application/vnd.nokia.n-gage.symbian.install")
-  , ("nb",        "application/mathematica")
-  , ("nc",        "application/x-netcdf")
-  , ("ngdat",     "application/vnd.nokia.n-gage.data")
-  , ("nlu",       "application/vnd.neurolanguage.nlu")
-  , ("nml",       "application/vnd.enliven")
-  , ("nnd",       "application/vnd.noblenet-directory")
-  , ("nns",       "application/vnd.noblenet-sealer")
-  , ("nnw",       "application/vnd.noblenet-web")
-  , ("npx",       "image/vnd.net-fpx")
-  , ("nsf",       "application/vnd.lotus-notes")
-  , ("oa2",       "application/vnd.fujitsu.oasys2")
-  , ("oa3",       "application/vnd.fujitsu.oasys3")
-  , ("oas",       "application/vnd.fujitsu.oasys")
-  , ("obd",       "application/x-msbinder")
-  , ("oda",       "application/oda")
-  , ("odc",       "application/vnd.oasis.opendocument.chart")
-  , ("odf",       "application/vnd.oasis.opendocument.formula")
-  , ("odg",       "application/vnd.oasis.opendocument.graphics")
-  , ("odi",       "application/vnd.oasis.opendocument.image")
-  , ("odp",       "application/vnd.oasis.opendocument.presentation")
-  , ("ods",       "application/vnd.oasis.opendocument.spreadsheet")
-  , ("odt",       "application/vnd.oasis.opendocument.text")
-  , ("ogg",       "application/ogg")
-  , ("oprc",      "application/vnd.palm")
-  , ("org",       "application/vnd.lotus-organizer")
-  , ("otc",       "application/vnd.oasis.opendocument.chart-template")
-  , ("otf",       "application/vnd.oasis.opendocument.formula-template")
-  , ("otg",       "application/vnd.oasis.opendocument.graphics-template")
-  , ("oth",       "application/vnd.oasis.opendocument.text-web")
-  , ("oti",       "application/vnd.oasis.opendocument.image-template")
-  , ("otm",       "application/vnd.oasis.opendocument.text-master")
-  , ("otp",       "application/vnd.oasis.opendocument.presentation-template")
-  , ("ots",       "application/vnd.oasis.opendocument.spreadsheet-template")
-  , ("ott",       "application/vnd.oasis.opendocument.text-template")
-  , ("oxt",       "application/vnd.openofficeorg.extension")
-  , ("p",         "text/x-pascal")
-  , ("p10",       "application/pkcs10")
-  , ("p12",       "application/x-pkcs12")
-  , ("p7b",       "application/x-pkcs7-certificates")
-  , ("p7c",       "application/pkcs7-mime")
-  , ("p7m",       "application/pkcs7-mime")
-  , ("p7r",       "application/x-pkcs7-certreqresp")
-  , ("p7s",       "application/pkcs7-signature")
-  , ("pas",       "text/x-pascal")
-  , ("pbd",       "application/vnd.powerbuilder6")
-  , ("pbm",       "image/x-portable-bitmap")
-  , ("pcl",       "application/vnd.hp-pcl")
-  , ("pclxl",     "application/vnd.hp-pclxl")
-  , ("pct",       "image/x-pict")
-  , ("pcx",       "image/x-pcx")
-  , ("pdb",       "application/vnd.palm")
-  , ("pdb",       "chemical/x-pdb")
-  , ("pdf",       "application/pdf")
-  , ("pfr",       "application/font-tdpfr")
-  , ("pfx",       "application/x-pkcs12")
-  , ("pgm",       "image/x-portable-graymap")
-  , ("pgn",       "application/x-chess-pgn")
-  , ("pgp",       "application/pgp-encrypted")
-  , ("pic",       "image/x-pict")
-  , ("pkg",       "application/octet-stream")
-  , ("pki",       "application/pkixcmp")
-  , ("pkipath",   "application/pkix-pkipath")
-  , ("plb",       "application/vnd.3gpp.pic-bw-large")
-  , ("plc",       "application/vnd.mobius.plc")
-  , ("plf",       "application/vnd.pocketlearn")
-  , ("pls",       "application/pls+xml")
-  , ("pml",       "application/vnd.ctc-posml")
-  , ("png",       "image/png")
-  , ("pnm",       "image/x-portable-anymap")
-  , ("portpkg",   "application/vnd.macports.portpkg")
-  , ("pot",       "application/vnd.ms-powerpoint")
-  , ("ppd",       "application/vnd.cups-ppd")
-  , ("ppm",       "image/x-portable-pixmap")
-  , ("pps",       "application/vnd.ms-powerpoint")
-  , ("ppt",       "application/vnd.ms-powerpoint")
-  , ("pqa",       "application/vnd.palm")
-  , ("prc",       "application/vnd.palm")
-  , ("pre",       "application/vnd.lotus-freelance")
-  , ("prf",       "application/pics-rules")
-  , ("ps",        "application/postscript")
-  , ("psb",       "application/vnd.3gpp.pic-bw-small")
-  , ("psd",       "image/vnd.adobe.photoshop")
-  , ("ptid",      "application/vnd.pvi.ptid1")
-  , ("pub",       "application/x-mspublisher")
-  , ("pvb",       "application/vnd.3gpp.pic-bw-var")
-  , ("pwn",       "application/vnd.3m.post-it-notes")
-  , ("qam",       "application/vnd.epson.quickanime")
-  , ("qbo",       "application/vnd.intu.qbo")
-  , ("qfx",       "application/vnd.intu.qfx")
-  , ("qps",       "application/vnd.publishare-delta-tree")
-  , ("qt",        "video/quicktime")
-  , ("qwd",       "application/vnd.quark.quarkxpress")
-  , ("qwt",       "application/vnd.quark.quarkxpress")
-  , ("qxb",       "application/vnd.quark.quarkxpress")
-  , ("qxd",       "application/vnd.quark.quarkxpress")
-  , ("qxl",       "application/vnd.quark.quarkxpress")
-  , ("qxt",       "application/vnd.quark.quarkxpress")
-  , ("ra",        "audio/x-pn-realaudio")
-  , ("ram",       "audio/x-pn-realaudio")
-  , ("rar",       "application/x-rar-compressed")
-  , ("ras",       "image/x-cmu-raster")
-  , ("rcprofile", "application/vnd.ipunplugged.rcprofile")
-  , ("rdf",       "application/rdf+xml")
-  , ("rdz",       "application/vnd.data-vision.rdz")
-  , ("rep",       "application/vnd.businessobjects")
-  , ("rgb",       "image/x-rgb")
-  , ("rif",       "application/reginfo+xml")
-  , ("rl",        "application/resource-lists+xml")
-  , ("rlc",       "image/vnd.fujixerox.edmics-rlc")
-  , ("rm",        "application/vnd.rn-realmedia")
-  , ("rmi",       "audio/midi")
-  , ("rmp",       "audio/x-pn-realaudio-plugin")
-  , ("rms",       "application/vnd.jcp.javame.midlet-rms")
-  , ("rnc",       "application/relax-ng-compact-syntax")
-  , ("roff",      "text/troff")
-  , ("rpss",      "application/vnd.nokia.radio-presets")
-  , ("rpst",      "application/vnd.nokia.radio-preset")
-  , ("rs",        "application/rls-services+xml")
-  , ("rsd",       "application/rsd+xml")
-  , ("rss",       "application/rss+xml")
-  , ("rtf",       "application/rtf")
-  , ("rtx",       "text/richtext")
-  , ("s",         "text/x-asm")
-  , ("saf",       "application/vnd.yamaha.smaf-audio")
-  , ("sbml",      "application/sbml+xml")
-  , ("sc",        "application/vnd.ibm.secure-container")
-  , ("scd",       "application/x-msschedule")
-  , ("scm",       "application/vnd.lotus-screencam")
-  , ("sdkd",      "application/vnd.solent.sdkm+xml")
-  , ("sdkm",      "application/vnd.solent.sdkm+xml")
-  , ("sdp",       "application/sdp")
-  , ("see",       "application/vnd.seemail")
-  , ("sema",      "application/vnd.sema")
-  , ("semd",      "application/vnd.semd")
-  , ("semf",      "application/vnd.semf")
-  , ("setpay",    "application/set-payment-initiation")
-  , ("setreg",    "application/set-registration-initiation")
-  , ("sfs",       "application/vnd.spotfire.sfs")
-  , ("sgm",       "text/sgml")
-  , ("sgml",      "text/sgml")
-  , ("sh",        "application/x-sh")
-  , ("shar",      "application/x-shar")
-  , ("shf",       "application/shf+xml")
-  , ("sig",       "application/pgp-signature")
-  , ("silo",      "model/mesh")
-  , ("sit",       "application/x-stuffit")
-  , ("sitx",      "application/x-stuffitx")
-  , ("skd",       "application/vnd.koan")
-  , ("skm",       "application/vnd.koan")
-  , ("skp",       "application/vnd.koan")
-  , ("skt",       "application/vnd.koan")
-  , ("slt",       "application/vnd.epson.salt")
-  , ("smi",       "application/smil+xml")
-  , ("smil",      "application/smil+xml")
-  , ("snd",       "audio/basic")
-  , ("so",        "application/octet-stream")
-  , ("spc",       "application/x-pkcs7-certificates")
-  , ("spf",       "application/vnd.yamaha.smaf-phrase")
-  , ("spl",       "application/x-futuresplash")
-  , ("spot",      "text/vnd.in3d.spot")
-  , ("src",       "application/x-wais-source")
-  , ("ssf",       "application/vnd.epson.ssf")
-  , ("ssml",      "application/ssml+xml")
-  , ("stf",       "application/vnd.wt.stf")
-  , ("stk",       "application/hyperstudio")
-  , ("str",       "application/vnd.pg.format")
-  , ("sus",       "application/vnd.sus-calendar")
-  , ("susp",      "application/vnd.sus-calendar")
-  , ("sv4cpio",   "application/x-sv4cpio")
-  , ("sv4crc",    "application/x-sv4crc")
-  , ("svd",       "application/vnd.svd")
-  , ("svg",       "image/svg+xml")
-  , ("svgz",      "image/svg+xml")
-  , ("swf",       "application/x-shockwave-flash")
-  , ("t",         "text/troff")
-  , ("tao",       "application/vnd.tao.intent-module-archive")
-  , ("tar",       "application/x-tar")
-  , ("tcl",       "application/x-tcl")
-  , ("tex",       "application/x-tex")
-  , ("texi",      "application/x-texinfo")
-  , ("texinfo",   "application/x-texinfo")
-  , ("text",      "text/plain")
-  , ("tif",       "image/tiff")
-  , ("tiff",      "image/tiff")
-  , ("tmo",       "application/vnd.tmobile-livetv")
-  , ("torrent",   "application/x-bittorrent")
-  , ("tpl",       "application/vnd.groove-tool-template")
-  , ("tpt",       "application/vnd.trid.tpt")
-  , ("tr",        "text/troff")
-  , ("tra",       "application/vnd.trueapp")
-  , ("trm",       "application/x-msterminal")
-  , ("tsv",       "text/tab-separated-values")
-  , ("twd",       "application/vnd.simtech-mindmapper")
-  , ("twds",      "application/vnd.simtech-mindmapper")
-  , ("txd",       "application/vnd.genomatix.tuxedo")
-  , ("txf",       "application/vnd.mobius.txf")
-  , ("txt",       "text/plain")
-  , ("ufd",       "application/vnd.ufdl")
-  , ("ufdl",      "application/vnd.ufdl")
-  , ("umj",       "application/vnd.umajin")
-  , ("unityweb",  "application/vnd.unity")
-  , ("uoml",      "application/vnd.uoml+xml")
-  , ("uri",       "text/uri-list")
-  , ("uris",      "text/uri-list")
-  , ("urls",      "text/uri-list")
-  , ("ustar",     "application/x-ustar")
-  , ("utz",       "application/vnd.uiq.theme")
-  , ("uu",        "text/x-uuencode")
-  , ("vcd",       "application/x-cdlink")
-  , ("vcf",       "text/x-vcard")
-  , ("vcg",       "application/vnd.groove-vcard")
-  , ("vcs",       "text/x-vcalendar")
-  , ("vcx",       "application/vnd.vcx")
-  , ("vis",       "application/vnd.visionary")
-  , ("viv",       "video/vnd.vivo")
-  , ("vrml",      "model/vrml")
-  , ("vsd",       "application/vnd.visio")
-  , ("vsf",       "application/vnd.vsf")
-  , ("vss",       "application/vnd.visio")
-  , ("vst",       "application/vnd.visio")
-  , ("vsw",       "application/vnd.visio")
-  , ("vtu",       "model/vnd.vtu")
-  , ("vxml",      "application/voicexml+xml")
-  , ("wav",       "audio/wav")
-  , ("wav",       "audio/x-wav")
-  , ("wax",       "audio/x-ms-wax")
-  , ("wbmp",      "image/vnd.wap.wbmp")
-  , ("wbs",       "application/vnd.criticaltools.wbs+xml")
-  , ("wbxml",     "application/vnd.wap.wbxml")
-  , ("wcm",       "application/vnd.ms-works")
-  , ("wdb",       "application/vnd.ms-works")
-  , ("wks",       "application/vnd.ms-works")
-  , ("wm",        "video/x-ms-wm")
-  , ("wma",       "audio/x-ms-wma")
-  , ("wmd",       "application/x-ms-wmd")
-  , ("wmf",       "application/x-msmetafile")
-  , ("wml",       "text/vnd.wap.wml")
-  , ("wmlc",      "application/vnd.wap.wmlc")
-  , ("wmls",      "text/vnd.wap.wmlscript")
-  , ("wmlsc",     "application/vnd.wap.wmlscriptc")
-  , ("wmv",       "video/x-ms-wmv")
-  , ("wmx",       "video/x-ms-wmx")
-  , ("wmz",       "application/x-ms-wmz")
-  , ("wpd",       "application/vnd.wordperfect")
-  , ("wpl",       "application/vnd.ms-wpl")
-  , ("wps",       "application/vnd.ms-works")
-  , ("wqd",       "application/vnd.wqd")
-  , ("wri",       "application/x-mswrite")
-  , ("wrl",       "model/vrml")
-  , ("wsdl",      "application/wsdl+xml")
-  , ("wspolicy",  "application/wspolicy+xml")
-  , ("wtb",       "application/vnd.webturbo")
-  , ("wvx",       "video/x-ms-wvx")
-  , ("x3d",       "application/vnd.hzn-3d-crossword")
-  , ("xar",       "application/vnd.xara")
-  , ("xbd",       "application/vnd.fujixerox.docuworks.binder")
-  , ("xbm",       "image/x-xbitmap")
-  , ("xdm",       "application/vnd.syncml.dm+xml")
-  , ("xdp",       "application/vnd.adobe.xdp+xml")
-  , ("xdw",       "application/vnd.fujixerox.docuworks")
-  , ("xenc",      "application/xenc+xml")
-  , ("xfdf",      "application/vnd.adobe.xfdf")
-  , ("xfdl",      "application/vnd.xfdl")
-  , ("xht",       "application/xhtml+xml")
-  , ("xhtml",     "application/xhtml+xml")
-  , ("xhvml",     "application/xv+xml")
-  , ("xif",       "image/vnd.xiff")
-  , ("xla",       "application/vnd.ms-excel")
-  , ("xlc",       "application/vnd.ms-excel")
-  , ("xlm",       "application/vnd.ms-excel")
-  , ("xls",       "application/vnd.ms-excel")
-  , ("xlt",       "application/vnd.ms-excel")
-  , ("xlw",       "application/vnd.ms-excel")
-  , ("xml",       "application/xml")
-  , ("xo",        "application/vnd.olpc-sugar")
-  , ("xop",       "application/xop+xml")
-  , ("xpm",       "image/x-xpixmap")
-  , ("xpr",       "application/vnd.is-xpr")
-  , ("xps",       "application/vnd.ms-xpsdocument")
-  , ("xpw",       "application/vnd.intercon.formnet")
-  , ("xpx",       "application/vnd.intercon.formnet")
-  , ("xsl",       "application/xml")
-  , ("xslt",      "application/xslt+xml")
-  , ("xsm",       "application/vnd.syncml+xml")
-  , ("xspf",      "application/xspf+xml")
-  , ("xul",       "application/vnd.mozilla.xul+xml")
-  , ("xvm",       "application/xv+xml")
-  , ("xvml",      "application/xv+xml")
-  , ("xwd",       "image/x-xwindowdump")
-  , ("xyz",       "chemical/x-xyz")
-  , ("zaz",       "application/vnd.zzazz.deck+xml")
-  , ("zip",       "application/zip")
-  , ("zmm",       "application/vnd.handheld-entertainment+xml")
-  , ("avi",       "video/x-msvideo")
-  , ("movie",     "video/x-sgi-movie")
-  , ("ice",       "x-conference/x-cooltalk")
-  ]
-
diff --git a/src/Network/Protocol/Uri.hs b/src/Network/Protocol/Uri.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-
-{-# LANGUAGE TemplateHaskell #-}
-module Network.Protocol.Uri (
-
-    {- | See rfc2396 for more info. -}
-
-  -- * URI datatype.
-
-    Scheme
-  , RegName
-  , Port
-  , Query
-  , Fragment
-  , Hash
-  , UserInfo
-  , PathSegment
-  , Parameters
-
-  , Domain (..)
-  , IPv4 (..)
-  , Path (..)
-  , Host (..)
-  , Authority (..)
-  , Uri (..)
-
-  -- * Accessing parts of URIs.
-
-  , relative
-  , scheme
-  , userinfo
-  , authority
-  , host
-  , domain
-  , ipv4
-  , regname
-  , port
-  , path
-  , segments
-  , query
-  , fragment
-
-  -- * More advanced labels and functions.
-
-  , pathAndQuery
-  , queryParams
-  , params
-  , extension
-
-  , remap
-
-  -- * Encoding/decoding URI encoded strings.
-
-  , encode
-  , decode
-  , encoded
-
-  -- * Creating empty URIs.
-
-  , mkUri
-  , mkScheme
-  , mkPath
-  , mkAuthority
-  , mkQuery
-  , mkFragment
-  , mkUserinfo
-  , mkHost
-  , mkPort
-
-  -- * Parsing URIs.
-
-  , toUri
-  , parseUri
-  , parseAbsoluteUri
-  , parseAuthority
-  , parsePath
-  , parseHost
-
-  -- * Printing URIs
-  , showUri
-  , showPath
-  , showAuthority
-
-  -- * Filename related utilities.
-
-  , mimetype
-  , normalize
-  , jail
-  , (/+)
-
-  ) where
-
-import Network.Protocol.Uri.Data
-import Network.Protocol.Uri.Encode
-import Network.Protocol.Uri.Parser
-import Network.Protocol.Uri.Path
-import Network.Protocol.Uri.Printer
-import Network.Protocol.Uri.Query
-import Network.Protocol.Uri.Remap
-
diff --git a/src/Network/Protocol/Uri/Chars.hs b/src/Network/Protocol/Uri/Chars.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Chars.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-module Network.Protocol.Uri.Chars
-  ( unreserved
-  , genDelims
-  , subDelims
-  ) where
-
-import Data.Char
-
--- 2.3.  Unreserved Characters
-unreserved :: Char -> Bool
-unreserved c = isAlphaNum c || elem c "-._~"
-
--- 2.2.  Reserved Characters
-genDelims :: Char -> Bool
-genDelims = flip elem ":/?#[]@"
-
-subDelims :: Char -> Bool
-subDelims = flip elem "!$&'()*+,;="
-
diff --git a/src/Network/Protocol/Uri/Data.hs b/src/Network/Protocol/Uri/Data.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Data.hs
+++ /dev/null
@@ -1,214 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE TemplateHaskell, TypeOperators #-}
-module Network.Protocol.Uri.Data where
-
-import Prelude hiding ((.), id)
-import Control.Category
-import Data.Label
-import Data.Maybe
-import Network.Protocol.Uri.Encode
-
-type Scheme      = String
-type RegName     = String
-type Port        = Int
-type Query       = String
-type Fragment    = String
-type Hash        = String
-type UserInfo    = String
-type PathSegment = String
-
-data IPv4 = IPv4 Int Int Int Int
-  deriving (Show, Read, Eq, Ord)
-
-data Domain = Domain { __parts :: [String] }
-  deriving (Show, Read, Eq, Ord)
-
-data Host =
-    Hostname { __domain  :: Domain }
-  | RegName  { __regname :: RegName }
-  | IP       { __ipv4    :: IPv4   }
---  | IPv6     { __ipv6    :: IPv6   }
-  deriving (Show, Read, Eq, Ord)
-
-data Authority = Authority
-  { __userinfo :: UserInfo
-  , __host     :: Host
-  , __port     :: Maybe Port
-  }
-  deriving (Show, Read, Eq, Ord)
-
-data Path = Path { __segments :: [PathSegment] }
-  deriving (Show, Read, Eq, Ord)
-
-data Uri = Uri
-  { _relative  :: Bool
-  , _scheme    :: Scheme
-  , _authority :: Authority
-  , __path     :: Path
-  , __query    :: Query
-  , __fragment :: Fragment
-  }
-  deriving (Show, Read, Eq, Ord)
-
-$(mkLabels [''Domain, ''Path, ''Host, ''Authority, ''Uri])
-
--- _parts    :: Domain :-> [String]
--- _domain   :: Host :-> Domain
--- _ipv4     :: Host :-> IPv4
--- _regname  :: Host :-> String
--- _host     :: Authority :-> Host
--- _port     :: Authority :-> Maybe Port
--- _userinfo :: Authority :-> UserInfo
--- _segments :: Path :-> [PathSegment]
--- _path     :: Uri :-> Path
-
--- | Access raw (URI-encoded) query.
-
--- _query :: Uri :-> Query
-
--- | Access authority part of the URI.
-
--- authority :: Uri :-> Authority
-
--- | Access domain part of the URI, returns `Nothing' when the host is a
--- regname or IP-address.
-
-domain :: Uri :-> Maybe Domain
-domain = (Bij f (Hostname . fromJust)) `iso` (_host . authority)
-  where
-    f (Hostname d) = Just d
-    f _            = Nothing
-
--- | Access regname part of the URI, returns `Nothing' when the host is a
--- domain or IP-address.
-
-regname :: Uri :-> Maybe RegName
-regname = (Bij f (RegName . fromJust)) `iso` (_host . authority)
-  where
-    f (RegName r) = Just r
-    f _           = Nothing
-
--- | Access IPv4-address part of the URI, returns `Nothing' when the host is a
--- domain or regname.
-
-ipv4 :: Uri :-> Maybe IPv4
-ipv4 = (Bij f (IP . fromJust)) `iso` (_host . authority)
-  where
-    f (IP i) = Just i
-    f _      = Nothing
-
--- | Access raw (URI-encoded) fragment.
-
--- _fragment :: Uri :-> Fragment
-
--- | Access the port number part of the URI when available.
-
-port :: Uri :-> Maybe Port
-port = _port . authority
-
--- | Access the query part of the URI, the part that follows the ?. The query
--- will be properly decoded when reading and encoded when writing.
-
-query :: Uri :-> Query
-query = encoded `iso` _query
-
--- | Access the fragment part of the URI, the part that follows the #. The
--- fragment will be properly decoded when reading and encoded when writing.
-
-fragment :: Uri :-> Fragment
-fragment = encoded `iso` _fragment
-
--- | Is a URI relative?
-
--- relative :: Uri :-> Bool
-
--- | Access the scheme part of the URI. A scheme is probably the protocol
--- indicator like /http/, /ftp/, etc.
-
--- scheme :: Uri :-> Scheme
-
--- | Access the path part of the URI as a list of path segments. The segments
--- will still be URI-encoded.
-
-segments :: Uri :-> [PathSegment]
-segments = _segments . _path
-
--- | Access the userinfo part of the URI. The userinfo contains an optional
--- username and password or some other credentials.
-
-userinfo :: Uri :-> String
-userinfo = _userinfo . authority
-
--- | Constructors for making empty URI.
-
-mkUri :: Uri
-mkUri = Uri False mkScheme mkAuthority mkPath mkQuery mkFragment
-
--- | Constructors for making empty `Scheme`.
-
-mkScheme :: Scheme
-mkScheme = ""
-
--- | Constructors for making empty `Path`.
-
-mkPath :: Path
-mkPath = Path []
-
--- | Constructors for making empty `Authority`.
-
-mkAuthority :: Authority
-mkAuthority = Authority "" mkHost mkPort
-
--- | Constructors for making empty `Query`.
-
-mkQuery :: Query
-mkQuery = ""
-
--- | Constructors for making empty `Fragment`.
-
-mkFragment :: Fragment
-mkFragment = ""
-
--- | Constructors for making empty `UserInfo`.
-
-mkUserinfo :: UserInfo
-mkUserinfo = ""
-
--- | Constructors for making empty `Host`.
-
-mkHost :: Host
-mkHost = Hostname (Domain [])
-
--- | Constructors for making empty `Port`.
-
-mkPort :: Maybe Port
-mkPort = Nothing
-
diff --git a/src/Network/Protocol/Uri/Encode.hs b/src/Network/Protocol/Uri/Encode.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Encode.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE TypeOperators #-}
-module Network.Protocol.Uri.Encode where
-
-import Data.Bits
-import Data.Char
-import Data.Maybe
-import Data.Label
-import Network.Protocol.Uri.Chars
-import qualified Data.ByteString as B
-import qualified Data.ByteString.UTF8 as U
-
--- | URI encode a string.
-
-encode :: String -> String
-encode = concatMap encodeChr
-  where
-    encodeChr c
-      | unreserved c || genDelims c || subDelims c = [c]
-      | otherwise = '%' :
-          intToDigit (shiftR (ord c) 4) :
-          intToDigit ((ord c) .&. 0x0F) : []
-
--- | URI decode a string.
-
-decode :: String -> String
-decode = U.toString . B.pack . map (fromIntegral . ord) . dec
-  where
-    dec [] = []
-    dec ('%':d:e:ds) | isHexDigit d && isHexDigit e = (chr $ digs d * 16 + digs e) : dec ds 
-      where digs a = fromJust $ lookup (toLower a) $ zip "0123456789abcdef" [0..]
-    dec (d:ds) = d : dec ds
-
--- | Decoding and encoding as a label.
-
-encoded :: Bijection (->) String String
-encoded = Bij decode encode
-
diff --git a/src/Network/Protocol/Uri/Parser.hs b/src/Network/Protocol/Uri/Parser.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Parser.hs
+++ /dev/null
@@ -1,308 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE
-    StandaloneDeriving
-  , TypeOperators
-  , FlexibleContexts
-  , FlexibleInstances
-  #-}
-module Network.Protocol.Uri.Parser where
-
-import Control.Applicative hiding (empty)
-import Control.Category
-import Data.Char
-import Data.List 
-import Data.Maybe
-import Data.Label
-import Network.Protocol.Uri.Data
-import Network.Protocol.Uri.Encode
-import Network.Protocol.Uri.Printer
-import Network.Protocol.Uri.Query
-import Prelude hiding ((.), id, mod)
-import Safe
-import Text.ParserCombinators.Parsec hiding (many, (<|>))
-
--- | Access the host part of the URI.
-
-host :: Uri :-> String
-host = (Bij showHost ((either (const mkHost) id) . parseHost)) `iso` (_host . authority)
-
--- | Access the path part of the URI. The query will be properly decoded when
--- reading and encoded when writing.
-
-path :: Uri :-> FilePath
-path = (Bij (decode . showPath) (either (const mkPath) id . parsePath . encode)) `iso` _path
-
--- | Access the path and query parts of the URI as a single string. The string
--- will will be properly decoded when reading and encoded when writing.
-
-pathAndQuery :: Uri :-> String
-pathAndQuery = values "?" `osi` Lens ((\p q -> [p, q]) <$> idx 0 `for` path <*> idx 1 `for` query)
-  where idx = flip (atDef "")
-        osi (Bij a b) = iso (Bij b a)
-
--- | Parse string into a URI and ignore all failures by returning an empty URI
--- when parsing fails. Can be quite useful in situations that parse errors are
--- unlikely.
-
-toUri :: String -> Uri
-toUri = either (const mkUri) id . parseUri
-
--- | Parse string into a URI.
-
-parseUri :: String -> Either ParseError Uri
-parseUri = parse pUriReference ""
-
--- | Parse string into a URI and only accept absolute URIs.
-
-parseAbsoluteUri :: String -> Either ParseError Uri
-parseAbsoluteUri = parse pAbsoluteUri ""
-
--- | Parse string into an authority.
-
-parseAuthority :: String -> Either ParseError Authority
-parseAuthority = parse pAuthority ""
-
--- | Parse string into a path.
-
-parsePath :: String -> Either ParseError Path
-parsePath = parse pPath ""
-
--- | Parse string into a host.
-
-parseHost :: String -> Either ParseError Host
-parseHost = parse pHost ""
-
--- D.2.  Modifications
-
-pAlpha, pDigit, pAlphanum :: CharParser st Char
-pAlpha    = letter
-pDigit    = digit
-pAlphanum = alphaNum
-
--- 2.3.  Unreserved Characters
-
-pUnreserved :: GenParser Char st Char
-pUnreserved  = pAlphanum <|> oneOf "-._~"
-
-pReserved :: GenParser Char st Char
-pReserved  = pGenDelims <|> pSubDelims
-
-pGenDelims :: CharParser st Char
-pGenDelims = oneOf ":/?#[]@"
-
-pSubDelims :: CharParser st Char
-pSubDelims = oneOf "!$&'()*+,;="
-
--- 2.1.  Percent-Encoding
-
-pPctEncoded :: GenParser Char st String
-pPctEncoded = (:) <$> char '%' <*> pHex
-
-pHex :: GenParser Char st String
-pHex = (\a b -> a:b:[])
-    <$> hexDigit
-    <*> hexDigit
-
--- 3.  Syntax Components
-
--- With the hier-part integrated.
-
-pUri :: GenParser Char st Uri
-pUri = (\a (b,c) d e -> Uri False a b c d e)
-  <$> (pScheme <* string ":")
-  <*> (q <|> p)
-  <*> option "" (string "?" *> pQuery)
-  <*> option "" (string "#" *> pFragment)
-  where
-    q = (,) <$> (string "//" *> pAuthority) <*> pPathAbempty
-    p = ((,) mkAuthority) <$> (pPathAbsolute <|> pPathRootless {-<|> pPathEmpty-})
-
--- 3.1.  Scheme
-
-pScheme :: GenParser Char st String
-pScheme = (:) <$> pAlpha <*> many (pAlphanum <|> oneOf "+_.")
-
--- 3.2.  Authority
-
-pAuthority :: GenParser Char st Authority
-pAuthority = Authority
-  <$> option mkUserinfo (try (pUserinfo <* string "@"))
-  <*> pHost
-  <*> option Nothing (string ":" *> pPort)
-
--- 3.2.1.  User Information
-
-pUserinfo :: GenParser Char st String
-pUserinfo = concat <$> many (
-      (pure <$> pUnreserved)
-  <|> (         pPctEncoded)
-  <|> (pure <$> pSubDelims)
-  <|> (pure <$> oneOf ":")
-  )
-
--- 3.2.2.  Host
-
-pHost :: GenParser Char st Host
-pHost = diff <$> pRegName -- <|> RegName <$> pRegName
-  where
-    diff  a = either (const (RegName a)) sep (parse pHostname "" a)
-    sep   a = if hst a then Hostname (Domain a) else ipreg a
-    ipreg a = if ip a then IP (toIP a) else RegName (intercalate "." a)
-    hst     = not . all isDigit . headDef "" . dropWhile null . reverse
-    ip    a = length a == 4 && length (mapMaybe (either (const Nothing) Just . parse pDecOctet "") a) == 4
-    toIP [a, b, c, d] = IPv4 (read a) (read b) (read c) (read d)
-    toIP _            = IPv4 0 0 0 0
-
-{-
-pfff, ipv6 is sooo not gonna make it..
-
-pIPLiteral = "[" ( IPv6address <|> IPvFuture  ) "]"
-
-pIPvFuture = "v" 1*HEXDIG "." 1*( unreserved <|> subDelims <|> ":" )
-
-pIPv6address =
-                                 6( h16 ":" ) ls32
-  <|>                       "::" 5( h16 ":" ) ls32
-  <|> [               h16 ] "::" 4( h16 ":" ) ls32
-  <|> [ *1( h16 ":" ) h16 ] "::" 3( h16 ":" ) ls32
-  <|> [ *2( h16 ":" ) h16 ] "::" 2( h16 ":" ) ls32
-  <|> [ *3( h16 ":" ) h16 ] "::"    h16 ":"   ls32
-  <|> [ *4( h16 ":" ) h16 ] "::"              ls32
-  <|> [ *5( h16 ":" ) h16 ] "::"              h16
-  <|> [ *6( h16 ":" ) h16 ] "::"
-
-pH16           = 1*4HEXDIG
-pLs32          = ( h16 ":" h16 ) <|> IPv4address
--}
-
-pIPv4address :: GenParser Char st [Int]
-pIPv4address = (:) <$> pDecOctet <*> (count 3 $ char '.' *> pDecOctet)
-
-pDecOctet :: GenParser Char st Int
-pDecOctet = read <$> choice [
-    try ((\a b c -> [a,b,c]) <$> char '2' <*> char '5'      <*> oneOf "012345")
-  , try ((\a b c -> [a,b,c]) <$> char '2' <*> oneOf "01234" <*> digit)
-  , try ((\a b c -> [a,b,c]) <$> char '1' <*> digit         <*> digit)
-  , try ((\a b   -> [a,b])   <$>              digit         <*> digit)
-  ,     (pure                <$>                                digit)
-  ]
-
-pRegName :: GenParser Char st String
-pRegName = concat <$> many1 (
-      (pure <$> pUnreserved)
-  <|>           pPctEncoded
-  <|> (pure <$> pSubDelims))
-
--- Not actually part of the rfc3986, but comptability with the rfc2396.
--- This information can be useful, so why throw away.
-
-pHostname :: GenParser Char st [String]
-pHostname = sepBy (option "" pDomainlabel) (string ".")
-
-pDomainlabel :: GenParser Char st String
-pDomainlabel = intercalate "-" <$> sepBy1 (some pAlphanum) (string "-")
-
--- 3.2.3.  Port
-
-pPort :: GenParser Char st (Maybe Port)
-pPort = readMay <$> some pDigit
-
--- 3.4.  Query
-
-pQuery :: GenParser Char st String
-pQuery = concat <$> many (pPchar <|> pure <$> oneOf "/?")
-
--- 3.5.  Fragment
-
-pFragment :: GenParser Char st String
-pFragment = concat <$> many (pPchar <|> pure <$> oneOf "/?" )
-
--- 3.3.  Path
-
-pPath, pPathAbempty, pPathAbsolute, pPathNoscheme, pPathRootless, pPathEmpty :: GenParser Char st Path
-
-pPath =
-      try pPathAbsolute -- begins with "/" but not "//"
-  <|> try pPathNoscheme -- begins with a nonColon segment
-  <|> try pPathRootless -- begins with a segment
-  <|> pPathEmpty        -- zero characters
-
-pPathAbempty  = Path . ("":) <$> _pSlashSegments
-pPathAbsolute = (char '/' *>) $ Path . ("":) <$> (option [] $ (:) <$> pSegmentNz <*> _pSlashSegments)
-pPathNoscheme = Path <$> ((:) <$> pSegmentNzNc <*> _pSlashSegments)
-pPathRootless = Path <$> ((:) <$> pSegmentNz    <*> _pSlashSegments)
-pPathEmpty    = Path [] <$ string ""
-
-pSegment, pSegmentNz, pSegmentNzNc :: GenParser Char st String
-pSegment     = concat <$> many pPchar
-pSegmentNz   = concat <$> some pPchar
-pSegmentNzNc = concat <$> some (
-      (pure <$> pUnreserved)
-  <|>           pPctEncoded
-  <|> (pure <$> pSubDelims)
-  <|> (pure <$> oneOf "@" ))
-
-_pSlashSegments :: GenParser Char st [PathSegment]
-_pSlashSegments = (many $ (:) <$> char '/' *> pSegment)
-
-
-pPchar :: GenParser Char st String
-pPchar = choice
-  [ pure <$> pUnreserved
-  , pPctEncoded
-  , pure <$> pSubDelims
-  , pure <$> oneOf ":@"
-  ]
-
--- 4.1.  URI Reference
-
-pUriReference :: GenParser Char st Uri
-pUriReference = try pAbsoluteUri <|> pRelativeRef
-
--- 4.2.  Relative Reference
-
--- With the relative-part integrated.
-
-pRelativeRef :: GenParser Char st Uri
-pRelativeRef = ($)
-  <$> (try pRelativePart
-  <|> ((Uri True mkScheme mkAuthority)
-  <$> (pPathAbsolute <|> pPathRootless <|> pPathEmpty)))
-  <*> option "" (string "?" *> pQuery)
-  <*> option "" (string "#" *> pFragment)
-
-pRelativePart :: GenParser Char st (Query -> Fragment -> Uri)
-pRelativePart = Uri True mkScheme <$> (string "//" *> pAuthority) <*> pPathAbempty
-
--- 4.3.  Absolute URI
-
-pAbsoluteUri :: GenParser Char st Uri
-pAbsoluteUri = pUri
diff --git a/src/Network/Protocol/Uri/Path.hs b/src/Network/Protocol/Uri/Path.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Path.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE TypeOperators #-}
-module Network.Protocol.Uri.Path where
-
-import Data.List
-import Network.Protocol.Mime
-import Data.Label
-
-{- | Label to access the extension of a filename. -}
-
-extension :: FilePath :-> Maybe String
-extension = lens getExt setExt
-  where
-    splt     p = (\(a,b) -> (reverse a, reverse b)) $ break (=='.') $ reverse p
-    isExt e  p = '/' `elem` e || not ('.' `elem` p)
-    getExt   p = let (u, v) = splt p in
-                 if isExt u v then Nothing else Just u
-    setExt e p = let (u, v) = splt p in
-                 (if isExt u v then p else init v) ++ maybe "" ('.':) e
-
-{- |
-Try to guess the correct mime type for the input file based on the file
-extension.
--}
-
-mimetype :: FilePath -> Maybe String
-mimetype p = get extension p >>= mime
-
-{- |
-Normalize a path by removing or merging all dot or dot-dot segments and double
-slashes. 
--}
-
--- Todo: is this windows-safe?  is it really secure?
-
-normalize :: FilePath -> FilePath
-normalize p  = norm_rev (reverse p)
-  where
-    norm_rev ('/':t) = start_dir 0 "/" t
-    norm_rev (    t) = start_dir 0 ""  t
-
-    start_dir n q (".."           ) = rest_dir   n    q  ""
-    start_dir n q ('/':t          ) = start_dir  n    q  t
-    start_dir n q ('.':'/':t      ) = start_dir  n    q  t
-    start_dir n q ('.':'.':'/': t ) = start_dir (n+1) q  t
-    start_dir n q (t              ) = rest_dir   n    q  t
-
-    rest_dir  n q  ""
-        | n > 0      = foldr (++) q (replicate n "../")
-        | null q     = "/"
-        | otherwise  = q
-    rest_dir  0 q ('/':t ) = start_dir  0   ('/':q)  t
-    rest_dir  n q ('/':t ) = start_dir (n-1)     q   t
-    rest_dir  0 q (h:t   ) = rest_dir   0   (  h:q)  t
-    rest_dir  n q (_:t   ) = rest_dir   n        q   t
-
-{- | Jail a filepath within a jail directory. -}
-
-jail
-  :: FilePath         -- ^ Jail directory.
-  -> FilePath         -- ^ Filename to jail.
-  -> Maybe FilePath
-jail jailDir p =
-  let nj = normalize jailDir
-      np = normalize p in
-  if nj `isPrefixOf` np -- && not (".." `isPrefixOf` np)
-    then Just np
-    else Nothing
-
-{- | Concatenate and normalize two filepaths. -}
-
-(/+) :: FilePath -> FilePath -> FilePath
-a /+ b = normalize (a ++ "/" ++ b)
-
diff --git a/src/Network/Protocol/Uri/Printer.hs b/src/Network/Protocol/Uri/Printer.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Printer.hs
+++ /dev/null
@@ -1,98 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-module Network.Protocol.Uri.Printer where
-
-import Network.Protocol.Uri.Data
-
-printPath :: Path -> ShowS
-printPath (Path ("":xs)) = sc '/' . printPath (Path xs)
-printPath (Path xs)      = intersperseS (sc '/') (map ss xs)
-
-showPath :: Path -> String
-showPath = flip printPath ""
-
--- instance Show Path where
---   showsPrec _ (Path ("":xs)) = sc '/' . shows (Path xs)
---   showsPrec _ (Path xs)      = intersperseS (sc '/') (map ss xs)
-
-printIPv4 :: IPv4 -> ShowS
-printIPv4 (IPv4 a b c d) = intersperseS (sc '.') (map shows [a, b, c, d])
-
--- instance Show IPv4 where
---   showsPrec _ (IPv4 a b c d) = intersperseS (sc '.') (map shows [a, b, c, d])
-
-printDomain :: Domain -> ShowS
-printDomain (Domain d) = intersperseS (sc '.') (map ss d)
-
--- instance Show Domain where
---   showsPrec _ (Domain d) = intersperseS (sc '.') (map ss d)
-
-printHost :: Host -> ShowS
-printHost (Hostname d) = printDomain d
-printHost (IP i)       = printIPv4 i 
-printHost (RegName r)  = ss r
-
-showHost :: Host -> String
-showHost = flip printHost ""
-
-printAuthority :: Authority -> ShowS
-printAuthority (Authority u h p) =
-    let u' = if null u then id else ss u . ss "@"
-        p' = maybe id (\s -> sc ':' . shows s) p
-    in u' . printHost h . p'
-
-showAuthority :: Authority -> String
-showAuthority = flip printAuthority ""
-
-printUri :: Uri -> ShowS
-printUri (Uri _ s a p q f) =
-    let s' = if null s then id else ss s . sc ':'
-        a' = printAuthority a ""
-        p' = printPath p
-        q' = if null q then id else sc '?' . ss q
-        f' = if null f then id else sc '#' . ss f
-        t' = if null a' then id else ss "//"
-    in s' . t' . ss a' . p' . q' . f'
-
-showUri :: Uri -> String
-showUri = flip printUri ""
-
-ss :: String -> ShowS
-ss = showString
-
-sc :: Char -> ShowS
-sc = showChar
-
--- | ShowS version of intersperse.
-
-intersperseS :: ShowS -> [ShowS] -> ShowS
-intersperseS _ []     = id
-intersperseS s (x:xs) = foldl (\a b -> a.s.b) x xs
-
diff --git a/src/Network/Protocol/Uri/Query.hs b/src/Network/Protocol/Uri/Query.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Query.hs
+++ /dev/null
@@ -1,82 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-{-# LANGUAGE TypeOperators #-}
-module Network.Protocol.Uri.Query where
-
-import Prelude hiding ((.), id)
-import Control.Category
-import Data.List
-import Data.List.Split 
-import Data.Label
-import Network.Protocol.Uri.Data
-import Network.Protocol.Uri.Encode
-
-type Parameters = [(String, String)]
-
--- | Fetch the query parameters form a URI.
-
-queryParams :: Uri :-> Parameters
-queryParams = params `iso` _query
-
--- | Generic lens to parse/print a string as query parameters.
-
-params :: Bijection (->) String Parameters
-params = keyValues "&" "=" . (Bij from to) . encoded
-  where from = intercalate " " . splitOn "+"
-        to   = intercalate "+" . splitOn " "
-
--- | Generic label for accessing key value pairs encoded in a string.
-
-keyValues :: String -> String -> Bijection (->) String Parameters
-keyValues sep eqs = Bij parser printer
-  where parser =
-            filter (\(a, b) -> not (null a))
-          . map (f . splitOn eqs)
-          . concat
-          . map (splitOn sep)
-          . lines
-          where f []     = ("", "")
-                f [x]    = (trim x, "")
-                f (x:xs) = (trim x, trim $ intercalate eqs xs)
-        printer = intercalate sep . map (\(a, b) -> a ++ eqs ++ b)
-
--- | Generic label for accessing lists of values encoded in a string.
-
-values :: String -> Bijection (->) String [String]
-values sep = Bij parser printer
-  where parser = filter (not . null) . concat . map (map trim . splitOn sep) . lines
-        printer = intercalate sep
-
--- Helper to trim all heading and trailing whitespace.
-
-trim :: String -> String
-trim = rev (dropWhile (`elem` " \t\n\r"))
-  where rev f = reverse . f . reverse . f
-
diff --git a/src/Network/Protocol/Uri/Remap.hs b/src/Network/Protocol/Uri/Remap.hs
deleted file mode 100644
--- a/src/Network/Protocol/Uri/Remap.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-
-Copyright (c) Sebastiaan Visser 2008
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions
-are met:
-1. Redistributions of source code must retain the above copyright
-   notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
-   notice, this list of conditions and the following disclaimer in the
-   documentation and/or other materials provided with the distribution.
-3. Neither the name of the author nor the names of his contributors
-   may be used to endorse or promote products derived from this software
-   without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGE.
--}
-module Network.Protocol.Uri.Remap where
-
-import Control.Category
-import Data.List 
-import Data.Label
-import Network.Protocol.Uri.Data
-import Prelude hiding ((.), id, mod)
-
--- | Map one URI to another using a URI mapping scheme. A URI mapping scheme is
--- simply a pair of URIs of which only the host part, port number and path will
--- be taken into account when mapping.
-
-remap :: (Uri, Uri) -> Uri -> Maybe Uri
-remap (f, t) u =
-  let
-    ftu = [f, t, u]
-    hst = _host . authority
-    [h0, h1, h2] = map (get hst)      ftu
-    [p0, p1, p2] = map (get port)     ftu
-    [s0, s1, s2] = map (get segments) ftu
-  in case
-     ( remapHost h0 h1 h2
-     , remapPort p0 p1 p2
-     , remapPath s0 s1 s2
-     ) of
-    (Just h, Just p, Just s)
-      -> Just (set hst h . set port p . set segments s $ u)
-    _ -> Nothing
-  where
-  remapHost (Hostname (Domain a))
-            (Hostname (Domain b))   (Hostname (Domain c))          = fmap (Hostname . Domain . (++b)) (a `stripPrefix` reverse c)
-  remapHost (Hostname (Domain a)) b (Hostname (Domain c)) | a == c = Just b
-  remapHost (RegName a)           b (RegName c)           | a == c = Just b
-  remapHost (IP a)                b (IP c)                | a == c = Just b
-  remapHost _                     _ _                              = Nothing
-  remapPath xs ys zs = fmap (ys++) (xs `stripPrefix` zs)
-  remapPort x y z = if x == z then Just y else Nothing
-
--- from = toUri "http://myhost:8080/ggl"
--- to   = toUri "http://google.com/gapp"
--- testRemap =
---   do let x = remap from to (toUri "http://images.myhost:8080/ggl/search?q=aapjes")
---      print x
-
-
diff --git a/src/Network/Shpider/Forms.hs b/src/Network/Shpider/Forms.hs
deleted file mode 100644
--- a/src/Network/Shpider/Forms.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-
- - Copyright (c) 2009-2010 Johnny Morrice
- -
- - Permission is hereby granted, free of charge, to any person
- - obtaining a copy of this software and associated documentation 
- - files (the "Software"), to deal in the Software without 
- - restriction, including without limitation the rights to use, copy, 
- - modify, merge, publish, distribute, sublicense, and/or sell copies 
- - of the Software, and to permit persons to whom the Software is 
- - furnished to do so, subject to the following conditions:
- -
- - The above copyright notice and this permission notice shall be 
- - included in all copies or substantial portions of the Software.
- -
- - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 
- - EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- - MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 
- - NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
- - BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
- - ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
- - CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
- - SOFTWARE.
- -
- -}
-module Network.Shpider.Forms 
-   (
-   Form (..)
-   , Method (..)
-   , gatherForms
-   , fillOutForm
-   , allForms
-   , toForm
-   , mkForm
-   )
-   where
-
-import Data.Maybe
-import Data.Char
-import Control.Arrow ( first )
-import qualified Data.Map as M
-import Text.HTML.TagSoup.Parsec
-
-data Method = GET | POST
-   deriving Show
-
--- | Plain old form: Method, action and inputs.
-data Form = 
-   Form { method :: Method
-        , action :: String 
-        , inputs :: M.Map String String
-        }
-   deriving Show
-
--- | Takes a form and fills out the inputs with the given [ ( String , String ) ].
--- It is convienent to use the `pairs` syntax here.
---
--- @
--- f : _ <- `getFormsByAction` \"http:\/\/whatever.com\"
--- `sendForm` $ `fillOutForm` f $ `pairs` $ do
---    \"author\" =: \"Johnny\"
---    \"message\" =: \"Nice syntax dewd.\"
--- @
-fillOutForm :: Form -> [ ( String , String ) ] -> Form
-fillOutForm = foldl ( \f (n,v) -> f { inputs = M.insert n v $ inputs f } )
-
--- | The first argument is the action attribute of the form, the second is the method attribute, and the third are the inputs.
-mkForm :: String -> Method -> [ ( String , String ) ] -> Form
-mkForm a m ps =
-   Form { action = a
-        , method = m
-        , inputs = M.fromList ps
-        }
-
--- | Gets all forms from a list of tags.
-gatherForms :: [ Tag String ] -> [ Form ]
-gatherForms =
-   tParse allForms
-
--- | The `TagParser` which parses all forms.
-allForms :: TagParser String [ Form ]
-allForms = do
-   fs <- allWholeTags "form"
-   return $ mapMaybe toForm fs
-
--- | A case insensitive lookup for html attributes.
-attrLookup :: String -> [ ( String , String ) ] -> Maybe String
-attrLookup attr =
-   lookup ( map toLower attr ) . map ( first (map toLower) )
-
--- | Turns a String lowercase.  <rant>In my humble opinion, and considering that a few different packages implement this meager code, this should be in the prelude.</rant>
-lowercase :: String -> String 
-lowercase = map toLower
-
-
-toForm :: WholeTag String -> Maybe Form
-toForm ( TagOpen _ attrs , innerTags , _ ) = do
-   m <- methodLookup attrs
-   a <- attrLookup "action" attrs
-   let is = tParse ( allOpenTags "input" ) innerTags
-       tas = tParse ( allWholeTags "textarea" ) innerTags
-   Just $ Form { inputs = M.fromList $ mapMaybe inputNameValue is ++ mapMaybe textAreaNameValue tas
-               , action = a
-               , method = m
-               }
-
-methodLookup attrs = do
-   m <- attrLookup "method" attrs
-   case lowercase m of
-      "get" ->
-         Just GET
-      "post" ->
-         Just POST
-      otherwise ->
-         Nothing
-
-inputNameValue ( TagOpen _ attrs ) = do
-   v <- case attrLookup "value" attrs of
-           Nothing ->
-              Just ""
-           j@(Just _ ) ->
-              j
-   n <- attrLookup "name" attrs
-   Just ( n , v )
-
-textAreaNameValue ( TagOpen _ attrs , inner , _ ) = do
-   let v = innerText inner
-   n <- attrLookup "name" attrs
-   Just ( n , v )
-
diff --git a/src/Test/API.hs b/src/Test/API.hs
deleted file mode 100644
--- a/src/Test/API.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module Test.API where
-
-import Web.VKHS
-
--- | Almost working example. Just set correct values for client_id/login/password
-print_user_info :: IO ()
-print_user_info = do
-    let e = env "3213232" "user@example.com" "password" [Photos,Audio,Groups]
-    r <- login e{verbose = Debug}
-    print r
-    let (Right (at,_,_)) = r
-    ans <- api (callEnv e{verbose = Debug} at) "users.get" [
-          ("uids","911727")
-        , ("fields","first_name,last_name,nickname,screen_name")
-        , ("name_case","nom")
-        ]
-    print ans
diff --git a/src/Test/Data.hs b/src/Test/Data.hs
deleted file mode 100644
--- a/src/Test/Data.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module Test.Data where
-
-import Data.Label
-import Network.Protocol.Http
-import Network.Protocol.Uri
-import Network.Protocol.Uri.Query
-import Network.Protocol.Cookie as C
-import Network.Shpider.Forms
-
-import Text.HTML.TagSoup
-
-tryparse = gatherForms . parseTags 
-
-test_cookies :: Cookies
-test_cookies = get setCookies test_headers
-
-
-test_headers :: Http Response
-test_headers = read "Http {_headline = Response {__status = Found}, _version = Version {_major = 1, _minor = 1}, _headers = Headers {unHeaders = [(\"Server\",\"nginx/1.2.1\"),(\"Date\",\"Wed, 29 Aug 2012 08:35:18 GMT\"),(\"Content-Type\",\"text/html; charset=windows-1251\"),(\"Content-Length\",\"0\"),(\"Connection\",\"keep-alive\"),(\"X-Powered-By\",\"PHP/5.3.3-7+squeeze3\"),(\"Set-Cookie\",\"remixlang=0; expires=Sat, 24-Aug-2013 14:23:04 GMT; path=/; domain=.vk.com\"),(\"Pragma\",\"no-cache\"),(\"Cache-control\",\"no-store\"),(\"Set-Cookie\",\"remixchk=5; expires=Tue, 20-Aug-2013 04:42:57 GMT; path=/; domain=.vk.com\"),(\"Location\",\"https://login.vk.com/?from_host=oauth.vk.com&from_protocol=http&ip_h=670993b49983a18c93&soft=1&to=aHR0cDovL29hdXRoLnZrLmNvbS9vYXV0aC9hdXRob3JpemU/Y2xpZW50X2lkPTMwODIyNjYmc2NvcGU9d2FsbCxncm91cCZyZWRpcmVjdF91cmk9aHR0cDovL29hdXRoLnZrLmNvbS9ibGFuay5odG1sJmRpc3BsYXk9d2FwJnJlc3BvbnNlX3R5cGU9dG9rZW4-\"),(\"Vary\",\"Accept-Encoding\")]}}"
-
-test_body :: String
-test_body = "<!DOCTYPE html PUBLIC \"-//WAPFORUM//DTD XHTML Mobile 1.0//EN\" \"http://www.wapforum.org/DTD/xhtml-mobile10.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\">\n<head>\n<meta http-equiv=\"content-type\" content=\"application/xhtml+xml; charset=UTF-8\" />\n<meta http-equiv=\"X-UA-Compatible\" content=\"IE=edge\" />\n<title>\208\159\208\190\208\187\209\131\209\135\208\181\208\189\208\184\208\181 \208\180\208\190\209\129\209\130\209\131\208\191\208\176 \208\186 \208\146\208\154\208\190\208\189\209\130\208\176\208\186\209\130\208\181</title>\n<style type=\"text/css\">\nhtml,body {\n  padding: 0px;\n  margin: 0px;\n  font-family: tahoma, arial, verdana, sans-serif, Lucida Sans;\n  text-align: center;\n  background: #f7f7f7;\n  font-size: 12px;\n}\nb {\n  color: #36638E;\n}\n.button_yes {\n  border: 1px solid #3B6798;\n  text-shadow: #45688E 0px 1px 0px;\n  display: inline-block;\n  width: 90px;\n  text-decoration: none;\n  padding: 0px;\n}\n.button_yes input {\n  background-color: #6D8FB3;\n  border: 1px solid #7E9CBC;\n  border-bottom-color: #5C82AB;\n  border-left-color: #5C82AB;\n  border-right-color: #5C82AB;\n  padding: 3px 3px 4px 3px;\n  color: #FFFFFF;\n  margin: 0px;\n  width: 90px;\n  cursor: pointer;\n  font-size: 12px;\n}\n.button_no {\n  border: 1px solid #B8B8B8;\n  border-top: 1px solid #9F9F9F;\n  text-shadow: #FFFFFF 0px 1px 0px;\n  display: inline-block;\n  width: 70px;\n  color: #000000;\n  text-decoration: none;\n}\n.button_no div {\n  background-color: #EAEAEA;\n  border: 1px solid #FFFFFF;\n  border-bottom-color: #DFDFDF;\n  border-left-color: #F4F4F4;\n  border-right-color: #F4F4F4;\n  padding: 3px 3px 4px 3px;\n}\na {\n  color: #2B587A;\n  text-decoration: none;\n}\n</style>\n<script type=\"text/javascript\" language=\"javascript\">\n// <![CDATA[\nif (parent && parent != window) {\n  location.href = 'http://vk.com';\n}\n// ]]>\n</script>\n</head>\n<body>\n<div style=\"background: #5b7fa6; padding: 2px 3px 3px 3px; border-bottom: 1px solid #6f91bb;\">\n<b style=\"color: #FFFFFF;\">\208\159\208\190\208\187\209\131\209\135\208\181\208\189\208\184\208\181 \208\180\208\190\209\129\209\130\209\131\208\191\208\176 \208\186 \208\146\208\154\208\190\208\189\209\130\208\176\208\186\209\130\208\181</b>\n</div>\n<div style=\"border-top: 1px solid #4a6a91; padding:10px;\">\n  <div style=\"background: #ffffff; border: 1px solid #adbbca; padding: 5px;'\">\n    <style>\ninput {\n  border: 1px solid #C0CAD5;\n}\n.label {\n  color: #777777;\n}\n</style>\n\n<form method=\"POST\" action=\"https://login.vk.com/?act=login&soft=1&utf8=1\">\n<input type=\"hidden\" name=\"q\" value=\"1\">\n<input type=\"hidden\" name=\"from_host\" value=\"oauth.vk.com\">\n<input type=\"hidden\" name=\"from_protocol\" value=\"http\">\n<input type=\"hidden\" name=\"ip_h\" value=\"670993b49983a18c93\" />\n<input type=\"hidden\" name=\"to\" value=\"aHR0cDovL29hdXRoLnZrLmNvbS9vYXV0aC9hdXRob3JpemU/Y2xpZW50X2lkPTMwODIyNjYmcmVkaXJlY3RfdXJpPWJsYW5rLmh0bWwmcmVzcG9uc2VfdHlwZT10b2tlbiZzY29wZT04MTkyJnN0YXRlPSZkaXNwbGF5PXdhcA--\">\n<span class=\"label\">\208\162\208\181\208\187\208\181\209\132\208\190\208\189 \208\184\208\187\208\184 e-mail:</span><br />\n<input type=\"text\" name=\"email\"><br />\n<span class=\"label\">\208\159\208\176\209\128\208\190\208\187\209\140:</span><br />\n<input type=\"password\" name=\"pass\">\n<div style=\"padding: 8px 0px 5px 0px\">\n<div class=\"button_yes\">\n  <input type=\"submit\" value=\"\208\146\208\190\208\185\209\130\208\184\" />\n</div>\n<a class=\"button_no\" href=\"https://oauth.vk.com/grant_access?hash=c3ebb24fc8c8def60f&client_id=3082266&settings=8192&redirect_uri=blank.html&cancel=1&state=&token_type=0\">\n  <div>\n  \208\158\209\130\208\188\208\181\208\189\208\176\n  </div>\n</a>\n</form>\n</div>\n  </div>\n  <div style=\"border-top: 1px solid #DDD; margin: 0 1px 7px 1px;\"></div>\n  \n  <a href=\"http://m.vkontakte.ru\">\208\191\208\181\209\128\208\181\208\185\209\130\208\184 \208\186 \209\129\208\176\208\185\209\130\209\131</a>\n</div>\n</body>"
-
-
-test_uri :: Uri
-test_uri = Uri {_relative = False, _scheme = "http", _authority = Authority {__userinfo = "", __host = Hostname {__domain = Domain {__parts = ["oauth","vk","com"]}}, __port = Nothing}, __path = Path {__segments = ["","blank.html"]}, __query = "", __fragment = "access_token=ab266e7cfb6db4e5ab99513d4aab048f09aab2bab2ba713c89d4d95b37ad4f6&expires_in=86400&user_id=911727"} 
-
diff --git a/src/Test/Debug.hs b/src/Test/Debug.hs
deleted file mode 100644
--- a/src/Test/Debug.hs
+++ /dev/null
@@ -1,19 +0,0 @@
--- FIXME: in order debug to work
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module Test.Debug where
-
-import Control.Monad
-import Control.Monad.Trans
-
-class Debug x where
-    debug :: (MonadIO m) => x -> m ()
-
-instance {-# OVERLAPPABLE #-} (Show x) => Debug x where
-    debug = liftIO . putStrLn . show . show
-
-instance {-# OVERLAPPING #-} Debug String where
-    debug = liftIO . putStrLn . show
-
diff --git a/src/Text/HTML/TagSoup/Parsec.hs b/src/Text/HTML/TagSoup/Parsec.hs
deleted file mode 100644
--- a/src/Text/HTML/TagSoup/Parsec.hs
+++ /dev/null
@@ -1,209 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-module Text.HTML.TagSoup.Parsec 
-   ( module Text.HTML.TagSoup
-   , TagParser
-   , TagParserSt
-   , WholeTag 
-   , tParse
-   , tStParse
-   , openTag 
-   , maybeOpenTag
-   , eitherOpenTag
-   , notOpenTag
-   , allOpenTags
-   , wholeTag
-   , maybeWholeTag
-   , eitherWholeTag
-   , allWholeTags
-   , closeTag
-   , maybeCloseTag
-   , eitherCloseTag
-   , notCloseTag
-   , allCloseTags
-   , maybeP
-   , allP
-   , eitherP
-   )
-   where
-
-import Text.ParserCombinators.Parsec
-import Text.ParserCombinators.Parsec.Pos
-import Text.HTML.TagSoup
-
-import Text.StringLike
-
-import Data.Maybe
-import Data.Char
-
--- | A type represent the TagOpen, any inner tags , and the TagClose.
-type WholeTag str = (Tag str, [Tag str] , Tag str)
-
--- | The Tag parser, using Tag as the token.
-type TagParser str = GenParser (Tag str) ()
-
--- | A stateful tag parser
--- This is a new type alias to allow backwards compatibility with old code.
-type TagParserSt str u = GenParser (Tag str) u
-
--- | Used to invoke parsing of Tags.
-tParse :: (StringLike str, Show str) => TagParser str a -> [ Tag str ] -> a
-tParse p ts =
-   either ( error . show ) id $ parse p "tagsoup" ts
-
--- | Simply run a stateful tag parser
-tStParse :: (StringLike str, Show str) => TagParserSt str st a -> st -> [ Tag str ] -> a
-tStParse p state tos =
-   either ( error . show ) id $ runParser p state "tagsoup" tos
-      
-
--- Tag eater is the basic tag matcher, it increments the line number for each tag parsed.
-tagEater matcher =
-   tokenPrim show 
-             ( \ oldSp _ _ -> do 
-                  setSourceLine oldSp ( 1 + sourceLine oldSp )
-             )
-             matcher
-
--- make a string lowercase
-lowercase :: StringLike s => s -> s
-lowercase =
-   fromString . map toLower . toString
-
-
--- | openTag matches a TagOpen with the given name.  It is not case sensitive.
-openTag :: (StringLike str, Show str) => str -> TagParserSt str st (Tag str)
-openTag soughtName =
-   openTagMatch soughtName ( Just ) $ \ _ -> Nothing
-
--- | notOpenTag will match any tag which is not a TagOpen with the given name.  It is not case sensitive.
-notOpenTag :: (StringLike str, Show str) => str -> TagParserSt str st (Tag str)
-notOpenTag avoidName =
-   openTagMatch avoidName ( \ _ -> Nothing ) Just
-
--- openTagMatch is the higher order function which will receive a TagOpen, and call match if it matches the soughtName, and noMatch if it doesn't
-openTagMatch soughtName match noMatch =
-   tagEater $ \ tag ->
-                 case tag of
-                    t@( TagOpen tname atrs ) ->
-                       if lowercase tname == lowercase soughtName
-                          then
-                             match t
-                          else
-                             noMatch t
-                    t ->
-                       noMatch t
-
--- closeTagMatch is the higher order function which will receive a TagClose, and call match if it matches the soughtName and noMatch if it doesn't.
-closeTagMatch soughtName match noMatch =
-   tagEater $ \ tag ->
-                 case tag of
-                    t@( TagClose tname ) ->
-                       if lowercase tname == lowercase soughtName
-                          then
-                             match t
-                          else
-                             noMatch t
-                    t ->
-                       noMatch t
-
--- | wholeTag matches a TagOpen with the given name,
--- then all intervening tags,
--- until it reaches a TagClose with the given name.
--- It is not case sensitive.
-wholeTag :: (StringLike str, Show str) => str -> TagParserSt str st (WholeTag str)
-wholeTag soughtName = do
-   open <- openTag soughtName
-   ts <- many $ notCloseTag soughtName
-   close <- closeTag soughtName
-   return ( open , ts , close )
-
--- | closeTag matches a TagClose with the given name.  It is not case sensitive.
-closeTag :: (StringLike str, Show str) => str -> TagParserSt str st (Tag str)
-closeTag soughtName =
-   closeTagMatch soughtName ( Just ) $ \ _ -> Nothing
-
--- | notCloseTag will match any tag which is not a TagClose with the given name.  It is not case sensitive.
-notCloseTag :: (StringLike str, Show str) => str -> TagParserSt str st (Tag str)
-notCloseTag avoidName =
-   closeTagMatch avoidName ( \ _ -> Nothing ) Just
-
--- | maybeOpenTag will return `Just` the tag if it gets a TagOpen with he given name,
--- It will return `Nothing` otherwise.
--- It is not case sensitive.
-maybeOpenTag :: (StringLike str, Show str) => str -> TagParserSt str st ( Maybe (Tag str) )
-maybeOpenTag =
-   maybeP . openTag
-
--- | maybeCloseTag will return `Just` the tag if it gets a TagClose with he given name,
--- It will return `Nothing` otherwise.
--- It is not case sensitive.
-maybeCloseTag :: (StringLike str, Show str) => str -> TagParserSt str st ( Maybe (Tag str) )
-maybeCloseTag =
-   maybeP . closeTag
-
--- | maybeWholeTag will return `Just` the tag if it gets a WholeTag with he given name,
--- It will return `Nothing` otherwise.
--- It is not case sensitive.
-maybeWholeTag :: (StringLike str, Show str) => str -> TagParserSt str st ( Maybe (WholeTag str) )
-maybeWholeTag =
-   maybeP . wholeTag
-
--- | allOpenTags will return all TagOpen with the given name.
--- It is not case sensitive.
-allOpenTags :: (StringLike str, Show str) => str -> TagParserSt str st [ Tag str ]
-allOpenTags =
-   allP . maybeOpenTag
-
--- | allCloseTags will return all TagClose with the given name.
--- It is not case sensitive.
-allCloseTags :: (StringLike str, Show str) => str -> TagParserSt str st [ Tag str ]
-allCloseTags =
-   allP . maybeCloseTag
-
--- | allWholeTags will return all WholeTag with the given name.
--- It is not case sensitive.
-allWholeTags :: (StringLike str, Show str) => str -> TagParserSt str st [ WholeTag str ]
-allWholeTags =
-   allP . maybeWholeTag
-
--- | eitherP takes a parser, and becomes its `Either` equivalent -- returning `Right` if it matches, and `Left` of anyToken if it doesn't.
-eitherP :: Show tok => GenParser tok st a -> GenParser tok st ( Either tok a )
-eitherP p = do
-   try ( do t <- p
-            return $ Right t
-       ) <|> ( do t <- anyToken
-                  return $ Left t
-             )
--- | either a Right TagOpen or a Left arbitary tag.
-eitherOpenTag :: (StringLike str, Show str) => str -> TagParserSt str st ( Either (Tag str) (Tag str) )
-eitherOpenTag = 
-   eitherP . openTag
-
--- | either a Right TagClose or a Left arbitary tag.
-eitherCloseTag :: (StringLike str, Show str) => str -> TagParserSt str st ( Either (Tag str) (Tag str) )
-eitherCloseTag =
-   eitherP . closeTag
-
--- | either a Right WholeTag or a Left arbitary tag.
-eitherWholeTag :: (StringLike str, Show str) => str -> TagParserSt str st ( Either (Tag str) (WholeTag str) )
-eitherWholeTag = 
-   eitherP . wholeTag
-
--- | allP takes a parser which returns  a `Maybe` value, and returns a list of matching tokens.
-allP :: GenParser tok st ( Maybe a ) -> GenParser tok st [ a ]
-allP p = do
-   ts <- many p
-   let ls = 
-          catMaybes ts
-   return ls
-
--- | maybeP takes a parser, and becomes its `Maybe` equivalent -- returning `Just` if it matches, and `Nothing` if it doesn't.
-maybeP :: Show tok => GenParser tok st a -> GenParser tok st ( Maybe a )
-maybeP p =
-   try ( do t <- p
-            return $ Just t
-       ) <|> ( do anyToken
-                  return Nothing
-             )
-
-
diff --git a/src/Text/Namefilter.hs b/src/Text/Namefilter.hs
deleted file mode 100644
--- a/src/Text/Namefilter.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module Text.Namefilter 
-  ( namefilter
-  ) where
-
-import Data.Char
-import Data.List
-import Text.RegexPR
-
-trim_space = gsubRegexPR "^ +| +$" ""
-one_space = gsubRegexPR " +" " "
-normal_letters = filter (\c -> or [ isAlphaNum c , c=='-', c=='_', c==' ', c=='&'])
-html_amp = gsubRegexPR "&amp;" "&"
-no_html = gsubRegexPR re "" where
-  re = concat $ intersperse "|" [ "&[a-z]+;" , "&#[0-9]+;" ]
-
-namefilter :: String -> String
-namefilter = trim_space . one_space . normal_letters . no_html . html_amp
diff --git a/src/Text/PFormat.hs b/src/Text/PFormat.hs
deleted file mode 100644
--- a/src/Text/PFormat.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Text.PFormat 
-  ( pformat 
-  ) where
-
-import Data.List
-import Data.Maybe
-
--- | Example: pformat '%' [('%',"%"), ('w',"world")] "hello %% %x %w"
--- pformat' :: Char -> [(Char,String)] -> String -> String
--- pformat' x d s = reverse $ scan [] s where
---   scan h (c:m:cs)
---     | c == x = scan ((reverse $ fromMaybe (c:m:[]) (lookup m d))++h) cs
---     | otherwise = scan (c:h) (m:cs)
---   scan h (c:[]) = c:h
---   scan h [] = h
-
-pformat :: Char -> [(Char,a->String)] -> String -> a -> String
-pformat x d s a = reverse $ scan [] s where
-  scan h (c:m:cs)
-    | c == x = scan ((reverse $ fromMaybe (const $ c:m:[]) (lookup m d) $ a)++h) cs
-    | otherwise = scan (c:h) (m:cs)
-  scan h (c:[]) = c:h
-  scan h [] = h
-
diff --git a/src/VKNews.hs b/src/VKNews.hs
deleted file mode 100644
--- a/src/VKNews.hs
+++ /dev/null
@@ -1,134 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-
-module Main where
-
-import Control.Applicative
-import Control.Concurrent (threadDelay)
-import Control.Monad.Trans
-import Control.Monad.Reader
-import Control.Monad.State
-import Control.Monad.Error
-import Control.Monad
-import Data.Aeson
-import Data.Maybe
-import Data.Either
-import Data.Monoid
-import Data.Time.Clock
-import Options.Applicative
-import System.Environment
-import System.Exit
-import System.IO
-import Text.Printf
-import Text.RegexPR
-import Web.VKHS as VK hiding (api,api')
-import Web.VKHS.API.Monad as VK
-import Network.CURL730
-
-data Options = Options
-  { verb :: Verbosity
-  , application_id :: String
-  , access_token :: String
-  , vk_poll_interval_sec :: Int
-  , username :: String
-  , password :: String
-  -- , vk_group_id :: String
-  } deriving(Show)
-
-data Pirozhok = Pirozhok
-  { plines :: String
-  , pdate :: UTCTime
-  }
-
-pprint p = liftIO $ do
-  -- putStrLn (show $ pdate p)
-  putStr (plines p)
-
-type PState a = StateT UTCTime (VKAPI IO) a
-
-instance Error (String,Maybe a) where
-  strMsg s = (s,Nothing)
-
-pirozhok d' wr@(WR _ _ _ t _) = Pirozhok <$> poetry <*> date
-  where
-    poetry = txt >>= nonempty >>= four >>=
-             maxlet >>= (pure . unlines)
-    date = check (publishedAt wr) where
-      check d | d <= d' = oops $ "older than " ++ (show d')
-              | otherwise = pure d
-    txt = pure $ lines $ gsubRegexPR "<br>" "\n" $ takeWhile (/= '©') t
-    nonempty ls = pure $ filter (/=[]) ls
-    four ls | length ls >4 = oops "more than 4 lines"
-            | otherwise = pure ls
-    maxlet ls | (sum $ map length ls) > 250 = oops "more than 250 letters"
-              | otherwise = pure ls
-    oops s = throwError (s, Just wr)
-
-env_var_name = "VKNEWS_ACCESS_TOKEN"
-
-opts at = Options
-  <$> flag Normal Debug (long "verbose" <> help "Be verbose")
-  <*> strOption (long "application-id" <> short 'a' <> value vkhs_app_id <> help (printf "Application ID (can be set via %s)" env_var_name))
-  <*> strOption (long "access-token" <> short 't' <> value at <> help "Access token")
-  <*> option auto (long "poll-interval" <> short 'i' <> value 20 <> help "Poll interval [sec]")
-  <*> argument str (metavar "USERNAME" <> help "User name")
-  <*> strOption (metavar "STR" <> long "password" <> short 'p' <> value "-" <> help "Password")
-  -- <*> argument str (metavar "GROUPID" <> help "Vkontakte ID of the group to read the news from")
-  where
-    vkhs_app_id = "3128877"
-
-pirozhki = do
-  Response (SL len ws) <- lift $ VK.api' "wall.get" [("owner_id",gid_piro)]
-  d <- get
-  e <- ask
-  let ps = map (pirozhok d) ws
-  let d' = maxtime d (map pdate $ rights ps)
-  forM (lefts ps) $ \(s,wr) -> do
-    when (verbose e >= Trace) $ do
-      liftIO $ hPutStrLn stderr $ printf "Rejecting record %s. Reason: %s" (maybe "?" (show . wid) wr) s
-  when (d' > d) $ do
-    when (verbose e >= Trace) $ do
-      liftIO $ hPutStrLn stderr $ printf "Updating time to %s" (show d')
-    (put d')
-  return (rights ps)
-  where
-    maxtime d [] = d
-    maxtime d ps = maximum ps
-    gid_piro = "-28122932"
-
-cmd :: Options -> IO ()
-cmd (Options v apid at pollint u pass) = run $ do
-  forever $ do
-    ps <- pirozhki
-    forM ps $ \p -> do
-        pprint p
-        pmsg []
-    sleep_sec pollint
-
-    where
-
-      run vk = do
-        t <- getCurrentTime
-        let e = (VK.env apid u pass VK.allAccess) { verbose = v }
-        let ma = runStateT vk t
-        r <- runVKAPI ma ([],[],[]) e
-        case r of
-          Left er -> do
-            perror (show er)
-            exitFailure
-          Right ((a,_),_) -> return a
-
-      perror s = liftIO $ hPutStrLn stderr s
-
-      pmsg s = liftIO $ putStrLn s
-
-      sleep_sec s = liftIO $ threadDelay (1000 * 1000 * s)
-
-
-main :: IO ()
-main = withlib CURL730 $ do
-  hSetBuffering stdout NoBuffering
-  hSetBuffering stderr NoBuffering
-  at <- fromMaybe [] <$> lookupEnv env_var_name
-  execParser (info (opts at) idm) >>= cmd
-
diff --git a/src/VKQ.hs b/src/VKQ.hs
deleted file mode 100644
--- a/src/VKQ.hs
+++ /dev/null
@@ -1,291 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Main where
-
-import Control.Monad
-import Control.Exception (SomeException(..),catch,bracket)
-import Data.Aeson as A
-import Data.Label.Abstract
-import Data.List
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.UTF8 as U
-import Network.Protocol.Uri.Query
-import Options.Applicative
-import System.Directory
-import System.Exit
-import System.FilePath
-import System.Environment
-import System.IO
-import Text.Printf
-import Text.PFormat (pformat)
-import Text.Namefilter (namefilter)
-import Text.Show.Pretty as PP
-import Web.VKHS
-import Web.VKHS.Curl
-import Web.VKHS.API.Aeson as A
-import Web.VKHS.API.Base as STR
-import Network.CURL730
-
-data Options = Options
-  { verb :: Verbosity
-  , cmdOpts :: CmdOptions
-  } deriving(Show)
-
-data CmdOptions
-  = Login LoginOptions
-  | Call CallOptions
-  | Music MusicOptions
-  | UserQ UserOptions
-  | WallQ WallOptions
-  deriving(Show)
-
-data LoginOptions = LoginOptions
-  { appid :: String
-  , username :: String
-  , password :: String
-  } deriving(Show)
-
-data CallOptions = CO
-  { accessToken :: String
-  , parse :: Bool
-  , method :: String
-  , args :: String
-  } deriving(Show)
-
-data MusicOptions = MO
-  { accessToken_m :: String
-  , list_music :: Bool
-  , search_string :: String
-  , name_format :: String
-  , output_format :: String
-  , out_dir :: String
-  , records_id :: [String]
-  , skip_existing :: Bool
-  } deriving(Show)
-
-data UserOptions = UO
-  { accessToken_u :: String
-  , queryString :: String
-  } deriving(Show)
-
-data WallOptions = WO
-  { accessToken_w :: String
-  , woid :: String
-  } deriving(Show)
-
-loginOptions :: Parser CmdOptions
-loginOptions = Login <$> (LoginOptions
-  <$> strOption (metavar "APPID" <> short 'a' <> value "3128877" <> help "Application ID, defaults to VKHS" )
-  <*> argument str (metavar "USER" <> help "User name or email")
-  <*> argument str (metavar "PASS" <> help "User password"))
-
-opts m =
-  let access_token_flag = strOption (short 'a' <> m <> metavar "ACCESS_TOKEN" <>
-        help "Access token. Honores VKQ_ACCESS_TOKEN environment variable")
-  in Options
-  <$> flag Normal Debug (long "verbose" <> help "Be verbose")
-  <*> subparser (
-    command "login" (info loginOptions
-      ( progDesc "Login and print access token (also prints user_id and expiration time)" ))
-    <> command "call" (info (Call <$> (CO
-      <$> access_token_flag
-      <*> switch (long "preparse" <> short 'p' <> help "Preparse into Aeson format")
-      <*> argument str (metavar "METHOD" <> help "Method name")
-      <*> argument str (metavar "PARAMS" <> help "Method arguments, KEY=VALUE[,KEY2=VALUE2[,,,]]")))
-      ( progDesc "Call VK API method" ))
-    <> command "music" (info ( Music <$> (MO
-      <$> access_token_flag
-      <*> switch (long "list" <> short 'l' <> help "List music files")
-      <*> strOption
-        ( metavar "STR"
-        <> long "query" <> short 'q' <> value [] <> help "Query string")
-      <*> strOption
-        ( metavar "FORMAT"
-        <> short 'f'
-        <> value "%o_%i %u\t%t"
-        <> help "Listing format, supported tags: %i %o %a %t %d %u"
-        )
-      <*> strOption
-        ( metavar "FORMAT"
-        <> short 'F'
-        <> value "%a - %t"
-        <> help "FileName format, supported tags: %i %o %a %t %d %u"
-        )
-      <*> strOption (metavar "DIR" <> short 'o' <> help "Output directory" <> value "")
-      <*> many (argument str (metavar "RECORD_ID" <> help "Download records"))
-      <*> flag False True (long "skip-existing" <> help "Don't download existing files")
-      ))
-      ( progDesc "List or download music files"))
-    <> command "user" (info ( UserQ <$> (UO
-      <$> access_token_flag
-      <*> strOption (long "query" <> short 'q' <> help "String to query")
-      ))
-      ( progDesc "Extract various user information"))
-    <> command "wall" (info ( WallQ <$> (WO
-      <$> access_token_flag
-      <*> strOption (long "id" <> short 'i' <> help "Owner id")
-      ))
-      ( progDesc "Extract wall information"))
-    )
-
-api_ :: (A.FromJSON a) => Env CallEnv -> String -> [(String,String)] -> IO a
-api_ a b c = do
-  r <- A.api' a b c
-  case r of
-    Right x -> return x
-    Left e -> hPutStrLn stderr (show e) >> exitFailure
-
-api_str :: Env CallEnv -> String -> [(String,String)] -> IO String
-api_str a b c = do
-  r <- STR.api a b c
-  case r of
-    Right x -> return (U.toString x)
-    Left e -> hPutStrLn stderr e >> exitFailure
-
-mr_format :: String -> MusicRecord -> String
-mr_format s mr = pformat '%'
-  [ ('i', show . aid)
-  , ('o', show . owner_id)
-  , ('a', namefilter . artist)
-  , ('t', namefilter . title)
-  , ('d', show . duration)
-  , ('u', url)
-  ] s mr
-
-ifeither e fl fr = either fl fr e
-
-errexit e = hPutStrLn stderr e >> exitFailure
-
-checkRight (Left e) = hPutStrLn stderr e >> exitFailure
-checkRight (Right a) = return a
-
-main :: IO ()
-main = withlib CURL730 $ do
-  m <- maybe (idm) (value) <$> lookupEnv "VKQ_ACCESS_TOKEN"
-  execParser (info (helper <*> opts m) (fullDesc <> header "Vkontakte social network tool")) >>= cmd
-  `catch` (\(e::SomeException) -> do
-    putStrLn $ (show e)
-    putStrLn $ "NOTE: make sure that libcurl.so is accessible (e.g. by setting LD_LIBRARY_PATH variable)" )
-
-cmd :: Options -> IO ()
-
--- Login
-cmd (Options v (Login (LoginOptions a u p))) = do
-  let e = (env a u p allAccess) { verbose = v }
-  ea <- login e
-  ifeither ea errexit $ \(at,usrid,expin) -> do
-    printf "%s %s %s\n" at usrid expin
-
--- Call user-specified API
-cmd (Options v (Call (CO act pp mn as))) = do
-  let e = (envcall act) { verbose = v }
-  let s = fw (keyValues "," "=") as
-  case pp of
-    False -> do
-      ea <- api_str e mn s
-      putStrLn (show ea)
-    True -> do
-      (ea :: A.Value) <- api_ e mn s
-      putStrLn $ PP.ppShow ea
-
--- Query audio files
-cmd (Options v (Music (MO act _ q@(_:_) fmt _ _ _ _))) = do
-  let e = (envcall act) { verbose = v }
-  Response (SL len ms) <- api_ e "audio.search" [("q",q)]
-  forM_ ms $ \m -> do
-    printf "%s\n" (mr_format fmt m)
-  printf "total %d\n" len
-
--- List audio files
-cmd (Options v (Music (MO act True [] fmt _ _ _ _))) = do
-  let e = (envcall act) { verbose = v }
-  Response (ms :: [MusicRecord]) <- api_ e "audio.get" []
-  forM_ ms $ \m -> do
-    printf "%s\n" (mr_format fmt m)
-cmd (Options _ (Music (MO _ False [] _ _ _ [] _))) = do
-  errexit "Music record ID is not specified (see --help)"
-
--- Download audio files
-cmd (Options v (Music (MO act False [] _ ofmt odir rid sk))) = do
-  let e = (envcall act) { verbose = v }
-  Response (ms :: [MusicRecord]) <- api_ e "audio.getById" [("audios", concat $ intersperse "," rid)]
-  forM_ ms $ \m -> do
-    (fp, mh) <- openFileMR odir sk ofmt m
-    case mh of
-      Just h -> do
-        r <- vk_curl_file e (url m) $ \ bs -> do
-          BS.hPut h bs
-        checkRight r
-        printf "%d_%d\n" (owner_id m) (aid m)
-        printf "%s\n" (title m)
-        printf "%s\n" fp
-      Nothing -> do
-        hPutStrLn stderr (printf "File %s already exist, skipping" fp)
-    return ()
-
-cmd (Options v (UserQ (UO act qs))) = do
-  let e = (envcall act) { verbose = v }
-  print qs
-  ea <- A.api e "users.search" [("q",qs),("fields","uid,first_name,last_name,photo,education")]
-  putStrLn $ show ea
-  -- ae <- checkRight ea
-  -- processUQ uo ae
-
--- List wall messages
-cmd (Options v (WallQ (WO act oid))) = do
-  let e = (envcall act) { verbose = v }
-  (Response (SL len ws)) <- api_ e "wall.get" [("owner_id",oid)]
-  forM_ ws $ \w -> do
-    putStrLn (show $ wdate w)
-    putStrLn (wtext w)
-  printf "total %d\n" len
-
-type NameFormat = String
-
--- Open file. Return filename and handle. Don't open file if it exists
-openFileMR :: FilePath -> Bool -> NameFormat -> MusicRecord -> IO (FilePath, Maybe Handle)
-openFileMR [] _ _ m = do
-  let (_,ext) = splitExtension (url m)
-  temp <- getTemporaryDirectory
-  (fp,h) <- openBinaryTempFile temp ("vkqmusic"++ext)
-  return (fp, Just h)
-openFileMR dir sk fmt m = do
-  let (_,ext) = splitExtension (url m)
-  let name = mr_format fmt m
-  let name' = replaceExtension name (takeWhile (/='?') ext)
-  let fp =  (dir </> name')
-  e <- doesFileExist fp
-  case (e && sk) of
-    True -> do
-      return (fp,Nothing)
-    False -> do
-      h <- openBinaryFile fp WriteMode
-      return (fp,Just h)
-
--- data Collection a = MC {
---   response :: [a]
---   } deriving (Show,Data,Typeable)
-
--- processMC :: MusicOptions -> Collection MusicRecord -> IO ()
--- processMC (MO _ _ _) (MC r) = do
---   forM_ r $ \m -> do
---     printf "%d_%d|%s|%s|%s\n" (owner_id m) (aid m) (artist m) (title m) (url m)
-
--- processMC (MO _ rid False) (MC r) = do
---   print r
-
--- parseUsers :: JSValue -> Maybe [JSValue]
--- parseUsers (JSObject (JSONObject [("response",(JSArray a))])) = Just a
--- parseUsers _ = Nothing
-
--- processUQ :: UserOptions -> JSValue -> IO ()
--- processUQ (UO _ _) j = do
-  -- let (Just u) = parseUsers j
-  -- a <- fromJS (u !! 1)
-  -- print $ show (a :: UserRecord)
-  -- print $ show $ j
-
-
diff --git a/src/Web/VKHS.hs b/src/Web/VKHS.hs
--- a/src/Web/VKHS.hs
+++ b/src/Web/VKHS.hs
@@ -1,85 +1,120 @@
-{- |
-Module      :  Web.VKHS
-Copyright   :  (c) Sergey Mironov <ierton@gmail.com> 2012
-License     :  BSD-style (see the file LICENSE)
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Web.VKHS where
 
-Maintainer  :  ierton@gmail.com
-Stability   :  experimental
-Portability :  non-portable (multi-parameter type classes)
+import Data.List
+import Data.Maybe
+import Data.Time
+import Data.Either
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State (MonadState, execState, evalStateT, StateT(..), get, modify)
+import Control.Monad.Cont
+import Control.Monad.Reader
+import Control.Monad.Trans.Either
 
-[@VKHS@]
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
 
-VKHS is written in Haskell and provides access to Vkontakte <http://vk.com>
-social network, popular mainly in Russia. Library can be used to login into the
-network as a standalone application (OAuth implicit flow as they call it).
-Interaction with user is not required. For now, vkhs offers limited error
-detection and no captcha support.
+import System.IO
 
-Following example illustrates basic usage (please fill client_id, email and
-password with correct values):
+import Web.VKHS.Error
+import Web.VKHS.Types
+import Web.VKHS.Client as Client
+import Web.VKHS.Monad
+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.Login
->   import Web.VKHS.API
->
->   main = do
->       let client_id = "111111"
->       let e = env client_id "user@example.com" "password" [Photos,Audio,Groups]
->       (Right at) <- login e
->
->       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
+import Debug.Trace
 
-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>.
+{- Test -}
 
-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.
+data State = State {
+    cs :: ClientState
+  , ls :: LoginState
+  , as :: APIState
+  , go :: GenericOptions
+  }
 
-[@Debugging@]
+instance ToLoginState State where
+  toLoginState = ls
+  modifyLoginState f = \s -> s { ls = f (ls s) }
+instance ToClientState State where
+  toClientState = cs
+  modifyClientState f = \s -> s { cs = f (cs s) }
+instance API.ToAPIState State where
+  toAPIState = as
+  modifyAPIState f = \s -> s { as = f (as s) }
+instance ToGenericOptions State where
+  toGenericOptions = go
 
-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.
+initialState :: GenericOptions -> EitherT String IO State
+initialState go = State
+  <$> lift (Client.defaultState go)
+  <*> pure (Login.defaultState go)
+  <*> pure (API.defaultState)
+  <*> pure go
 
-To deal with that potential problem, I\'ve included some debugging facilities:
-changing:
 
-writing
+newtype VK r a = VK { unVK :: Guts VK (StateT State (EitherT String IO)) r a }
+  deriving(MonadIO, Functor, Applicative, Monad, MonadState State, MonadReader (r -> VK r r) , MonadCont)
 
->       (Right at) <- login e { verbose = Debug }
+instance MonadClient (VK r) State
+instance MonadVK (VK r) r
+instance MonadLogin (VK r) r State
+instance API.MonadAPI (VK r) r State
 
-will trigger curl output plus html dumping to the current directory. Please,
-mail those .html to me if problem appears.
+type Guts x m r a = ReaderT (r -> x r r) (ContT r m) a
 
-[@Limitations@]
+runVK :: VK r r -> StateT State (EitherT String IO) r
+runVK m = runContT (runReaderT (unVK (catch m)) undefined) return
 
-    * Ignores \'Invalid password\' answers
+defaultSuperviser :: (Show a) => VK (R VK a) (R VK a) -> StateT State (EitherT String IO) a
+defaultSuperviser = go where
+  go m = do
+    GenericOptions{..} <- toGenericOptions <$> get
+    res <- runVK m
+    res_desc <- pure (describeResult res)
+    case res of
+      Fine a -> return a
+      UnexpectedInt e k -> do
+        alert "UnexpectedInt (ignoring)"
+        go (k 0)
+      UnexpectedFormField (Form tit f) i k -> do
+        alert $ "While filling form " ++ (printForm "" f)
+        case o_allow_interactive of
+          True -> do
+            v <- do
+              alert $ "Please, enter the correct value for input " ++ i ++ " : "
+              liftIO $ getLine
+            go (k v)
+          False -> do
+            alert $ "Unable to query value for " ++ i ++ " since interactive mode is disabled"
+            lift $ left res_desc
+      _ -> do
+        alert $ "Unsupervised error: " ++ res_desc
+        lift $ left res_desc
 
-    * Captchas are treated as errors
+runLogin go = do
+  s <- initialState go
+  evalStateT (defaultSuperviser (login >>= return . Fine)) s
 
-    * Implicit-flow authentication, see documentation in
-      Russian <http://vk.com/developers.php>
-      for details
 
-    * Probably, low speed due to restarting curl session on every request. But
-      anyway, vk.com limits request rate to 3 per second.
-
--}
-
-module Web.VKHS
-    ( module Web.VKHS.Login
-    , module Web.VKHS.Types
-    , module Web.VKHS.API
-    ) where
+runAPI go@GenericOptions{..} m = do
+  s <- initialState go
+  flip evalStateT s $ do
+  case (null l_access_token) of
+    True -> do
+      AccessToken{..} <- defaultSuperviser (login >>= return . Fine)
+      modify $ modifyAPIState (\as -> as{api_access_token = at_access_token})
+    False -> do
+      modify $ modifyAPIState (\as -> as{api_access_token = l_access_token})
+  defaultSuperviser (m >>= return . Fine)
 
-import Web.VKHS.Types
-import Web.VKHS.Login
-import Web.VKHS.API
 
diff --git a/src/Web/VKHS/API.hs b/src/Web/VKHS/API.hs
--- a/src/Web/VKHS/API.hs
+++ b/src/Web/VKHS/API.hs
@@ -1,6 +1,117 @@
-module Web.VKHS.API
-    ( module Web.VKHS.API.Aeson
-    ) where
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
 
-import Web.VKHS.API.Aeson
+module Web.VKHS.API where
+
+import Data.List
+import Data.Maybe
+import Data.Time
+import Data.Either
+import Control.Category ((>>>))
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Writer
+import Control.Monad.Cont
+
+import Data.ByteString.Char8 (ByteString)
+import Data.ByteString.Lazy (fromStrict)
+import qualified Data.ByteString.Char8 as BS
+
+import Data.Aeson ((.=), (.:))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
+
+import Text.Printf
+
+import Web.VKHS.Types
+import Web.VKHS.Client
+import Web.VKHS.Monad
+import Web.VKHS.Error
+
+import Debug.Trace
+
+data APIState = APIState {
+    api_access_token :: String
+  } deriving (Show)
+
+defaultState = APIState {
+    api_access_token = []
+  }
+
+class ToGenericOptions s => ToAPIState s where
+  toAPIState :: s -> APIState
+  modifyAPIState :: (APIState -> APIState) -> (s -> s)
+
+class (MonadIO m, MonadClient m s, ToAPIState s, MonadVK m r) => MonadAPI m r s | m -> s
+
+-- | Invoke the request. Return answer (normally, string representation of
+-- JSON data). See documentation:
+--
+-- <http://vk.com/developers.php?oid=-1&p=%D0%9E%D0%BF%D0%B8%D1%81%D0%B0%D0%BD%D0%B8%D0%B5_%D0%BC%D0%B5%D1%82%D0%BE%D0%B4%D0%BE%D0%B2_API>
+-- api :: Env CallEnv
+--     -- ^ the VKHS environment
+--     -> String
+--     -- ^ API method name
+--     -> [(String, String)]
+--     -- ^ API method parameters (name-value pairs)
+--     -> IO (Either String BS.ByteString)
+-- api e mn mp =
+--   let uri = showUri $ (\f -> f $ toUri $ printf "https://api.vk.com/method/%s" mn) $
+--               set query $ bw params (("access_token",(access_token . sub) e):mp)
+--   in vk_curl_payload e (tell [CURLOPT_URL uri])
+
+
+type API m x a = m (R m x) a
+
+parseJSON :: (MonadAPI (m (R m x)) (R m x) s)
+    => ByteString
+    -> API m x JSON
+parseJSON bs = do
+  case Aeson.decode (fromStrict bs) of
+    Just js -> return (JSON js)
+    Nothing -> raise (JSONParseFailure bs)
+
+apiJ :: (MonadAPI (m (R m x)) (R m x) s)
+    => String
+    -- ^ API method name
+    -> [(String, String)]
+    -- ^ API method arguments
+    -> API m x JSON
+apiJ mname margs = do
+  GenericOptions{..} <- gets toGenericOptions
+  APIState{..} <- gets toAPIState
+  let protocol = (case o_use_https of
+                    True -> "https"
+                    False -> "http")
+  url <- ensure $ pure
+        (urlCreate
+          (URL_Protocol protocol)
+          (URL_Host o_api_host)
+          (Just (URL_Port (show o_port)))
+          (URL_Path ("/method/" ++ mname))
+          (buildQuery (("access_token", api_access_token):margs)))
+
+  debug $ "> " ++ (show url)
+
+  req <- ensure (requestCreateGet url (cookiesCreate ()))
+  (res, jar') <- requestExecute req
+  parseJSON (responseBody res)
+
+
+api :: (Aeson.FromJSON a, MonadAPI (m (R m x)) (R m x) s)
+    => String
+    -- ^ API method name
+    -> [(String, String)]
+    -- ^ API method arguments
+    -> API m x a
+api m args = do
+  j@JSON{..} <- apiJ m args
+  case Aeson.parseEither Aeson.parseJSON js_aeson of
+    Right a -> return a
+    Left e -> terminate (JSONParseFailure' j e)
 
diff --git a/src/Web/VKHS/API/Aeson.hs b/src/Web/VKHS/API/Aeson.hs
deleted file mode 100644
--- a/src/Web/VKHS/API/Aeson.hs
+++ /dev/null
@@ -1,93 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Web.VKHS.API.Aeson
-  ( api
-  , api'
-  , Base.envcall
-  , APIError(..)
-  , module Web.VKHS.API.Types
-  ) where
-
-import Control.Applicative
-import Control.Monad.Error
-
-import Data.Aeson as A
-import Data.Aeson.Types as A
-import Data.Aeson.Parser as AG
-import Data.ByteString.Lazy as BS
-import Data.Data
-import Data.Vector as V (head, tail)
-import Text.Printf
-import Web.VKHS.Types
-import Web.VKHS.API.Types
-import qualified Web.VKHS.API.Base as Base
-
-parseJSON_obj_error :: String -> A.Value -> A.Parser a
-parseJSON_obj_error name o = fail $
-  printf "parseJSON: %s expects object, got %s" (show name) (show o)
-
-parseJSON_arr_error :: String -> A.Value -> A.Parser a
-parseJSON_arr_error name o = fail $
-  printf "parseJSON: %s expects array, got %s" (show name) (show o)
-
-instance (FromJSON a) => FromJSON (Response a) where
-  parseJSON (A.Object v) = do
-    a <- v .: "response"
-    x <- A.parseJSON a
-    return (Response x)
-  parseJSON o = parseJSON_obj_error "Response" o
-
-parseGeneric :: (FromJSON a,Data a) => A.Value -> A.Parser a
-parseGeneric val =
-  case A.fromJSON val of
-    A.Success a -> return a
-    A.Error s -> fail $ "parseGeneric fails:" ++ s
-
-instance FromJSON MusicRecord where
-  parseJSON = parseGeneric
-
-instance FromJSON WallRecord where
-  parseJSON (Object o) =
-    WR <$> (o .: "id")
-       <*> (o .: "to_id")
-       <*> (o .: "from_id")
-       <*> (o .: "text")
-       <*> (o .: "date")
-  parseJSON o = parseJSON_obj_error "WallRecord" o
-
-instance (FromJSON a) => FromJSON (SizedList a) where
-  parseJSON (A.Array v) = do
-    n <- A.parseJSON (V.head v)
-    t <- A.parseJSON (A.Array (V.tail v))
-    return (SL n t)
-  parseJSON o = parseJSON_arr_error "SizedList" o
-
-instance FromJSON RespError where
-  parseJSON (Object o) = do
-    (Object e) <- o .: "error"
-    ER <$> (e .: "error_code")
-       <*> (e .: "error_msg")
-  parseJSON o = parseJSON_obj_error "RespError" o
-
-data APIError = APIE_resp RespError | APIE_other String | APIE_badAccessToken
-  deriving(Show)
-
-instance Error APIError where
-  strMsg x =  APIE_other x
-
-api' :: (A.FromJSON a) => Env CallEnv -> String -> [(String,String)] -> IO (Either APIError a)
-api' env mn mp
-  | Prelude.null ((access_token . sub) env) = return (Left APIE_badAccessToken)
-  | otherwise = runErrorT $ do
-    e <- BS.fromStrict <$> ErrorT (either (Left . APIE_other) (Right . id) <$> (Base.api env mn mp))
-    case (A.decode e) of
-      Just x -> return x
-      Nothing -> do
-        case (A.decode e) of
-          Just x -> throwError (APIE_resp x)
-          Nothing -> throwError $ APIE_other $ "AESON: error parsing JSON: " ++ show e
-
-api :: Env CallEnv -> String -> [(String,String)] -> IO (Either APIError A.Value)
-api = api'
-
diff --git a/src/Web/VKHS/API/Base.hs b/src/Web/VKHS/API/Base.hs
deleted file mode 100644
--- a/src/Web/VKHS/API/Base.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-module Web.VKHS.API.Base
-    ( api
-    , envcall
-    )  where
-
-import Control.Monad ()
-import Control.Monad.Error ()
-import Control.Monad.Writer
-import Control.Monad.Trans ()
-
-import Data.Label
-import qualified Data.ByteString.UTF8 as U
-import qualified Data.ByteString as BS
-
-import Network.CURL730
-
-import Network.Protocol.Http ()
-import Network.Protocol.Uri
-import Network.Protocol.Uri.Query ()
-
-import Text.Printf
-
-import Web.VKHS.Types
-import Web.VKHS.Curl
-
-envcall :: String -> Env CallEnv
-envcall at = mkEnv (CallEnv at)
-
--- | Invoke the request. Return answer (normally, string representation of
--- JSON data). See documentation:
---
--- <http://vk.com/developers.php?oid=-1&p=%D0%9E%D0%BF%D0%B8%D1%81%D0%B0%D0%BD%D0%B8%D0%B5_%D0%BC%D0%B5%D1%82%D0%BE%D0%B4%D0%BE%D0%B2_API>
-api :: Env CallEnv
-    -- ^ the VKHS environment
-    -> String
-    -- ^ API method name
-    -> [(String, String)]
-    -- ^ API method parameters (name-value pairs)
-    -> IO (Either String BS.ByteString)
-api e mn mp =
-  let uri = showUri $ (\f -> f $ toUri $ printf "https://api.vk.com/method/%s" mn) $
-              set query $ bw params (("access_token",(access_token . sub) e):mp)
-  in vk_curl_payload e (tell [CURLOPT_URL uri])
-
-
diff --git a/src/Web/VKHS/API/Monad.hs b/src/Web/VKHS/API/Monad.hs
deleted file mode 100644
--- a/src/Web/VKHS/API/Monad.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Web.VKHS.API.Monad
-  ( api
-  , api'
-  , runVKAPI
-  , VKAPI(..)
-  , module Web.VKHS.API.Types
-  ) where
-
-import Control.Applicative
-import Control.Monad.Error
-import Control.Monad.State
-import Control.Monad.Reader
-import Control.Concurrent (threadDelay)
-import Data.Aeson as A
-
-import Web.VKHS.API.Types
-import qualified Web.VKHS.API.Aeson as VK
-import qualified Web.VKHS.Login as VK
-import Web.VKHS as VK (callEnv, Env(..), LoginEnv(..), AccessToken, APIError(..))
-
-newtype VKAPI m a = VKAPI { unVKAPI :: ReaderT (Env LoginEnv) (StateT AccessToken (ErrorT APIError m)) a }
-  deriving(Monad, Applicative, Functor, MonadIO, MonadState AccessToken, MonadReader (Env LoginEnv), MonadError APIError)
-
-runVKAPI :: (MonadIO m) => VKAPI m a -> VK.AccessToken -> Env LoginEnv -> m (Either VK.APIError (a,AccessToken))
-runVKAPI m at e = runErrorT (runStateT (runReaderT (unVKAPI m) e) at)
-
-shallTryRelogin :: APIError -> Bool
-shallTryRelogin (APIE_other _) = False
-shallTryRelogin _ = True
-
--- TODO: report whole error stack
-apiRetryWrapper :: (A.FromJSON a, MonadIO m) => Int -> String -> [(String,String)] -> VKAPI m a
-apiRetryWrapper nr name args = do
-  e <- ask
-  (at,_,_) <- get
-  r <- liftIO $ VK.api' (callEnv e at) name args
-  case (nr,r) of
-    (0, Left er) -> throwError er
-    (x, Left er)
-      | shallTryRelogin er -> do
-        res <- liftIO $ VK.login e
-        case res of
-          Left err -> throwError (VK.APIE_other err)
-          Right at' -> do
-            put at' >> apiRetryWrapper (x-1) name args
-      | otherwise  -> throwError er
-    (_, Right a) -> return a
-
-apiForewerWrapper :: (A.FromJSON a, MonadIO m) => String -> [(String,String)] -> VKAPI m a
-apiForewerWrapper name args = do
-  e <- ask
-  let call_api = do
-        (at,_,_) <- get
-        r <- liftIO $ VK.api' (callEnv e at) name args
-        case r of
-          (Left _) -> do_login
-          (Right a) -> return a
-      do_login = do
-        sleep 3
-        r <- liftIO $ VK.login e
-        case r of
-          Left _ -> do_login
-          Right at' -> put at' >> call_api
-      sleep x = 
-        liftIO $ threadDelay (1000 * 1000 * x); -- convert sec to us
-  call_api
-
-api' :: (A.FromJSON a, MonadIO m) => String -> [(String,String)] -> VKAPI m a
-api' = apiForewerWrapper
-
-api :: (MonadIO m) => String -> [(String,String)] -> VKAPI m A.Value
-api = api'
-
diff --git a/src/Web/VKHS/API/Types.hs b/src/Web/VKHS/API/Types.hs
deleted file mode 100644
--- a/src/Web/VKHS/API/Types.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
-module Web.VKHS.API.Types where
-
-import Data.Typeable
-import Data.Data
-import Data.Time.Clock
-import Data.Time.Clock.POSIX
-
-newtype Response a = Response a
-  deriving (Show)
-
-data SizedList a = SL Int [a]
-
-data MusicRecord = MR
-  { aid :: Int
-  , owner_id :: Int
-  , artist :: String
-  , title :: String
-  , duration :: Int
-  , url :: String
-  } deriving (Show, Data, Typeable)
-
-
-data UserRecord = UR
-  { uid :: Int
-  , first_name :: String
-  , last_name :: String
-  , photo :: String
-  , university :: Maybe Int
-  , university_name :: Maybe String
-  , faculty :: Maybe Int
-  , faculty_name :: Maybe String
-  , graduation :: Maybe Int
-  } deriving (Show, Data, Typeable)
-
-data WallRecord = WR
-  { wid :: Int
-  , to_id :: Int
-  , from_id :: Int
-  , wtext :: String
-  , wdate :: Int
-  } deriving (Show)
-
-publishedAt :: WallRecord -> UTCTime
-publishedAt wr = posixSecondsToUTCTime $ fromIntegral $ wdate wr
-
-data RespError = ER
-  { error_code :: Int
-  , error_msg :: String
-  } deriving (Show)
-
diff --git a/src/Web/VKHS/Client.hs b/src/Web/VKHS/Client.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/VKHS/Client.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Web.VKHS.Client where
+
+import Data.List
+import Data.Maybe
+import Data.Time
+import Data.Either
+import Control.Applicative
+import Control.Arrow ((***))
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Cont
+import Data.Default.Class
+import qualified Data.CaseInsensitive as CI
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.List.Split
+
+import Control.Concurrent (threadDelay)
+
+import System.IO as IO
+import System.IO.Unsafe as IO
+import System.Clock as Clock
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+
+import Network.HTTP.Client ()
+import Network.HTTP.Client.Internal (setUri)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
+import qualified Network.HTTP.Types as Client
+import qualified Network.HTTP.Client as Client
+import qualified Network.HTTP.Client.Internal as Client
+import qualified Network.URI as Client
+import qualified Network.Shpider.Forms as Shpider
+
+import Pipes.Prelude as PP (foldM)
+import qualified Pipes as Pipes (Producer(..), for, runEffect, (>->))
+import qualified Pipes.HTTP as Pipes hiding (Request, Response)
+
+import qualified Text.Parsec as Parsec
+
+import Debug.Trace
+
+import Web.VKHS.Types
+
+data Error = ErrorParseURL { euri :: String, emsg :: String }
+           | ErrorSetURL { eurl :: URL, emsg :: String }
+  deriving(Show, Eq)
+
+{-
+ __  __                       _
+|  \/  | ___  _ __   __ _  __| |
+| |\/| |/ _ \| '_ \ / _` |/ _` |
+| |  | | (_) | | | | (_| | (_| |
+|_|  |_|\___/|_| |_|\__,_|\__,_|
+-}
+
+data ClientState = ClientState {
+    cl_man :: Client.Manager
+  , cl_last_execute :: TimeSpec
+  , cl_minimum_interval_ns :: Integer
+  }
+
+defaultState :: GenericOptions -> IO ClientState
+defaultState GenericOptions{..} = do
+  cl_man <- Client.newManager
+              (Client.managerSetProxy (Client.proxyEnvironment Nothing)
+                (case o_use_https of
+                  True -> tlsManagerSettings
+                  False -> Client.defaultManagerSettings))
+  cl_last_execute <- pure (TimeSpec 0 0)
+  cl_minimum_interval_ns <- pure (round (10^9  / o_max_request_rate_per_sec))
+  return ClientState{..}
+
+class ToClientState s where
+  toClientState :: s -> ClientState
+  modifyClientState :: (ClientState -> ClientState) -> (s -> s)
+
+class (MonadIO m, MonadState s m, ToClientState s) => MonadClient m s | m -> s
+
+-- newtype ClientT m a = ClientT { unClient :: StateT ClientState m a }
+--   deriving(Functor, Applicative, Monad, MonadState ClientState, MonadIO)
+
+-- runClient :: (MonadIO m) => ClientT m a -> m a
+-- runClient l = do
+--   cl_man <- liftIO $ newManager defaultManagerSettings
+--   evalStateT (unClient l) ClientState{..}
+
+-- liftClient :: (Monad m) => m a -> ClientT m a
+-- liftClient = ClientT . lift
+
+{-
+ _   _ ____  _
+| | | |  _ \| |
+| | | | |_) | |
+| |_| |  _ <| |___
+ \___/|_| \_\_____|
+-}
+
+newtype URL_Protocol = URL_Protocol { urlproto :: String }
+  deriving(Show)
+newtype URL_Query = URL_Query { urlq :: String }
+  deriving(Show)
+newtype URL_Host = URL_Host { urlh :: String }
+  deriving(Show)
+newtype URL_Port = URL_Port { urlp :: String }
+  deriving(Show)
+newtype URL_Path = URL_Path { urlpath :: String }
+  deriving(Show)
+newtype URL = URL { uri :: Client.URI }
+  deriving(Show, Eq)
+
+buildQuery :: [(String,String)] -> URL_Query
+buildQuery qis = URL_Query ("?" ++ intercalate "&" (map (\(a,b) -> (esc a) ++ "=" ++ (esc b)) qis)) where
+  esc x = Client.escapeURIString Client.isAllowedInURI x
+
+urlCreate :: URL_Protocol -> URL_Host -> Maybe URL_Port -> URL_Path -> URL_Query -> Either Error URL
+urlCreate URL_Protocol{..} URL_Host{..} port  URL_Path{..} URL_Query{..} =
+  pure $ URL $ Client.URI (urlproto ++ ":") (Just (Client.URIAuth "" urlh (maybe "" ((":"++).urlp) port))) urlpath urlq []
+
+urlFromString :: String -> Either Error URL
+urlFromString s =
+  case Client.parseURI s of
+    Nothing -> Left (ErrorParseURL s "Client.parseURI failed")
+    Just u -> Right (URL u)
+
+splitFragments :: String -> String -> String -> [(String,String)]
+splitFragments sep eqs =
+    filter (\(a, b) -> not (null a))
+  . map (f . splitOn eqs)
+  . concat
+  . map (splitOn sep)
+  . lines
+  where f []     = ("", "")
+        f [x]    = (trim x, "")
+        f (x:xs) = (trim x, trim $ intercalate eqs xs)
+
+        trim = rev (dropWhile (`elem` (" \t\n\r" :: String)))
+          where rev f = reverse . f . reverse . f
+
+urlFragments :: URL -> [(String,String)]
+urlFragments URL{..} = splitFragments "&" "=" $  unsharp $ Client.uriFragment uri where
+  unsharp ('#':x) = x
+  unsharp y = y
+
+{-
+  ____            _    _
+ / ___|___   ___ | | _(_) ___
+| |   / _ \ / _ \| |/ / |/ _ \
+| |__| (_) | (_) |   <| |  __/
+ \____\___/ \___/|_|\_\_|\___|
+-}
+
+data Cookies = Cookies { jar :: Client.CookieJar }
+  deriving(Show,Eq)
+
+cookiesCreate :: () -> Cookies
+cookiesCreate () = Cookies (Client.createCookieJar [])
+
+{-
+ _   _ _____ _____ ____
+| | | |_   _|_   _|  _ \
+| |_| | | |   | | | |_) |
+|  _  | | |   | | |  __/
+|_| |_| |_|   |_| |_|
+-}
+
+data Request = Request {
+    req :: Client.Request
+  , req_jar :: Client.CookieJar
+  }
+
+requestCreateGet :: (MonadClient m s) => URL -> Cookies -> m (Either Error Request)
+requestCreateGet URL{..} Cookies{..} = do
+  case setUri def uri of
+    Left exc -> do
+      return $ Left $ ErrorSetURL (URL uri) (show exc)
+    Right r -> do
+      now <- liftIO getCurrentTime
+      (r',_) <- pure $ Client.insertCookiesIntoRequest r jar now
+      return $ Right $ Request {
+          req = r'{
+              Client.redirectCount = 0
+            , Client.checkStatus = \_ _ _ -> Nothing
+            },
+          req_jar = jar
+      }
+
+requestCreatePost :: (MonadClient m s) => FilledForm -> Cookies -> m (Either Error Request)
+requestCreatePost (FilledForm tit Shpider.Form{..}) c = do
+  case Client.parseURI (Client.escapeURIString Client.isAllowedInURI action) of
+    Nothing -> return (Left (ErrorParseURL action "parseURI failed"))
+    Just action_uri -> do
+      r <- requestCreateGet (URL action_uri) c
+      case r of
+        Left err -> do
+          return $ Left err
+        Right Request{..} -> do
+          return $ Right $ Request (Client.urlEncodedBody (map (BS.pack *** BS.pack) $ Map.toList inputs) req) req_jar
+
+data Response = Response {
+    resp :: Client.Response (Pipes.Producer ByteString IO ())
+  , resp_body :: ByteString
+  }
+
+responseBodyS :: Response -> String
+responseBodyS Response{..} = BS.unpack $ resp_body
+
+responseBody :: Response -> ByteString
+responseBody Response{..} = resp_body
+
+dumpResponseBody :: (MonadClient m s) => FilePath -> Response -> m ()
+dumpResponseBody f Response{..} = liftIO $ BS.writeFile f resp_body
+
+responseCookies :: Response -> Cookies
+responseCookies Response{..} = Cookies (Client.responseCookieJar resp)
+
+responseHeaders :: Response -> [(String,String)]
+responseHeaders Response{..} =
+  map (\(o,h) -> (BS.unpack (CI.original o), BS.unpack h)) $ Client.responseHeaders resp
+
+responseCode :: Response -> Int
+responseCode Response{..} = Client.statusCode $ Client.responseStatus resp
+
+responseCodeMessage :: Response -> String
+responseCodeMessage Response{..} = BS.unpack $ Client.statusMessage $ Client.responseStatus resp
+
+responseRedirect :: Response -> Maybe URL
+responseRedirect r =
+  case lookup "Location" (responseHeaders r) of
+    Just loc -> URL <$> Client.parseURI loc
+    Nothing -> Nothing
+
+responseOK :: Response -> Bool
+responseOK r = c == 200 where
+  c = responseCode r
+
+requestExecute :: (MonadClient m s) => Request -> m (Response, Cookies)
+requestExecute Request{..} = do
+  jar <- pure req_jar
+  ClientState{..} <- toClientState <$> get
+  clk <- liftIO $ do
+    clk <- Clock.getTime Clock.Realtime
+    let interval_ns = timeSpecAsNanoSecs (clk `diffTimeSpec` cl_last_execute)
+    when (interval_ns < cl_minimum_interval_ns) $ do
+      threadDelay (fromInteger $ (cl_minimum_interval_ns - interval_ns) `div` 1000); -- convert ns to us
+    return clk
+
+  modify (modifyClientState (\s -> s{cl_last_execute = clk}))
+
+  liftIO $ do
+    Pipes.withHTTP req cl_man $ \resp -> do
+      resp_body <- PP.foldM (\a b -> return $ BS.append a b) (return BS.empty) return (Client.responseBody resp)
+      now <- getCurrentTime
+      let (jar', resp') = Client.updateCookieJar resp req now jar
+      return (Response resp resp_body, Cookies jar')
+
+downloadFileWith :: (MonadClient m s) => URL -> (ByteString -> IO ()) -> m ()
+downloadFileWith url h = do
+  (ClientState{..}) <- toClientState <$> get
+  (Right Request{..}) <- requestCreateGet url (cookiesCreate ())
+  liftIO $ Pipes.withHTTP req cl_man $ \resp -> do
+      PP.foldM (\() a -> h a) (return ()) (const (return ())) (Client.responseBody resp)
+
diff --git a/src/Web/VKHS/Curl.hs b/src/Web/VKHS/Curl.hs
deleted file mode 100644
--- a/src/Web/VKHS/Curl.hs
+++ /dev/null
@@ -1,177 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Web.VKHS.Curl
-  ( vk_curl
-  , vk_curl_file
-  , vk_curl_payload
-  , pack
-  , unpack
-  ) where
-
-import Data.IORef (newIORef, readIORef, atomicModifyIORef)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Internal as BS (c2w, w2c)
-
-import Control.Applicative
-import Control.Exception (catch,bracket)
-import Control.Concurrent (threadDelay)
-import Control.Monad.Writer
-
-import Network.CURL730
-
-import Prelude hiding (catch)
-
-import System.IO
-
-import Web.VKHS.Types
-
-
-pack = BS.pack . map BS.c2w
-unpack = map BS.w2c . BS.unpack
-
--- | Generic request sender. Returns whole HTTP answer as a ByteString
-vk_curl :: Env a -> Writer [CURLoption] () -> IO (Either String BS.ByteString)
-vk_curl e w = do
-    let askE x = return (x e)
-    v <- askE verbose
-    a <- askE useragent
-    d <- askE delay_ms
-    do
-        buff <- newIORef BS.empty
-        do {
-          bracket (curl_easy_init) (curl_easy_cleanup) $ \curl ->
-              let
-                  memwrite n = atomicModifyIORef buff
-                      (\o -> (BS.append o n, CURL_WRITEFUNC_OK))
-              in do
-              curl_easy_setopt curl $
-                  [ CURLOPT_HEADER         True
-                  , CURLOPT_WRITEFUNCTION (Just $ memwrite)
-                  , CURLOPT_SSL_VERIFYPEER False
-                  , CURLOPT_USERAGENT a
-                  , CURLOPT_VERBOSE (v == Debug )
-                  ] ++ (execWriter w);
-              curl_easy_perform curl;
-              threadDelay (1000 * d); -- convert ms to us
-              b <- readIORef buff ;
-              return (Right b) ;
-        } `catch`
-            (\(e::CURLE) -> return $ Left ("CURL error: " ++ (show e)))
-
-scanPattern pat s =
-  let (_,o,x,n) = BS.foldl' check (False, BS.empty, BS.empty, BS.empty) s
-  in (BS.reverse o, x, BS.reverse n)
-  where
-    check (False, old, st, new) b
-      | BS.length st < BS.length pat = (False, old, st`BS.snoc`b, new)
-      | st == pat                    = (True, old, st, b`BS.cons`new)
-      | otherwise                    = (False, (BS.head st)`BS.cons`old, (BS.tail st)`BS.snoc`b, new)
-    check (True, old, st, new) b     = (True, old, st, b`BS.cons`new)
-
-cutheader :: BS.ByteString -> BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)
-cutheader buf new =
-  let
-  buf' = BS.append buf new
-  overfill = BS.length buf' >= 1024
-  (_,p,t) = scanPattern (BS.pack $ map BS.c2w "\r\n\r\n") buf'
-  in case (overfill, BS.null t) of
-    (True, True) -> Nothing
-    (False, True) -> Just (buf', t)
-    (_, False) -> Just (buf', t)
-
-data State = Pending BS.ByteString | Working BS.ByteString | FailNoHeader
-
-process :: State -> BS.ByteString -> State
-process s@(Pending b) bs =
-  case cutheader b bs of
-    Nothing -> FailNoHeader
-    Just (b', t)
-      | BS.null t -> (Pending b')
-      | otherwise -> (Working t)
-process s@(Working _) bs = (Working bs)
-process s _ = s
-
--- | Downloads the file and saves it on disk
-vk_curl_file
-  :: Env a
-  -- ^ User environment
-  -> String
-  -- ^ URL
-  -> (BS.ByteString -> IO ())
-  -- ^ File write handler
-  -> IO (Either String ())
-vk_curl_file e url cb = do
-    let askE x = return (x e)
-    v <- askE verbose
-    a <- askE useragent
-    d <- askE delay_ms
-    do
-        sr <- newIORef =<< (Pending <$> pure BS.empty)
-
-        bracket (curl_easy_init) (curl_easy_cleanup) $ \curl -> do {
-            let
-            filewrite bs = do
-              s' <- atomicModifyIORef sr (\s -> let s' = process s bs in (s',s'))
-              case s' of
-                FailNoHeader -> return CURL_WRITEFUNC_FAIL
-                Pending b -> return CURL_WRITEFUNC_OK
-                Working t -> do
-                  cb t
-                  return CURL_WRITEFUNC_OK
-            in
-              curl_easy_setopt curl $
-                [ CURLOPT_HEADER         True
-                , CURLOPT_WRITEFUNCTION (Just $ filewrite)
-                , CURLOPT_SSL_VERIFYPEER False
-                , CURLOPT_USERAGENT a
-                , CURLOPT_VERBOSE (v == Debug)
-                , CURLOPT_URL url
-                ];
-
-            curl_easy_perform curl;
-            threadDelay (1000 * d); -- convert ms to us
-            s <- readIORef sr;
-            case s of
-              Working _ -> return $ Right ()
-              _         -> return $ Left "HTTP header detection failure"
-        } `catch`
-            (\(e::CURLE) -> return $ Left ("CURL error: " ++ (show e)))
-
-
--- | Return HTTP payload, ignore headers
-vk_curl_payload :: Env a -> Writer [CURLoption] () -> IO (Either String BS.ByteString)
-vk_curl_payload e w = do
-    let askE x = return (x e)
-    v <- askE verbose
-    a <- askE useragent
-    d <- askE delay_ms
-    do
-        sr <- newIORef (BS.empty, Pending BS.empty)
-
-        bracket (curl_easy_init) (curl_easy_cleanup) $ \curl -> do {
-            let
-            writer bs = do
-              atomicModifyIORef sr (\(buff,s) -> let s' = process s bs ; paired x =(x,x) in
-                case s' of
-                  FailNoHeader -> paired (buff,s')
-                  Pending b -> paired (buff,s')
-                  Working t -> paired (BS.append buff t,s'))
-              return CURL_WRITEFUNC_OK
-
-            in
-              curl_easy_setopt curl $
-                [ CURLOPT_HEADER         True
-                , CURLOPT_WRITEFUNCTION (Just $ writer)
-                , CURLOPT_SSL_VERIFYPEER False
-                , CURLOPT_USERAGENT a
-                , CURLOPT_VERBOSE (v == Debug)
-                ] ++ (execWriter w);
-            curl_easy_perform curl;
-            threadDelay (1000 * d); -- convert ms to us
-            (buff,s) <- readIORef sr;
-            case s of
-              Working _ -> return $ Right buff
-              _         -> return $ Left "HTTP header detection failure"
-        } `catch`
-            (\(e::CURLE) -> return $ Left ("CURL error: " ++ (show e)))
-
diff --git a/src/Web/VKHS/Login.hs b/src/Web/VKHS/Login.hs
--- a/src/Web/VKHS/Login.hs
+++ b/src/Web/VKHS/Login.hs
@@ -1,243 +1,190 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts #-}
-
-module Web.VKHS.Login
-    ( login
-    , env
-    ) where
-
-import Prelude hiding ((.), id, catch)
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FunctionalDependencies #-}
+module Web.VKHS.Login where
 
+import Data.List
+import Data.Maybe
+import Data.Time
+import Data.Either
+import Control.Category ((>>>))
 import Control.Applicative
-import Control.Category
-import Control.Exception
-import Control.Failure
-import Control.Monad.Trans
-import Control.Monad.Error
-import Control.Monad.Reader
+import Control.Monad
+import Control.Monad.State
 import Control.Monad.Writer
-import qualified Control.Monad.State as S
+import Control.Monad.Cont
 
-import qualified Data.ByteString as BS
-import Data.List
-import Data.String
-import Data.Char
-import Data.Monoid
-import Data.Either
-import Data.Label
-import qualified Data.Map as M
-import Data.Maybe
-import Data.Typeable
+import Data.Map (Map)
+import qualified Data.Map as Map
 
-import Network.CURL730
-import Network.Protocol.Http
-import Network.Protocol.Uri
-import Network.Protocol.Uri.Query
-import Network.Protocol.Cookie as C
-import Network.Shpider.Forms
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
 
-import Text.HTML.TagSoup
-import Text.Printf
-import System.IO
+import qualified Text.HTML.TagSoup.Parsec as Tagsoup
+import qualified Network.Shpider.Forms as Shpider
 
 import Web.VKHS.Types
-import Web.VKHS.Curl as VKHS
-
--- Test applications:
---
--- pirocheck
--- ID 3115622
--- Key IOmaB10C1v7RoMiM6Lnu
---
--- pirofetch
--- ID 3082266
--- Key <lost>
-
-type Url = String
-type Email = String
-type Uid = String
-type Password = String
-type Body = String
-
-toarg :: [AccessRight] -> String
-toarg = intercalate "," . map (map toLower . show)
-
--- | Gathers login information into Env data set.
-env :: String
-    -- ^ Client ID (provided by VKontakte, also known as application ID)
-    -> String
-    -- ^ User email, able to authenticate the user
-    -> String
-    -- ^ User password
-    -> [AccessRight]
-    -- ^ Access rights to request
-    -> Env LoginEnv
-env cid email pwd ar = mkEnv
-  (LoginEnv
-    [ ("email",email) , ("pass",pwd) ]
-    ar
-    cid
-  )
-
-vk_start_action :: ClientId -> [AccessRight] -> ActionHist
-vk_start_action cid ac = AH [] $ OpenUrl start_url mempty where
-    start_url = (\f -> f $ toUri "https://oauth.vk.com/authorize")
-        $ set query $ bw params
-            [ ("client_id",     cid)
-            , ("scope",         toarg ac)
-            , ("redirect_uri",  "https://oauth.vk.com/blank.html")
-            , ("display",       "wap")
-            , ("response_type", "token")
-            ]
-
-type FilledForm = Form
-
-type VK a = ReaderT (Env LoginEnv) (ErrorT String IO) a
-
-runVK :: Env LoginEnv -> VK a -> IO (Either String a)
-runVK e vk = runErrorT (runReaderT vk e)
-
-liftVK :: IO (Either String a) -> VK a
-liftVK m = liftIO m >>= either fail return
+import Web.VKHS.Client
+import Web.VKHS.Monad
+import Web.VKHS.Error
 
-dbgVK :: Verbosity -> IO () -> VK ()
-dbgVK v act = ask >>= \e -> do
-        if v > (verbose e) then return ()
-                            else liftIO $ act
+import Debug.Trace
+import System.IO
 
-when_debug = dbgVK Debug
-when_trace = dbgVK Trace
+data LoginState = LoginState {
+    ls_rights :: [AccessRight]
+  -- ^ Access rights to be requested
+  , ls_appid :: AppID
+  -- ^ Application ID provided by vk.com
+  , ls_formdata :: [(String,String)]
+  -- ^ Dictionary containig inputID/value map for filling forms
+  , ls_input_sets :: [[String]]
+  }
 
-type Page = (Http Response, Body)
+defaultState :: GenericOptions -> LoginState
+defaultState go@GenericOptions{..} =
+  LoginState {
+    ls_rights = allAccess
+  , ls_appid = l_appid
+  , ls_formdata = (if not (null l_username) then [("email", l_username)] else [])
+               ++ (if not (null l_password) then [("pass", l_password)] else [])
+  , ls_input_sets = []
+  }
 
--- | Browser action
+class (ToGenericOptions s) => ToLoginState s where
+  toLoginState :: s -> LoginState
+  modifyLoginState :: (LoginState -> LoginState) -> (s -> s)
 
-type Hist = [[String]]
+class (MonadIO m, MonadClient m s, ToLoginState s, MonadVK m r) => MonadLogin m r s | m -> s
 
-data ActionHist = AH Hist Action
+-- | Login robot action
+data RobotAction = DoGET URL Cookies | DoPOST FilledForm Cookies
   deriving(Show)
 
-data Action = OpenUrl Uri Cookies | SendForm Form Cookies
-  deriving (Show)
-
--- | Url assotiated with Action
-actionUri :: Action -> Uri
-actionUri (OpenUrl u _) = u
-actionUri (SendForm f _) = toUri . action $ f
-
-liftEIO act = (liftIO act) >>= either fail return
-
--- | Send a get-request to the server
-vk_get :: Uri -> Cookies -> VK Page
-vk_get u c = let
-    c' = (bw cookie $ map toShort $ bw gather c )
-    u' = (showUri u)
-    in do
-        e <- ask
-        s <- liftEIO $ vk_curl e $ do
-            when ((not . null) c') $ do
-                tell [CURLOPT_COOKIE c']
-            when ((not . null) u') $ do
-                tell [CURLOPT_URL u']
-        liftVK (return $ parseResponse $ VKHS.unpack s)
-
--- | Send a form to the server.
-vk_post :: FilledForm -> Cookies -> VK Page
-vk_post f c = let
-    c' = (bw cookie $ map toShort $ bw gather c )
-    p' = (bw params $ M.toList $ inputs f)
-    u' = (action f)
-    in do
-        e <- ask
-        s <- liftEIO $ vk_curl e $ do
-            when ((not . null) c') $ do
-                tell [CURLOPT_COOKIE c']
-            when ((not . null) u') $ do
-                tell [CURLOPT_URL u']
-            tell [CURLOPT_POST True]
-            tell [CURLOPT_COPYPOSTFIELDS p']
-        liftVK (return $ parseResponse $ VKHS.unpack s)
+printAction :: String -> RobotAction -> String
+printAction prefix (DoGET url jar) = prefix ++ " GET " ++ (show url)
+printAction prefix (DoPOST FilledForm{..} jar) = printForm prefix fform
 
--- | Splits parameters into 3 categories:
--- 1)without a value, 2)filled from user dictionary, 3)with default values
-split_inputs :: [(String,String)]
-             -- ^ User dictionary
-             -> M.Map String String
-             -- ^ Fields with default values (default doesn't exist if zero string)
-             -> (M.Map String (), M.Map String String, M.Map String String)
-split_inputs d m =
-    let (b,g) = M.mapEitherWithKey (match_field d) m
-    in (b, M.map (either id id) g, snd (M.mapEither id g))
-    where
-        match_field d k a
-            | not (null a) = maybe ((Right . Left) a)  (Right . Right) u
-            | otherwise    = maybe (Left ())           (Right . Right) u
-            where u = lookup k d
+type Login m x a = m (R m x) a
 
-inputs_to_fill :: Form -> [String]
-inputs_to_fill f = let (inps,_,_) = split_inputs [] (inputs f) in M.keys inps
+initialAction :: (MonadLogin (m (R m x)) (R m x) s) => Login m x RobotAction
+initialAction = do
+  LoginState{..} <- gets toLoginState
+  GenericOptions{..} <- gets toGenericOptions
+  let
+    protocol = (case o_use_https of
+                  True -> "https"
+                  False -> "http")
+  u <- ensure $ pure
+        (urlCreate
+          (URL_Protocol protocol)
+          (URL_Host o_login_host)
+          (Just (URL_Port (show o_port)))
+          (URL_Path "/authorize")
+          (buildQuery [
+              ("client_id", aid_string ls_appid)
+            , ("scope", toUrlArg ls_rights)
+            , ("redirect_url", protocol ++ "://oauth.vk.com/blank.html")
+            , ("display", "wap")
+            , ("response_type", "token")
+            ]))
+  return (DoGET u (cookiesCreate ()))
 
-vk_fill_form :: Form -> VK FilledForm
-vk_fill_form f = ask >>= \e -> do
-    let (bad,good,user) = split_inputs ((formdata . sub) e) (inputs f)
-    when (not $ M.null bad) (fail $ "Unmatched form parameters: " ++ (show bad))
-    return f { inputs = good }
+printForm :: String -> Shpider.Form -> String
+printForm prefix Shpider.Form{..} =
+  let
+    telln x = tell (x ++ "\n")
+  in
+  execWriter $ do
+    telln $ prefix ++ "Form #" ++ " (" ++ (show method) ++ ") Action " ++ action
+    forM_ (Map.toList inputs) $ \(input,value) -> do
+      telln $ prefix ++ "\t" ++ input ++ ":" ++ (if null value then "<empty>" else value)
 
--- | Execute an action, return Web-server's answer and adjusted cookies. Cookie
--- management is very primitive: it's no more than merging old and new ones
-vk_move :: Action -> VK (Page, Cookies)
-vk_move (OpenUrl u c) = do
-    (h,b) <- (vk_get u c)
-    return ((h,b),c`mappend`(get setCookies h))
-vk_move (SendForm f c) = do
-    f' <- vk_fill_form f
-    (h,b) <- (vk_post f' c)
-    return ((h,b),c`mappend`(get setCookies h))
+fillForm :: (MonadLogin (m (R m x)) (R m x) s) => Form -> Login m x FilledForm
+fillForm f@(Form{..}) = do
+    LoginState{..} <- toLoginState <$> get
+    GenericOptions{..} <- gets toGenericOptions
+    let empty_inputs = Shpider.emptyInputs form
+    case empty_inputs `elem` ls_input_sets of
+      False -> do
+        modify $ modifyLoginState (\s -> s{ls_input_sets = empty_inputs:ls_input_sets})
+      True -> do
+        raise (\k -> RepeatedForm f k)
+        return ()
+    fis <- forM (Map.toList (Shpider.inputs form)) $ \(input,value) -> do
+      case lookup input ls_formdata of
+        Just value' -> do
+          -- trace $ "Overwriting default value for " ++ input ++ "( " ++ value ++ ") with " ++ value' $ do
+          return (input, value')
+        Nothing -> do
+          case null value of
+            False -> do
+              -- trace "Using default value for " ++ input ++ " (" ++ value ++ ")" $ do
+              return (input, value)
+            True -> do
+              value' <- raise (\k -> UnexpectedFormField f input k)
+              return (input, value')
+    -- Replace HTTPS with HTTP if not using TLS
+    let action' = (if o_use_https == False && isPrefixOf "https" (Shpider.action form) then
+                     "http" ++ (fromJust $ stripPrefix "https" (Shpider.action form))
+                   else
+                     Shpider.action form)
+    return $ FilledForm form_title form{Shpider.inputs = Map.fromList fis, Shpider.action = action'}
 
-uri_fragment :: Http Response -> Maybe AccessToken
-uri_fragment = get location >=> pure . get fragment >=> pure . fw (keyValues "&" "=") >=> \f -> do
-    (\a b c -> (a,b,c)) <$> lookup "access_token" f <*> lookup "user_id" f <*> lookup "expires_in" f
+actionRequest :: (MonadLogin (m (R m x)) (R m x) s) => RobotAction -> Login m x (Response, Cookies)
+actionRequest a@(DoGET url jar) = do
+  debug (printAction "> " a)
+  req <- ensure $ requestCreateGet url jar
+  (res, jar') <- requestExecute req
+  return (res, jar')
+actionRequest a@(DoPOST form jar) = do
+  debug (printAction "> " a)
+  req <- ensure $ requestCreatePost form jar
+  (res, jar') <- requestExecute req
+  return (res, jar')
 
--- | Suggest new action
-vk_analyze :: Hist -> (Page,Cookies) -> VK (Either AccessToken (Action,Hist))
-vk_analyze hist ((h,b),c)
-    | isJust a        = return $ Left (fromJust a)
-    | isJust l        = return $ Right (OpenUrl (fromJust l) c, hist)
-    | not (null fs) && not (is `elem` hist)
-                      = return $ Right (SendForm f c, is:hist)
-    | not (null fs) && (is `elem` hist)
-                      = fail $ "Invalid password/Form containig following inputs already seen: " ++ (show is)
-    | not gs          = fail $ "HTTP error: status " ++ (show s)
-    | otherwise       = fail $ "HTML processing failure (new design of VK login dialog?)"
-    where
-        gs = s`elem` [OK,Created,Found,SeeOther,Accepted,Continue]
-        s = get status h
-        l = get location h
-        fs = parseTags >>> gatherForms $ b
-        f = head fs
-        is = inputs_to_fill f
-        a = uri_fragment h
+analyzeResponse :: (MonadLogin (m (R m x)) (R m x) s) => (Response, Cookies) -> Login m x (Either RobotAction AccessToken)
+analyzeResponse (res, jar) = do
+  LoginState{..} <- toLoginState <$> get
+  let tags = Tagsoup.parseTags (responseBodyS res)
+      title = Shpider.gatherTitle tags
+      forms = map (Form title) (Shpider.gatherForms tags)
+  dumpResponseBody "latest.html" res
+  debug ("< 0 Title: " ++ title)
 
-vk_dump_page :: Int -> Uri -> Page -> IO ()
-vk_dump_page n u (h,b)
-  | (>0) . length . filter (isAlpha) $ b =
-    let name = printf "%02d-%s.html" n (showAuthority (get authority u))
-    in bracket (openFile name WriteMode) (hClose) $ \f -> do
-        hPutStrLn f b
-        hPutStrLn stderr $ "dumped: name " ++ (name) ++ " size " ++ (show $ length b)
-  | otherwise = return ()
+  case (responseRedirect res) of
+    Just url -> do
+      debug $ "< 0 Fragments: " ++ show (urlFragments url)
+      maybe (return $ Left $ DoGET url jar) (\x -> return $ Right x) $ do
+        at_access_token <- lookup "access_token" (urlFragments url)
+        at_user_id <-  lookup "user_id" (urlFragments url)
+        at_expires_in <-  lookup "expires_in" (urlFragments url)
+        return AccessToken{..}
+    Nothing -> do
+      case forms of
+        [] -> do
+          terminate LoginActionsExhausted
+        (f:[]) -> do
+           debug $ printForm "< 0 " $ form f
+           ff <- fillForm f
+           return $ Left (DoPOST ff jar)
+        fs -> do
+          forM_ (fs`zip`[0..]) $ \(f,n) -> do
+            ff <- fillForm f
+            debug $ printForm ("< " ++ (show n) ++ " ") $ fform ff
+          terminate LoginActionsExhausted
 
--- | Execute login procedure, return (Right AccessToken) on success
-login :: Env LoginEnv -> IO (Either String AccessToken)
-login e@(Env (LoginEnv _ acr cid) _ _ _) =
-  runVK e $ loop [0..] (vk_start_action cid acr) where
-    loop (n:ns) (AH h act) = do
-        when_trace $ printf "VK => %02d %s" n (show act)
-        ans@(p,c) <- vk_move act
-        when_debug $ vk_dump_page n (actionUri act) p
-        a <- vk_analyze h ans
-        case a of
-            Right (act',h') -> do
-                loop ns (AH h' act')
-            Left at -> do
-                return at
+login :: (MonadLogin (m (R m x)) (R m x) s) => Login m x AccessToken
+login = initialAction >>= go where
+  go a = do
+    req <- actionRequest a
+    res <- analyzeResponse req
+    -- trace (show res) $ do
+    case res of
+      Left a' -> go a'
+      Right at -> return at
 
diff --git a/src/Web/VKHS/Monad.hs b/src/Web/VKHS/Monad.hs
new file mode 100644
--- /dev/null
+++ b/src/Web/VKHS/Monad.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FunctionalDependencies #-}
+module Web.VKHS.Monad where
+
+import Data.List
+import Data.Maybe
+import Data.Time
+import Data.Either
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Monad.Cont
+import Data.Default.Class
+import System.IO
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+
+import Web.VKHS.Error
+import Web.VKHS.Types
+import Web.VKHS.Client hiding(Error)
+import qualified Web.VKHS.Client as Client
+
+
+-- newtype VKT m r a = VKT { unVKT :: StateT (r -> VKT m r r) (ContT r m) a }
+--   deriving(Functor, Applicative, Monad, MonadState (r -> VKT m r r), MonadCont, MonadIO)
+
+class (MonadCont m, MonadReader (r -> m r) m) => MonadVK m r
+
+-- instance (Monad m) => MonadVK (VKT m r) r
+
+catch :: (MonadVK m r) => m r -> m r
+catch m = do
+  callCC $ \k -> do
+    local (const k) m
+
+raise :: (MonadVK m r) => ((a -> m b) -> r) -> m a
+raise z = callCC $ \k -> do
+  err <- ask
+  err (z k)
+  undefined
+
+terminate :: (MonadVK m r) => r -> m a
+terminate r = do
+  err <- ask
+  err r
+  undefined
+
+class MonadVK (t r) r => EnsureVK t r c a | c -> a where
+  ensure :: t r c -> t r a
+
+instance (MonadVK (t (R t x)) (R t x)) => EnsureVK t (R t x) (Either Client.Error Request) Request where
+  ensure m  = m >>= \x ->
+    case x of
+      (Right u) -> return u
+      (Left e) -> raise (\k -> UnexpectedRequest e k)
+
+instance (MonadVK (t (R t x)) (R t x)) => EnsureVK t (R t x) (Either Client.Error URL) URL where
+  ensure m  = m >>= \x ->
+    case x of
+      (Right u) -> return u
+      (Left e) -> raise (\k -> UnexpectedURL e k)
+
+-- instance EnsureVK (Either Client.Error Request) Request where
+--   ensure m  = m >>= \x ->
+--     case x of
+--       (Right u) -> return u
+--       (Left e) -> raiseError (\k -> UnexpectedRequest e k)
+
+-- instance EnsureVK (Either Client.Error URL) URL where
+--   ensure m  = m >>= \x ->
+--     case x of
+--       (Right u) -> return u
+--       (Left e) -> raiseError (\k -> UnexpectedURL e k)
+
+
+debug :: (ToGenericOptions s, MonadState s m, MonadIO m) => String -> m ()
+debug str = do
+  GenericOptions{..} <- gets toGenericOptions
+  when o_verbose $ do
+    liftIO $ hPutStrLn stderr str
+
+alert :: (ToGenericOptions s, MonadState s m, MonadIO m) => String -> m ()
+alert str = do
+    liftIO $ hPutStrLn stderr str
+
diff --git a/src/Web/VKHS/Types.hs b/src/Web/VKHS/Types.hs
--- a/src/Web/VKHS/Types.hs
+++ b/src/Web/VKHS/Types.hs
@@ -1,14 +1,31 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
 module Web.VKHS.Types where
 
+import Data.List
+import Data.Char
+
+import Data.Aeson (FromJSON(..), ToJSON(..), (.=), (.:))
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
+
+import qualified Network.Shpider.Forms as Shpider
+
 -- | AccessToken is a authentication data, required by all VK API
 -- functions. It is a tuple of access_token, user_id, expires_in fields,
 -- returned by login procedure.
--- 
+--
 -- See http://vk.com/developers.php?oid=-1&p=Авторизация_клиентских_приложений
 -- (in Russian) for more details
-type AccessToken = (String,String,String)
+data AccessToken = AccessToken {
+    at_access_token :: String
+  , at_user_id :: String
+  , at_expires_in :: String
+  } deriving(Show, Eq, Ord)
 
 -- | Access rigth to request from VK.
+-- See API docs http://vk.com/developers.php?oid=-1&p=Права_доступа_приложений (in
+-- Russian) for details
 data AccessRight
   = Notify  -- Пользователь разрешил отправлять ему уведомления.
   | Friends -- Доступ к друзьям.
@@ -28,12 +45,16 @@
   | Notifications   -- Доступ к оповещениям об ответах пользователю.
   | Stats   -- Доступ к статистике групп и приложений пользователя, администратором которых он является.
   | Ads     -- Доступ к расширенным методам работы с рекламным API.
-  | Offline -- Доступ к API в любое время со стороннего сервера. 
-  deriving(Show)
+  | Offline -- Доступ к API в любое время со стороннего сервера.
+  deriving(Show, Eq, Ord, Enum)
 
+toUrlArg :: [AccessRight] -> String
+toUrlArg = intercalate "," . map (map toLower . show)
+
+
 allAccess :: [AccessRight]
 allAccess =
-  [ 
+  [
   --   Notify
     Friends
   , Photos
@@ -54,48 +75,86 @@
   -- , Offline
   ]
 
--- See API docs http://vk.com/developers.php?oid=-1&p=Права_доступа_приложений (in
--- Russian) for details
+newtype AppID = AppID { aid_string :: String }
+  deriving(Show, Eq, Ord)
 
--- | Verbosity level. Debug will dump *html and output curl log
+
+data JSON = JSON { js_aeson :: Aeson.Value }
+  deriving(Show)
+
+data Form = Form {
+    form_title :: String
+  , form :: Shpider.Form
+  } deriving(Show)
+
+data FilledForm = FilledForm {
+    fform_title :: String
+  , fform :: Shpider.Form
+  } deriving(Show)
+
+
+data GenericOptions = GenericOptions {
+    o_login_host :: String
+  , o_api_host :: String
+  , o_port :: Int
+  , o_verbose :: Bool
+  , o_use_https :: Bool
+  , o_max_request_rate_per_sec :: Rational
+  -- ^ How many requests per second is allowed
+  , o_allow_interactive :: Bool
+
+  , l_appid :: AppID
+  , l_username :: String
+  -- ^ Empty string means no value is given
+  , l_password :: String
+  -- ^ Empty string means no value is given
+  , l_access_token :: String
+  } deriving(Show)
+
+defaultOptions = GenericOptions {
+    o_login_host = "oauth.vk.com"
+  , o_api_host = "api.vk.com"
+  , o_port = 443
+  , o_verbose = False
+  , o_use_https = True
+  , o_max_request_rate_per_sec = 3
+  , o_allow_interactive = True
+
+  , l_appid  = AppID "3128877"
+  , l_username = ""
+  -- ^ Empty string means no value is given
+  , l_password = ""
+  -- ^ Empty string means no value is given
+  , l_access_token = ""
+  }
+
+class ToGenericOptions s where
+  toGenericOptions :: s -> GenericOptions
+
 data Verbosity = Normal | Trace | Debug
   deriving(Enum,Eq,Ord,Show)
 
-type ClientId = String
 
-data LoginEnv = LoginEnv
-  { formdata :: [(String,String)]
-  -- ^ Dictionary containig forms input/value
-  , ac_rights :: [AccessRight]
-  -- ^ Access rights, required by later API calls
-  , clientId :: ClientId
-  -- ^ Application ID provided by vk.com
+data MusicOptions = MusicOptions {
+    m_list_music :: Bool
+  , m_search_string :: String
+  , m_name_format :: String
+  , m_output_format :: String
+  , m_out_dir :: Maybe String
+  , m_records_id :: [String]
+  , m_skip_existing :: Bool
   } deriving(Show)
 
-data CallEnv = CallEnv
-  { access_token :: String
-  -- ^ Access token, the result of login operation
+data UserOptions = UserOptions {
+    u_queryString :: String
   } deriving(Show)
 
--- | VKHS environment
-data Env subenv = Env
-  { sub :: subenv
-  , verbose :: Verbosity
-  -- ^ Verbosity level
-  , useragent :: String
-  -- ^ User agent identifier, defaults to Mozilla Firefox
-  , delay_ms :: Int
-  -- ^ Delay after each transaction, in milliseconds. Library uses it for
-  -- preventing application from being banned for flooding.
-  } deriving (Show)
-
-mkEnv :: s -> Env s
-mkEnv x = Env
-  x
-  Normal
-  "Mozilla/5.0 (X11; Linux x86_64; rv:12.0) Gecko/20120702 Firefox/12.0"
-  500
+data WallOptions = WallOptions {
+    w_woid :: String
+  } deriving(Show)
 
-callEnv :: Env a -> String -> Env CallEnv
-callEnv (Env _ a b c) at = Env (CallEnv at) a b c
+data GroupOptions = GroupOptions {
+    g_search_string :: String
+  , g_output_format :: String
+  } deriving(Show)