diff --git a/examples/defaultsignature.hs b/examples/defaultsignature.hs
--- a/examples/defaultsignature.hs
+++ b/examples/defaultsignature.hs
@@ -25,7 +25,7 @@
   enumAll :: [t]
   
   default enumAll :: (ADT t, Constraints t EnumAll) => [t]
-  enumAll = concatMap snd $ buildsA (For :: For EnumAll) (const enumAll)
+  enumAll = concat $ buildsA (For :: For EnumAll) (const enumAll)
 
 instance EnumAll Bool
 instance EnumAll a => EnumAll (Maybe a)
@@ -38,13 +38,13 @@
   
   ctorIndex Leaf{}  = 0
   ctorIndex (_:^:_) = 1
+  ctorInfo _ 0 = CtorInfo "Leaf" True Prefix
+  ctorInfo _ 1 = CtorInfo ":^:"  False (Infix RightAssociative 5)
   
   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)))
+    [ Leaf <$> sub (SelectorInfo "value" value)
+    , (:^:) <$> rec (FieldInfo (\(l :^: _) -> l)) <*> rec (FieldInfo (\(_ :^: r) -> r))
     ]
 
 instance Show a => Show (Tree a) where showsPrec = showsPrecADT
diff --git a/examples/paradise.hs b/examples/paradise.hs
--- a/examples/paradise.hs
+++ b/examples/paradise.hs
@@ -35,35 +35,42 @@
 
 instance ADT Company where
   type Constraints Company c = c [Dept]
-  buildsA For f = [(ctor "C", C <$> f (FieldInfo $ \(C l) -> l))]
+  ctorInfo _ 0 = ctor "C"
+  buildsA For f = [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 
+  ctorInfo _ 0 = ctor "D"
+  buildsA For f = [D 
     <$> f (FieldInfo $ \(D n _ _) -> n) 
     <*> f (FieldInfo $ \(D _ m _) -> m) 
-    <*> f (FieldInfo $ \(D _ _ u) -> u))]
+    <*> f (FieldInfo $ \(D _ _ u) -> u)]
 
 instance ADT Unit where
   ctorIndex PU{} = 0
   ctorIndex DU{} = 1
+  ctorInfo _ 0 = ctor "PU"
+  ctorInfo _ 1 = ctor "DU"
   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))
+    [ PU <$> f (FieldInfo $ \(PU e) -> e)
+    , 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))]
+  ctorInfo _ 0 = ctor "E"
+  buildsA For f = [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))]
+  ctorInfo _ 0 = ctor "P"
+  buildsA For f = [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))]
+  ctorInfo _ 0 = ctor "S"
+  buildsA For f = [S <$> f (FieldInfo $ \(S s) -> s)]
 
   
 class IncreaseSalary t where
diff --git a/one-liner.cabal b/one-liner.cabal
--- a/one-liner.cabal
+++ b/one-liner.cabal
@@ -1,5 +1,5 @@
 Name:                 one-liner
-Version:              0.1
+Version:              0.2
 Synopsis:             Constraint-based generics
 Description:          Write short and concise generic instances of type classes.
 Homepage:             https://github.com/sjoerdvisscher/one-liner
@@ -22,6 +22,7 @@
     Generics.OneLiner.ADT
     Generics.OneLiner.ADT1
     Generics.OneLiner.Functions
+    Generics.OneLiner.Functions1
     Generics.OneLiner.Info
   
   Build-depends:
diff --git a/src/Generics/OneLiner/ADT.hs b/src/Generics/OneLiner/ADT.hs
--- a/src/Generics/OneLiner/ADT.hs
+++ b/src/Generics/OneLiner/ADT.hs
@@ -53,6 +53,7 @@
     
     -- * The @ADT@ type class
   , ADT(..)
+  , ADTRecord(..)
   , For(..)
 
     -- * Helper functions
@@ -65,6 +66,12 @@
   , gmap
   , gfoldMap
   , gtraverse
+
+    -- ** ...for single constructor data types
+  , build
+  , op0
+  , op1
+  , op2
   
   ) where
   
