diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+		   GNU LESSER GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+  This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+  0. Additional Definitions.
+
+  As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+  "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+  An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+  A "Combined Work" is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+  The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+  The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+  1. Exception to Section 3 of the GNU GPL.
+
+  You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+  2. Conveying Modified Versions.
+
+  If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+   a) under this License, provided that you make a good faith effort to
+   ensure that, in the event an Application does not supply the
+   function or data, the facility still operates, and performs
+   whatever part of its purpose remains meaningful, or
+
+   b) under the GNU GPL, with none of the additional permissions of
+   this License applicable to that copy.
+
+  3. Object Code Incorporating Material from Library Header Files.
+
+  The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+   a) Give prominent notice with each copy of the object code that the
+   Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the object code with a copy of the GNU GPL and this license
+   document.
+
+  4. Combined Works.
+
+  You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+   a) Give prominent notice with each copy of the Combined Work that
+   the Library is used in it and that the Library and its use are
+   covered by this License.
+
+   b) Accompany the Combined Work with a copy of the GNU GPL and this license
+   document.
+
+   c) For a Combined Work that displays copyright notices during
+   execution, include the copyright notice for the Library among
+   these notices, as well as a reference directing the user to the
+   copies of the GNU GPL and this license document.
+
+   d) Do one of the following:
+
+       0) Convey the Minimal Corresponding Source under the terms of this
+       License, and the Corresponding Application Code in a form
+       suitable for, and under terms that permit, the user to
+       recombine or relink the Application with a modified version of
+       the Linked Version to produce a modified Combined Work, in the
+       manner specified by section 6 of the GNU GPL for conveying
+       Corresponding Source.
+
+       1) Use a suitable shared library mechanism for linking with the
+       Library.  A suitable mechanism is one that (a) uses at run time
+       a copy of the Library already present on the user's computer
+       system, and (b) will operate properly with a modified version
+       of the Library that is interface-compatible with the Linked
+       Version.
+
+   e) Provide Installation Information, but only if you would otherwise
+   be required to provide such information under section 6 of the
+   GNU GPL, and only to the extent that such information is
+   necessary to install and execute a modified version of the
+   Combined Work produced by recombining or relinking the
+   Application with a modified version of the Linked Version. (If
+   you use option 4d0, the Installation Information must accompany
+   the Minimal Corresponding Source and Corresponding Application
+   Code. If you use option 4d1, you must provide the Installation
+   Information in the manner specified by section 6 of the GNU GPL
+   for conveying Corresponding Source.)
+
+  5. Combined Libraries.
+
+  You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+   a) Accompany the combined library with a copy of the same work based
+   on the Library, uncombined with any other library facilities,
+   conveyed under the terms of this License.
+
+   b) Give prominent notice with the combined library that part of it
+   is a work based on the Library, and explaining where to find the
+   accompanying uncombined form of the same work.
+
+  6. Revised Versions of the GNU Lesser General Public License.
+
+  The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+  Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+  If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/httpspec.cabal b/httpspec.cabal
new file mode 100644
--- /dev/null
+++ b/httpspec.cabal
@@ -0,0 +1,64 @@
+Name:                httpspec
+Version:             0.1
+Synopsis:            Specification of HTTP request/response generators and parsers
+License:             LGPL
+License-file:        LICENSE
+Author:              David Leuschner
+Maintainer:          David Leuschner <leuschner@openfactis.org>
+Category:            Data, Web
+Description:
+  Using httpspec you can write a specification for a HTTP request/response
+  defining the method, headers, url parameters and the body.  This
+  specification bidirectionally maps an abstract request/response data
+  type to a concrete realisation as a HTTP request/response.  The
+  specification can be used to generate HTTP requests/responses from an
+  abstract description and it can be used to parse a HTTP request/response
+  into such an abstract description.  The idea is very similar to the way
+  pickling of XML data is described in HXT.
+
+  For example, the abstract representation of an authentication request
+  and response could be described as
+
+  data AuthUserReq
+      = AuthUserReq
+        { authUser_user :: String
+        , authUser_pass :: String
+        }
+
+  data AuthUserRes
+      = AuthUserOk { authUserOk_sid :: String }
+      | AuthUserFailed
+
+  Using httpspec you can define a mapping between HTTP and these types:
+
+  instance HasReqSpec AuthUserReq where
+    reqSpec =
+        rsMeth Http.POST $
+        rsPath "/authenticate-user" $
+        rsWrap (uncurry AuthUserReq, \(AuthUserReq a b) -> (a,b)) $
+        rsPair (rsParam "uid") (rsParam "pass")
+
+  instance HasResSpec AuthUserRes where
+    resSpec =
+        rsSwitch
+        [ rsCase (AuthUserOk,authUserOk_sid) $
+          rsStatus 200 $
+          rsContentType "text/plain" $
+          rsEncodingFixed UTF8 $
+          rsBody
+        , rsCaseConst AuthUserFailed $
+          rsStatus 403
+        ]
+Build-Type:          Simple
+Cabal-Version:       >= 1.2
+
+Library
+  Hs-Source-Dirs:    src
+  GHC-Options: -Wall
+  Build-Depends:     base >= 4 && < 5, bytestring, bidispec, mtl,
+                     tagsoup == 0.6, hxt > 8.3 && < 8.4, pretty,
+                     Safe, cgi, network, HTTP, filepath, containers,
+                     encoding >= 0.6
+  Exposed-Modules:   Data.HttpSpec,Data.HttpSpec.HttpTypes
+                     Data.HttpSpec.Pretty, Data.HttpSpec.MiscHelper
+                     Data.HttpSpec.XmlHelper, Data.HttpSpec.EncodingHelper
diff --git a/src/Data/HttpSpec.hs b/src/Data/HttpSpec.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/HttpSpec.hs
@@ -0,0 +1,245 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Data.HttpSpec
+    (ReqSpec, ResSpec, HttpSpec, WebErr(..)
+    ,HasReqSpec(..), HasResSpec(..), TextEncoding
+    ,rsHeader, rsHeaderFixed, rsParam, rsMeth, rsStatus
+    ,rsXmlString, rsXml, rsPath, rsWithBody, rsBody, rsContentType
+    ,rsPathSegment, rsXmlEncoding, rsTextEncoding, rsEncodingFixed
+    ,genReqOut, genResOut, parseReqIn, parseResIn
+    )
+where
+----------------------------------------
+-- STDLIB
+----------------------------------------
+import Control.Monad (liftM,when,unless)
+import Control.Monad.Reader (ask,asks,local)
+import Control.Monad.Error (MonadError(..), Error(..))
+import Data.Maybe (fromMaybe)
+import Data.List (isPrefixOf)
+
+----------------------------------------
+-- SITE-PACKAGES
+----------------------------------------
+import qualified Network.HTTP as Http
+import qualified Network.URI as Uri
+import qualified Network.CGI as Cgi
+
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy.Char8 as BSLChar
+
+import Data.Encoding (Encoding, DynEncoding
+                     ,encodeLazyByteString, decodeLazyByteStringExplicit
+                     ,encodingFromStringExplicit)
+
+import Text.XML.HXT.Arrow (PU)
+
+import Data.BidiSpec
+
+----------------------------------------
+-- LOCAL
+----------------------------------------
+import Data.HttpSpec.MiscHelper (eitherToM)
+import Data.HttpSpec.EncodingHelper (encodingName)
+import Data.HttpSpec.HttpTypes
+    (HttpHeaderName,HttpHeaderValue,HttpHeader,HttpMethod,HttpBody
+    ,HttpUrl, HttpParamName, HttpParamValue
+    ,HttpData(..),ReqIn(..),ReqOut(..),ResIn(..),ResOut(..)
+    ,IsHttp(..), IsReq(..), IsRes(..)
+    ,urlParams, urlMatchPrefix, urlSplit)
+import Data.HttpSpec.XmlHelper
+    (XmlEncoding, pickleStr, pickleWithEnc, unpickle, unpickleStr
+    ,xmlEncodingFromString, xmlEncodingToString)
+
+
+-- ----------------------------------------------------------------------------
+--  Spec types for request and response
+-- ----------------------------------------------------------------------------
+
+class HasReqSpec a where
+    reqSpec :: ReqSpec a
+
+class HasResSpec a where
+    resSpec :: ResSpec a
+
+type TextEncoding = DynEncoding
+
+data WebErr
+    = WebErrMissingParam String
+    | WebErrMissingHeader HttpHeaderName
+    | WebErrInvalidHeaderValue HttpHeaderName HttpHeaderValue String
+    | WebErrInvalidMethod HttpMethod String
+    | WebErrInvalidStatus Int String
+    | WebErrInvalidUrl { webErr_expected :: String, webErr_actual :: String }
+    | WebErrMissingContentType
+    | WebErrUnexpectedContentType String String
+    | WebErrEmptyContent
+    | WebErrNoMatch ReqIn
+    | WebErrNotImplemented String
+    | WebErrCustomMsg String
+      deriving (Show)
+
+instance Error WebErr where
+    noMsg = WebErrCustomMsg "HttpSpec: unknown error."
+    strMsg = WebErrCustomMsg
+
+type ReqErr = WebErr
+type ResErr = WebErr
+type HttpErr = WebErr
+
+type ReqSpecGen a = SpecGen ReqOut a
+type ReqSpecParser a = SpecParser ReqIn ReqErr a
+
+type ResSpecGen a = SpecGen ResOut a
+type ResSpecParser a = SpecParser ResIn ResErr a
+type HttpSpecParser i a = SpecParser i HttpErr a
+
+type ReqSpec = Spec ReqErr ReqIn ReqOut
+type ResSpec = Spec ResErr ResIn ResOut
+type HttpSpec = Spec HttpErr
+
+mkReqSpec :: ReqSpecParser a -> ReqSpecGen a -> ReqSpec a
+mkReqSpec = mkSpec
+
+mkResSpec :: ResSpecParser a -> ResSpecGen a -> ResSpec a
+mkResSpec = mkSpec
+
+-- ----------------------------------------------------------------------------
+--  HttpSpec combinators
+-- ----------------------------------------------------------------------------
+
+spGetHeader :: IsHttp h => HttpHeaderName -> HttpSpecParser h HttpHeaderValue
+spGetHeader name = asks (httpGetHeader name)
+                   >>= spFromMaybe (WebErrMissingHeader name)
+
+rsWithBody :: (IsHttp i, IsHttp o) =>
+              (HttpSpec i o BSL.ByteString -> HttpSpec i o a)
+           -> HttpSpec i o a
+rsWithBody f = rsWith f rsBody
+
+rsBody :: (IsHttp i, IsHttp o) => HttpSpec i o BSL.ByteString
+rsBody = rsWrap (BSLChar.pack, BSLChar.unpack) $
+         rsGetSet httpBody (flip httpSetBody)
+
+rsHeader :: (IsHttp i, IsHttp o) =>
+            HttpHeaderName
+         -> HttpSpec i o HttpHeaderValue
+rsHeader n = mkSpec (spGetHeader n) (flip $ httpSetHeader n)
+
+rsHeaderFixed :: (IsHttp i, IsHttp o) =>
+                 HttpHeader
+              -> HttpSpec i o a
+              -> HttpSpec i o a
+rsHeaderFixed (n,v) = rsCheckSet check (httpSetHeader n v)
+    where check = spGetHeader n >>= spCheck (==v) err
+          err v' = WebErrInvalidHeaderValue n v' ("Expected `"++v++"'.")
+
+rsContentType :: (IsHttp i, IsHttp o) =>
+                 String
+              -> HttpSpec i o a
+              -> HttpSpec i o a
+rsContentType v = rsCheckSet check (httpSetHeader n v)
+    where check = spGetHeader n >>= spCheck checkfun err
+          checkfun v' = v `isPrefixOf` v'
+          err v' = WebErrInvalidHeaderValue n v' ("Expected `"++v++"'.")
+          n = Http.HdrContentType
+
+-- ----------------------------------------------------------------------------
+--  ReqSpec combinators
+-- ----------------------------------------------------------------------------
+
+rsParam :: HttpParamName -> ReqSpec HttpParamValue
+rsParam name = mkSpec rsParse rsGen
+    where
+      rsGen req val = reqAddUrlParam name val req
+      rsParse = spGets (urlParams . reqIn_fullUrl)
+                >>= spFromMaybe err . lookup name
+      err = WebErrMissingParam name
+
+rsMeth :: HttpMethod -> ReqSpec a -> ReqSpec a
+rsMeth meth = rsCheckSet check (reqSetMethod meth)
+    where check = spGets reqMethod >>= spCheck (==meth) err
+          err m = WebErrInvalidMethod m ("Expected method `"++show meth++"'.")
+
+rsPathSegment :: ReqSpec a -> ReqSpec (String, a)
+rsPathSegment rs = mkSpec rsParseDef rsGenDef
+    where
+      rsParseDef =
+          do req <- spGet
+             let msg = "URL too short."
+                 url = reqUrl req
+             case urlSplit url of
+               Just (head,tail) ->
+                   do a <- local (reqSetUrl tail) (rsParse rs)
+                      return (head, a)
+               Nothing -> throwError $ WebErrInvalidUrl msg (show url)
+      rsGenDef r (path, a) = rsGen rs (reqAppendUrlPath path r) a
+
+rsPath :: String -> ReqSpec a -> ReqSpec a
+rsPath path rs = mkSpec rsParseDef rsGenDef
+    where
+      rsParseDef =
+          do req <- spGet
+             let msg = "Expected URL prefix: `"++path++"'"
+                 url = reqUrl req
+             case urlMatchPrefix path url of
+               Just url' -> local (reqSetUrl url') (rsParse rs)
+               Nothing -> throwError $ WebErrInvalidUrl msg (show url)
+      rsGenDef r = rsGen rs (reqAppendUrlPath path r)
+
+-- ----------------------------------------------------------------------------
+--  ResSpec combinators
+-- ----------------------------------------------------------------------------
+rsStatus :: Int -> ResSpec a -> ResSpec a
+rsStatus c = rsCheckSet check (resSetStatus c Nothing)
+    where check = spGets resCode >>= spCheck (==c) err
+          err i = WebErrInvalidStatus i ("Expected status code `"++show c++"'.")
+
+-- ----------------------------------------------------------------------------
+--  other specific combinators
+-- ----------------------------------------------------------------------------
+
+rsXmlString :: Error e => PU a -> Spec e i o String -> Spec e i o a
+rsXmlString xp rs = rsWrapMaybe msg (unpickleStr xp, pickleStr xp) rs
+    where msg = "Failed to unpickle XML."
+
+rsXml :: Error e =>
+         XmlEncoding
+      -> PU a
+      -> Spec e i o BSL.ByteString
+      -> Spec e i o a
+rsXml enc xp rs = rsWrapMaybe msg (unpickle xp, pickleWithEnc enc xp) rs
+    where msg = "Failed to unpickle XML."
+
+rsEncodingFixed :: (Error e, Encoding enc) =>
+              enc
+           -> Spec e i o BSL.ByteString
+           -> Spec e i o String
+rsEncodingFixed enc = rsWrapEither' (decode, encode)
+    where decode = decodeLazyByteStringExplicit enc
+          encode = encodeLazyByteString enc
+
+rsXmlEncoding :: Error e => Spec e i o String -> Spec e i o XmlEncoding
+rsXmlEncoding = rsWrapEither' (decode, xmlEncodingToString)
+    where msg = "rsXmlEncoding: unknown encoding"
+          decode = xmlEncodingFromString
+
+rsTextEncoding :: Error e => Spec e i o String -> Spec e i o TextEncoding
+rsTextEncoding = rsWrapMaybe msg (encodingFromStringExplicit, encodingName)
+    where msg = "rsTextEncoding: unknown encoding"
+
+-- ----------------------------------------------------------------------------
+--  Spec runners
+-- ----------------------------------------------------------------------------
+
+genReqOut :: Monad m => ReqSpec a -> HttpUrl -> a -> m ReqOut
+genReqOut rs base = genBySpec rs (ReqOut base Http.GET (HttpData [] ""))
+
+parseReqIn :: MonadError ReqErr m => ReqSpec a -> ReqIn -> m a
+parseReqIn rs reqIn = parseBySpec rs reqIn
+
+genResOut :: Monad m => ResSpec a -> a -> m ResOut
+genResOut rs = genBySpec rs (ResOut 200 Nothing (HttpData [] ""))
+
+parseResIn :: MonadError ReqErr m => ResSpec a -> ResIn -> m a
+parseResIn rs reqIn = parseBySpec rs reqIn
diff --git a/src/Data/HttpSpec/EncodingHelper.hs b/src/Data/HttpSpec/EncodingHelper.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/HttpSpec/EncodingHelper.hs
@@ -0,0 +1,33 @@
+module Data.HttpSpec.EncodingHelper (encodingName) where
+
+encodingName :: Show enc => enc -> String
+encodingName enc =
+    case show enc of
+      "UTF8" -> "UTF-8"
+      "UTF16" -> "UTF-16"
+      "UTF32" -> "UTF-32"
+      "ISO88591" -> "ISO-8859-1"
+      "ISO88592" -> "ISO-8859-2"
+      "ISO88593" -> "ISO-8859-3"
+      "ISO88594" -> "ISO-8859-4"
+      "ISO88595" -> "ISO-8859-5"
+      "ISO88596" -> "ISO-8859-6"
+      "ISO88597" -> "ISO-8859-7"
+      "ISO88598" -> "ISO-8859-8"
+      "ISO88599" -> "ISO-8859-9"
+      "ISO885910" -> "ISO-8859-10"
+      "ISO885911" -> "ISO-8859-11"
+      "ISO885913" -> "ISO-8859-13"
+      "ISO885914" -> "ISO-8859-14"
+      "ISO885915" -> "ISO-8859-15"
+      "ISO885916" -> "ISO-8859-16"
+      "CP1250" -> "WINDOWS-1250"
+      "CP1251" -> "WINDOWS-1251"
+      "CP1252" -> "WINDOWS-1252"
+      "CP1253" -> "WINDOWS-1253"
+      "CP1254" -> "WINDOWS-1254"
+      "CP1255" -> "WINDOWS-1255"
+      "CP1256" -> "WINDOWS-1256"
+      "CP1257" -> "WINDOWS-1257"
+      "CP1258" -> "WINDOWS-1258"
+      _ -> "unknown"
diff --git a/src/Data/HttpSpec/HttpTypes.hs b/src/Data/HttpSpec/HttpTypes.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/HttpSpec/HttpTypes.hs
@@ -0,0 +1,350 @@
+module Data.HttpSpec.HttpTypes
+    (HttpBody, HttpMethod, HttpUrl, HttpCode, HttpReason
+    ,HttpHeaderName, HttpHeaderValue, HttpHeader, HttpHeaders
+    ,HttpParamName, HttpParamValue, HttpParams
+    ,HttpData(..), ReqIn(..), ReqOut(..), ResIn(..), ResOut(..)
+    ,IsHttp(..), IsReq(..), IsRes(..)
+    ,reqIn_body, reqIn_headers, reqOut_body, reqOut_headers
+    ,resIn_body, resIn_headers, resOut_body, resOut_headers
+    ,urlParams, urlMatchPrefix, urlMatchPrefix', urlSplit, url
+    ,completeReq, completeRes, mkHeaderName)
+where
+
+----------------------------------------
+-- STDLIB
+----------------------------------------
+import Data.Char (toLower)
+import Data.Maybe (fromMaybe, catMaybes)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.List (isPrefixOf)
+
+import Control.Monad (liftM)
+import Control.Arrow (first)
+
+import System.FilePath (takeDirectory, (</>))
+
+----------------------------------------
+-- SITE-PACKAGES
+----------------------------------------
+import qualified Network.HTTP as Http
+import qualified Network.URI as Uri
+import qualified Network.CGI as Cgi
+
+import Text.PrettyPrint.HughesPJ (Doc, vcat, ($+$), (<+>), (<>), text, colon
+                                 ,int, empty)
+
+import Safe (headMay)
+
+----------------------------------------
+-- LOCAL
+----------------------------------------
+import Data.HttpSpec.Pretty (Pretty(..))
+
+-- ============================================================================
+--  http types
+-- ============================================================================
+
+-- URL types
+type HttpPath = String
+type HttpParamName = String
+type HttpParamValue = String
+type HttpParams = [(HttpParamName, HttpParamValue)]
+type HttpUrl = Uri.URI
+
+-- Http message types
+type HttpHeaderName = Http.HeaderName
+type HttpHeaderValue = String
+type HttpHeader = (HttpHeaderName, String)
+type HttpHeaders = [HttpHeader]
+type HttpBody = String
+
+-- Request types
+type HttpMethod = Http.RequestMethod
+
+-- Response types
+type HttpCode = Int
+type HttpReason = String
+
+
+data HttpData = HttpData { http_headers :: HttpHeaders
+                         , http_body :: HttpBody
+                         }
+              deriving (Show)
+
+data ReqIn = ReqIn { reqIn_progUrl :: HttpUrl
+                   , reqIn_fullUrl :: HttpUrl
+                   , reqIn_method :: HttpMethod
+                   , reqIn_data :: HttpData
+                   }
+           deriving (Show)
+reqIn_body = http_body . reqIn_data
+reqIn_headers = http_headers . reqIn_data
+
+data ReqOut = ReqOut { reqOut_url :: HttpUrl
+                     , reqOut_method :: HttpMethod
+                     , reqOut_data :: HttpData }
+            deriving (Show)
+reqOut_body = http_body . reqOut_data
+reqOut_headers = http_headers . reqOut_data
+
+data ResIn = ResIn { resIn_code :: HttpCode
+                   , resIn_reason :: HttpReason
+                   , resIn_data :: HttpData }
+             deriving (Show)
+resIn_body = http_body . resIn_data
+resIn_headers = http_headers . resIn_data
+
+
+data ResOut = ResOut { resOut_code :: HttpCode
+                     , resOut_reason :: Maybe HttpReason
+                     , resOut_data :: HttpData }
+             deriving (Show)
+resOut_body = http_body . resOut_data
+resOut_headers = http_headers . resOut_data
+
+
+-- ============================================================================
+--  helper functions and instances
+-- ============================================================================
+
+instance Ord Http.HeaderName where
+    compare hn1 hn2 = compare (mapHdr hn1) (mapHdr hn2)
+        where mapHdr (Http.HdrCustom l) = Left l
+              mapHdr other = Right (show other)
+
+mkHeaderName :: String -> HttpHeaderName
+mkHeaderName = Http.HdrCustom
+
+url :: String -> HttpUrl
+url s = case Uri.parseURI s of
+          Just uri -> uri
+          Nothing -> error $ "HttpTypes.url: Invalid URI `" ++ s ++ "'"
+
+urlParams :: HttpUrl -> HttpParams
+urlParams uri = Cgi.formDecode $ dropWhile (=='?') (Uri.uriQuery uri)
+
+urlAddParam :: HttpParamName -> HttpParamValue -> HttpUrl -> HttpUrl
+urlAddParam n v uri = uri'
+    where params = Cgi.formDecode $ dropWhile (=='?') (Uri.uriQuery uri)
+          params' = (n,v) : params
+          uri' = uri { Uri.uriQuery = '?' : Cgi.formEncode params' }
+
+urlAppendPath :: HttpPath -> HttpUrl -> HttpUrl
+urlAppendPath path uri = uri { Uri.uriPath = Uri.uriPath uri ++ path }
+
+-- | Splits off the first path component of a URL.
+-- @urlSplit (url "http://svr/foo/bar") == Just ("/foo", url "http://svr/bar")@
+-- @urlSplit (url "http://svr/") == Just ("/", url "http://svr")@
+-- @urlSplit (url "http://svr") == Nothing@
+urlSplit :: Monad m => HttpUrl -> m (HttpPath, HttpUrl)
+urlSplit uri = liftM mapUri (uriPathSplit $ Uri.uriPath uri)
+    where
+      mapUri (head, tail) = (head, uri { Uri.uriPath = tail })
+      uriPathSplit "" = fail "Empty URL Path."
+      uriPathSplit "/" = return ("/", "")
+      uriPathSplit ('/':path) = liftM (first ('/':)) (uriPathSplit path)
+      uriPathSplit path = return $ span (/='/') path
+
+urlMatchPrefix :: HttpPath -> HttpUrl -> Maybe HttpUrl
+urlMatchPrefix s uri
+    | s `isPrefixOf` path = Just $ uri { Uri.uriPath = drop (length s) path }
+    | otherwise = Nothing
+    where path = Uri.uriPath uri
+
+
+urlMatchPrefix' :: HttpUrl -> HttpUrl -> Maybe HttpUrl
+urlMatchPrefix' prefixUrl = urlMatchPrefix prefixPath
+    where prefixPath = Uri.uriPath prefixUrl
+
+
+completeReq :: IsHttp req => req -> req
+completeReq r = if clen /= 0 then r2 else r
+    where
+      clen = length (httpBody r)
+      r1 | not (httpHasHeader Http.HdrTransferEncoding r)
+           && not (httpHasHeader Http.HdrContentLength r)
+               = httpSetHeader Http.HdrContentLength (show clen) r
+         | otherwise = r
+      r2 | not (httpHasHeader Http.HdrContentType r1)
+             = httpSetHeader Http.HdrContentType "application/octet-stream" r1
+         | otherwise = r1
+
+completeRes :: IsHttp res => res -> res
+completeRes = completeReq
+
+-- ============================================================================
+--  access helper type classes
+-- ============================================================================
+
+
+class IsHttp a where
+    -- required methods
+    httpData :: a -> HttpData
+    httpSetData :: a -> HttpData -> a
+    -- methods with default implementations
+    httpHeaders :: a -> HttpHeaders
+    httpHeaders = http_headers . httpData
+    httpBody :: a -> HttpBody
+    httpBody = http_body . httpData
+    httpGetHeader :: HttpHeaderName -> a -> Maybe HttpHeaderValue
+    httpGetHeader n x =
+        case n of
+          Http.HdrCustom mixedName -> headMay vals
+              where vals = [v | (Http.HdrCustom n, v) <- httpHeaders x, map toLower n == name]
+                    name = map toLower mixedName
+          _ ->  lookup n (httpHeaders x)
+    httpHasHeader :: HttpHeaderName -> a -> Bool
+    httpHasHeader n = (/=Nothing) . httpGetHeader n
+    httpSetBody :: HttpBody -> a -> a
+    httpSetBody body this = httpSetData this (HttpData (httpHeaders this) body)
+    httpSetHeaders :: HttpHeaders -> a -> a
+    httpSetHeaders hs this = httpSetData this (HttpData hs (httpBody this))
+    httpSetHeader :: HttpHeaderName -> HttpHeaderValue -> a -> a
+    httpSetHeader name val this = flip httpSetHeaders this .
+                                  Map.toList $
+                                  Map.insert name val $
+                                  Map.fromList (httpHeaders this)
+
+class IsHttp a => IsRes a where
+    resCode :: a -> HttpCode
+    resSetStatus :: HttpCode -> Maybe HttpReason -> a -> a
+    resReason :: a -> HttpReason
+    resReason res = fromMaybe def $ lookup (resCode res) statusCodeMessageMap
+        where def = ""
+
+class IsHttp a => IsReq a where
+    reqMethod :: a -> HttpMethod
+    reqUrl :: a -> HttpUrl
+    reqSetMethod :: HttpMethod -> a -> a
+    reqSetUrl :: HttpUrl -> a -> a
+    reqUrlPath :: a -> HttpPath
+    reqUrlPath req = Uri.uriPath (reqUrl req)
+    reqAppendUrlPath :: HttpPath -> a -> a
+    reqAppendUrlPath p req = reqSetUrl (urlAppendPath p (reqUrl req)) req
+    reqAddUrlParam :: HttpParamName -> HttpParamValue -> a -> a
+    reqAddUrlParam n v r = reqSetUrl (urlAddParam n v (reqUrl r)) r
+
+instance IsHttp HttpData where
+    httpData = id
+    httpSetData = const
+
+instance IsHttp ReqIn where
+    httpData = reqIn_data
+    httpSetData this x = this { reqIn_data = x }
+
+instance IsHttp ReqOut where
+    httpData = reqOut_data
+    httpSetData this x = this { reqOut_data = x }
+
+instance IsHttp ResIn where
+    httpData = resIn_data
+    httpSetData this x = this { resIn_data = x }
+
+instance IsHttp ResOut where
+    httpData = resOut_data
+    httpSetData this x = this { resOut_data = x }
+
+
+instance IsRes ResIn where
+    resCode = resIn_code
+    resSetStatus code mr r = r { resIn_reason = fromMaybe (resIn_reason r) mr
+                               , resIn_code = code }
+
+instance IsRes ResOut where
+    resCode = resOut_code
+    resSetStatus code mr r = r { resOut_reason = mr
+                               , resOut_code = code }
+
+
+instance IsReq ReqIn where
+    reqMethod = reqIn_method
+    reqUrl = reqIn_fullUrl
+    reqSetMethod meth req = req { reqIn_method = meth }
+    reqSetUrl url req = req { reqIn_fullUrl = url }
+
+instance IsReq ReqOut where
+    reqMethod = reqOut_method
+    reqUrl = reqOut_url
+    reqSetMethod meth req = req { reqOut_method = meth }
+    reqSetUrl url req = req { reqOut_url = url }
+
+
+pprReq :: IsReq req => req -> Doc
+pprReq req =  ppr (reqMethod req) <+> ppr (reqUrl req) <+> text "HTTP/1.1"
+              $+$ ppr (httpData req)
+
+pprRes :: IsRes res => res -> Doc
+pprRes res = int (resCode res) <+> text (resReason res) $+$ ppr (httpData res)
+
+instance Pretty Uri.URI where
+    ppr = text . show
+
+instance Pretty HttpData where
+    ppr (HttpData hds b) = foldl ($+$) empty (map pprHd hds)
+                           $+$ foldl ($+$) empty (map text $ "" : bodylines)
+        where pprHd (n,v) = text (show n) <> colon <+> text v
+              showlines | showlines' /= bodylines = bodylines ++ ["[...]"]
+                        | otherwise = bodylines
+              showlines' = takeWhile ((<=80) . length) $ take 5 bodylines
+              bodylines = lines b
+
+instance Pretty ReqIn where
+    ppr = pprReq
+
+instance Pretty ReqOut where
+    ppr = pprReq
+
+instance Pretty ResIn where
+    ppr = pprRes
+
+instance Pretty ResOut where
+    ppr = pprRes
+
+instance Pretty Http.RequestMethod where
+    ppr = text . show
+
+
+statusCodeMessageMap :: [(Int, String)]
+statusCodeMessageMap =
+    [(100, "Continue")
+    ,(101, "Switching Protocols")
+    ,(200, "OK")
+    ,(201, "Created")
+    ,(202, "Accepted")
+    ,(203, "Non-Authoritative Information")
+    ,(204, "No Content")
+    ,(205, "Reset Content")
+    ,(206, "Partial Content")
+    ,(300, "Multiple Choices")
+    ,(301, "Moved Permanently")
+    ,(302, "Found")
+    ,(303, "See Other")
+    ,(304, "Not Modified")
+    ,(305, "Use Proxy")
+    ,(307, "Temporary Redirect")
+    ,(400, "Bad Request")
+    ,(401, "Unauthorized")
+    ,(402, "Payment Required")
+    ,(403, "Forbidden")
+    ,(404, "Not Found")
+    ,(405, "Method Not Allowed")
+    ,(406, "Not Acceptable")
+    ,(407, "Proxy Authentication Required")
+    ,(408, "Request Time-out")
+    ,(409, "Conflict")
+    ,(410, "Gone")
+    ,(411, "Length Required")
+    ,(412, "Precondition Failed")
+    ,(413, "Request Entity Too Large")
+    ,(414, "Request-URI Too Large")
+    ,(415, "Unsupported Media Type")
+    ,(416, "Requested range not satisfiable")
+    ,(417, "Expectation Failed")
+    ,(500, "Internal Server Error")
+    ,(501, "Not Implemented")
+    ,(502, "Bad Gateway")
+    ,(503, "Service Unavailable")
+    ,(504, "Gateway Time-out")
+    ,(505, "HTTP Version not supported")
+    ]
diff --git a/src/Data/HttpSpec/MiscHelper.hs b/src/Data/HttpSpec/MiscHelper.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/HttpSpec/MiscHelper.hs
@@ -0,0 +1,40 @@
+module Data.HttpSpec.MiscHelper
+    (errorToMaybe, errorToDefault, maybeToM, eitherToM, safeMain)
+where
+
+----------------------------------------
+-- STDLIB
+----------------------------------------
+import Prelude hiding (catch)
+
+import Control.Monad (liftM)
+import Control.Monad.Error (MonadError, catchError)
+import Control.Exception (catch,SomeException)
+
+import System.IO (hPutStrLn,stderr)
+import System.Exit (exitFailure)
+import System.Environment (getProgName)
+
+
+maybeToM :: Monad m => String -> Maybe a -> m a
+maybeToM _msg (Just x) = return x
+maybeToM msg Nothing = fail msg
+
+errorToMaybe :: MonadError e m => m a -> m (Maybe a)
+errorToMaybe ma = catchError (liftM Just ma) (\_ -> return Nothing)
+
+errorToDefault :: MonadError e m => a -> m a -> m a
+errorToDefault a ma = catchError ma (\_ -> return a)
+
+eitherToM :: (Show a, Monad m) => Either a b -> m b
+eitherToM (Left err) = fail (show err)
+eitherToM (Right ok) = return ok
+
+safeMain :: IO () -> IO ()
+safeMain io = io `catch` handle
+    where
+      handle :: SomeException -> IO ()
+      handle e =
+          do s <- getProgName
+             hPutStrLn stderr ("Caught exception while running " ++ s ++ ": " ++ show e)
+             exitFailure
diff --git a/src/Data/HttpSpec/Pretty.hs b/src/Data/HttpSpec/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/HttpSpec/Pretty.hs
@@ -0,0 +1,10 @@
+module Data.HttpSpec.Pretty (Pretty(..)) where
+
+----------------------------------------
+-- SITE-PACKAGES
+----------------------------------------
+import Text.PrettyPrint.HughesPJ (Doc)
+
+
+class Pretty a where
+    ppr :: a -> Doc
diff --git a/src/Data/HttpSpec/XmlHelper.hs b/src/Data/HttpSpec/XmlHelper.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/HttpSpec/XmlHelper.hs
@@ -0,0 +1,240 @@
+module Data.HttpSpec.XmlHelper
+
+-- == EXPORTS =================================================================
+    (XmlEncoding, xmlEncodingFromString, xmlEncodingToString
+    ,serializeXml, parseXml
+    ,pickle, pickleWithEnc, pickleStr, unpickle, unpickleStr, unpickleDocM
+    ,fromPair,fromTriple,fromQuadruple,fromQuintuple
+    ,PUCase, xpOne, xpMany, xpTagSwitch, xpCase, xpCaseConst, xpSwitch
+    ,xpTextFixed
+    ,_ISO8859_1_, _ISO8859_2_, _ISO8859_3_, _ISO8859_4_, _ISO8859_5_
+    ,_ISO8859_6_, _ISO8859_7_, _ISO8859_8_, _ISO8859_9_, _ISO8859_10_
+    ,_ISO8859_11_, _ISO8859_13_, _ISO8859_14_, _ISO8859_15_, _ISO8859_16_
+    ,_USASCII_, _UCS2_, _UTF8_, _UTF16_, _UTF16BE_, _UTF16LE_, _ISOLATIN1_
+    ,_UNICODE_)
+where
+
+-- == IMPORTS =================================================================
+
+----------------------------------------
+-- STDLIB
+----------------------------------------
+import Control.Monad (liftM)
+
+import Data.Char (toLower)
+import Data.Maybe (fromMaybe)
+import Data.List (elemIndex)
+
+----------------------------------------
+-- SITE-PACKAGES
+----------------------------------------
+import Control.Arrow.ArrowIf (when)
+import Control.Arrow.ArrowList (this,none)
+import Control.Arrow.ArrowTree (processChildren, processTopDown)
+
+import qualified Data.ByteString.Lazy.Char8 as BSLChar
+
+import Data.Tree.NTree.TypeDefs (NTrees, NTree(..))
+
+import Text.XML.HXT.Arrow
+    ( XmlTree, XmlPickler(..)
+    ,runLA, constA, (>>>), arr
+    ,addXmlPi,addXmlPiEncoding,replaceChildren,xshow,mkText,escapeXmlDoc
+    ,getChildren, xread)
+
+import Text.XML.HXT.Arrow.Pickle (PU(..), Schema, unpickleDoc,
+                                 pickleDoc ,xpElem, xpList, xpAlt, xpWrap,
+                                 xpWrapMaybe, xpLift, xpText)
+import Text.XML.HXT.Arrow.Pickle.Schema (scFixed)
+import Text.XML.HXT.Arrow.ParserInterface (parseXmlDoc,substXmlEntityRefs)
+import Text.XML.HXT.Arrow.Edit (canonicalizeContents, removeDocWhiteSpace
+                               ,transfAllCharRef, indentDoc)
+import Text.XML.HXT.Arrow.GeneralEntitySubstitution (processGeneralEntities)
+import Text.XML.HXT.Arrow.XmlArrow (root, isPi, hasName)
+import Text.XML.HXT.Arrow.DocumentOutput (encodeDocument')
+import Text.XML.HXT.DOM.TypeDefs (XNode(..))
+import Text.XML.HXT.DOM.XmlKeywords
+    (t_xml
+    ,iso8859_1, iso8859_2, iso8859_3, iso8859_4, iso8859_5, iso8859_6
+    ,iso8859_7, iso8859_8, iso8859_9, iso8859_10, iso8859_11, iso8859_13
+    ,iso8859_14, iso8859_15, iso8859_16, usAscii, ucs2, utf8, utf16, utf16be
+    ,utf16le, unicodeString, isoLatin1)
+import Text.XML.HXT.Arrow.Namespace (propagateNamespaces, validateNamespaces)
+
+----------------------------------------
+-- LOCAL
+----------------------------------------
+import Data.HttpSpec.MiscHelper (maybeToM)
+
+-- == TYPES ===================================================================
+
+newtype XmlEncoding = XmlEncoding { xmlEncodingName :: String } deriving (Eq)
+
+
+instance Show XmlEncoding where
+    show (XmlEncoding name) = name
+
+_UNICODE_ = XmlEncoding unicodeString
+_ISO8859_1_ = XmlEncoding iso8859_1
+_ISO8859_2_ = XmlEncoding iso8859_2
+_ISO8859_3_ = XmlEncoding iso8859_3
+_ISO8859_4_ = XmlEncoding iso8859_4
+_ISO8859_5_ = XmlEncoding iso8859_5
+_ISO8859_6_ = XmlEncoding iso8859_6
+_ISO8859_7_ = XmlEncoding iso8859_7
+_ISO8859_8_ = XmlEncoding iso8859_8
+_ISO8859_9_ = XmlEncoding iso8859_9
+_ISO8859_10_ = XmlEncoding iso8859_10
+_ISO8859_11_ = XmlEncoding iso8859_11
+_ISO8859_13_ = XmlEncoding iso8859_13
+_ISO8859_14_ = XmlEncoding iso8859_14
+_ISO8859_15_ = XmlEncoding iso8859_15
+_ISO8859_16_ = XmlEncoding iso8859_16
+_USASCII_ = XmlEncoding usAscii
+_UCS2_ = XmlEncoding ucs2
+_UTF8_ = XmlEncoding utf8
+_UTF16_ = XmlEncoding utf16
+_UTF16BE_ = XmlEncoding utf16be
+_UTF16LE_ = XmlEncoding utf16le
+_ISOLATIN1_ = XmlEncoding isoLatin1
+
+
+-- == ENCODING FUNCTIONS ======================================================
+
+xmlEncodingFromString :: String -> Either String XmlEncoding
+xmlEncodingFromString name =
+    case map toLower name of
+      "latin1" -> return _ISOLATIN1_
+      "latin9" -> return _ISO8859_15_
+      "iso-8859-1" -> return _ISO8859_1_
+      "iso-8859-2" -> return _ISO8859_2_
+      "iso-8859-3" -> return _ISO8859_3_
+      "iso-8859-4" -> return _ISO8859_4_
+      "iso-8859-5" -> return _ISO8859_5_
+      "iso-8859-6" -> return _ISO8859_6_
+      "iso-8859-7" -> return _ISO8859_7_
+      "iso-8859-8" -> return _ISO8859_8_
+      "iso-8859-9" -> return _ISO8859_9_
+      "iso-8859-10" -> return _ISO8859_10_
+      "iso-8859-11" -> return _ISO8859_11_
+      "iso-8859-13" -> return _ISO8859_13_
+      "iso-8859-14" -> return _ISO8859_14_
+      "iso-8859-15" -> return _ISO8859_15_
+      "utf8" -> return _UTF8_
+      "utf-8" -> return _UTF8_
+      "utf16" -> return _UTF16_
+      "utf-16" -> return _UTF16_
+      "ascii" -> return _USASCII_
+      "us-ascii" -> return _USASCII_
+      "unicode" -> return _UNICODE_
+      _ -> fail $ "Can't parse unsupported XmlEncoding name `" ++ name ++ "'."
+
+xmlEncodingToString :: XmlEncoding -> String
+xmlEncodingToString = show
+
+-- == XML FUNCTIONS ===========================================================
+
+xpOne :: PU a -> PU a
+xpOne = id
+
+xpMany :: String -> PU a -> PU [a]
+xpMany root pu = xpElem root (xpList pu)
+
+pickle :: PU a -> a -> BSLChar.ByteString
+pickle pu = serializeXml _UTF8_ . pickleDoc pu
+
+pickleWithEnc :: XmlEncoding -> PU a -> a -> BSLChar.ByteString
+pickleWithEnc enc pu = serializeXml' noProlog enc . pickleDoc pu
+    where noProlog = enc == _UNICODE_
+
+unpickle :: Monad m => PU a -> BSLChar.ByteString -> m a
+unpickle pu bsl = parseXml True True bsl >>= unpickleDocM pu
+
+pickleStr :: PU a -> a -> String
+pickleStr pu = BSLChar.unpack . pickleWithEnc _UNICODE_ pu
+
+unpickleDocM :: Monad m => PU a -> XmlTree -> m a
+unpickleDocM pu = maybeToM "Unpickling failed." . unpickleDoc pu
+
+unpickleStr pu = unpickle pu . BSLChar.pack
+
+serializeXml :: XmlEncoding -> XmlTree -> BSLChar.ByteString
+serializeXml enc xml = serializeXml' False enc xml
+
+serializeXml' :: Bool -> XmlEncoding -> XmlTree -> BSLChar.ByteString
+serializeXml' indent enc xml =
+    let [str] = runLA (constA xml >>> encodeA) undefined
+    in (BSLChar.pack (strip str))
+    where rmpi = enc == _UNICODE_
+          encodeA =
+              (if indent then processChildren indentDoc else this)
+              >>>
+              escapeXmlDoc
+              >>>
+              encodeDocument' rmpi (xmlEncodingName enc)
+              >>>
+              replaceChildren (xshow getChildren >>> arr encode >>> mkText)
+              >>>
+              xshow getChildren
+          encode = id
+          strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+          isSpace = (`elem` " \n\t")
+
+
+parseXml :: Monad m => Bool -> Bool -> BSLChar.ByteString -> m XmlTree
+parseXml rmpi rmspace bstr =
+    let trees = runLA pipe undefined
+    in case trees of
+         [] -> fail "empty result"
+         (NTree _ ((NTree (XError _ msg) _) : _) : _) -> fail msg
+         trees -> return (last trees)
+    where str = BSLChar.unpack bstr
+          pipe = root [] []
+                 >>> replaceChildren parse
+                 >>> (if rmpi then removeXmlPi else this)
+                 >>> (if rmspace then removeDocWhiteSpace else this)
+          parse = constA ("urn:Data.ByteString", str)
+                  >>> parseXmlDoc
+                  >>> substXmlEntityRefs
+                  >>> canonicalizeContents
+                 -- >>> propagateNamespaces
+
+removeXmlPi = processTopDown (none `when` (isPi >>> hasName t_xml))
+
+fromPair :: (a -> b -> c) -> (a, b) -> c
+fromPair f ~(a, b) = f a b
+
+fromTriple :: (a -> b -> c -> d) -> (a, b, c) -> d
+fromTriple f ~(a, b, c) = f a b c
+
+fromQuadruple :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
+fromQuadruple f ~(a, b, c, d) = f a b c d
+
+fromQuintuple :: (a -> b -> c -> d -> e -> f) -> (a, b, c, d, e) -> f
+fromQuintuple f ~(a, b, c, d, e) = f a b c d e
+
+data PUCase a = PUCase { case_value :: a
+                       , case_spec :: PU a }
+
+xpCase :: (a -> b, b -> a) -> PU a -> PUCase b
+xpCase wrapfuns@(aToB,_bToA) specA = PUCase value spec
+    where value = aToB (error "xpCase: tagging function requires evaluation")
+          spec = xpWrap wrapfuns specA
+
+xpCaseConst :: a -> PU () -> PUCase a
+xpCaseConst a pu = xpCase (const a, const undefined) pu
+    where undef = error "xpCaseConst: this value should have been ignored"
+
+xpSwitch :: Show a => [PUCase a] -> PU a
+xpSwitch = xpTagSwitch (takeWhile (/= ' ') . show)
+
+xpTagSwitch :: Eq t => (a -> t) -> [PUCase a] -> PU a
+xpTagSwitch tag cases = xpAlt idx (map case_spec cases)
+    where idx = fromMaybe err . flip elemIndex tags . tag
+          err = error $ "xpTagSwitch: no case matched"
+          tags = map (tag . case_value) cases
+
+xpTextFixed :: String -> PU ()
+xpTextFixed text =
+    (xpWrapMaybe (\t -> if t == text then Just () else Nothing, const text)
+     xpText) { theSchema = scFixed text }