diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2011, 
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * 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.
+
+    * Neither the name of  nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT
+OWNER 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.
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/roundtrip-xml.cabal b/roundtrip-xml.cabal
new file mode 100644
--- /dev/null
+++ b/roundtrip-xml.cabal
@@ -0,0 +1,47 @@
+Name:           roundtrip-xml
+Version:        0.1.0.0
+Synopsis:       Bidirectional (de-)serialization for XML.
+Description:    Roundtrip allows the definition of bidirectional
+                (de-)serialization specifications. This package provides
+                concrete implementations of these specifications
+                for the serialization format XML. See the roundtrip
+                package for more details.
+License:        BSD3
+License-file:   LICENSE
+Author:         Stefan Wehr <wehr@factisresearch.com>,
+                David Leuschner <leuschner@factisresearch.com>
+Maintainer:     Stefan Wehr <wehr@factisresearch.com>,
+Category:       Text
+Build-type:     Simple
+Cabal-version:  >=1.8
+
+Library
+  GHC-Prof-Options: -auto-all -caf-all
+  Hs-Source-Dirs: src
+  Exposed-modules:
+      Text.Roundtrip.Xml
+    , Text.Roundtrip.Xml.Classes
+    , Text.Roundtrip.Xml.Combinators
+    , Text.Roundtrip.Xml.Printer
+    , Text.Roundtrip.Xml.Parser
+    , Text.Roundtrip.Xml.Enumerator
+    , Text.Roundtrip.Xml.Enumerator.Printer
+    , Text.Roundtrip.Xml.Enumerator.Parser
+  Other-modules:
+      Text.Roundtrip.Xml.ParserInternal
+    , Text.Roundtrip.Xml.Pretty
+  Build-depends:
+      base == 4.*
+    , safe == 0.3.*
+    , bytestring == 0.9.*
+    , containers >= 0.3 && < 0.6
+    , mtl >= 1.1.1.1
+    , text == 0.11.*
+    , enumerator >= 0.4.8 && < 0.5
+    , xml-enumerator == 0.3.*
+    , xml-types == 0.3.*
+    , blaze-builder == 0.2.*
+    , blaze-builder-enumerator == 0.2.*
+    , pretty == 1.0.*
+    , parsec == 3.1.*
+    , roundtrip == 0.1.*
diff --git a/src/Text/Roundtrip/Xml.hs b/src/Text/Roundtrip/Xml.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml.hs
@@ -0,0 +1,13 @@
+module Text.Roundtrip.Xml (
+
+    module Text.Roundtrip.Xml.Classes
+  , module Text.Roundtrip.Xml.Combinators
+  , module Text.Roundtrip.Xml.Printer
+  , module Text.Roundtrip.Xml.Parser
+
+) where
+
+import Text.Roundtrip.Xml.Classes
+import Text.Roundtrip.Xml.Combinators
+import Text.Roundtrip.Xml.Printer
+import Text.Roundtrip.Xml.Parser
diff --git a/src/Text/Roundtrip/Xml/Classes.hs b/src/Text/Roundtrip/Xml/Classes.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Classes.hs
@@ -0,0 +1,39 @@
+module Text.Roundtrip.Xml.Classes (
+
+    XmlSyntax(..), Attribute
+
+) where
+
+import Data.Text as T
+
+import Data.XML.Types (Name(..), Content)
+
+import qualified Text.PrettyPrint.HughesPJ as P
+
+import Text.Roundtrip.Classes
+import Text.Roundtrip.SpecPrinter
+
+type Attribute = (Name, [Content])
+
+class Syntax delta => XmlSyntax delta where
+    xmlBeginDoc :: delta ()
+    xmlEndDoc :: delta ()
+    xmlBeginElem :: Name -> delta ()
+    xmlEndElem :: Name -> delta ()
+    xmlAttrValue :: Name -> delta T.Text -- FIXME: parser for attr value
+    xmlTextNotEmpty :: delta T.Text
+
+instance XmlSyntax SpecPrinter where
+    xmlBeginDoc = specPrinter $ P.text "begin-doc"
+    xmlEndDoc = specPrinter $ P.text "end-doc"
+    xmlBeginElem name = specPrinter $ P.text "<" P.<> P.text (format name) P.<+> P.text "...>"
+    xmlEndElem name = specPrinter $ P.text "</" P.<> P.text (format name) P.<> P.text ">"
+    xmlAttrValue name = specPrinter $ P.text "attr" P.<+> P.text (format name)
+    xmlTextNotEmpty = specPrinter $ P.text "text-node"
+
+format :: Name -> String
+format n =
+    case n of
+      Name localName _ (Just prefix) -> T.unpack prefix ++ ':' : T.unpack localName
+      Name localName (Just ns) Nothing -> '{' : (T.unpack ns ++ '}' : T.unpack localName)
+      Name localName Nothing Nothing -> T.unpack localName
diff --git a/src/Text/Roundtrip/Xml/Combinators.hs b/src/Text/Roundtrip/Xml/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Combinators.hs
@@ -0,0 +1,39 @@
+module Text.Roundtrip.Xml.Combinators (
+
+    eatWhiteSpace, xmlElem, xmlAttr, xmlFixedAttr, xmlText, xmlString
+
+) where
+
+import Prelude hiding ((.))
+
+import Control.Category ((.))
+import Data.Char (isSpace)
+import qualified Data.Text as T
+
+import Data.XML.Types (Name)
+import Safe (readMay)
+
+import Text.Roundtrip.Classes
+import Text.Roundtrip.Combinators
+import Text.Roundtrip.Xml.Classes
+
+import Control.Isomorphism.Partial
+
+eatWhiteSpace :: XmlSyntax d => d ()
+eatWhiteSpace = ignore T.empty . subset "allIsSpace" (T.all isSpace) <$> xmlText <|> pure ()
+
+xmlElem :: XmlSyntax x => Name -> x a -> x a
+xmlElem name children =
+    xmlBeginElem name *> children <* xmlEndElem name
+
+xmlAttr :: XmlSyntax x => Name -> Iso T.Text a -> x a
+xmlAttr name p = p <$> xmlAttrValue name
+
+xmlFixedAttr :: XmlSyntax x => Name -> T.Text -> x ()
+xmlFixedAttr name value = fixedValue value <$> xmlAttrValue name
+
+xmlText :: XmlSyntax d => d T.Text
+xmlText = optionalWithDefault T.empty xmlTextNotEmpty
+
+xmlString :: XmlSyntax d => d String
+xmlString = textStringIso <$> xmlText
diff --git a/src/Text/Roundtrip/Xml/Enumerator.hs b/src/Text/Roundtrip/Xml/Enumerator.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Enumerator.hs
@@ -0,0 +1,13 @@
+module Text.Roundtrip.Xml.Enumerator (
+
+    module Text.Roundtrip.Xml.Classes
+  , module Text.Roundtrip.Xml.Combinators
+  , module Text.Roundtrip.Xml.Enumerator.Printer
+  , module Text.Roundtrip.Xml.Enumerator.Parser
+
+) where
+
+import Text.Roundtrip.Xml.Classes
+import Text.Roundtrip.Xml.Combinators
+import Text.Roundtrip.Xml.Enumerator.Printer
+import Text.Roundtrip.Xml.Enumerator.Parser
diff --git a/src/Text/Roundtrip/Xml/Enumerator/Parser.hs b/src/Text/Roundtrip/Xml/Enumerator/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Enumerator/Parser.hs
@@ -0,0 +1,148 @@
+{-# OPTIONS_GHC -ddump-minimal-imports #-}
+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses #-}
+module Text.Roundtrip.Xml.Enumerator.Parser (
+
+    XmlParseIteratee, parseXml, parseXml', parseXml''
+  , XmlException(..)
+
+) where
+
+import Control.Monad.State
+import Control.Exception
+
+import qualified Data.Enumerator as E
+import qualified Data.Enumerator.List as EL
+import qualified Data.Text as T
+import Data.XML.Types
+import Data.Typeable
+
+import qualified Debug.Trace
+
+import qualified Text.Parsec as P
+
+import Text.Roundtrip
+import Text.Roundtrip.Xml
+import Text.Roundtrip.Xml.ParserInternal
+
+type PStreamPos = Int
+type PStreamState = (PStreamPos, Maybe RtEventWithPos) -- last event read from stream with position
+
+type XmlParseIteratee m a = GenXmlParser PStreamPos (StateT PStreamState (E.Iteratee RtEventWithPos m)) a
+
+data XmlException = ParseError P.ParseError
+                  | InvalidEntity T.Text P.SourcePos
+    deriving (Typeable, Show)
+
+instance Exception XmlException
+
+instance Monad m => P.Stream PStreamPos (StateT PStreamState (E.Iteratee RtEventWithPos m)) RtEventWithPos where
+    uncons pos =
+        do (lastPos, mLastTok) <- get
+           case () of
+             _| pos == lastPos ->
+                  do mx <- lift $ EL.head
+                     let pos' = pos + 1
+                     put (pos', mx)
+                     ("returning " ++ show mx ++ " from underlying stream, position " ++ show pos') `debug`
+                       case mx of
+                         Just x -> return $ Just (x, pos')
+                         Nothing -> return Nothing
+              | pos == lastPos - 1 ->
+                  ("returning " ++ show mLastTok ++ " from lookahead buffer, position " ++ show lastPos) `debug`
+                    case mLastTok of
+                      Just lastTok -> return $ Just (lastTok, lastPos)
+                      Nothing -> return Nothing
+              | otherwise ->  ("invalid lookahead, position request: " ++ show (pos + 1) ++
+                               ", position of next token: " ++ show (lastPos + 1) ++
+                               ", position of buffered token: " ++ show lastPos ++
+                               " (" ++ show mLastTok ++ ")") `warn` return Nothing
+
+parseXml :: Monad m => P.SourceName -> EntityRenderer -> XmlParseIteratee m a -> E.Iteratee Event m a
+parseXml sourceName entityRenderer p =
+    E.joinI $ EL.map eventWithoutPos E.$$
+              E.joinI $ simplify entityRenderer E.$$
+              parseXml''' sourceName p
+
+parseXml' :: Monad m => EntityRenderer -> XmlParseIteratee m a -> E.Iteratee EventWithPos m a
+parseXml' entityRenderer p =
+    do first <- E.peek
+       let sourceName = case first of
+                          Just (WithPos _ pos) -> P.sourceName pos
+                          Nothing -> ""
+       E.joinI $ simplify entityRenderer E.$$ parseXml''' sourceName p
+
+parseXml'' :: Monad m => P.SourceName -> EntityRenderer -> XmlParseIteratee m a -> E.Iteratee EventWithPos m a
+parseXml'' sourceName entityRenderer p =
+       E.joinI $ simplify entityRenderer E.$$ parseXml''' sourceName p
+
+parseXml''' :: Monad m => P.SourceName -> XmlParseIteratee m a -> E.Iteratee RtEventWithPos m a
+parseXml''' sourceName p =
+    let GenXmlParser q = xmlBeginDoc *> p <* xmlEndDoc
+    in do let startPos = -1
+          res <- evalStateT (P.runParserT q Nothing sourceName startPos) (startPos, Nothing)
+          case res of
+            Left err -> E.returnI (E.Error $ toException $ ParseError err)
+            Right x -> E.yield x E.EOF
+
+simplify :: Monad m => (T.Text -> Maybe T.Text) -> E.Enumeratee EventWithPos RtEventWithPos m b
+simplify renderEntity = loop
+  where
+    loop = E.checkDone go
+    go k =
+        do x <- EL.head
+           case x of
+             Nothing -> k (E.Chunks []) E.>>== return
+             Just (WithPos EventBeginDocument pos) ->
+                 k (E.Chunks [WithPos RtBeginDocument pos]) E.>>== loop
+             Just (WithPos EventEndDocument pos) ->
+                 k (E.Chunks [WithPos RtEndDocument pos]) E.>>== loop
+             Just (WithPos (EventInstruction{}) pos) -> go k
+             Just (WithPos (EventBeginDoctype{}) pos) -> go k
+             Just (WithPos (EventEndDoctype{}) pos) -> go k
+             Just (WithPos (EventBeginElement n as) pos) ->
+                 let insertAttr m (k, vs) =
+                      do vs' <- mapM (contentToText pos) vs
+                         return $ (k, (T.concat vs')) : m
+                 in do as' <- foldM insertAttr [] as
+                       as' `seq` k (E.Chunks [WithPos (RtBeginElement n (reverse as')) pos])
+                                 E.>>== loop
+             Just (WithPos (EventEndElement n) pos) ->
+                 k (E.Chunks [WithPos (RtEndElement n) pos]) E.>>== loop
+             Just (WithPos (EventContent c) pos) -> do
+                 t <- contentToText pos c
+                 ts <- takeContents $ (:) t
+                 let text = T.strip $ T.concat $ ts []
+                 if T.null text
+                    then go k
+                    else k (E.Chunks [WithPos (RtText text) pos]) E.>>== loop
+             Just (WithPos (EventComment{}) _) -> go k
+    contentToText pos c =
+        case c of
+          ContentEntity e ->
+              case renderEntity e of
+                Nothing -> E.throwError $ InvalidEntity e pos
+                Just t -> return t
+          ContentText t -> return t
+    takeContents front = do
+      do x <- E.peek
+         case x of
+           Nothing -> return front
+           Just (WithPos EventBeginElement{} pos) -> return front
+           Just (WithPos EventEndElement{} pos) -> return front
+           Just (WithPos (EventContent c) pos) ->
+               do EL.drop 1
+                  t <- contentToText pos c
+                  takeContents $ front . (:) t
+           Just (WithPos EventBeginDocument pos) -> return front
+           Just (WithPos EventEndDocument pos) -> return front
+           Just (WithPos EventInstruction{} pos) -> helper
+           Just (WithPos EventBeginDoctype{} pos) -> helper
+           Just (WithPos EventEndDoctype{} pos) -> helper
+           Just (WithPos EventComment{} pos) -> helper
+      where
+        helper = EL.drop 1 >> takeContents front
+
+warn = Debug.Trace.trace
+
+-- debug = Debug.Trace.trace
+debug _ x = x
diff --git a/src/Text/Roundtrip/Xml/Enumerator/Printer.hs b/src/Text/Roundtrip/Xml/Enumerator/Printer.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Enumerator/Printer.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+module Text.Roundtrip.Xml.Enumerator.Printer (
+
+  XmlPrinter, xmlPrintEnumerator, printToLazyByteString, printToByteString, printToString
+
+) where
+
+import Control.Monad.Identity
+import Control.Exception (SomeException, Exception, toException)
+import Data.Typeable (Typeable)
+import Data.Monoid (mconcat)
+
+import System.IO.Unsafe (unsafePerformIO)
+
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString as BS
+
+import qualified Data.Enumerator as E
+import qualified Data.Enumerator.List as EL
+import qualified Data.Enumerator.Binary as EB
+import qualified Data.Enumerator.Text as ET
+import qualified Data.Text.Lazy as TL
+import qualified Text.XML.Enumerator.Render as Xml
+import Blaze.ByteString.Builder (Builder, toLazyByteString, toByteString)
+
+import Data.XML.Types
+
+import Text.Roundtrip.Xml.Printer
+
+data PrinterError = PrinterError
+                  deriving (Show, Typeable)
+
+instance Exception PrinterError
+
+_CHUNK_SIZE_ :: Integer
+_CHUNK_SIZE_ = 20
+
+xmlPrintEnumerator :: Monad m => XmlPrinter a -> a -> E.Enumerator Event m b
+xmlPrintEnumerator p x =
+    case runXmlPrinter p x of
+      Just l -> E.enumList _CHUNK_SIZE_ l
+      Nothing -> \step -> case step of
+                            E.Error e -> E.throwError e
+                            _ -> E.throwError PrinterError
+
+printToByteString :: XmlPrinter a -> a -> Either SomeException BS.ByteString
+printToByteString p x =
+    case printToLazyByteString p x of
+      Right bsl -> Right $ BS.concat (BSL.toChunks bsl)
+      Left err -> Left err
+
+printToLazyByteString :: XmlPrinter a -> a -> Either SomeException BSL.ByteString
+printToLazyByteString p x =
+    unsafePerformIO $
+    E.run $
+    xmlPrintEnumerator p x E.$$
+    E.joinI $ (Xml.renderBytes E.$$ EB.consume)
+
+printToText p x =
+    unsafePerformIO $
+    E.run $
+    xmlPrintEnumerator p x E.$$
+    E.joinI $ (Xml.renderText E.$$ ET.consume)
+
+printToString :: XmlPrinter a -> a -> Either SomeException String
+printToString p x =
+    case printToText p x of
+      Left err -> Left err
+      Right text ->
+          case TL.unpack text of
+            ('<':'?':'x':'m':'l':z) -> Right (eat z)
+            str -> Right str
+    where
+      eat l =
+          case dropWhile (/= '?') l of
+            '>':xs -> xs
+            [] -> []
+            _:xs -> eat xs
diff --git a/src/Text/Roundtrip/Xml/Parser.hs b/src/Text/Roundtrip/Xml/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Parser.hs
@@ -0,0 +1,213 @@
+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}
+module Text.Roundtrip.Xml.Parser (
+
+    GenXmlParser, XmlParser, runXmlParser, runXmlParser', runXmlParser''
+
+  , WithPos, EventWithPos, eventWithPos, eventWithoutPos
+
+  , P.SourceName, P.Line, P.Column, P.ParseError
+
+  , EntityRenderer, defaultEntityRenderer
+
+) where
+
+import Control.Monad (unless, foldM)
+import Control.Monad.State
+import Control.Monad.Identity (Identity)
+import Control.Exception (ErrorCall(..), SomeException, Exception, toException)
+
+import qualified Data.Map as Map
+import Data.Map (Map)
+import qualified Data.List as List
+import Data.Typeable (Typeable)
+import qualified Data.Text as T
+import Data.Either (partitionEithers)
+
+import qualified Debug.Trace
+
+import qualified Text.Parsec as P
+import qualified Text.Parsec.Pos as P
+
+import qualified Text.PrettyPrint.HughesPJ as Pp
+
+import Data.XML.Types
+
+import Text.Roundtrip
+import Text.Roundtrip.Xml.Classes
+import Text.Roundtrip.Xml.ParserInternal
+import Text.Roundtrip.Xml.Pretty
+
+type EntityRenderer = T.Text -> Maybe T.Text
+
+defaultEntityRenderer :: EntityRenderer
+defaultEntityRenderer = const Nothing
+
+type XmlParser a = GenXmlParser [RtEventWithPos] Identity a
+
+runXmlParser :: P.SourceName -> EntityRenderer -> [Event] -> XmlParser a -> (Either P.ParseError a)
+runXmlParser sourceName renderer events p =
+    runXmlParser'' sourceName renderer (map eventWithoutPos events) p
+
+runXmlParser' :: EntityRenderer -> [EventWithPos] -> XmlParser a -> (Either P.ParseError a)
+runXmlParser' renderer events p = runXmlParser'' sourceName renderer events p
+    where
+      sourceName = case events of
+                     [] -> ""
+                     (e:_) -> P.sourceName (wp_pos e)
+
+runXmlParser'' :: P.SourceName -> EntityRenderer -> [EventWithPos] -> XmlParser a -> (Either P.ParseError a)
+runXmlParser'' sourceName entityRenderer events p =
+    let GenXmlParser q = xmlBeginDoc *> p <* xmlEndDoc
+        rtEvents = List.unfoldr (simplifyEvents entityRenderer) events
+    in P.runParser q Nothing sourceName rtEvents
+
+simplifyEvents :: EntityRenderer -> [EventWithPos] -> Maybe (RtEventWithPos, [EventWithPos])
+simplifyEvents renderEntity evs = go evs
+    where
+      go evs =
+        case evs of
+          [] -> Nothing
+          (WithPos EventBeginDocument pos : rest) -> Just (WithPos RtBeginDocument pos, rest)
+          (WithPos EventEndDocument pos : rest) -> Just (WithPos RtEndDocument pos, rest)
+          (WithPos (EventInstruction _) _ : rest) -> go rest
+          (WithPos (EventBeginDoctype _ _) _ : rest) -> go rest
+          (WithPos EventEndDoctype _ : rest) -> go rest
+          (WithPos (EventBeginElement n as) pos : rest) ->
+              let insertAttr :: Either T.Text AttrMap -> Attribute
+                             -> Either T.Text AttrMap
+                  insertAttr em (k, vs) =
+                      case em of
+                        Right m ->
+                            case partitionEithers (map contentToText vs) of
+                              ((t:_), _) -> Left t
+                              ([], vs') -> Right ((k, T.concat vs') : m)
+                        Left t -> Left t
+              in case Prelude.foldl insertAttr (Right []) as of
+                   Right as' ->  as' `seq` Just (WithPos (RtBeginElement n (reverse as')) pos, rest)
+                   Left t -> Just (WithPos (RtInvalidEntity t) pos, [])
+          (WithPos (EventEndElement n) pos : rest) -> Just (WithPos (RtEndElement n) pos, rest)
+          (WithPos (EventContent c) pos : rest) ->
+              case contentToText c of
+                Left t -> Just (WithPos (RtInvalidEntity t) pos, [])
+                Right t ->
+                    let (cs, rest') = splitContent rest
+                    in case partitionEithers (map contentToText cs) of
+                         ((t:_), _) -> Just (WithPos (RtInvalidEntity t) pos, [])
+                         ([], ts) -> let text = T.strip $ t `T.append` T.concat ts
+                                     in if T.null text
+                                           then go rest'
+                                           else Just (WithPos (RtText text) pos, rest')
+          (WithPos (EventComment _) _ : rest) -> go rest
+      splitContent (WithPos (EventContent c) pos : rest) =
+          let (cs, rest') = splitContent rest
+          in (c:cs, rest')
+      splitContent l = ([], l)
+      contentToText c =
+          case c of
+            ContentText t -> Right t
+            ContentEntity t ->
+                case renderEntity t of
+                  Just t' -> Right t'
+                  Nothing -> Left t
+
+instance (Monad m, P.Stream s m RtEventWithPos) => IsoFunctor (GenXmlParser s m) where
+    iso <$> (GenXmlParser p) = GenXmlParser $  xmlParserApply iso p
+
+instance (Monad m, P.Stream s m RtEventWithPos) => ProductFunctor (GenXmlParser s m) where
+    (GenXmlParser p) <*> (GenXmlParser q) = GenXmlParser $ xmlParserConcat p q
+
+instance (Monad m, P.Stream s m RtEventWithPos) => Alternative (GenXmlParser s m) where
+    GenXmlParser p <|> GenXmlParser q = GenXmlParser $ xmlParserAlternative1Lookahead p q
+    GenXmlParser p <||> GenXmlParser q = GenXmlParser $ xmlParserAlternativeInfLookahead p q
+    empty = GenXmlParser P.parserZero
+
+xmlParserApply iso p =
+    do a <- p
+       case apply iso a of
+         Just b -> return b
+         Nothing -> fail $ isoFailedErrorMessageL iso a
+
+xmlParserConcat p q =
+    do x <- p
+       y <- q
+       return (x, y)
+
+xmlParserAlternative1Lookahead p q = p P.<|> q
+
+xmlParserAlternativeInfLookahead p q = P.try p P.<|> q
+
+instance (Monad m, P.Stream s m RtEventWithPos) => Syntax (GenXmlParser s m) where
+    pure x = GenXmlParser (return x)
+
+instance (Monad m, P.Stream s m RtEventWithPos) => XmlSyntax (GenXmlParser s m) where
+    xmlBeginDoc = GenXmlParser xmlParserBeginDoc
+    xmlEndDoc = GenXmlParser xmlParserEndDoc
+    xmlBeginElem = GenXmlParser . xmlParserBeginElem
+    xmlAttrValue = GenXmlParser . xmlParserAttrValue
+    xmlTextNotEmpty = GenXmlParser xmlParserTextNotEmpty
+    xmlEndElem = GenXmlParser . xmlParserEndElem
+
+matchEvent :: (Show a, Monad m, P.Stream s m RtEventWithPos)
+           => (RtEvent -> Maybe a) -> String -> PParser s m a
+matchEvent matcher desc =
+    do state <- P.getState
+       case state of
+         Just _ -> P.parserZero
+         Nothing -> P.tokenPrim show (\_ t _ -> wp_pos t) debugMatcher
+   where
+     debugMatcher ev =
+         let res = matcher (wp_data ev)
+         in ("matching " ++ show ev ++ " against " ++ desc ++ ", result: " ++ show res) `debug` res
+
+mkPParser :: Monad m => String -> PParser s m a -> PParser s m a
+mkPParser msg p = (p P.<?> msg)
+
+xmlParserBeginDoc :: (Monad m, P.Stream s m RtEventWithPos) => PParser s m ()
+xmlParserBeginDoc = mkPParser "begin-document" $
+    let f RtBeginDocument = Just ()
+        f _ = Nothing
+    in matchEvent f "begin-document"
+
+xmlParserEndDoc :: (Monad m, P.Stream s m RtEventWithPos) => PParser s m ()
+xmlParserEndDoc = mkPParser "end-document" $
+    let f RtEndDocument = Just ()
+        f _ = Nothing
+    in matchEvent f "end-document"
+
+xmlParserBeginElem :: (Monad m, P.Stream s m RtEventWithPos) => Name -> PParser s m ()
+xmlParserBeginElem name = mkPParser ("<" ++ ppStr name ++ " ...>") $
+    do let f (RtBeginElement name' attrs) | name == name' = Just attrs
+           f _ = Nothing
+       attrs <- matchEvent f ("begin-element " ++ ppStr name)
+       unless (null attrs) (P.putState $ Just attrs)
+       return ()
+
+xmlParserAttrValue :: Monad m => Name -> PParser s m T.Text
+xmlParserAttrValue name = mkPParser ("attribute " ++ ppStr name) $
+    do state <- P.getState
+       case state of
+         Nothing -> P.parserZero
+         Just m ->
+             case List.break (\(x,_) -> x == name) m of
+               (prefix, (_, t) : suffix) ->
+                   do let m' = prefix ++ suffix
+                      if null m'
+                         then P.putState Nothing
+                         else P.putState (Just m')
+                      return t
+               _ -> P.parserZero
+
+xmlParserEndElem :: (Monad m, P.Stream s m RtEventWithPos) => Name -> PParser s m ()
+xmlParserEndElem name = mkPParser ("</" ++ ppStr name ++ ">") $
+    let f (RtEndElement name') | name == name' = Just ()
+        f _ = Nothing
+    in matchEvent f ("end-element " ++ ppStr name)
+
+xmlParserTextNotEmpty :: (Monad m, P.Stream s m RtEventWithPos) => PParser s m T.Text
+xmlParserTextNotEmpty = mkPParser "text node" $
+    let f (RtText t) = Just t
+        f _ = Nothing
+    in matchEvent f "text node"
+
+-- debug = Debug.Trace.trace
+debug _ x = x
diff --git a/src/Text/Roundtrip/Xml/ParserInternal.hs b/src/Text/Roundtrip/Xml/ParserInternal.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/ParserInternal.hs
@@ -0,0 +1,71 @@
+module Text.Roundtrip.Xml.ParserInternal (
+
+    PState, PParser, GenXmlParser(..)
+  , AttrMap, RtEvent(..)
+  , WithPos(..), RtEventWithPos
+  , EventWithPos, eventWithPos, eventWithoutPos
+
+) where
+
+import Data.XML.Types
+import qualified Data.Text as T
+
+import Text.PrettyPrint.HughesPJ
+
+import qualified Text.Parsec as P
+import qualified Text.Parsec.Pos as P
+
+import Text.Roundtrip.Xml.Pretty
+
+type PState = Maybe AttrMap
+type PParser s m a = P.ParsecT s PState m a
+newtype GenXmlParser s m a = GenXmlParser (PParser s m a)
+
+type AttrMap = [(Name, T.Text)]
+
+data RtEvent
+    = RtBeginDocument
+    | RtEndDocument
+    | RtBeginElement Name AttrMap
+    | RtText T.Text
+    | RtEndElement Name
+    | RtInvalidEntity T.Text
+      deriving (Eq)
+
+instance Pretty RtEvent where
+    pp RtBeginDocument = text "begin-document"
+    pp RtEndDocument = text "end-document"
+    pp (RtBeginElement n m) = text "<" <> pp n <>
+                                 (if null m
+                                     then empty
+                                     else Prelude.foldl (\d (n, t) -> d <+> pp n <> text "=" <>
+                                                                      doubleQuotes (text (T.unpack t)))
+                                                        (text "") m)
+                                 <> text ">"
+    pp (RtText t) = text "text" <> parens (shorten 32 t)
+        where shorten n t | T.length t <= n = text (T.unpack t)
+                          | otherwise = text (T.unpack (T.take n t)) <+> text "..."
+    pp  (RtEndElement n) = text "</" <> pp n <> text ">"
+
+instance Show RtEvent where
+    showsPrec _ ev = showString (render (pp ev))
+
+data WithPos a = WithPos {
+                     wp_data :: a
+                   , wp_pos  :: P.SourcePos
+                 }
+
+eventWithPos :: a -> P.SourceName -> P.Line -> P.Column -> WithPos a
+eventWithPos x s l c = WithPos x (P.newPos s l c)
+
+eventWithoutPos :: a -> WithPos a
+eventWithoutPos x = WithPos x (P.newPos "" (-1) (-1))
+
+type EventWithPos = WithPos Event
+type RtEventWithPos = WithPos RtEvent
+
+instance Pretty a => Pretty (WithPos a) where
+    pp (WithPos a p) = pp a <+> text " at " <+> text (show p)
+
+instance Pretty a => Show (WithPos a) where
+    showsPrec _ p = showString (render (pp p))
diff --git a/src/Text/Roundtrip/Xml/Pretty.hs b/src/Text/Roundtrip/Xml/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Pretty.hs
@@ -0,0 +1,26 @@
+module Text.Roundtrip.Xml.Pretty (
+
+    Pretty(..)
+
+) where
+
+import qualified Data.Text as T
+
+import Data.XML.Types
+import Text.PrettyPrint.HughesPJ
+
+class Pretty p where
+    pp :: p -> Doc
+    ppStr :: p -> String
+    ppStr = render . pp
+
+instance Pretty Name where
+    pp n =
+        case n of
+          Name localName _ (Just prefix) ->
+              text (T.unpack prefix) <> char ':' <>
+              text (T.unpack localName)
+          Name localName (Just ns) Nothing ->
+              char '{' <> text (T.unpack ns) <> char '}' <>
+              text (T.unpack localName)
+          Name localName Nothing Nothing -> text (T.unpack localName)
diff --git a/src/Text/Roundtrip/Xml/Printer.hs b/src/Text/Roundtrip/Xml/Printer.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Xml/Printer.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE OverloadedStrings, BangPatterns #-}
+module Text.Roundtrip.Xml.Printer (
+
+    XmlPrinter, runXmlPrinter
+
+) where
+
+import Control.Monad (mplus, liftM2)
+
+import Data.XML.Types
+import Control.Monad.State
+import qualified Data.Text as T
+
+import Control.Isomorphism.Partial
+import Text.Roundtrip
+import Text.Roundtrip.Xml.Classes
+
+data PState = PStateJust Name [Attribute]
+            | PStateNothing
+              deriving (Show)
+
+newtype XmlPrinter a = XmlPrinter { unXmlPrinter :: (a -> State PState (Maybe [Event])) }
+
+instance IsoFunctor XmlPrinter where
+    -- (<$>) :: Iso a b -> XmlPrinter a -> XmlPrinter b
+    (<$>) = xmlPrinterApply
+
+xmlPrinterApply iso (XmlPrinter p) = XmlPrinter (\b -> case unapply iso b of
+                                                         Just x -> p x
+                                                         Nothing -> return Nothing)
+
+instance ProductFunctor XmlPrinter where
+    -- (<*>) :: XmlPrinter a -> XmlPrinter b -> XmlPrinter (a, b)
+    (<*>) = {-# SCC "<*>XmlPrinter" #-} xmlPrinterConcat
+
+xmlPrinterConcat p q =
+    XmlPrinter (\(a, b) -> do ma <- unXmlPrinter p a
+                              case ma of
+                                Nothing -> return Nothing
+                                Just !ea -> do mb <- unXmlPrinter q b
+                                               case mb of
+                                                 Nothing -> return Nothing
+                                                 Just eb -> return (Just (ea ++ eb)))
+
+instance Alternative XmlPrinter where
+    -- (<|>) :: XmlPrinter a -> XmlPrinter a -> XmlPrinter a
+    (<|>) = xmlPrinterAlternative
+    (<||>) = xmlPrinterAlternative
+    empty = XmlPrinter (\_ -> return Nothing)
+
+xmlPrinterAlternative (XmlPrinter p) (XmlPrinter q) =
+    XmlPrinter (\a -> do state <- get
+                         ma <- p a
+                         case ma of
+                           Nothing -> put state >> q a
+                           Just ea -> return (Just ea))
+
+instance Syntax XmlPrinter where
+    pure = xmlPrinterPure
+
+xmlPrinterPure x = XmlPrinter (\y -> if x == y
+                                              then return (Just [])
+                                              else return Nothing)
+
+runXmlPrinter :: XmlPrinter a -> a -> Maybe [Event]
+runXmlPrinter (XmlPrinter p) x =
+    evalState (p x) PStateNothing
+
+instance XmlSyntax XmlPrinter where
+    xmlBeginDoc = xmlPrinterBeginDoc
+    xmlEndDoc = xmlPrinterEndDoc
+    xmlBeginElem = xmlPrinterBeginElem
+    xmlEndElem = xmlPrinterEndElem
+    xmlAttrValue = xmlPrinterAttrValue
+    xmlTextNotEmpty = xmlPrinterTextNotEmpty
+
+xmlPrinterBeginDoc :: XmlPrinter ()
+xmlPrinterBeginDoc = XmlPrinter $ \() -> return (Just [EventBeginDocument])
+
+xmlPrinterEndDoc :: XmlPrinter ()
+xmlPrinterEndDoc = XmlPrinter $ \() -> return (Just [EventEndDocument])
+
+xmlPrinterBeginElem :: Name -> XmlPrinter ()
+xmlPrinterBeginElem name = XmlPrinter $ \() ->
+    do l <- possiblyCloseOpeningTag []
+       state <- get
+       let newState = case state of
+                        PStateNothing -> PStateJust name []
+                        _ -> error $ "expected state Nothing, but got " ++ (show state)
+       put newState
+       return l
+
+xmlPrinterEndElem :: Name -> XmlPrinter ()
+xmlPrinterEndElem name = XmlPrinter $ \() -> possiblyCloseOpeningTag [EventEndElement name]
+
+xmlPrinterAttrValue :: Name -> XmlPrinter T.Text
+xmlPrinterAttrValue aName = XmlPrinter $ \value ->
+     do state <- get
+        let newState = case state of
+                         PStateJust elName attrs ->
+                             PStateJust elName ((aName, [ContentText value]) : attrs)
+                         PStateNothing -> error "xmlAttribute: state is Nothing"
+        put newState
+        return $ Just []
+
+xmlPrinterTextNotEmpty :: XmlPrinter T.Text
+xmlPrinterTextNotEmpty = XmlPrinter $ \value ->
+                         if T.null value
+                            then return $ Just []
+                            else possiblyCloseOpeningTag [EventContent (ContentText value)]
+
+possiblyCloseOpeningTag :: [Event] -> State PState (Maybe [Event])
+possiblyCloseOpeningTag l =
+    do state <- get
+       case state of
+         PStateJust name attrs ->
+             do put PStateNothing
+                return $ Just (EventBeginElement name (reverse attrs) : l)
+         PStateNothing -> return $ Just l