@@ -93,6 +100,10 @@
   -- | Gives the index of the constructor of the given value in the list returned by `buildsA` and `buildsRecA`.
   ctorIndex :: t -> Int
   ctorIndex _ = 0
+  
+  -- | @ctorInfo n@ gives constructor information, f.e. its name, for the @n@th constructor.
+  --   The first argument is a dummy argument and can be @(undefined :: t)@.
+  ctorInfo :: t -> Int -> CtorInfo
 
   -- | 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@.
@@ -104,12 +115,12 @@
              -- 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.
+          -> [f t] -- ^ A list of results, one for each constructor of type @t@. Each element is 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)]  
+                  => For c -> (forall s. c s => FieldInfo (t -> s) -> f s) -> [f t]
   buildsA for f = buildsRecA for f f
   
   buildsRecA :: (Constraints t c, Applicative f) 
@@ -120,28 +131,30 @@
                 -- 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.
+             -> [f t] -- ^ A list of results, one for each constructor of type @t@. Each element is the 
+             -- result of applicatively applying the constructor to the results of the given function 
+             -- for each field of the constructor.
   buildsRecA for sub _ = buildsA for sub
 
+-- | Add an instance for this class if the data type has exactly one constructor.
+--
+--   This class has no methods.
+class ADT t => ADTRecord t where
+
 -- | `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)  
+       => For c -> (forall s. c s => FieldInfo (t -> s) -> s) -> [t]
+builds for f = 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)
+        => For c -> (forall s. c s => FieldInfo (t -> s) -> m) -> [m]
+mbuilds for f = getConstant <$> (buildsA for (Constant . f) :: [Constant m t])
 
 -- | 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
+gmap for f t = builds for (\fld -> f (t ! fld)) `at` t
 
 -- | Fold a value, by mapping each subcomponent to a monoid value and collecting those. 
 gfoldMap :: (ADT t, Constraints t c, Monoid m)
@@ -151,65 +164,122 @@
 -- | 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
+gtraverse for f t = buildsA for (\fld -> f (t ! fld)) `at` t
 
+-- | `builds` for data types with exactly one constructor
+build :: (ADTRecord t, Constraints t c) 
+      => For c -> (forall s. c s => FieldInfo (t -> s) -> s) -> t
+build for f = head $ builds for f
 
+-- | Derive a 0-ary operation by applying the operation to every subcomponent.
+op0 :: (ADTRecord t, Constraints t c) => For c -> (forall s. c s => s) -> t
+op0 for op = build for (const op)
+
+-- | Derive a unary operation by applying the operation to every subcomponent.
+op1 :: (ADTRecord t, Constraints t c) => For c -> (forall s. c s => s -> s) -> t -> t
+op1 for op t = build for (\fld -> op $ t ! fld)
+
+-- | Derive a binary operation by applying the operation to every subcomponent.
+op2 :: (ADTRecord t, Constraints t c) => For c -> (forall s. c s => s -> s -> s) -> t -> t -> t
+op2 for op s t = build for (\fld -> (s ! fld) `op` (t ! fld))
+
+
+
 infixl 9 !
 -- | Get the subcomponent by using the projector from the field information.
 (!) :: t -> FieldInfo (t -> s) -> s
-t ! info = project info t
+t ! fld = project fld 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)
+at :: ADT t => [a] -> t -> a
+at as t = as !! ctorIndex t
 
 
 
 instance ADT () where
   
   type Constraints () c = ()
-  buildsA For _ = [ (ctor "()", pure ()) ]
+  ctorInfo _ 0 = ctor "()"
+  buildsA For _ = [ pure () ]
+
+instance ADTRecord () where
   
+instance ADT (a, b) where
+  
+  type Constraints (a, b) c = (c a, c b)
+  ctorInfo _ 0 = ctor "(,)"
+  buildsA For f = [ (,) <$> f (FieldInfo fst) <*> f (FieldInfo snd) ]
+
+instance ADTRecord (a, b) where
+
+instance ADT (a, b, c) where
+
+  type Constraints (a, b, c) tc = (tc a, tc b, tc c)
+  ctorInfo _ 0 = ctor "(,,)"
+  buildsA For f = [(,,) <$> f (FieldInfo (\(a, _, _) -> a))
+                        <*> f (FieldInfo (\(_, b, _) -> b))
+                        <*> f (FieldInfo (\(_, _, c) -> c))
+                  ]
+
+instance ADTRecord (a, b, c) where
+
+instance ADT (a, b, c, d) where
+
+  type Constraints (a, b, c, d) tc = (tc a, tc b, tc c, tc d)
+  ctorInfo _ 0 = ctor "(,,,)"
+  buildsA For f = [(,,,) <$> f (FieldInfo (\(a, _, _, _) -> a))
+                         <*> f (FieldInfo (\(_, b, _, _) -> b))
+                         <*> f (FieldInfo (\(_, _, c, _) -> c))
+                         <*> f (FieldInfo (\(_, _, _, d) -> d))
+                  ]
+
+instance ADTRecord (a, b, c, d) where
+
 instance ADT Bool where
 
   ctorIndex False = 0
   ctorIndex True  = 1
+  ctorInfo _ 0 = ctor "False"
+  ctorInfo _ 1 = ctor "True"
 
   type Constraints Bool c = ()
-  buildsA For _ = 
-    [ (ctor "False", pure False)
-    , (ctor "True",  pure True) ]
+  buildsA For _ = [ pure False, pure True ]
 
 instance ADT (Either a b) where
 
   ctorIndex Left{}  = 0
   ctorIndex Right{} = 1
+  ctorInfo _ 0 = ctor "Left"
+  ctorInfo _ 1 = ctor "Right"
 
   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)))
+    [ Left  <$> f (FieldInfo (\(Left a)  -> a))
+    , Right <$> f (FieldInfo (\(Right a) -> a))
     ]
 
 instance ADT (Maybe a) where
 
   ctorIndex Nothing = 0
   ctorIndex Just{}  = 1
+  ctorInfo _ 0 = ctor "Nothing"
+  ctorInfo _ 1 = ctor "Just"
 
   type Constraints (Maybe a) c = c a
   buildsA For f = 
-    [ (ctor "Nothing", pure Nothing)
-    , (ctor "Just", Just <$> f (FieldInfo fromJust))
+    [ pure Nothing
+    , Just <$> f (FieldInfo fromJust)
     ]
 
 instance ADT [a] where
 
   ctorIndex []    = 0
   ctorIndex (_:_) = 1
+  ctorInfo _ 0 = ctor "[]"
+  ctorInfo _ 1 = CtorInfo ":" False (Infix RightAssociative 5)
 
   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))]
+    [ pure []
+    , (:) <$> sub (FieldInfo head) <*> rec (FieldInfo tail)]
   
diff --git a/src/Generics/OneLiner/ADT1.hs b/src/Generics/OneLiner/ADT1.hs
--- a/src/Generics/OneLiner/ADT1.hs
+++ b/src/Generics/OneLiner/ADT1.hs
@@ -47,6 +47,7 @@
   
     -- * The @ADT1@ type class
   , ADT1(..)
+  , ADT1Record(..)
   , For(..)
   , Extract(..)
   , (:~>)(..)
@@ -61,6 +62,7 @@
   -- * Derived traversal schemes
   , builds
   , mbuilds
+  , build
   
   ) where
 
@@ -93,6 +95,10 @@
   -- | Gives the index of the constructor of the given value in the list returned by `buildsA` and `buildsRecA`.
   ctorIndex :: t a -> Int
   ctorIndex _ = 0
+  
+  -- | @ctorInfo n@ gives constructor information, f.e. its name, for the @n@th constructor.
+  --   The first argument is a dummy argument and can be @(undefined :: t a)@.
+  ctorInfo :: t a -> Int -> CtorInfo
 
   -- | 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@.
@@ -101,13 +107,13 @@
           => 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))]
+          -> [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))]
+                  -> [f (t b)]
   buildsA for param sub = buildsRecA for param sub sub 
 
   buildsRecA :: (Constraints t c, Applicative f)
@@ -115,31 +121,41 @@
              -> (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))]
+             -> [f (t b)]
   buildsRecA for param sub _ = buildsA for param sub
 
+-- | Add an instance for this class if the data type has exactly one constructor.
+--
+--   This class has no methods.
+class ADT1 t => ADT1Record t where
+
 -- | `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)
