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.cabal b/roundtrip.cabal
new file mode 100644
--- /dev/null
+++ b/roundtrip.cabal
@@ -0,0 +1,47 @@
+Name:           roundtrip
+Version:        0.1.0.0
+Synopsis:       Bidirectional (de-)serialization
+Description:    Roundtrip allows the definition of bidirectional
+                (de-)serialization specifications. The specification language
+                is based on the ideas described in the paper /Invertible
+                Syntax Descriptions: Unifying Parsing and Pretty Printing/
+                by Tillmann Rendel and Klaus Ostermann, Haskell Symposium 2010.
+                .
+                This package does not provide concrete instances of the
+                specification classes, see the package roundtrip-xml instead.
+                .
+                The package contains slightly modified code from
+                Tillmann Rendel's partial-isomorphisms and invertible-syntax
+                packages.
+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
+  Extensions: TemplateHaskell
+  GHC-Prof-Options: -auto-all -caf-all
+  Hs-Source-Dirs: src
+  Exposed-modules:
+      Text.Roundtrip
+    , Text.Roundtrip.Combinators
+    , Text.Roundtrip.Classes
+    , Text.Roundtrip.SpecPrinter
+    , Control.Isomorphism.Partial
+    , Control.Isomorphism.Partial.Prim
+    , Control.Isomorphism.Partial.Iso
+    , Control.Isomorphism.Partial.TH
+    , Control.Isomorphism.Partial.Constructors
+    , Control.Isomorphism.Partial.Derived
+  Build-depends:
+      base == 4.*
+    , safe == 0.3.*
+    , containers >= 0.3 && < 0.6
+    , text == 0.11.*
+    , template-haskell >= 2.4 && < 2.6
+    , xml-types == 0.3.*
+    , pretty == 1.0.*
diff --git a/src/Control/Isomorphism/Partial.hs b/src/Control/Isomorphism/Partial.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Isomorphism/Partial.hs
@@ -0,0 +1,11 @@
+module Control.Isomorphism.Partial
+  ( module Control.Isomorphism.Partial.Prim
+  , module Control.Isomorphism.Partial.Derived
+  , module Control.Isomorphism.Partial.Constructors
+  , module Control.Isomorphism.Partial.Iso
+  ) where
+
+import Control.Isomorphism.Partial.Prim
+import Control.Isomorphism.Partial.Derived
+import Control.Isomorphism.Partial.Constructors
+import Control.Isomorphism.Partial.Iso
diff --git a/src/Control/Isomorphism/Partial/Constructors.hs b/src/Control/Isomorphism/Partial/Constructors.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Isomorphism/Partial/Constructors.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Control.Isomorphism.Partial.Constructors
+  ( nil
+  , cons
+  , listCases
+  , left
+  , right
+  , nothing
+  , just
+  , readShowIso
+  , textStringIso
+  , lazyStrictTextIso
+  , listMapIso
+  ) where
+
+import Prelude hiding ((.), id)
+import Control.Category ((.), id)
+
+import Data.Bool (Bool, otherwise)
+import Data.Either (Either (Left, Right))
+import Data.Eq (Eq ((==)))
+import Data.Maybe (Maybe (Just, Nothing))
+
+import qualified Data.Map as Map
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+
+import Safe (readMay)
+
+import Control.Isomorphism.Partial.Iso
+import Control.Isomorphism.Partial.TH (defineIsomorphisms)
+
+nil :: Iso () [alpha]
+nil = unsafeMakeIso f g where
+  f ()  =  Just []
+  g []  =  Just ()
+  g _   =  Nothing
+
+cons :: Iso (alpha, [alpha]) [alpha]
+cons = unsafeMakeIso f g where
+  f (x, xs)   =  Just (x : xs)
+  g (x : xs)  =  Just (x, xs)
+  g _         =  Nothing
+
+listCases :: Iso (Either () (alpha, [alpha])) [alpha]
+listCases = unsafeMakeIso f g
+  where
+    f (Left ())        =  Just []
+    f (Right (x, xs))  =  Just (x : xs)
+    g []               =  Just (Left ())
+    g (x:xs)           =  Just (Right (x, xs))
+
+$(defineIsomorphisms ''Either)
+$(defineIsomorphisms ''Maybe)
+
+readShowIso :: (Read a, Show a) => Iso T.Text a
+readShowIso = unsafeMakeNamedIsoLR "readShow" (readMay . T.unpack) (Just . T.pack . show)
+
+textStringIso :: Iso T.Text String
+textStringIso = unsafeMakeNamedIsoLR "textString" (Just . T.unpack) (Just . T.pack)
+
+lazyStrictTextIso :: Iso TL.Text T.Text
+lazyStrictTextIso = unsafeMakeNamedIsoLR "lazyStrictText" lazyToStrict strictToLazy
+    where
+      lazyToStrict = Just . T.concat . TL.toChunks
+      strictToLazy = Just . TL.fromChunks . (:[])
+
+listMapIso :: Ord a => Iso ([(a, b)]) (Map.Map a b)
+listMapIso = unsafeMakeNamedIso "listMap" (Just . Map.fromList) (Just . Map.toList)
diff --git a/src/Control/Isomorphism/Partial/Derived.hs b/src/Control/Isomorphism/Partial/Derived.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Isomorphism/Partial/Derived.hs
@@ -0,0 +1,24 @@
+module Control.Isomorphism.Partial.Derived (
+
+    foldl, swap23
+
+) where
+
+import Prelude ()
+import Control.Category (Category (id, (.)))
+
+import Control.Isomorphism.Partial.Iso (Iso)
+import Control.Isomorphism.Partial.Prim
+import Control.Isomorphism.Partial.Constructors (cons, nil)
+
+foldl :: Iso (alpha, beta) alpha -> Iso (alpha, [beta]) alpha
+foldl i = inverse unit
+        . (id *** inverse nil)
+        . iterateIso (step i) where
+
+  step i = (i *** id)
+         . associate
+         . (id *** inverse cons)
+
+swap23 :: Iso (a, (b, c)) (a, (c, b))
+swap23 = id *** commute
diff --git a/src/Control/Isomorphism/Partial/Iso.hs b/src/Control/Isomorphism/Partial/Iso.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Isomorphism/Partial/Iso.hs
@@ -0,0 +1,85 @@
+module Control.Isomorphism.Partial.Iso (
+
+    Iso, unsafeMakeIso, unsafeMakeIso', unsafeMakeNamedIso, unsafeMakeNamedIsoL
+  , unsafeMakeNamedIsoR, unsafeMakeNamedIsoLR, isoRL, isoLR, isoName
+  , isoShowSL, isoShowSR, isoShowL, isoShowR
+  , isoFailedErrorMessageL, isoFailedErrorMessageR
+
+) where
+
+data Iso a b = Iso {
+      isoLR     :: a -> Maybe b
+    , isoRL     :: b -> Maybe a
+    , isoName   :: String
+    , isoShowSL :: Maybe (a -> ShowS)
+    , isoShowSR :: Maybe (b -> ShowS)
+    }
+
+unsafeMakeIso :: (alpha -> Maybe beta) -> (beta -> Maybe alpha) -> Iso alpha beta
+unsafeMakeIso f g = Iso { isoLR = f
+                        , isoRL = g
+                        , isoName = "?"
+                        , isoShowSL = Nothing
+                        , isoShowSR = Nothing }
+
+unsafeMakeIso' :: String -> Maybe (a -> ShowS) -> Maybe (b -> ShowS)
+               -> (a -> Maybe b) -> (b -> Maybe a) -> Iso a b
+unsafeMakeIso' name showSL showSR f g = Iso { isoLR = f
+                                            , isoRL = g
+                                            , isoName = name
+                                            , isoShowSL = showSL
+                                            , isoShowSR = showSR }
+
+unsafeMakeNamedIso :: String -> (alpha -> Maybe beta) -> (beta -> Maybe alpha) -> Iso alpha beta
+unsafeMakeNamedIso name f g = Iso { isoLR = f
+                                  , isoRL = g
+                                  , isoName = name
+                                  , isoShowSL = Nothing
+                                  , isoShowSR = Nothing }
+
+unsafeMakeNamedIsoL :: Show alpha
+                    => String -> (alpha -> Maybe beta) -> (beta -> Maybe alpha) -> Iso alpha beta
+unsafeMakeNamedIsoL name f g = Iso { isoLR = f
+                                   , isoRL = g
+                                   , isoName = name
+                                   , isoShowSL = Just shows
+                                   , isoShowSR = Nothing }
+
+unsafeMakeNamedIsoR :: Show beta
+                    => String -> (alpha -> Maybe beta) -> (beta -> Maybe alpha) -> Iso alpha beta
+unsafeMakeNamedIsoR name f g = Iso { isoLR = f
+                                   , isoRL = g
+                                   , isoName = name
+                                   , isoShowSL = Nothing
+                                   , isoShowSR = Just shows }
+
+unsafeMakeNamedIsoLR :: (Show alpha, Show beta)
+                     => String -> (alpha -> Maybe beta) -> (beta -> Maybe alpha) -> Iso alpha beta
+unsafeMakeNamedIsoLR name f g = Iso { isoLR = f
+                                    , isoRL = g
+                                    , isoName = name
+                                    , isoShowSL = Just shows
+                                    , isoShowSR = Just shows }
+
+isoShowL :: Iso a b -> Maybe (a -> String)
+isoShowL iso = makeShow (isoShowSL iso)
+
+isoShowR :: Iso a b -> Maybe (b -> String)
+isoShowR iso = makeShow (isoShowSR iso)
+
+makeShow :: Maybe (a -> ShowS) -> Maybe (a -> String)
+makeShow Nothing = Nothing
+makeShow (Just f) = Just (\x -> f x "")
+
+isoFailedErrorMessageL :: Iso a b -> a -> String
+isoFailedErrorMessageL iso = isoFailedErrorMessage (isoName iso) (isoShowSL iso)
+
+isoFailedErrorMessageR :: Iso a b -> b -> String
+isoFailedErrorMessageR iso = isoFailedErrorMessage (isoName iso) (isoShowSR iso)
+
+isoFailedErrorMessage :: String -> Maybe (a -> ShowS) -> a -> String
+isoFailedErrorMessage name mf x =
+    "Isomorphism " ++ name ++ " failed" ++
+    (case mf of
+       Nothing -> ""
+       Just f -> " on input " ++ f x "")
diff --git a/src/Control/Isomorphism/Partial/Prim.hs b/src/Control/Isomorphism/Partial/Prim.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Isomorphism/Partial/Prim.hs
@@ -0,0 +1,144 @@
+module Control.Isomorphism.Partial.Prim
+  ( idIso
+  , inverse
+  , apply
+  , unapply
+  , IsoFunctor ((<$>))
+  , ignore
+  , (***)
+  , (|||)
+  , associate
+  , commute
+  , unit
+  , element
+  , subset
+  , iterateIso
+  , distribute
+  ) where
+
+import Prelude hiding ((.), id)
+
+import Control.Monad (liftM2, (>=>), fmap, mplus)
+import Control.Category (Category (id, (.)))
+
+import Data.Bool (Bool, otherwise)
+import Data.Either (Either (Left, Right))
+import Data.Eq (Eq ((==)))
+import Data.Maybe (Maybe (Just, Nothing))
+
+import Control.Isomorphism.Partial.Iso
+
+inverse :: Iso alpha beta -> Iso beta alpha
+inverse iso = unsafeMakeIso' name' (isoShowSR iso) (isoShowSL iso) (isoRL iso) (isoLR iso)
+    where
+      name' = "inverse(" ++ isoName iso ++ ")"
+
+apply :: Iso alpha beta -> alpha -> Maybe beta
+apply = isoLR
+
+unapply  ::  Iso alpha beta -> beta -> Maybe alpha
+unapply = isoRL
+
+idIso :: Iso a a
+idIso = unsafeMakeNamedIso "id" Just Just
+
+instance Category Iso where
+  g . f = unsafeMakeIso' name' (isoShowSL f) (isoShowSR g)
+                        (apply f >=> apply g) (unapply g >=> unapply f)
+      where
+        name' = "(" ++ isoName g ++ " . " ++ isoName f ++ ")"
+  id = idIso
+
+infix 5 <$>
+
+class IsoFunctor f where
+  (<$>) :: Iso alpha beta -> (f alpha -> f beta)
+
+ignore :: alpha -> Iso alpha ()
+ignore x = unsafeMakeNamedIsoR "ignore" f g where
+  f _   =  Just ()
+  g ()  =  Just x
+
+-- | the product type constructor `(,)` is a bifunctor from
+-- `Iso` $\times$ `Iso` to `Iso`, so that we have the
+-- bifunctorial map `***` which allows two separate isomorphisms
+-- to work on the two components of a tuple.
+(***) :: Iso alpha beta -> Iso gamma delta -> Iso (alpha, gamma) (beta, delta)
+i *** j = unsafeMakeIso' name (showPair isoShowSL isoShowSL) (showPair isoShowSR isoShowSR) f g
+    where
+      f (a, b) = liftM2 (,) (apply i a) (apply j b)
+      g (c, d) = liftM2 (,) (unapply i c) (unapply j d)
+      name = "(" ++ isoName i ++ " *** " ++ isoName j ++ ")"
+      showPair f g =
+          case (f i, g j) of
+            (Just si, Just sj) -> Just $ \(x,y) -> showChar '(' . si x . showString ", "
+                                                   . sj y . showString ")"
+            _ -> Nothing
+
+-- | The mediating arrow for sums constructed with `Either`.
+-- This is not a proper partial isomorphism because of `mplus`.
+(|||) :: Iso alpha gamma -> Iso beta gamma -> Iso (Either alpha beta) gamma
+i ||| j = unsafeMakeIso' name showEither (isoShowSR i `mplus` isoShowSR j) f g
+    where
+      f (Left x) = apply i x
+      f (Right x) = apply j x
+      g y = (Left `fmap` unapply i y) `mplus` (Right `fmap` unapply j y)
+      name = "(" ++ isoName i ++ " ||| " ++ isoName j ++ ")"
+      showEither =
+          case (isoShowSL i, isoShowSL j) of
+            (Just si, Just sj) -> Just $ \e -> case e of
+                                                 Left x -> showChar '(' . showString "Left " .
+                                                           si x . showChar ')'
+                                                 Right x -> showChar '(' . showString "Right " .
+                                                            sj x . showChar ')'
+            _ -> Nothing
+
+-- | Nested products associate.
+associate :: Iso (alpha, (beta, gamma)) ((alpha, beta), gamma)
+associate = unsafeMakeIso f g where
+  f (a, (b, c)) = Just ((a, b), c)
+  g ((a, b), c) = Just (a, (b, c))
+
+-- | Products commute.
+commute :: Iso (alpha, beta) (beta, alpha)
+commute = unsafeMakeIso f f where
+  f (a, b) = Just (b, a)
+
+-- | `()` is the unit element for products.
+unit :: Iso alpha (alpha, ())
+unit = unsafeMakeNamedIso "unit" f g
+    where
+      f a = Just (a, ())
+      g (a, ()) = Just a
+
+-- | Products distribute over sums.
+distribute :: Iso (alpha, Either beta gamma) (Either (alpha, beta) (alpha, gamma))
+distribute = unsafeMakeIso f g where
+  f (a, Left   b)    =  Just (Left   (a, b))
+  f (a, Right  c)    =  Just (Right  (a, c))
+  g (Left   (a, b))  =  Just (a,  Left   b)
+  g (Right  (a, b))  =  Just (a,  Right  b)
+
+-- | `element x` is the partial isomorphism between `()` and the
+-- singleton set which contains just `x`.
+element :: (Show alpha, Eq alpha) => alpha -> Iso () alpha
+element x = unsafeMakeNamedIsoR ("element(" ++ show x ++ ")")
+  (\a -> Just x)
+  (\b -> if x == b then Just () else Nothing)
+
+-- | For a predicate `p`, `subset p` is the identity isomorphism
+-- restricted to elements matching the predicate.
+subset :: Show alpha => String -> (alpha -> Bool) -> Iso alpha alpha
+subset name p = unsafeMakeNamedIsoLR ("subset(" ++ name ++ ")") f f where
+  f x | p x = Just x
+      | otherwise = Nothing
+
+iterateIso :: Iso alpha alpha -> Iso alpha alpha
+iterateIso step = unsafeMakeIso f g where
+  f = Just . driver (apply step)
+  g = Just . driver (unapply step)
+  driver :: (alpha -> Maybe alpha) -> (alpha -> alpha)
+  driver step state
+    =  case step state of
+         Just state'  ->  driver step state'
+         Nothing      ->  state
diff --git a/src/Control/Isomorphism/Partial/TH.hs b/src/Control/Isomorphism/Partial/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Isomorphism/Partial/TH.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Control.Isomorphism.Partial.TH
+  ( defineIsomorphisms
+  , defineIsomorphisms'
+  ) where
+
+----------------------------------------
+-- SITE-PACKAGES
+----------------------------------------
+import Language.Haskell.TH ( lamE, tupP, appE, conE, varP, caseE
+                           , match, conP, normalB, newName, clause
+                           , funD, mkName, reify, varE, nameBase
+                           , Info(..), Dec(..), Con(..), wildP, tupE
+                           , Name, Q, MatchQ
+                           )
+import Control.Monad (replicateM)
+import Data.List (find)
+import Data.Char (toLower)
+
+----------------------------------------
+-- LOCAL
+----------------------------------------
+import Control.Isomorphism.Partial.Iso (Iso, unsafeMakeIso)
+
+defineIsomorphisms :: Name -> Q [Dec]
+defineIsomorphisms d = defineIsomorphisms' d (\(x:xs) -> (toLower x):xs)
+
+defineIsomorphisms' :: Name -> (String -> String) -> Q [Dec]
+defineIsomorphisms' d renameFun =
+    do info <- reify d
+       let cs = case info of
+                  TyConI (DataD _ _ _ cs _) -> cs
+                  TyConI (NewtypeD _ _ _ c _) -> [c]
+                  otherwise -> error $ show d ++
+                                       " neither denotes a data or newtype declaration. Found: " ++
+                                       show info
+       mapM (defFromCon (length cs > 1) renameFun) cs
+
+defFromCon :: Bool -> (String -> String) -> Con -> Q Dec
+defFromCon wc renameFun con@(NormalC n fields) = funCreation wc n (length fields) renameFun
+defFromCon wc renameFun con@(RecC n fields) = funCreation wc n (length fields) renameFun
+defFromCon wc renameFun con@(InfixC _ n _) = funCreation wc n 2 renameFun
+defFromCon wc renameFun con@(ForallC _ _ _) = error $ "defineIsomorphisms not available for " ++
+                                                      "existential data constructors"
+
+funCreation :: Bool -> Name -> Int -> (String -> String) -> Q Dec
+funCreation wc n nfields renameFun =
+    funD (mkName $ renameFun $ nameBase n)
+      [clause [] (normalB (isoFromCon (wildcard wc) n nfields)) []]
+
+isoFromCon wildcard conName nfields =
+    do (paths, exprs)  <-  genPE nfields
+       dat <-  newName "x"
+       let f = lamE [nested tupP paths]
+                    [| Just $(foldl appE (conE conName) exprs) |]
+       let g = lamE [varP dat]
+                  (caseE (varE dat) $
+                    [ match (conP conName paths)
+                        (normalB [| Just $(nested tupE exprs) |]) []
+                    ] ++ wildcard)
+       [| unsafeMakeIso $f $g |]
+
+wildcard :: Bool -> [MatchQ]
+wildcard True = [match (wildP) (normalB [| Nothing |]) []]
+wildcard _ = []
+
+genPE number = do
+  ids <- replicateM number (newName "x")
+  return (map varP ids, map varE ids)
+
+checkInfix :: Con -> Bool
+checkInfix (InfixC _ _ _) = False
+checkInfix _ = True
+
+nested tup []      =  tup []
+nested tup [x]     =  x
+nested tup (x:xs)  =  tup [x, nested tup xs]
diff --git a/src/Text/Roundtrip.hs b/src/Text/Roundtrip.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip.hs
@@ -0,0 +1,11 @@
+module Text.Roundtrip (
+
+    module Text.Roundtrip.Classes
+  , module Text.Roundtrip.Combinators
+  , module Control.Isomorphism.Partial
+
+)  where
+
+import Text.Roundtrip.Classes
+import Text.Roundtrip.Combinators
+import Control.Isomorphism.Partial
diff --git a/src/Text/Roundtrip/Classes.hs b/src/Text/Roundtrip/Classes.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Classes.hs
@@ -0,0 +1,36 @@
+module Text.Roundtrip.Classes where
+
+--import Prelude ()
+
+import Control.Isomorphism.Partial (IsoFunctor)
+import Data.Eq (Eq)
+import Data.Char (Char)
+
+infixl 3 <|>
+infixl 3 <||>
+infixr 6 <*>
+
+class ProductFunctor f where
+  (<*>) :: f alpha -> f beta -> f (alpha, beta)
+
+class Alternative f where
+  -- one token lookahead for lhs
+  (<|>)  :: f alpha -> f alpha -> f alpha
+  -- infinite lookahead for lhs
+  (<||>) :: f alpha -> f alpha -> f alpha
+  empty  :: f alpha
+
+class (IsoFunctor delta, ProductFunctor delta, Alternative delta)
+   => Syntax delta where
+  -- (<$>)   ::  Iso alpha beta -> delta alpha -> delta beta
+  -- (<*>)   ::  delta alpha -> delta beta -> delta (alpha, beta)
+  -- (<|>)   ::  delta alpha -> delta alpha -> delta alpha
+  -- empty   ::  delta alpha
+  pure    ::  Eq alpha => alpha -> delta alpha
+  rule :: String -> delta beta -> delta alpha -> delta alpha
+  rule _ _ x = x
+  ruleInfix :: String -> delta beta -> delta gamma -> delta alpha -> delta alpha
+  ruleInfix _ _ _ x = x
+
+class Syntax delta => StringSyntax delta where
+  token  ::  delta Char
diff --git a/src/Text/Roundtrip/Combinators.hs b/src/Text/Roundtrip/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/Combinators.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE BangPatterns #-}
+module Text.Roundtrip.Combinators
+  (  -- * Lexemes
+     text
+  ,  comma
+  ,  dot
+     -- * Repetition
+  ,  many
+  ,  many1
+  ,  sepBy
+  ,  chainl1
+     -- * Sequencing
+  ,  (*>)
+  ,  (<*)
+  ,  between
+     -- * Alternation
+  ,  (<+>)
+  ,  optional
+  ,  optionalWithDefault
+     -- * Whitespace
+  ,  skipSpace
+  ,  sepSpace
+  ,  optSpace
+
+     -- * Other
+  ,  fixedValue
+) where
+
+import Prelude hiding ((.), foldl)
+
+import Control.Category ((.))
+import Control.Isomorphism.Partial.Constructors (nothing, just, nil, cons, left, right)
+import Control.Isomorphism.Partial.Derived (foldl)
+import Control.Isomorphism.Partial.Iso (Iso)
+import Control.Isomorphism.Partial.Prim ((<$>), inverse, element, unit, commute, ignore)
+
+import Data.Char (String)
+import Data.Maybe (Maybe)
+import Data.Either (Either)
+
+import Text.Roundtrip.Classes
+
+-- derived combinators
+many :: Syntax delta => delta alpha -> delta [alpha]
+many p =
+    rule "many" p $
+    (cons <$> p <*> many p
+     <|> nil <$> pure ())
+
+many1 :: Syntax delta => delta alpha -> delta [alpha]
+many1 p =
+    rule "many1" p $ cons <$> p <*> many p
+
+infixl 4 <+>
+
+(<+>) :: Syntax delta => delta alpha -> delta beta -> delta (Either alpha beta)
+p <+> q = (left <$> p) <|> (right <$> q)
+
+-- | `text` parses\/prints a fixed text and consumes\/produces a unit value.
+text :: StringSyntax delta => String -> delta ()
+text []      =    pure ()
+text (c:cs)  =    inverse (element ((), ()))
+             <$>  (inverse (element c) <$> token)
+             <*>  text cs
+
+infixr 6 *>, <*
+
+-- | This variant of `<*>` ignores its left result.
+-- In contrast to its counterpart derived from the `Applicative` class, the ignored
+-- parts have type `delta ()` rather than `delta beta` because otherwise information relevant
+-- for pretty-printing would be lost.
+
+(*>) :: Syntax delta => delta () -> delta alpha -> delta alpha
+p *> q = ruleInfix "*>" p q $ inverse unit . commute <$> p <*> q
+
+-- | This variant of `<*>` ignores its right result.
+-- In contrast to its counterpart derived from the `Applicative` class, the ignored
+-- parts have type `delta ()` rather than `delta beta` because otherwise information relevant
+-- for pretty-printing would be lost.
+
+(<*) :: Syntax delta => delta alpha -> delta () -> delta alpha
+p <* q = ruleInfix "<*" p q $ inverse unit <$> p <*> q
+
+-- | The `between` function combines `*>` and `<*` in the obvious way.
+between :: Syntax delta => delta () -> delta () -> delta alpha -> delta alpha
+between p q r = p *> r <* q
+
+-- | The `chainl1` combinator is used to parse a
+-- left-associative chain of infix operators.
+chainl1 :: Syntax delta => delta alpha -> delta beta -> Iso (alpha, (beta, alpha)) alpha -> delta alpha
+chainl1 arg op f
+  = foldl f <$> arg <*> many (op <*> arg)
+
+optional :: Syntax delta => delta alpha -> delta (Maybe alpha)
+optional x  = rule "optional" x $ just <$> x <|> nothing <$> (pure ())
+
+optionalWithDefault :: (Eq alpha, Syntax delta) => alpha -> delta alpha -> delta alpha
+optionalWithDefault def x = rule "optionalWithDefault" x $ x <|> pure def
+
+sepBy :: Syntax delta => delta alpha -> delta () -> delta [alpha]
+sepBy x sep
+  =   cons <$> x <*> many (sep *> x)
+  <|> nil <$> (pure ())
+
+comma :: StringSyntax delta => delta ()
+comma = text ","
+
+dot :: StringSyntax delta => delta ()
+dot = text "."
+
+
+-- Expressing whitespace
+-- ---------------------
+--
+-- Parsers and pretty printers treat whitespace
+-- differently. Parsers
+-- specify where whitespace is allowed or required to occur, while
+-- pretty printers specify how much whitespace is to be inserted at
+-- these locations. To account for these different roles of
+-- whitespace, the following three syntax descriptions provide
+-- fine-grained control over where whitespace is allowed, desired or
+-- required to occur.
+
+-- | `skipSpace` marks a position where whitespace is allowed to
+-- occur. It accepts arbitrary space while parsing, and produces
+-- no space while printing.
+
+skipSpace  ::  StringSyntax delta => delta ()
+skipSpace  =   ignore []    <$>  many (text " ")
+
+-- | `optSpace` marks a position where whitespace is desired to occur.
+-- It accepts arbitrary space while parsing, and produces a
+-- single space character while printing.
+
+optSpace  ::  StringSyntax delta => delta ()
+optSpace  =   ignore [()]  <$>  many (text " ")
+
+-- | `sepSpace` marks a position where whitespace is required to
+-- occur. It requires one or more space characters while parsing,
+-- and produces a single space character while printing.
+
+sepSpace  ::  StringSyntax delta => delta ()
+sepSpace  =   text " " <* skipSpace
+
+fixedValue :: (Show a, Eq a) => a -> Iso a ()
+fixedValue = inverse . element
diff --git a/src/Text/Roundtrip/SpecPrinter.hs b/src/Text/Roundtrip/SpecPrinter.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/Roundtrip/SpecPrinter.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Text.Roundtrip.SpecPrinter (
+
+  SpecPrinter, specPrinter, runSpecPrinter
+
+) where
+
+import Prelude hiding (catch)
+
+import Control.Exception (AsyncException, catch)
+import qualified Data.Text.Lazy as TL
+import Text.PrettyPrint.HughesPJ
+
+import Control.Isomorphism.Partial
+import Text.Roundtrip hiding (text, (<+>))
+
+newtype SpecPrinter a = SpecPrinter { unSpecPrinter :: Doc }
+
+specPrinter :: Doc -> SpecPrinter a
+specPrinter = SpecPrinter
+
+instance IsoFunctor SpecPrinter where
+    iso <$> (SpecPrinter p) = SpecPrinter $ text (isoName iso) <+> text "<$>" <+> p
+
+instance ProductFunctor SpecPrinter where
+    (SpecPrinter p) <*> (SpecPrinter q) =
+        SpecPrinter $ parens (p <+> text "<*>" <+> q)
+
+instance Alternative SpecPrinter where
+    (SpecPrinter p) <|> (SpecPrinter q) =
+        SpecPrinter $ parens (p <+> text "<|>" <+> q)
+    (SpecPrinter p) <||> (SpecPrinter q) =
+        SpecPrinter $ parens (p <+> text "<||>" <+> q)
+    empty = SpecPrinter $ text "empty"
+
+instance Syntax SpecPrinter where
+    pure _ = SpecPrinter $ text "pure"
+    rule name (SpecPrinter p) _ = SpecPrinter $ text name <+> p
+    ruleInfix name (SpecPrinter p) (SpecPrinter q) _ = SpecPrinter $ p <+> text name <+> q
+
+runSpecPrinter :: SpecPrinter a -> String
+runSpecPrinter (SpecPrinter p) = render p