diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2012, Sjoerd Visscher
+
+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 Sjoerd Visscher 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/examples/defaultsignature.hs b/examples/defaultsignature.hs
new file mode 100644
--- /dev/null
+++ b/examples/defaultsignature.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE TypeFamilies, DefaultSignatures, ConstraintKinds, TypeOperators #-}
+
+import Generics.OneLiner.ADT
+import Generics.OneLiner.Functions
+
+import Data.Monoid
+import Control.Applicative
+
+import Text.Read (readPrec)
+
+
+class Size t where
+  
+  size :: t -> Int
+  
+  default size :: (ADT t, Constraints t Size) => t -> Int
+  size = succ . getSum . gfoldMap (For :: For Size) (Sum . size)
+  
+instance Size Bool
+instance Size a => Size (Maybe a)
+
+
+class EnumAll t where
+  
+  enumAll :: [t]
+  
+  default enumAll :: (ADT t, Constraints t EnumAll) => [t]
+  enumAll = concatMap snd $ buildsA (For :: For EnumAll) (const enumAll)
+
+instance EnumAll Bool
+instance EnumAll a => EnumAll (Maybe a)
+
+
+infixr 5 :^:
+data Tree a = Leaf { value :: a } | Tree a :^: Tree a
+
+instance ADT (Tree a) where
+  
+  ctorIndex Leaf{}  = 0
+  ctorIndex (_:^:_) = 1
+  
+  type Constraints (Tree a) c = (c a, c (Tree a))
+  buildsRecA For sub rec = 
+    [ (CtorInfo "Leaf" True Prefix, 
+         Leaf <$> sub (SelectorInfo "value" value))
+    , (CtorInfo ":^:"  False (Infix RightAssociative 5),
+        (:^:) <$> rec (FieldInfo (\(l :^: _) -> l)) <*> rec (FieldInfo (\(_ :^: r) -> r)))
+    ]
+
+instance Show a => Show (Tree a) where showsPrec = showsPrecADT
+instance Read a => Read (Tree a) where readPrec = readPrecADT
+instance Size a => Size (Tree a)
+instance EnumAll a => EnumAll (Tree a)
+
+trees :: [Tree (Maybe Bool)]
+trees = enumAll
+
+sizes :: [Int]
+sizes = map size trees
diff --git a/examples/paradise.hs b/examples/paradise.hs
new file mode 100644
--- /dev/null
+++ b/examples/paradise.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE 
+    TypeFamilies
+  , ConstraintKinds
+  , FlexibleInstances
+  , DefaultSignatures
+  , OverlappingInstances
+  , TypeSynonymInstances
+  #-}
+
+import Generics.OneLiner.ADT
+import Control.Applicative
+
+
+data Company  = C [Dept]               deriving (Eq, Read, Show)               
+data Dept     = D Name Manager [Unit]  deriving (Eq, Read, Show)
+data Unit     = PU Employee | DU Dept  deriving (Eq, Read, Show)
+data Employee = E Person Salary        deriving (Eq, Read, Show)
+data Person   = P Name Address         deriving (Eq, Read, Show)
+data Salary   = S Float                deriving (Eq, Read, Show)                  
+type Manager  = Employee 
+type Name     = String
+type Address  = String
+
+-- An illustrative company
+genCom :: Company
+genCom = C [D "Research" laemmel [PU joost, PU marlow],
+            D "Strategy" blair   []]
+
+laemmel, joost, marlow, blair :: Employee
+laemmel = E (P "Laemmel" "Amsterdam") (S 8000)
+joost   = E (P "Joost"   "Amsterdam") (S 1000)
+marlow  = E (P "Marlow"  "Cambridge") (S 2000)
+blair   = E (P "Blair"   "London")    (S 100000)
+
+
+instance ADT Company where
+  type Constraints Company c = c [Dept]
+  buildsA For f = [(ctor "C", C <$> f (FieldInfo $ \(C l) -> l))]
+
+instance ADT Dept where
+  type Constraints Dept c = (c Name, c Manager, c [Unit])
+  buildsA For f = [(ctor "D", D 
+    <$> f (FieldInfo $ \(D n _ _) -> n) 
+    <*> f (FieldInfo $ \(D _ m _) -> m) 
+    <*> f (FieldInfo $ \(D _ _ u) -> u))]
+
+instance ADT Unit where
+  ctorIndex PU{} = 0
+  ctorIndex DU{} = 1
+  type Constraints Unit c = (c Employee, c Dept)
+  buildsA For f = 
+    [ (ctor "PU", PU <$> f (FieldInfo $ \(PU e) -> e))
+    , (ctor "DU", DU <$> f (FieldInfo $ \(DU d) -> d))
+    ]
+
+instance ADT Employee where
+  type Constraints Employee c = (c Person, c Salary)
+  buildsA For f = [(ctor "E", E <$> f (FieldInfo $ \(E p _) -> p) <*> f (FieldInfo $ \(E _ s) -> s))]
+
+instance ADT Person where
+  type Constraints Person c = (c Name, c Address)
+  buildsA For f = [(ctor "P", P <$> f (FieldInfo $ \(P n _) -> n) <*> f (FieldInfo $ \(P _ a) -> a))]
+
+instance ADT Salary where
+  type Constraints Salary c = (c Float)
+  buildsA For f = [(ctor "S", S <$> f (FieldInfo $ \(S s) -> s))]
+
+  
+class IncreaseSalary t where
+  increaseSalary :: Float -> t -> t
+  default increaseSalary :: (ADT t, Constraints t IncreaseSalary) => Float -> t -> t
+  increaseSalary k = gmap (For :: For IncreaseSalary) (increaseSalary k)
+
+instance IncreaseSalary Company
+instance IncreaseSalary Dept
+instance IncreaseSalary Unit
+instance IncreaseSalary Employee
+instance IncreaseSalary Person
+instance IncreaseSalary Salary where
+  increaseSalary k (S s) = S (s * (1+k))
+instance IncreaseSalary a => IncreaseSalary [a]
+instance IncreaseSalary String where
+  increaseSalary _ = id
+  
+main :: IO ()
+main = print $ increaseSalary 0.1 genCom
diff --git a/one-liner.cabal b/one-liner.cabal
new file mode 100644
--- /dev/null
+++ b/one-liner.cabal
@@ -0,0 +1,34 @@
+Name:                 one-liner
+Version:              0
+Synopsis:             Constraint-based generics
+Description:          Write short and concise generic instances of type classes.
+Homepage:             https://github.com/sjoerdvisscher/one-liner
+Bug-reports:          https://github.com/sjoerdvisscher/one-liner/issues
+License:              BSD3
+License-file:         LICENSE
+Author:               Sjoerd Visscher
+Maintainer:           sjoerd@w3future.com
+Category:             Generics
+Build-type:           Simple
+Cabal-version:        >= 1.6
+
+Extra-Source-Files:
+  examples/*.hs
+
+Library
+  HS-Source-Dirs:  src
+  
+  Exposed-modules:
+    Generics.OneLiner.ADT
+    Generics.OneLiner.ADT1
+    Generics.OneLiner.Functions
+    Generics.OneLiner.Info
+  
+  Build-depends:
+      base         >= 4.5 && < 5 
+    , transformers >= 0.3 && < 0.4
+    , ghc-prim
+
+source-repository head
+  type:     git
+  location: git://github.com/sjoerdvisscher/one-liner.git
diff --git a/src/Generics/OneLiner/ADT.hs b/src/Generics/OneLiner/ADT.hs
new file mode 100644
--- /dev/null
+++ b/src/Generics/OneLiner/ADT.hs
@@ -0,0 +1,215 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Generics.OneLiner.ADT
+-- Copyright   :  (c) Sjoerd Visscher 2012
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  sjoerd@w3future.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- This module is for writing generic functions on algebraic data types 
+-- of kind @*@. These data types must be an instance of the `ADT` type class.
+-- 
+-- Here's an example how to write such an instance for this data type:
+--
+-- @
+-- data T a = A Int a | B a (T a)
+-- @
+--
+-- @
+-- instance `ADT` (T a) where
+--   `ctorIndex` A{} = 0
+--   `ctorIndex` B{} = 1
+--   type `Constraints` (T a) c = (c Int, c a, c (T a))
+--   `buildsRecA` `For` sub rec = 
+--     [ (`ctor` \"A\", A `<$>` sub (`FieldInfo` (\\(A i _) -> i)) `<*>` sub (`FieldInfo` (\\(A _ a) -> a)))
+--     , (`ctor` \"B\", B `<$>` sub (`FieldInfo` (\\(B a _) -> a)) `<*>` rec (`FieldInfo` (\\(B _ t) -> t)))
+--     ]
+-- @
+--
+-- And this is how you would write generic equality, using the `All` monoid:
+--
+-- @
+-- eqADT :: (`ADT` t, `Constraints` t `Eq`) => t -> t -> `Bool`
+-- eqADT s t = `ctorIndex` s == `ctorIndex` t `&&` 
+--   `getAll` (`mbuilds` (`For` :: `For` `Eq`) (\\fld -> `All` $ s `!` fld `==` t `!` fld) \``at`\` s)
+-- @
+-----------------------------------------------------------------------------
+{-# LANGUAGE 
+    RankNTypes
+  , TypeFamilies
+  , ConstraintKinds
+  , FlexibleInstances
+  , DefaultSignatures
+  , ScopedTypeVariables
+  #-}
+module Generics.OneLiner.ADT (
+  
+    -- * Re-exports
+    module Generics.OneLiner.Info
+  , Constraint
+    -- | The kind of constraints
+    
+    -- * The @ADT@ type class
+  , ADT(..)
+  , For(..)
+
+    -- * Helper functions
+  , (!)
+  , at
+  
+    -- * Derived traversal schemes
+  , builds
+  , mbuilds
+  , gmap
+  , gfoldMap
+  , gtraverse
+  
+  ) where
+  
+import Generics.OneLiner.Info
+
+import GHC.Prim (Constraint)
+import Control.Applicative
+import Data.Functor.Identity
+import Data.Functor.Constant
+import Data.Monoid
+
+import Data.Maybe (fromJust)
+
+
+-- | Tell the compiler which class we want to use in the traversal. Should be used like this:
+--
+-- > (For :: For Show)
+--
+-- Where @Show@ can be any class.
+data For (c :: * -> Constraint) = For
+
+-- | Type class for algebraic data types of kind @*@. Minimal implementation: `ctorIndex` and either `buildsA`
+-- if the type @t@ is not recursive, or `buildsRecA` if the type @t@ is recursive.
+class ADT t where
+
+  -- | Gives the index of the constructor of the given value in the list returned by `buildsA` and `buildsRecA`.
+  ctorIndex :: t -> Int
+  ctorIndex _ = 0
+
+  -- | The constraints needed to run `buildsA` and `buildsRecA`. 
+  -- It should be a list of all the types of the subcomponents of @t@, each applied to @c@.
+  type Constraints t c :: Constraint
+  
+  buildsA :: (Constraints t c, Applicative f)
+          => For c -- ^ Witness for the constraint @c@.
+          -> (forall s. c s => FieldInfo (t -> s) -> f s) -- ^ This function should return a value
+             -- for each subcomponent of @t@, wrapped in an applicative functor @f@. It is given 
+             -- information about the field, which contains a projector function to get the subcomponent 
+             -- from a value of type @t@. The type of the subcomponent is an instance of class @c@.
+          -> [(CtorInfo, f t)] -- ^ A list of pairs, one for each constructor of type @t@. Each pair
+             -- consists of information about the constructor and the result of applicatively applying 
+             -- the constructor to the results of the given function for each field of the constructor.
+  
+  default buildsA :: (c t, Constraints t c, Applicative f) 
+                  => For c -> (forall s. c s => FieldInfo (t -> s) -> f s) -> [(CtorInfo, f t)]  
+  buildsA for f = buildsRecA for f f
+  
+  buildsRecA :: (Constraints t c, Applicative f) 
+             => For c -- ^ Witness for the constraint @c@.
+             -> (forall s. c s => FieldInfo (t -> s) -> f s) -- ^ This function should return a value
+                -- for each subcomponent of @t@, wrapped in an applicative functor @f@. It is given 
+                -- information about the field, which contains a projector function to get the subcomponent 
+                -- from a value of type @t@. The type of the subcomponent is an instance of class @c@.
+             -> (FieldInfo (t -> t) -> f t) -- ^ This function should return a value
+                -- for each subcomponent of @t@ that is itself of type @t@.
+             -> [(CtorInfo, f t)] -- ^ A list of pairs, one for each constructor of type @t@. Each pair
+                -- consists of information about the constructor and the result of applicatively applying 
+                -- the constructor to the results of the given functions for each field of the constructor.
+  buildsRecA for sub _ = buildsA for sub
+
+-- | `buildsA` specialized to the `Identity` applicative functor.
+builds :: (ADT t, Constraints t c) 
+       => For c -> (forall s. c s => FieldInfo (t -> s) -> s) -> [(CtorInfo, t)]
+builds for f = fmap runIdentity <$> buildsA for (Identity . f)  
+
+-- | `buildsA` specialized to the `Constant` applicative functor, which collects monoid values @m@.
+mbuilds :: forall t c m. (ADT t, Constraints t c, Monoid m) 
+        => For c -> (forall s. c s => FieldInfo (t -> s) -> m) -> [(CtorInfo, m)]
+mbuilds for f = fmap getConstant <$> ms
+  where
+    ms :: [(CtorInfo, Constant m t)]
+    ms = buildsA for (Constant . f)
+
+-- | Transform a value by transforming each subcomponent.
+gmap :: (ADT t, Constraints t c)
+     => For c -> (forall s. c s => s -> s) -> t -> t
+gmap for f t = builds for (\info -> f (t ! info)) `at` t
+
+-- | Fold a value, by mapping each subcomponent to a monoid value and collecting those. 
+gfoldMap :: (ADT t, Constraints t c, Monoid m)
+         => For c -> (forall s. c s => s -> m) -> t -> m
+gfoldMap for f = getConstant . gtraverse for (Constant . f)
+
+-- | Applicative traversal given a way to traverse each subcomponent.
+gtraverse :: (ADT t, Constraints t c, Applicative f) 
+          => For c -> (forall s. c s => s -> f s) -> t -> f t
+gtraverse for f t = buildsA for (\info -> f (t ! info)) `at` t
+
+
+infixl 9 !
+-- | Get the subcomponent by using the projector from the field information.
+(!) :: t -> FieldInfo (t -> s) -> s
+t ! info = project info t
+
+-- | Get the value from the result of one of the @builds@ functions that matches the constructor of @t@.
+at :: ADT t => [(a, b)] -> t -> b
+at ab t = snd (ab !! ctorIndex t)
+
+
+
+instance ADT () where
+  
+  type Constraints () c = ()
+  buildsA For _ = [ (ctor "()", pure ()) ]
+  
+instance ADT Bool where
+
+  ctorIndex False = 0
+  ctorIndex True  = 1
+
+  type Constraints Bool c = ()
+  buildsA For _ = 
+    [ (ctor "False", pure False)
+    , (ctor "True",  pure True) ]
+
+instance ADT (Either a b) where
+
+  ctorIndex Left{}  = 0
+  ctorIndex Right{} = 1
+
+  type Constraints (Either a b) c = (c a, c b)
+  buildsA For f = 
+    [ (ctor "Left",  Left  <$> f (FieldInfo (\(Left a)  -> a)))
+    , (ctor "Right", Right <$> f (FieldInfo (\(Right a) -> a)))
+    ]
+
+instance ADT (Maybe a) where
+
+  ctorIndex Nothing = 0
+  ctorIndex Just{}  = 1
+
+  type Constraints (Maybe a) c = c a
+  buildsA For f = 
+    [ (ctor "Nothing", pure Nothing)
+    , (ctor "Just", Just <$> f (FieldInfo fromJust))
+    ]
+
+instance ADT [a] where
+
+  ctorIndex []    = 0
+  ctorIndex (_:_) = 1
+
+  type Constraints [a] c = (c a, c [a])
+  buildsRecA For sub rec = 
+    [ (ctor "[]", pure [])
+    , (CtorInfo ":" False (Infix RightAssociative 5)
+      ,(:) <$> sub (FieldInfo head) <*> rec (FieldInfo tail))]
+  
diff --git a/src/Generics/OneLiner/ADT1.hs b/src/Generics/OneLiner/ADT1.hs
new file mode 100644
--- /dev/null
+++ b/src/Generics/OneLiner/ADT1.hs
@@ -0,0 +1,179 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Generics.OneLiner.ADT1
+-- Copyright   :  (c) Sjoerd Visscher 2012
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  sjoerd@w3future.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+--
+-- This module is for writing generic functions on algebraic data types 
+-- of kind @* -> *@. 
+-- These data types must be an instance of the `ADT1` type class.
+-- 
+-- Here's an example how to write such an instance for this data type:
+--
+-- @
+-- data T a = A [a] | B a (T a)
+-- @
+--
+-- @
+-- instance `ADT1` T where
+--   `ctorIndex` A{} = 0
+--   `ctorIndex` B{} = 1
+--   type `Constraints` T c = (c [], c T)
+--   `buildsRecA` `For` par sub rec = 
+--     [ (`ctor` \"A\", A `<$>` sub (`component` (\\(A l) -> l))
+--     , (`ctor` \"B\", B `<$>` par (`param` (\\(B a _) -> a)) `<*>` rec (`component` (\\(B _ t) -> t)))
+--     ]
+-- @
+-----------------------------------------------------------------------------
+{-# LANGUAGE 
+    RankNTypes
+  , TypeFamilies
+  , TypeOperators
+  , ConstraintKinds
+  , FlexibleInstances
+  , DefaultSignatures
+  , ScopedTypeVariables
+  #-}
+module Generics.OneLiner.ADT1 (
+
+    -- * Re-exports
+    module Generics.OneLiner.Info
+  , Constraint
+    -- | The kind of constraints
+  
+    -- * The @ADT1@ type class
+  , ADT1(..)
+  , For(..)
+  , Extract(..)
+  , (:~>)(..)
+  
+    -- * Helper functions
+  , (!)
+  , (!~)
+  , at
+  , param
+  , component
+  
+  -- * Derived traversal schemes
+  , builds
+  , mbuilds
+  
+  ) where
+
+import Generics.OneLiner.Info
+
+import GHC.Prim (Constraint)
+import Control.Applicative
+import Data.Functor.Identity
+import Data.Functor.Constant
+import Data.Monoid
+
+import Data.Maybe (fromJust)
+
+
+newtype f :~> g = Nat { getNat :: forall x. f x -> g x }
+newtype Extract f = Extract { getExtract :: forall x. f x -> x }
+
+
+-- | Tell the compiler which class we want to use in the traversal. Should be used like this:
+--
+-- > (For :: For Show)
+--
+-- Where @Show@ can be any class.
+data For (c :: (* -> *) -> Constraint) = For
+
+-- | Type class for algebraic data types of kind @* -> *@. Minimal implementation: `ctorIndex` and either `buildsA`
+-- if the type @t@ is not recursive, or `buildsRecA` if the type @t@ is recursive.
+class ADT1 t where
+
+  -- | Gives the index of the constructor of the given value in the list returned by `buildsA` and `buildsRecA`.
+  ctorIndex :: t a -> Int
+  ctorIndex _ = 0
+
+  -- | The constraints needed to run `buildsA` and `buildsRecA`. 
+  -- It should be a list of all the types of the subcomponents of @t@, each applied to @c@.
+  type Constraints t c :: Constraint
+  buildsA :: (Constraints t c, Applicative f)
+          => For c -- ^ Witness for the constraint @c@.
+          -> (FieldInfo (Extract t) -> f b)
+          -> (forall s. c s => FieldInfo (t :~> s) -> f (s b))
+          -> [(CtorInfo, f (t b))]
+          
+  default buildsA :: (c t, Constraints t c, Applicative f)
+                  => For c
+                  -> (FieldInfo (Extract t) -> f b)
+                  -> (forall s. c s => FieldInfo (t :~> s) -> f (s b))
+                  -> [(CtorInfo, f (t b))]
+  buildsA for param sub = buildsRecA for param sub sub 
+
+  buildsRecA :: (Constraints t c, Applicative f)
+             => For c -- ^ Witness for the constraint @c@.
+             -> (FieldInfo (Extract t) -> f b)
+             -> (forall s. c s => FieldInfo (t :~> s) -> f (s b))
+             -> (FieldInfo (t :~> t) -> f (t b))
+             -> [(CtorInfo, f (t b))]
+  buildsRecA for param sub _ = buildsA for param sub
+
+-- | `buildsA` specialized to the `Identity` applicative functor.
+builds :: (ADT1 t, Constraints t c) 
+       => For c
+       -> (FieldInfo (Extract t) -> b)
+       -> (forall s. c s => FieldInfo (t :~> s) -> s b)
+       -> [(CtorInfo, t b)]
+builds for f g = fmap runIdentity <$> buildsA for (Identity . f) (Identity . g)
+
+-- | `buildsA` specialized to the `Constant` applicative functor, which collects monoid values @m@.
+mbuilds :: forall t c m. (ADT1 t, Constraints t c, Monoid m) 
+        => For c
+        -> (FieldInfo (Extract t) -> m)
+        -> (forall s. c s => FieldInfo (t :~> s) -> m)
+        -> [(CtorInfo, m)]
+mbuilds for f g = fmap getConstant <$> ms
+  where
+    ms :: [(CtorInfo, Constant m (t b))]
+    ms = buildsA for (Constant . f) (Constant . g)
+
+-- | Get the value from the result of one of the @builds@ functions that matches the constructor of @t@.
+at :: ADT1 t => [(c, a)] -> t b -> a
+at as t = snd (as !! ctorIndex t)
+
+param :: (forall a. t a -> a) -> FieldInfo (Extract t)
+param f = FieldInfo (Extract f)
+
+component :: (forall a. t a -> s a) -> FieldInfo (t :~> s)
+component f = FieldInfo (Nat f)
+
+infixl 9 !
+(!) :: t a -> FieldInfo (Extract t) -> a
+t ! info = getExtract (project info) t
+
+infixl 9 !~
+(!~) :: t a -> FieldInfo (t :~> s) -> s a
+t !~ info = getNat (project info) t
+
+
+instance ADT1 Maybe where
+  
+  ctorIndex Nothing = 0
+  ctorIndex Just{}  = 1
+  
+  type Constraints Maybe c = ()
+  buildsA For f _ = 
+    [ (ctor "Nothing", pure Nothing)
+    , (ctor "Just", Just <$> f (param fromJust))
+    ]
+  
+instance ADT1 [] where
+  
+  ctorIndex [] = 0
+  ctorIndex (_:_) = 1 
+  
+  type Constraints [] c = c []
+  buildsRecA For p _ r = 
+    [ (ctor "[]", pure [])
+    , (CtorInfo ":" False (Infix RightAssociative 5), (:) <$> p (param head) <*> r (component tail))
+    ]
diff --git a/src/Generics/OneLiner/Functions.hs b/src/Generics/OneLiner/Functions.hs
new file mode 100644
--- /dev/null
+++ b/src/Generics/OneLiner/Functions.hs
@@ -0,0 +1,93 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Generics.OneLiner.Functions
+-- Copyright   :  (c) Sjoerd Visscher 2012
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  sjoerd@w3future.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+-----------------------------------------------------------------------------
+{-# LANGUAGE RankNTypes, ConstraintKinds, ScopedTypeVariables #-}
+module Generics.OneLiner.Functions where
+
+import Generics.OneLiner.ADT
+import Control.Applicative
+import Data.Monoid
+
+import Text.Read
+import Control.Monad
+import Control.Monad.Trans.State
+import qualified Control.Monad.Trans.Class as T
+
+eqADT :: (ADT t, Constraints t Eq) => t -> t -> Bool
+eqADT s t = ctorIndex s == ctorIndex t && 
+  getAll (mbuilds (For :: For Eq) (\fld -> All $ s ! fld == t ! fld) `at` s)
+
+compareADT :: (ADT t, Constraints t Ord) => t -> t -> Ordering
+compareADT s t = compare (ctorIndex s) (ctorIndex t) <> 
+  mbuilds (For :: For Ord) (\fld -> compare (s ! fld) (t ! fld)) `at` s
+
+minBoundADT :: (ADT t, Constraints t Bounded) => t
+minBoundADT = snd $ head $ builds (For :: For Bounded) (const minBound)
+
+maxBoundADT :: (ADT t, Constraints t Bounded) => t
+maxBoundADT = snd $ last $ builds (For :: For Bounded) (const maxBound)
+
+showsPrecADT :: forall t. (ADT t, Constraints t Show) => Int -> t -> ShowS
+showsPrecADT d t = inner fty
+  where
+    CtorInfo name rec fty = fst $ builds (For :: For Show) (t !) !! ctorIndex t
+
+    inner (Infix _ d') = showParen (d > d') $ let [f0, f1] = fields (d' + 1) in 
+      f0 . showChar ' ' . showString name . showChar ' ' . f1
+    inner _ = showParen (d > 10) $ showString name . showChar ' ' . body
+
+    body = if rec 
+      then showChar '{' . conc (showString ", ") (fields 0) . showChar '}'
+      else conc (showString " ") (fields 11)
+
+    fields d' = mbuilds (For :: For Show) (return . f d') `at` t
+
+    f :: Show s => Int -> FieldInfo (t -> s) -> ShowS
+    f d' info = if rec 
+      then showString (selectorName info) . showString " = " . showsPrec d' (t ! info)
+      else showsPrec d' (t ! info)
+
+    conc sep = foldr1 (\g ss -> g . sep . ss)
+
+readPrecADT :: forall t. (ADT t, Constraints t Read) => ReadPrec t
+readPrecADT = parens (choice ctorReads)
+  where
+    ctorReads = ctorParse <$> buildsA (For :: For Read) fieldParse
+
+    ctorParse (CtorInfo name _ (Infix _ d), getFields) = 
+      let flds = evalStateT getFields $ do { Symbol name' <- lexP; guard (name' == name) }
+      in prec d flds
+
+    ctorParse (CtorInfo name rec _, getFields) = 
+      let flds = evalStateT getFields (return ())
+      in prec (if rec then 11 else 10) $ do
+        Ident name' <- lexP
+        guard (name == name')
+        if rec then do
+            Punc "{" <- lexP
+            res <- flds
+            Punc "}" <- lexP
+            return res
+          else
+            flds
+
+    -- StateT is used to parse an infix operator after the first field
+    fieldParse :: Read s => FieldInfo (t -> s) -> StateT (ReadPrec ()) ReadPrec s
+    fieldParse (SelectorInfo name _) = StateT $ \parseOp -> do
+      Ident name' <- lexP
+      guard (name == name')
+      Punc "=" <- lexP
+      res <- reset readPrec
+      parseOp
+      return (res, return ())  
+    fieldParse _ = StateT $ \parseOp -> do
+      res <- step readPrec
+      parseOp
+      return (res, return ())
diff --git a/src/Generics/OneLiner/Info.hs b/src/Generics/OneLiner/Info.hs
new file mode 100644
--- /dev/null
+++ b/src/Generics/OneLiner/Info.hs
@@ -0,0 +1,36 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Generics.OneLiner.Info
+-- Copyright   :  (c) Sjoerd Visscher 2012
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  sjoerd@w3future.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+-----------------------------------------------------------------------------
+module Generics.OneLiner.Info where
+
+data CtorInfo = CtorInfo
+  { ctorName  :: String
+  , isRecord  :: Bool
+  , fixity    :: Fixity
+  }
+  deriving (Eq, Show, Ord, Read)
+
+ctor :: String -> CtorInfo
+ctor name = CtorInfo name False Prefix
+
+data Fixity = Prefix | Infix Associativity Int
+  deriving (Eq, Show, Ord, Read)
+
+data Associativity = LeftAssociative | RightAssociative | NotAssociative
+  deriving (Eq, Show, Ord, Read)
+
+data FieldInfo p 
+  = SelectorInfo
+    { selectorName :: String
+    , project      :: p
+    }
+  | FieldInfo
+    { project      :: p 
+    }