+       -> [t b]
+builds for f g = 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)
+        -> [m]
+mbuilds for f g = getConstant <$> (buildsA for (Constant . f) (Constant . g) :: [Constant m (t b)])
 
+-- | `builds` for data types with exactly one constructor
+build :: (ADT1Record t, Constraints t c) 
+       => For c
+       -> (FieldInfo (Extract t) -> b)
+       -> (forall s. c s => FieldInfo (t :~> s) -> s b)
+       -> t b
+build for f g = head $ builds for f 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)
+at :: ADT1 t => [a] -> t b -> a
+at as t = as !! ctorIndex t
 
 param :: (forall a. t a -> a) -> FieldInfo (Extract t)
 param f = FieldInfo (Extract f)
@@ -160,20 +176,24 @@
   
   ctorIndex Nothing = 0
   ctorIndex Just{}  = 1
+  ctorInfo _ 0 = ctor "Nothing"
+  ctorInfo _ 1 = ctor "Just"
   
   type Constraints Maybe c = ()
   buildsA For f _ = 
-    [ (ctor "Nothing", pure Nothing)
-    , (ctor "Just", Just <$> f (param fromJust))
+    [ pure Nothing
+    , Just <$> f (param fromJust)
     ]
   
 instance ADT1 [] where
   
-  ctorIndex [] = 0
-  ctorIndex (_:_) = 1 
+  ctorIndex []    = 0
+  ctorIndex (_:_) = 1
+  ctorInfo _ 0 = ctor "[]"
+  ctorInfo _ 1 = CtorInfo ":" False (Infix RightAssociative 5)
   
   type Constraints [] c = c []
   buildsRecA For p _ r = 
-    [ (ctor "[]", pure [])
-    , (CtorInfo ":" False (Infix RightAssociative 5), (:) <$> p (param head) <*> r (component tail))
+    [ pure []
+    , (:) <$> p (param head) <*> r (component tail)
     ]
diff --git a/src/Generics/OneLiner/Functions.hs b/src/Generics/OneLiner/Functions.hs
--- a/src/Generics/OneLiner/Functions.hs
+++ b/src/Generics/OneLiner/Functions.hs
@@ -9,7 +9,19 @@
 -- Portability :  non-portable
 -----------------------------------------------------------------------------
 {-# LANGUAGE RankNTypes, ConstraintKinds, ScopedTypeVariables #-}
-module Generics.OneLiner.Functions where
+module Generics.OneLiner.Functions (
+  -- * For all instances
+    eqADT
+  , compareADT
+  , minBoundADT
+  , maxBoundADT
+  , showsPrecADT
+  , readPrecADT
+  -- * For datatypes with one constructor
+  , memptyADT
+  , mappendADT
+  , fromIntegerADT
+  ) where
 
 import Generics.OneLiner.ADT
 import Control.Applicative
@@ -29,15 +41,15 @@
   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)
+minBoundADT = head $ builds (For :: For Bounded) (const minBound)
 
 maxBoundADT :: (ADT t, Constraints t Bounded) => t
-maxBoundADT = snd $ last $ builds (For :: For Bounded) (const maxBound)
+maxBoundADT = 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
+    CtorInfo name rec fty = ctorInfo t (ctorIndex t)
 
     inner (Infix _ d') = showParen (d > d') $ let [f0, f1] = fields (d' + 1) in 
       f0 . showChar ' ' . showString name . showChar ' ' . f1
@@ -59,7 +71,7 @@
 readPrecADT :: forall t. (ADT t, Constraints t Read) => ReadPrec t
 readPrecADT = parens (choice ctorReads)
   where
-    ctorReads = ctorParse <$> buildsA (For :: For Read) fieldParse
+    ctorReads = ctorParse <$> zip (fmap (ctorInfo (undefined :: t)) [0..]) (buildsA (For :: For Read) fieldParse)
 
     ctorParse (CtorInfo name _ (Infix _ d), getFields) = 
       let flds = evalStateT getFields $ do { Symbol name' <- lexP; guard (name' == name) }
@@ -91,3 +103,13 @@
       res <- step readPrec
       parseOp
       return (res, return ())
+
+
+memptyADT :: (ADTRecord t, Constraints t Monoid) => t
+memptyADT = op0 (For :: For Monoid) mempty
+
+mappendADT :: (ADTRecord t, Constraints t Monoid) => t -> t -> t
+mappendADT = op2 (For :: For Monoid) mappend
+
+fromIntegerADT :: (ADTRecord t, Constraints t Num) => Integer -> t
+fromIntegerADT i = op0 (For :: For Num) (fromInteger i)
diff --git a/src/Generics/OneLiner/Functions1.hs b/src/Generics/OneLiner/Functions1.hs
new file mode 100644
--- /dev/null
+++ b/src/Generics/OneLiner/Functions1.hs
@@ -0,0 +1,53 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Generics.OneLiner.Functions1
+-- Copyright   :  (c) Sjoerd Visscher 2013
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  sjoerd@w3future.com
+-- Stability   :  experimental
+-- Portability :  non-portable
+-----------------------------------------------------------------------------
+{-# LANGUAGE RankNTypes, ConstraintKinds, ScopedTypeVariables #-}
+module Generics.OneLiner.Functions1 (
+  -- * For all instances
+    fmapADT
+  , foldMapADT
+  , traverseADT
+  -- * For datatypes with one constructor
+  , pureADT
+  , apADT
+  , bindADT
+  , mfixADT
+) where
+
+import Generics.OneLiner.ADT1
+import Control.Applicative
+import Control.Monad.Fix
+import Data.Monoid
+import Data.Foldable
+import Data.Traversable
+
+fmapADT :: (ADT1 t, Constraints t Functor) => (a -> b) -> t a -> t b
+fmapADT f ta = builds (For :: For Functor) (\fld -> f (ta ! fld)) (\fld -> fmap f (ta !~ fld)) `at` ta
+
+foldMapADT :: (ADT1 t, Constraints t Foldable, Monoid m) => (a -> m) -> t a -> m
+foldMapADT f ta = mbuilds (For :: For Foldable) (\fld -> f (ta ! fld)) (\fld -> foldMap f (ta !~ fld)) `at` ta
+
+traverseADT :: (ADT1 t, Constraints t Traversable, Applicative f) => (a -> f b) -> t a -> f (t b)
+traverseADT f ta = buildsA (For :: For Traversable) (\fld -> f (ta ! fld)) (\fld -> traverse f (ta !~ fld)) `at` ta
+
+-- unfoldADT :: (ADT1 t, Constraints t Unfoldable, Unfolder f) => f a -> f (t a)
+-- unfoldADT fa = choose $ buildsA (For :: For Unfoldable) (const fa) (const $ unfold fa)
+
+pureADT :: (ADT1Record t, Constraints t Applicative) => a -> t a
+pureADT a = build (For :: For Applicative) (const a) (const $ pure a)
+
+apADT :: (ADT1Record t, Constraints t Applicative) => t (a -> b) -> t a -> t b
+apADT tf ta = build (For :: For Applicative) (\fld -> (tf ! fld) (ta ! fld)) (\fld -> (tf !~ fld) <*> (ta !~ fld))
+
+bindADT :: (ADT1Record t, Constraints t Monad) => t a -> (a -> t b) -> t b
+bindADT ta f = build (For :: For Monad) (\fld -> f (ta ! fld) ! fld) (\fld -> (ta !~ fld) >>= ((!~ fld) . f))
+
+mfixADT :: (ADT1Record t, Constraints t MonadFix) => (a -> t a) -> t a
+mfixADT f = build (For :: For MonadFix) (\fld -> fix ((! fld) . f)) (\fld -> mfix ((!~ fld) . f))