diff --git a/Data/Generics/Any.hs b/Data/Generics/Any.hs
--- a/Data/Generics/Any.hs
+++ b/Data/Generics/Any.hs
@@ -22,19 +22,24 @@
 ---------------------------------------------------------------------
 -- BASIC TYPES
 
+-- | Any value, with a Data dictionary.
 data Any = forall a . Data a => Any a
+
 type AnyT t = Any
 
 instance Show Any where
     show = show . typeOf
 
-fromAny :: Data a => Any -> a
-fromAny (Any x) = case cast x of
+fromAny :: Typeable a => Any -> a
+fromAny (Any x) = case D.cast x of
     Just y -> y
     ~(Just y) -> error $ "Data.Generics.Any.fromAny: Failed to extract any, got " ++
                          show (D.typeOf x) ++ ", wanted " ++ show (D.typeOf y)
 
 
+cast :: Typeable a => Any -> Maybe a
+cast (Any x) = D.cast x
+
 ---------------------------------------------------------------------
 -- SYB COMPATIBILITY
 
@@ -82,9 +87,17 @@
 
 
 recompose :: Any -> [Any] -> Any
-recompose (Any x) cs = Any $ res `asTypeOf` x
-    where res = flip evalState cs $ flip fromConstrM (D.toConstr x) $ do
-                    c:cs <- get; put cs; return $ fromAny c
+recompose (Any x) cs | null s = Any $ res `asTypeOf` x
+                     | otherwise = err
+    where (res,s) = flip runState cs $ flip fromConstrM (D.toConstr x) $ do
+                        cs <- get
+                        if null cs then err else do
+                            put $ tail cs
+                            return $ fromAny $ head cs
+
+          err = error $ "Data.Generics.Any.recompose: Incorrect number of children to recompose, " ++
+                        ctor (Any x) ++ " :: " ++ show (Any x) ++ ", expected " ++ show (arity $ Any x) ++
+                        ", got " ++ show (length cs)
 
 
 ctors :: Any -> [CtorName]
diff --git a/Main.hs b/Main.hs
--- a/Main.hs
+++ b/Main.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
 
 module Main where
 
diff --git a/System/Console/CmdArgs/Annotate.hs b/System/Console/CmdArgs/Annotate.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/CmdArgs/Annotate.hs
@@ -0,0 +1,278 @@
+{-# LANGUAGE PatternGuards, ScopedTypeVariables, ExistentialQuantification, DeriveDataTypeable #-}
+
+-- | This module captures annotations on a value, and builds a 'Capture' value.
+--   This module has two ways of writing annotations:
+--
+--   /Impure/: The impure method of writing annotations is susceptible to over-optimisation by GHC
+--   - sometimes @\{\-\# OPTIONS_GHC -fno-cse \#\-\}@ will be required.
+--
+--   /Pure/: The pure method is more verbose, and lacks some type safety.
+--
+--   As an example of the two styles:
+--
+-- > data Foo = Foo {foo :: Int, bar :: Int}
+--
+--   @ impure = 'capture' $ Foo {foo = 12, bar = 'many' [1 '&=' \"inner\", 2]} '&=' \"top\"@
+--
+--   @ pure = 'capture_' $ 'record' Foo{} [foo := 12, bar :=+ ['atom' 1 '+=' \"inner\", 'atom' 2]] '+=' \"top\"@
+--
+--   Both evaluate to:
+--
+-- > Capture (Ann "top") (Ctor (Foo 12 1) [Value 12, Many [Ann "inner" (Value 1), Value 2]]
+module System.Console.CmdArgs.Annotate(
+    -- * Capture framework
+    Capture(..), Any(..), fromCapture, defaultMissing,
+    -- * Impure
+    capture, many, (&=),
+    -- * Pure
+    capture_, many_, (+=), atom, record, Annotate((:=),(:=+))
+    ) where
+
+import Control.Monad
+import Control.Monad.State
+import Data.Data(Data,Typeable)
+import Data.List
+import Data.Maybe
+import Data.IORef
+import System.IO.Unsafe
+import Control.Exception
+import Data.Generics.Any
+
+infixl 2 &=, +=
+infix 3 :=
+
+
+-- | The result of capturing some annotations.
+data Capture ann
+    = Many [Capture ann] -- ^ Many values collapsed ('many' or 'many_')
+    | Ann ann (Capture ann) -- ^ An annotation attached to a value ('&=' or '+=')
+    | Value Any -- ^ A value (just a value, or 'atom')
+    | Missing Any -- ^ A missing field (a 'RecConError' exception, or missing from 'record')
+    | Ctor Any [Capture ann] -- ^ A constructor (a constructor, or 'record')
+      deriving Show
+
+instance Functor Capture where
+    fmap f (Many xs) = Many $ map (fmap f) xs
+    fmap f (Ann a x) = Ann (f a) $ fmap f x
+    fmap f (Value x) = Value x
+    fmap f (Missing x) = Missing x
+    fmap f (Ctor x xs) = Ctor x $ map (fmap f) xs
+
+
+-- | Return the value inside a capture.
+fromCapture :: Capture ann -> Any
+fromCapture (Many (x:_)) = fromCapture x
+fromCapture (Ann _ x) = fromCapture x
+fromCapture (Value x) = x
+fromCapture (Missing x) = x
+fromCapture (Ctor x _) = x
+
+
+-- | Remove all Missing values by using any previous instances as default values
+defaultMissing :: Capture ann -> Capture ann
+defaultMissing x = evalState (f Nothing Nothing x) []
+    where
+        f ctor field (Many xs) = fmap Many $ mapM (f ctor field) xs
+        f ctor field (Ann a x) = fmap (Ann a) $ f ctor field x
+        f ctor field (Value x) = return $ Value x
+        f (Just ctor) (Just field) (Missing x) = do
+            s <- get
+            return $ head $
+                [x2 | (ctor2,field2,x2) <- s, typeOf ctor == typeOf ctor2, field == field2] ++
+                err ("missing value encountered, no field for " ++ field ++ " (of type " ++ show x ++ ")")
+        f _ _ (Missing x) = err $ "missing value encountered, but not as a field (of type " ++ show x ++ ")"
+        f _ _ (Ctor x xs) | length (fields x) == length xs = do
+            ys <- zipWithM (g x) (fields x) xs
+            return $ Ctor (recompose x $ map fromCapture ys) ys
+        f _ _ (Ctor x xs) = fmap (Ctor x) $ mapM (f Nothing Nothing) xs
+
+        g ctor field x = do
+            y <- f (Just ctor) (Just field) x
+            modify ((ctor,field,y):)
+            return y
+
+        err x = error $ "System.Console.CmdArgs.Annotate.defaultMissing, " ++ x
+
+---------------------------------------------------------------------
+-- IMPURE BIT
+
+-- test = show $ capture $ many [Just ((66::Int) &= P 1 &= P 2), Nothing &= P 8] &= P 3
+
+{-
+Notes On Purity
+---------------
+
+There is a risk that things that are unsafe will be inlined. That can generally be
+removed by NOININE on everything.
+
+There is also a risk that things get commoned up. For example:
+
+foo = trace "1" 1
+bar = trace "1" 1
+main = do
+    evaluate foo
+    evaluate bar
+
+Will print "1" only once, since foo and bar share the same pattern. However, if
+anything in the value is a lambda they are not seen as equal. We exploit this by
+defining const_ and id_ as per this module.
+
+Now anything wrapped in id_ looks different from anything else.
+-}
+
+
+{-
+The idea is to keep a stack of either continuations, or values
+If you encounter 'many' you become a value
+If you encounter '&=' you increase the continuation
+-}
+
+{-# NOINLINE ref #-}
+ref :: IORef [Either (Capture Any -> Capture Any) (Capture Any)]
+ref = unsafePerformIO $ newIORef []
+
+push = modifyIORef ref (Left id :)
+pop = do x:xs <- readIORef ref; writeIORef ref xs; return x
+change f = modifyIORef ref $ \x -> case x of Left g : rest -> f g : rest ; _ -> error "Internal error in Capture"
+add f = change $ \x -> Left $ x . f
+set x = change $ \f -> Right $ f x
+
+
+-- | Collapse multiple values in to one.
+{-# NOINLINE many #-}
+many :: Data val => [val] -> val
+many xs = unsafePerformIO $ do
+    ys <- mapM (force . Any) xs
+    set $ Many ys
+    return $ head xs
+
+
+{-# NOINLINE addAnn #-}
+addAnn :: (Data val, Data ann) => val -> ann -> val
+addAnn x y = unsafePerformIO $ do
+    add (Ann $ Any y)
+    evaluate x
+    return x
+
+
+-- | Capture a value. Note that if the value is evaluated
+--   more than once the result may be different, i.e.
+--
+-- > capture x /= capture x
+{-# NOINLINE capture #-}
+capture :: (Data val, Data ann) => val -> Capture ann
+capture x = unsafePerformIO $ fmap (fmap fromAny) $ force $ Any x
+
+
+force :: Any -> IO (Capture Any)
+force x@(Any xx) = do
+    push
+    res <- try $ evaluate xx
+    y <- pop
+    case y of
+        _ | Left (_ :: RecConError) <- res -> return $ Missing x
+        Right r -> return r
+        Left f | not $ isAlgType x -> return $ f $ Value x
+               | otherwise -> do
+            cs <- mapM force $ children x
+            return $ f $ Ctor x cs
+
+
+-- | Add an annotation to a value.
+--
+--   It is recommended that anyone making use of this function redefine
+--   it with a more restrictive type signature to control the type of the
+--   annotation (the second argument). Any redefinitions of this function
+--   should add an INLINE pragma, to reduce the chance of incorrect
+--   optimisations.
+{-# INLINE (&=) #-}
+(&=) :: (Data val, Data ann) => val -> ann -> val
+(&=) x y = addAnn (id_ x) (id_ y)
+
+
+{-# NOINLINE const_ #-}
+const_ :: a -> b -> b
+const_ f x = x
+
+{-# INLINE id_ #-}
+id_ :: a -> a
+id_ x = const_ (\() -> ()) x
+
+
+---------------------------------------------------------------------
+-- PURE PART
+
+-- | This type represents an annotated value. The type of the underlying value is not specified.
+data Annotate ann
+    = forall c f . (Data c, Data f) => (c -> f) := f -- ^ Construct a field, @fieldname := value@.
+    | forall c f . (Data c, Data f) => (c -> f) :=+ [Annotate ann] -- ^ Add annotations to a field.
+    | AAnn ann (Annotate ann)
+    | AMany [Annotate ann]
+    | AAtom Any
+    | ACtor Any [Annotate ann]
+
+
+-- | Add an annotation to a value.
+(+=) :: Annotate ann -> ann -> Annotate ann
+(+=) = flip AAnn
+
+-- | Collapse many annotated values in to one.
+many_ :: [Annotate a] -> Annotate a
+many_ = AMany
+
+-- | Lift a pure value to an annotation.
+atom :: Data val => val -> Annotate ann
+atom = AAtom . Any
+
+-- | Create a constructor/record. The first argument should be
+--   the type of field, the second should be a list of fields constructed
+--   originally defined by @:=@ or @:=+@.
+--
+--   This operation is not type safe, and may raise an exception at runtime
+--   if any field has the wrong type or label.
+record :: Data a => a -> [Annotate b] -> Annotate b
+record a b = ACtor (Any a) b
+
+-- | Capture the annotations from an annotated value.
+capture_ :: Show a => Annotate a -> Capture a
+capture_ (AAnn a x) = Ann a (capture_ x)
+capture_ (AMany xs) = Many (map capture_ xs)
+capture_ (AAtom x) = Value x
+capture_ (_ := c) = Value $ Any c
+capture_ (_ :=+ c) = Many $ map capture_ c
+capture_ (ACtor x xs)
+    | not $ null rep = error $ "Some fields got repeated under " ++ show x ++ "." ++ ctor x ++ ": " ++ show rep
+    | otherwise = Ctor x2 xs2
+    where
+        x2 = recompose x $ map fromCapture xs2
+        xs2 = [fromMaybe (Missing c) $ lookup i is | let is = zip inds $ map capture_ xs, (i,c) <- zip [0..] $ children x]
+        inds = zipWith fromMaybe [0..] $ map (fieldIndex x) xs
+        rep = inds \\ nub inds
+
+
+fieldIndex :: Any -> Annotate a -> Maybe Int
+fieldIndex ctor (AAnn a x) = fieldIndex ctor x
+fieldIndex ctor (f := _) = fieldIndex ctor (f :=+ [])
+fieldIndex ctor (f :=+ _) | isJust res = res
+                          | otherwise = error $ "Couldn't resolve field for " ++ show ctor
+    where c = recompose ctor [Any $ throwInt i `asTypeOf` x | (i,Any x) <- zip [0..] (children ctor)]
+          res = catchInt $ f $ fromAny c
+fieldIndex _ _ = Nothing
+
+
+
+data ExceptionInt = ExceptionInt Int deriving (Show, Typeable)
+instance Exception ExceptionInt
+
+
+throwInt :: Int -> a
+throwInt i = throw (ExceptionInt i)
+
+
+{-# NOINLINE catchInt #-}
+catchInt :: a -> Maybe Int
+catchInt x = unsafePerformIO $ do
+    y <- try (evaluate x)
+    return $ case y of
+        Left (ExceptionInt z) -> Just z
+        _ -> Nothing
diff --git a/System/Console/CmdArgs/Explicit.hs b/System/Console/CmdArgs/Explicit.hs
--- a/System/Console/CmdArgs/Explicit.hs
+++ b/System/Console/CmdArgs/Explicit.hs
@@ -48,7 +48,7 @@
     module System.Console.CmdArgs.Explicit.Help
     ) where
 
-import System.Console.CmdArgs.Explicit.Type
+import System.Console.CmdArgs.Explicit.Type hiding (showRecord, (*=))
 import System.Console.CmdArgs.Explicit.Process
 import System.Console.CmdArgs.Explicit.Help
 import System.Console.CmdArgs.Default
diff --git a/System/Console/CmdArgs/Explicit/Help.hs b/System/Console/CmdArgs/Explicit/Help.hs
--- a/System/Console/CmdArgs/Explicit/Help.hs
+++ b/System/Console/CmdArgs/Explicit/Help.hs
@@ -64,6 +64,11 @@
 instance Show (Mode a) where
     show = show . helpTextDefault
 
+instance Show (Flag a) where
+    show = show . helpFlag
+
+instance Show (Arg a) where
+    show = show . argType
 
 -- | Generate a help message from a mode.
 helpText :: HelpFormat -> Mode a -> [Text]
diff --git a/System/Console/CmdArgs/Explicit/Process.hs b/System/Console/CmdArgs/Explicit/Process.hs
--- a/System/Console/CmdArgs/Explicit/Process.hs
+++ b/System/Console/CmdArgs/Explicit/Process.hs
@@ -58,6 +58,11 @@
     ,errs :: [String]
     }
 
+stop :: S a -> Maybe (Either String a)
+stop s | not $ null $ errs s = Just $ Left $ last $ errs s
+       | null $ args s = Just $ Right $ val s
+       | otherwise = Nothing
+
 err :: S a -> String -> S a
 err s x = s{errs=x:errs s}
 
@@ -69,10 +74,7 @@
 
 processFlags :: Mode a -> a -> [String] -> Either String a
 processFlags mode val_ args_ = f $ S val_ args_ []
-    where
-        f s | not $ null $ errs s = Left $ last $ errs s
-            | null $ args s = Right $ val s
-            | otherwise = f (processFlag mode s)
+    where f s = fromMaybe (f $ processFlag mode s) $ stop s
 
 
 pickFlags long mode = [(filter (\x -> (length x > 1) == long) $ flagNames flag,(flagInfo flag,flag)) | flag <- modeFlags mode]
@@ -114,14 +116,19 @@
         s = s_{args=ys}
 
 
-processFlag mode s_ =
+processFlag mode s_@S{args="--":ys} = f s_{args=ys}
+    where f s | isJust $ stop s = s
+              | otherwise = f $ processArg mode s
+
+processFlag mode s = processArg mode s
+
+processArg mode s_@S{args=x:ys} =
     case modeArgs mode of
         Nothing -> err s $ "Unhandled argument, none expected: " ++ x
         Just arg -> case argValue arg x (val s) of
             Left e -> err s $ "Unhandled argument, " ++ e ++ ": " ++ x
             Right v -> s{val=v}
     where
-        x:ys = if head (args s_) == "--" then tail (args s_) else args s_
         s = s_{args=ys}
 
 
diff --git a/System/Console/CmdArgs/Explicit/Type.hs b/System/Console/CmdArgs/Explicit/Type.hs
--- a/System/Console/CmdArgs/Explicit/Type.hs
+++ b/System/Console/CmdArgs/Explicit/Type.hs
@@ -63,6 +63,10 @@
 ---------------------------------------------------------------------
 -- TYPES
 
+showRecord x ys = x ++ " {" ++ intercalate ", " ys ++ "}"
+a *= b = a ++ " = " ++ show b
+
+
 -- | A mode. Each mode has three main features:
 --
 --   * A list of submodes ('modeGroupModes')
@@ -103,7 +107,7 @@
     | FlagOpt String      -- ^ Optional argument
     | FlagOptRare String  -- ^ Optional argument that requires an = before the value
     | FlagNone            -- ^ No argument
-      deriving (Eq,Ord)
+      deriving (Eq,Ord,Show)
 
 -- | Extract the value from inside a 'FlagOpt' or 'FlagOptRare', or raises an error.
 fromFlagOpt :: FlagInfo -> String
@@ -123,12 +127,22 @@
     ,flagHelp :: Help -- ^ The help message associated with this flag.
     }
 
--- | An unnamed argument.
+
+-- | An unnamed argument. Anything not starting with @-@ is considered an argument,
+--   apart from @\"-\"@ which is considered to be the argument @\"-\"@, and any arguments
+--   following @\"--\"@. For example:
+--
+-- > programname arg1 -j - --foo arg3 -- -arg4 --arg5=1 arg6
+--
+--   Would have the arguments:
+--
+-- > ["arg1","-","arg3","-arg4","--arg5=1","arg6"]
 data Arg a = Arg
     {argValue :: Update a -- ^ A way of processing the argument.
     ,argType :: FlagHelp -- ^ The type of data for the argument, i.e. FILE\/DIR\/EXT
     }
 
+
 ---------------------------------------------------------------------
 -- CHECK FLAGS
 
@@ -160,20 +174,29 @@
 ---------------------------------------------------------------------
 -- REMAP
 
--- | Change the underlying type of a 'Mode' structure.
-remap :: (a -> b) -- ^ Embed the mode
-      -> (b -> (a, a -> b)) -- ^ Extract the mode and give a way of re-embedding
-      -> Mode a -> Mode b
-remap f g x = x
-    {modeGroupModes = fmap (remap f g) $ modeGroupModes x
-    ,modeValue = f $ modeValue x
-    ,modeCheck = \v -> let (a,b) = g v in fmap b $ modeCheck x a
-    ,modeArgs = fmap remapArg $ modeArgs x
-    ,modeGroupFlags = fmap remapFlag $ modeGroupFlags x}
-    where
-        remapUpdate upd = \s v -> let (a,b) = g v in fmap b $ upd s a
-        remapFlag x = x{flagValue = remapUpdate $ flagValue x}
-        remapArg x = x{argValue = remapUpdate $ argValue x}
+class Remap m where
+    remap :: (a -> b) -- ^ Embed a value
+          -> (b -> (a, a -> b)) -- ^ Extract the mode and give a way of re-embedding
+          -> m a -> m b
+
+remap2 :: Remap m => (a -> b) -> (b -> a) -> m a -> m b
+remap2 f g = remap f (\x -> (g x, f))
+
+instance Remap Mode where
+    remap f g x = x
+        {modeGroupModes = fmap (remap f g) $ modeGroupModes x
+        ,modeValue = f $ modeValue x
+        ,modeCheck = \v -> let (a,b) = g v in fmap b $ modeCheck x a
+        ,modeArgs = fmap (remap f g) $ modeArgs x
+        ,modeGroupFlags = fmap (remap f g) $ modeGroupFlags x}
+
+instance Remap Flag where
+    remap f g x = x{flagValue = remapUpdate f g $ flagValue x}
+
+instance Remap Arg where
+    remap f g x = x{argValue = remapUpdate f g $ argValue x}
+
+remapUpdate f g upd = \s v -> let (a,b) = g v in fmap b $ upd s a
 
 
 ---------------------------------------------------------------------
diff --git a/System/Console/CmdArgs/Implicit.hs b/System/Console/CmdArgs/Implicit.hs
--- a/System/Console/CmdArgs/Implicit.hs
+++ b/System/Console/CmdArgs/Implicit.hs
@@ -46,12 +46,15 @@
 -}
 module System.Console.CmdArgs.Implicit(
     -- * Running command lines
-    cmdArgs, cmdArgsMode, cmdArgsRun, cmdArgsApply, CmdArgs(..),
+    cmdArgs, cmdArgsMode, cmdArgsRun, cmdArgs_, cmdArgsMode_, cmdArgsApply, CmdArgs(..),
     -- * Constructing command lines
     -- | Attributes can work on a flag (inside a field), on a mode (outside the record),
     --   or on all modes (outside the 'modes' call).
-    (&=), modes, enum,
     module System.Console.CmdArgs.Implicit.UI,
+    -- ** Impure
+    (&=), modes, enum,
+    -- ** Pure
+    (+=), record, atom, Annotate((:=)), enum_, modes_,
     -- * Re-exported for convenience
     -- | Provides a few opaque types (for writing type signatures),
     --   verbosity control, default values with 'def' and the
@@ -67,32 +70,49 @@
 import System.Exit
 import System.Console.CmdArgs.Explicit(Mode,processArgs,remap)
 import System.Console.CmdArgs.Implicit.Ann
-import System.Console.CmdArgs.Implicit.Capture
-import System.Console.CmdArgs.Implicit.Step1
-import System.Console.CmdArgs.Implicit.Step2
-import System.Console.CmdArgs.Implicit.Step3
+import System.Console.CmdArgs.Annotate hiding ((&=))
+import qualified System.Console.CmdArgs.Annotate as A((&=))
+import System.Console.CmdArgs.Implicit.Type
+import System.Console.CmdArgs.Implicit.Local
+import System.Console.CmdArgs.Implicit.Global
 import System.Console.CmdArgs.Implicit.UI
 import System.Console.CmdArgs.Verbosity
 import System.Console.CmdArgs.Default
 
 
--- | Take annotated records and run the corresponding command line.
+-- | Take impurely annotated records and run the corresponding command line.
 --   Shortcut for @'cmdArgsRun' . 'cmdArgsMode'@.
 cmdArgs :: Data a => a -> IO a
 cmdArgs = cmdArgsRun . cmdArgsMode
 
 
--- | Take annotated records and turn them in to a 'Mode' value, that can
+-- | Take purely annotated records and run the corresponding command line.
+--   Shortcut for @'cmdArgsRun' . 'cmdArgsMode_'@.
+cmdArgs_ :: Data a => Annotate Ann -> IO a
+cmdArgs_ = cmdArgsRun . cmdArgsMode_
+
+
+cmdArgsCapture :: Data a => Capture Ann -> Mode (CmdArgs a)
+cmdArgsCapture = remap embed proj . global . local
+    where embed = fmap fromAny
+          proj x = (fmap Any x, embed)
+
+
+-- | Take impurely annotated records and turn them in to a 'Mode' value, that can
 --   make use of the "System.Console.CmdArgs.Explicit" functions (i.e. 'process').
 --
 --   Annotated records are impure, and will only contain annotations on
 --   their first use. The result of this function is pure, and can be reused.
 cmdArgsMode :: Data a => a -> Mode (CmdArgs a)
-cmdArgsMode = remap embed proj . step3 . step2 . step1 . capture . Any
-    where embed = fmap fromAny
-          proj x = (fmap Any x, embed)
+cmdArgsMode = cmdArgsCapture . capture
 
 
+-- | Take purely annotated records and turn them in to a 'Mode' value, that can
+--   make use of the "System.Console.CmdArgs.Explicit" functions (i.e. 'process').
+cmdArgsMode_ :: Data a => Annotate Ann -> Mode (CmdArgs a)
+cmdArgsMode_ = cmdArgsCapture . capture_
+
+
 -- | Run a Mode structure. This function reads the command line arguments
 --   and then performs as follows:
 --
@@ -137,7 +157,7 @@
 --
 -- > data Modes = Mode1 | Mode2 | Mode3 deriving Data
 -- > cmdArgs $ modes [Mode1,Mode2,Mode3]
-modes :: Data a => [a] -> a
+modes :: Data val => [val] -> val
 modes = many
 
 -- | Flag: \"I want several different flags to set this one field to different values.\"
@@ -150,5 +170,21 @@
 -- > cmdArgs $ Mode {state = enum [On &= help "Turn on",Off &= help "Turn off"]}
 -- >   --on   Turn on
 -- >   --off  Turn off
-enum :: Data a => [a] -> a
+enum :: Data val => [val] -> val
 enum = many
+
+
+-- | Add an annotation to a value. Note that if the value is evaluated
+--   more than once the annotation will only be available the first time.
+{-# INLINE (&=) #-}
+(&=) :: Data val => val -> Ann -> val
+(&=) = (A.&=)
+
+
+enum_ :: (Data c, Data f) => (c -> f) -> [Annotate Ann] -> Annotate Ann
+enum_ = (:=+)
+
+modes_ :: [Annotate Ann] -> Annotate Ann
+modes_ = many_
+
+
diff --git a/System/Console/CmdArgs/Implicit/Ann.hs b/System/Console/CmdArgs/Implicit/Ann.hs
--- a/System/Console/CmdArgs/Implicit/Ann.hs
+++ b/System/Console/CmdArgs/Implicit/Ann.hs
@@ -1,7 +1,9 @@
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 
 module System.Console.CmdArgs.Implicit.Ann where
 
+import Data.Data
+
 -- | The general type of annotations that can be associated with a value.
 data Ann
     = Help String
@@ -13,8 +15,6 @@
     | FlagArgs
     | FlagArgPos Int
     | FlagType String
-    | FlagEnum -- private, specified by 'one'
-    | FlagInherit -- private, specified by omitting it (which throws RecConError)
 
     | ModeDefault
     | ModeHelpSuffix [String]
@@ -22,4 +22,4 @@
     | ProgSummary String
     | ProgProgram String
     | ProgVerbosity
-      deriving (Eq,Ord,Show)
+      deriving (Eq,Ord,Show,Data,Typeable)
diff --git a/System/Console/CmdArgs/Implicit/Capture.hs b/System/Console/CmdArgs/Implicit/Capture.hs
deleted file mode 100644
--- a/System/Console/CmdArgs/Implicit/Capture.hs
+++ /dev/null
@@ -1,120 +0,0 @@
-{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
-
--- | This module does all the tricky/unsafe bits of CmdArgs.
---   It captures annotations on the data structure in the most direct way
---   possible.
-module System.Console.CmdArgs.Implicit.Capture(
-    Capture(..), capture, many, (&=)
-    ) where
-
-{-
-Notes on purity:
-
-There is a risk that things that are unsafe will be inlined. That can generally be
-removed by NOININE on everything.
-
-There is also a risk that things get commoned up. For example:
-
-foo = trace "1" 1
-bar = trace "1" 1
-main = do
-    evaluate foo
-    evaluate bar
-
-Will print "1" only once, since foo and bar share the same pattern. However, if
-anything in the value is a lambda they are not seen as equal. We exploit this by
-defining const_ and id_ as per this module.
-
-Now anything wrapped in id_ looks different from anything else.
--}
-
-
-import Data.Data(Data)
-import Data.IORef
-import System.IO.Unsafe
-import Control.Exception
-import System.Console.CmdArgs.Implicit.Ann
-import Data.Generics.Any
-
-
--- test = show $ capture $ many [Just ((66::Int) &= P 1 &= P 2), Nothing &= P 8] &= P 3
-
-
-infixl 2 &=
-
-data Capture
-    = Many [Capture]
-    | Ann Ann Capture
-    | Value Any
-    | Missing Any -- a RecConError
-    | Ctor Any [Capture]
-      deriving Show
-      
-{-
-The idea is to keep a stack of either continuations, or values
-If you encounter 'many' you become a value
-If you encounter '&=' you increase the continuation
--}
-
-{-# NOINLINE ref #-}
-ref :: IORef [Either (Capture -> Capture) Capture]
-ref = unsafePerformIO $ newIORef []
-
-push = modifyIORef ref (Left id :)
-pop = do x:xs <- readIORef ref; writeIORef ref xs; return x
-modify f = modifyIORef ref $ \x -> case x of Left g : rest -> f g : rest ; _ -> error "Internal error in Capture"
-add f = modify $ \x -> Left $ x . f
-set x = modify $ \f -> Right $ f x
-
-
--- | Collapse multiple values in to one.
-{-# NOINLINE many #-}
-many :: Data a => [a] -> a
-many xs = unsafePerformIO $ do
-    ys <- mapM (force . Any) xs
-    set $ Many ys
-    return $ head xs
-
-
--- | Add an annotation to a value. Note that if the value is evaluated
---   more than once the annotation will only be available the first time.
-{-# NOINLINE addAnn #-}
-addAnn :: Data a => a -> Ann -> a
-addAnn x y = unsafePerformIO $ do
-    add (Ann y)
-    evaluate x
-    return x
-
-
-{-# NOINLINE capture #-}
-capture :: Any -> Capture
-capture x = unsafePerformIO $ force x
-
-
-force :: Any -> IO Capture
-force x@(Any xx) = do
-    push
-    res <- try $ evaluate xx
-    y <- pop
-    case y of
-        _ | Left (_ :: RecConError) <- res -> return $ Missing x
-        Right r -> return r
-        Left f | not $ isAlgType x -> return $ f $ Value x
-               | otherwise -> do
-            cs <- mapM force $ children x
-            return $ f $ Ctor x cs
-
-
-{-# INLINE (&=) #-}
-(&=) :: Data a => a -> Ann -> a
-(&=) x y = addAnn (id_ x) (id_ y)
-
-
-{-# NOINLINE const_ #-}
-const_ :: a -> b -> b
-const_ f x = x
-
-{-# INLINE id_ #-}
-id_ :: a -> a
-id_ x = const_ (\() -> ()) x
-
diff --git a/System/Console/CmdArgs/Implicit/Global.hs b/System/Console/CmdArgs/Implicit/Global.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/CmdArgs/Implicit/Global.hs
@@ -0,0 +1,218 @@
+{-# LANGUAGE PatternGuards #-}
+
+module System.Console.CmdArgs.Implicit.Global(global) where
+
+import System.Console.CmdArgs.Implicit.Local
+import System.Console.CmdArgs.Implicit.Type
+import System.Console.CmdArgs.Explicit
+import System.Console.CmdArgs.Text
+import System.Console.CmdArgs.Default
+
+import Control.Monad
+import Data.Char
+import Data.Function
+import Data.Generics.Any
+import Data.List
+import Data.Maybe
+
+
+global :: Prog_ -> Mode (CmdArgs Any)
+global x = setHelp x $ collapse $ assignGroups $ assignNames $ extraFlags x
+
+
+---------------------------------------------------------------------
+-- COLLAPSE THE FLAGS/MODES UPWARDS
+
+collapse :: Prog_ -> Mode (CmdArgs Any)
+collapse x | length ms == 1 = (head ms){modeNames=[progProgram x]}
+           | length auto > 1 = err "prog" "Multiple automatic modes"
+           | otherwise = (head $ map zeroMode auto ++ map emptyMode ms){modeNames=[progProgram x], modeGroupModes = toGroup ms}
+    where
+        ms = map collapseMode $ progModes x
+        auto = [m | (m,True) <- zip ms $ map modeDefault $ progModes x]
+
+
+-- | A mode devoid of all it's contents
+emptyMode :: Mode (CmdArgs Any) -> Mode (CmdArgs Any)
+emptyMode x = x
+    {modeCheck = \x -> if cmdArgsHasValue x then Left "No mode given and no default mode" else Right x
+    ,modeGroupFlags = groupUncommonDelete $ modeGroupFlags x
+    ,modeArgs=Nothing, modeHelpSuffix=[]}
+
+-- | A mode whose help hides all it's contents
+zeroMode :: Mode (CmdArgs Any) -> Mode (CmdArgs Any)
+zeroMode x = x
+    {modeGroupFlags = groupUncommonHide $ modeGroupFlags x
+    ,modeArgs=fmap (\x -> x{argType=""}) $ modeArgs x
+    ,modeHelpSuffix=[]}
+
+
+collapseMode :: Mode_ -> Mode (CmdArgs Any)
+collapseMode x =
+    collapseArgs [x | x@Arg_{} <- modeFlags_ x] $
+    collapseFlags [x | x@Flag_{} <- modeFlags_ x] $
+    modeMode x
+
+
+collapseFlags :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
+collapseFlags xs x = x{modeGroupFlags = Group (pick Nothing) [] [(g, pick $ Just g) | g <- groups]}
+    where
+        pick x = map flagFlag $ filter ((==) x . flagGroup) xs
+        groups = nub $ mapMaybe flagGroup xs
+
+
+collapseArgs :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
+collapseArgs [] x = x
+collapseArgs xs x = x{modeCheck=chk, modeArgs = Just $ flagArg upd hlp}
+    where
+        argUpd = argValue . flagArg_
+
+        (ord,rep) = orderArgs xs
+        mn = length $ dropWhile (isJust . flagArgOpt) $ reverse ord
+
+        chk v | not $ cmdArgsHasValue v = Right v
+              | n < mn = Left $ "Requires at least " ++ show mn ++ " arguments, got " ++ show n
+              | otherwise = foldl f (addOptArgs n v) (drop n ord)
+            where n = getArgsSeen v
+                  f (Right v) arg = argUpd arg (fromJust $ flagArgOpt arg) v
+                  f x _ = x
+
+        -- if we have repeating args which is also opt, translate that here
+        addOptArgs n v
+            | Just x <- rep, Just o <- flagArgOpt x, Just n <= findIndex (isNothing . flagArgPos) (ord ++ [x]) = argUpd x o v
+            | otherwise = Right v
+
+        hlp = unwords $ a ++ map (\x -> "["++x++"]") b
+            where (a,b) = splitAt mn $ map (argType . flagArg_) $ ord ++ maybeToList rep
+
+        upd s v | n < length ord = argUpd (ord !! n) s v2
+                | Just x <- rep = argUpd x s v2
+                | otherwise = Left $ "expected at most " ++ show (length ord)
+            where n = getArgsSeen v
+                  v2 = incArgsSeen v
+
+
+-- return the arguments in order, plus those at the end
+orderArgs :: [Flag_] -> ([Flag_], Maybe Flag_)
+orderArgs args = (f 0 ord, listToMaybe rep)
+    where
+        (rep,ord) = span (isNothing . flagArgPos) $ sortBy (compare `on` flagArgPos) args
+        f i [] = []
+        f i (x:xs) = case fromJust (flagArgPos x) `compare` i of
+            LT -> f i xs
+            EQ -> x : f (i+1) xs
+            GT -> take 1 rep ++ f (i+1) (x:xs)
+
+
+incArgsSeen x = x{cmdArgsPrivate = CmdArgsPrivate $ getArgsSeen x + 1}
+getArgsSeen CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = i
+
+
+---------------------------------------------------------------------
+-- DEAL WITH GROUPS
+
+assignGroups :: Prog_ -> Prog_
+assignGroups p = assignCommon $ p{progModes = map (\m -> m{modeFlags_ = f Nothing $ modeFlags_ m}) $ progModes p}
+    where
+        f grp [] = []
+        f grp (x@Flag_{}:xs) = x{flagGroup=grp2} : f grp2 xs
+            where grp2 = flagGroup x `mplus` grp
+        f grp (x:xs) = x : f grp xs
+
+
+assignCommon :: Prog_ -> Prog_
+assignCommon p =
+    p{progModes = [m{modeFlags_ =
+        [if isFlag_ f && show (flagFlag f) `elem` com then f{flagGroup = Just commonGroup} else f | f <- modeFlags_ m]}
+    | m <- progModes p]}
+    where
+        com = map head $ filter ((== length (progModes p)) . length) $ group $ sort
+              [show $ flagFlag f | m <- progModes p, f@Flag_{flagGroup=Nothing} <- modeFlags_ m]
+
+
+commonGroup = "Common flags"
+
+groupSplitCommon :: Group a -> ([a], Group a)
+groupSplitCommon (Group unnamed hidden named) = (concatMap snd com, Group unnamed hidden uni)
+    where (com,uni) = partition ((==) commonGroup . fst) named
+
+groupCommonHide x = let (a,b) = groupSplitCommon x in b{groupHidden = groupHidden b ++ a}
+groupUncommonHide x = let (a,b) = groupSplitCommon x in Group [] (fromGroup b) [(commonGroup,a) | not $ null a]
+groupUncommonDelete x = let a = fst $ groupSplitCommon x in Group [] [] [(commonGroup,a) | not $ null a]
+
+
+---------------------------------------------------------------------
+-- ADD EXTRA PIECES
+
+
+extraFlags :: Prog_ -> Prog_
+extraFlags p = p{progModes = map f $ progModes p}
+    where f m = m{modeFlags_ = modeFlags_ m ++ map (\x -> def{flagFlag=x, flagExplicit=True, flagGroup=grp}) flags}
+          grp = if length (progModes p) > 1 then Just commonGroup else Nothing
+          flags = flagHelpFormat undefined : flagVersion vers : if progVerbosity p then flagsVerbosity verb else []
+          vers x = x{cmdArgsVersion = Just $ progSumm p}
+          verb v x = x{cmdArgsVerbosity = Just v}
+
+
+setHelp :: Prog_ -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)
+setHelp p = mapModes0 add ""
+    where
+        mapModes0 f pre m = f pre $ mapModes1 f pre m
+        mapModes1 f pre m = m{modeGroupModes = fmap (mapModes0 f (pre ++ head (modeNames m) ++ " ")) $ modeGroupModes m}
+
+        add pre m = changeHelp m $ \hlp txt x -> x{cmdArgsHelp=Just $ showText txt $ msg hlp}
+            where msg hlp = Line (progSumm p) : Line "" : helpText hlp (prepare m{modeNames = map (pre++) $ modeNames m})
+
+        prepare = mapModes1 (\_ m -> m{modeGroupFlags = groupCommonHide $ modeGroupFlags m}) ""
+
+
+changeHelp :: Mode a -> (HelpFormat -> TextFormat -> a -> a) -> Mode a
+changeHelp m upd = m{modeGroupFlags = fmap f $ modeGroupFlags m}
+    where hlp = flagHelpFormat upd
+          f flg = if flagNames hlp == flagNames flg then hlp else flg
+
+
+---------------------------------------------------------------------
+-- ASSIGN NAMES
+
+assignNames :: Prog_ -> Prog_
+assignNames x = x{progModes = map f $ namesOn fromMode toMode $ progModes x}
+    where
+        fromMode x = Names (modeNames $ modeMode x) [asName $ ctor $ cmdArgsValue $ modeValue $ modeMode x]
+        toMode xs x = x{modeMode = (modeMode x){modeNames=["["++head xs++"]" | modeDefault x] ++ xs}}
+
+        fromFlagLong x = Names (flagNames $ flagFlag x) [asName $ fromMaybe (flagField x) (flagEnum x) | not $ flagExplicit x]
+        fromFlagShort x = Names ns $ nub [take 1 s | not $ flagExplicit x, all ((/=) 1 . length) ns, s <- ns]
+            where ns = flagNames $ flagFlag x
+        toFlag xs x = x{flagFlag = (flagFlag x){flagNames=xs}}
+
+        f x = x{modeFlags_ = rest ++ namesOn fromFlagShort toFlag (namesOn fromFlagLong toFlag flgs)}
+            where (flgs,rest) = partition isFlag_ $ modeFlags_ x
+
+        isFlag_ Flag_{} = True
+        isFlag_ _ = False
+
+
+asName s = map (\x -> if x == '_' then '-' else toLower x) $ if last s == '_' then init s else s 
+
+-- have are already assigned, want are a list of ones I might want
+data Names = Names {have :: [String], want :: [String]}
+
+-- error out if any name is by multiple have's, or one item would get no names
+names :: [Names] -> [[String]]
+names xs | not $ null bad = err "repeated names" $ unwords bad
+    where bad = duplicates $ concatMap have xs
+
+names xs | any null res = err "no available name" "?"
+         | otherwise = res
+    where
+        bad = concatMap have xs ++ duplicates (concatMap want xs)
+        res = map (\x -> have x ++ (want x \\ bad)) xs
+
+
+duplicates :: Eq a => [a] -> [a]
+duplicates xs = nub $ xs \\ nub xs
+
+
+namesOn :: (a -> Names) -> ([String] -> a -> a) -> [a] -> [a]
+namesOn f g xs = zipWith g (names $ map f xs) xs
diff --git a/System/Console/CmdArgs/Implicit/Local.hs b/System/Console/CmdArgs/Implicit/Local.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/CmdArgs/Implicit/Local.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE PatternGuards #-}
+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
+
+-- | This module takes the result of Capture, and deals with all the local
+--   constraints.
+module System.Console.CmdArgs.Implicit.Local(
+    local, err,
+    Prog_(..), progSumm, Mode_(..), Flag_(..), isFlag_
+    ) where
+
+import System.Console.CmdArgs.Implicit.Ann
+import System.Console.CmdArgs.Implicit.Type
+import System.Console.CmdArgs.Implicit.Read
+import System.Console.CmdArgs.Explicit
+import System.Console.CmdArgs.Annotate
+import System.Console.CmdArgs.Default
+
+import Data.Char
+import Data.Generics.Any
+import Data.Maybe
+
+
+data Prog_ = Prog_
+    {progModes :: [Mode_]
+    ,progSummary :: Maybe String
+    ,progProgram :: String
+    ,progHelp :: String -- only for multiple mode programs
+    ,progVerbosity :: Bool
+    } deriving Show
+instance Default Prog_ where
+    def = Prog_ def def def def def
+progSumm x = fromMaybe ("The " ++ progProgram x ++ " program") $ progSummary x
+
+data Mode_ = Mode_
+    {modeFlags_ :: [Flag_]
+    ,modeMode :: Mode (CmdArgs Any)
+    ,modeDefault :: Bool
+    ,modeGroup :: Maybe String
+    ,modeExplicit :: Bool
+    } deriving Show
+instance Default Mode_ where
+    def = Mode_ [] m def def def
+        where m = Mode (toGroup []) [] undefined Right "" [] Nothing (toGroup [])
+
+data Flag_
+    = Flag_
+        {flagField :: String
+        ,flagFlag :: Flag (CmdArgs Any)
+        ,flagExplicit :: Bool
+        ,flagGroup :: Maybe String
+        ,flagEnum :: Maybe String -- if you are an enum, what is your string value
+        }
+    | Arg_
+        {flagArg_ :: Arg (CmdArgs Any)
+        ,flagArgPos :: Maybe Int
+        ,flagArgOpt :: Maybe String
+        }
+      deriving Show
+instance Default Flag_ where
+    def = Flag_ "" undefined def def def
+
+isFlag_ Flag_{} = True
+isFlag_ _ = False
+
+withMode x f = x{modeMode = f $ modeMode x}
+withFlagArg x f = x{flagArg_ = f $ flagArg_ x}
+withFlagFlag x f = x{flagFlag = f $ flagFlag x}
+
+err x y = error $ "System.Console.CmdArgs.Implicit, unexpected " ++ x ++ ": " ++ y
+errFlag x y = err ("flag (" ++ x ++ ")") y
+
+
+local :: Capture Ann -> Prog_
+local = prog_ . defaultMissing
+
+
+---------------------------------------------------------------------
+-- CAPTURE THE STRUCTURE
+
+prog_ :: Capture Ann -> Prog_
+prog_ (Ann a b) = progAnn a $ prog_ b
+prog_ (Many xs) = def{progModes=map mode_ xs, progProgram=prog}
+    where prog = map toLower $ typeShell $ fromCapture $ head xs
+prog_ x@Ctor{} = prog_ $ Many [x]
+prog_ x = err "program" $ show x
+
+
+mode_ :: Capture Ann -> Mode_
+mode_ (Ann a b) = modeAnn a $ mode_ b
+mode_ o@(Ctor x ys) = withMode def{modeFlags_=concat $ zipWith flag_ (fields x) ys} $ \x -> x{modeValue=embed $ fromCapture o}
+mode_ x = err "mode" $ show x
+
+
+flag_ :: String -> Capture Ann -> [Flag_]
+flag_ name (Ann a b) = map (flagAnn a) $ flag_ name b
+flag_ name (Value x) = [def{flagField=name, flagFlag = remap embed reembed $ value_ name x}]
+flag_ name x@Ctor{} = flag_ name $ Value $ fromCapture x
+flag_ name (Many xs) = map (enum_ name) xs
+flag_ name x = errFlag name $ show x
+
+
+enum_ :: String -> Capture Ann -> Flag_
+enum_ name (Ann a b) = flagAnn a $ enum_ name b
+enum_ name (Value x) = def{flagField=name, flagFlag = flagNone [] (fmap $ setField (name,x)) "", flagEnum=Just $ ctor x}
+enum_ name x@Ctor{} = enum_ name $ Value $ fromCapture x
+enum_ name x = errFlag name $ show x
+
+
+value_ :: String -> Any -> Flag Any
+value_ name x
+    | isNothing mty = errFlag name $ show x
+    | isReadBool ty =
+        let upd b x = setField (name,addContainer ty (getField name x) (Any b)) x
+        in flagBool [] upd ""
+    | otherwise =
+        let upd s x = fmap (\c -> setField (name,c) x) $ reader ty s $ getField name x
+        in flagReq [] upd (readHelp ty) ""
+    where
+        mty = toReadContainer x
+        ty = fromJust mty
+
+
+---------------------------------------------------------------------
+-- CAPTURE THE ANNOTATIONS
+
+progAnn :: Ann -> Prog_ -> Prog_
+progAnn (ProgSummary a) x = x{progSummary=Just a}
+progAnn (ProgProgram a) x = x{progProgram=a}
+progAnn ProgVerbosity x = x{progVerbosity=True}
+progAnn (Help a) x | length (progModes x) > 1 = x{progHelp=a}
+progAnn a x | length (progModes x) == 1 = x{progModes = map (modeAnn a) $ progModes x}
+progAnn a x = err "program" $ show a
+
+
+modeAnn :: Ann -> Mode_ -> Mode_
+modeAnn (Help a) x = withMode x $ \x -> x{modeHelp=a}
+modeAnn (ModeHelpSuffix a) x = withMode x $ \x -> x{modeHelpSuffix=a}
+modeAnn ModeDefault x = x{modeDefault=True}
+modeAnn (GroupName a) x = x{modeGroup=Just a}
+modeAnn Explicit x = x{modeExplicit=True}
+modeAnn a x = err "mode" $ show a
+
+
+flagAnn :: Ann -> Flag_ -> Flag_
+flagAnn (FlagType a) x@Arg_{} = withFlagArg x $ \x -> x{argType=a}
+flagAnn (FlagType a) x@Flag_{} = withFlagFlag x $ \x -> x{flagType=a}
+flagAnn (Help a) x@Flag_{} = withFlagFlag x $ \x -> x{flagHelp=a}
+flagAnn (FlagArgPos a) x = toArg x $ Just a
+flagAnn FlagArgs x = toArg x Nothing
+flagAnn Explicit x@Flag_{} = x{flagExplicit=True}
+flagAnn (FlagOptional a) x@Flag_{flagEnum=Nothing,flagFlag=Flag{flagInfo=FlagReq}} = withFlagFlag x $ \x -> x{flagInfo=FlagOpt a}
+flagAnn (FlagOptional a) x@Arg_{} = x{flagArgOpt=Just a}
+flagAnn (Name a) x@Flag_{} = withFlagFlag x $ \x -> x{flagNames = a : flagNames x}
+flagAnn (GroupName a) x@Flag_{} = x{flagGroup=Just a}
+flagAnn a x = errFlag (head $ words $ show x) $ show a
+
+toArg :: Flag_ -> Maybe Int -> Flag_
+toArg (Flag_ fld x False Nothing Nothing) pos
+    | null (flagNames x), null (flagHelp x), Just y <- opt $ flagInfo x
+    = Arg_ (Arg (flagValue x) (flagType x)) pos y
+    where
+        opt FlagReq = Just Nothing
+        opt (FlagOpt x) = Just (Just x)
+        opt (FlagOptRare x) = Just Nothing
+        opt _ = Nothing
+toArg a _ = errFlag "args/argPos" $ show a
diff --git a/System/Console/CmdArgs/Implicit/Step1.hs b/System/Console/CmdArgs/Implicit/Step1.hs
deleted file mode 100644
--- a/System/Console/CmdArgs/Implicit/Step1.hs
+++ /dev/null
@@ -1,176 +0,0 @@
-{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}
-{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
-
--- | This module takes the result of Structure, and traslates it to
---   the CmdArgs.Explicit format.
-module System.Console.CmdArgs.Implicit.Step1(step1, Prog1(..), Mode1(..), Flag1(..)) where
-
-import System.Console.CmdArgs.Implicit.Ann
-import Data.Generics.Any
-import System.Console.CmdArgs.Implicit.Capture
-
-import Data.Char
-import Data.List
-
-
-data Prog1 = Prog1 [Ann] [Mode1] deriving Show
-data Mode1 = Mode1 [Ann] Any [Flag1] deriving Show
-data Flag1 = Flag1 [Ann] String Any deriving Show
-
-
-step1 :: Capture -> Prog1
-step1 = expand . groupnames . inherit . flatten
-
-
-err x = error $ "CmdArgs.Implicit.Step1: " ++ x
-
-
-mapMode :: (Mode1 -> Mode1) -> Prog1 -> Prog1
-mapMode f (Prog1 a b) = Prog1 a $ map f b
-
-
----------------------------------------------------------------------
--- EXPAND FLAGS
--- Add FlagName properties where you can
-
--- For every flag/mode, assign it a name based on the type information, unless it has explicit
--- For every flag, assign it a short name if it doesn't have one and it would be unambiguous, and no explicit
--- Remove all explicit annotations
-expand :: Prog1 -> Prog1
-expand = mapMode (removeExplicit . assignShort . assignLong)
-
-
-removeExplicit (Mode1 a b c) = Mode1 (del a) b $ map f c
-    where f (Flag1 a b c) = Flag1 (del a) b c
-          del = filter (/= Explicit)
-
-
-assignShort (Mode1 a b c) = Mode1 a b [Flag1 ((s \\ dupe) ++ x) y z | (s,Flag1 x y z) <- zip poss c]
-    where seen = [x | Flag1 a _ _ <- c, Name [x] <- a]
-          dupe = concat poss \\ nub (concat poss)
-          poss = map f c
-          f (Flag1 a b c) = [Name [x] | Explicit `notElem` a, null [() | Name [_] <- a]
-                                       , x <- take 1 [head x | Name x <- a], x `notElem` seen]
-
-
-assignLong (Mode1 a b c) = Mode1 (add (ctor b) a) b $ map f c
-    where f (Flag1 a b c) = Flag1 (add newname a) b c
-               where newname = if FlagEnum `elem` a then ctor c else b
-          add s xs = [Name ss | all g xs, Name ss `notElem` xs] ++ xs
-               where ss = map (\x -> if x == '_' then '-' else toLower x) $ if last s == '_' then init s else s
-
-          g Explicit = False
-          g FlagArgs = False
-          g FlagArgPos{} = False
-          g _ = True
-
-
----------------------------------------------------------------------
--- GROUP NAMES
--- Make sure every mode/flag has a GroupName annotation
-
-groupnames :: Prog1 -> Prog1
-groupnames (Prog1 a b) = Prog1 a $ f onmode "" [Mode1 c d $ f onflag "" e | Mode1 c d e <- b]
-    where
-        onmode (Mode1 a b c) = (a, \a -> Mode1 a b c)
-        onflag (Flag1 a b c) = (a, \a -> Flag1 a b c)
-
-        f on name [] = []
-        f on name (x:xs) = case [y | GroupName y <- c] of
-            [] -> g (GroupName name:c) : f on name xs
-            ys -> x : f on (last ys) xs
-            where (c,g) = on x
-
-
----------------------------------------------------------------------
--- INHERIT
--- Deal with FlagInherit
-
-inherit :: Prog1 -> Prog1
-inherit (Prog1 a b) = Prog1 a $ f ask0 b
-    where
-        ask0 s = err $ "Field missing and not specified previously: " ++ show s
-
-        f ask (x:xs) = x2 : f (\s -> let c = [b | b@(Flag1 _ a _) <- cs, a == s] in if null c then ask s else c) xs
-            where x2@(Mode1 _ _ cs) = inheritMode ask x
-        f ask [] = []
-
-
-inheritMode :: (String -> [Flag1]) -> Mode1 -> Mode1
-inheritMode ask (Mode1 a b c) = Mode1 a (foldr ($) b upd) (concat c2)
-    where (c2,upd) = unzip $ map (inheritFlag ask) c
-
-
-inheritFlag :: (String -> [Flag1]) -> Flag1 -> ([Flag1], Any -> Any)
-inheritFlag ask (Flag1 a b c)
-    | FlagInherit `notElem` a = ([Flag1 a b c], id)
-    | or [typeOf c /= typeOf c2 | Flag1 _ _ c2 <- ys] = err $ "Field missing and previous instance has a different type:" ++ show b
-    | Flag1 a2 b2 c2 : _ <- ys = (ys, setField (b2,c2))
-    where ys = ask b
-
----------------------------------------------------------------------
--- FLATTEN
--- Separate the data in to Prog/Mode/Flag
-
-flatten :: Capture -> Prog1
-flatten = moveAnn . flattenProg
-
-
--- Move annotations from Prog to Mode if appropriate
--- 'Help' can be at the program level for multi-mode programs
-moveAnn :: Prog1 -> Prog1
-moveAnn (Prog1 as ms) = Prog1 prog [Mode1 (mode++a) b c | Mode1 a b c <- ms]
-    where (prog,mode) = partition (\x -> case x of Help{} -> length ms > 1; _ -> isProgAnn x) as
-
-isProgAnn ProgSummary{} = True
-isProgAnn ProgProgram{} = True
-isProgAnn ProgVerbosity{} = True
-isProgAnn _ = False
-
-
-flattenProg :: Capture -> Prog1
-flattenProg (Ann a b) = let Prog1 x y = flattenProg b in Prog1 (x++[a]) y
-flattenProg (Many xs) = Prog1 [] $ map flattenMode xs
-flattenProg x@Ctor{} = Prog1 [] [flattenMode x]
-flattenProg x = err $ "Unexpected in a program: " ++ show x
-
-
-flattenMode :: Capture -> Mode1
-flattenMode (Ann a b) = let Mode1 x y z = flattenMode b in Mode1 (x++[a]) y z
-flattenMode (Ctor x ys) = Mode1 [] x [Flag1 a n b | (y,n) <- zip ys $ fields x, Flag1 a _ b <- flattenFlag y]
-flattenMode x = err $ "Unexpected in a mode: " ++ show x
-
-
-flattenFlag :: Capture -> [Flag1]
-flattenFlag (Ann a b) = [Flag1 (x++[a]) y z | Flag1 x y z <- flattenFlag b]
-flattenFlag (Value x) = [Flag1 [] "" x]
-flattenFlag (Missing x) = [Flag1 [FlagInherit] "" x]
-flattenFlag x@Ctor{} = [Flag1 [] "" $ flattenValue x]
-flattenFlag (Many xs) = concatMap flattenFlag $ map (Ann FlagEnum) xs
-flattenFlag x = err $ "Unexpected in a flag: " ++ show x
-
-
-flattenValue :: Capture -> Any
-flattenValue (Ctor x _) = x
-flattenValue (Value x) = x
-flattenValue x = err $ "Unexpected in a value: " ++ show x
-
-
-{-
-*** Exception:
-
-Ann (ProgSummary "HLint v1.6.5, (C) Neil Mitchell 2006-2009")
-Ann (ModeHelpSuffix ["To check all Haskell files in 'src' and generate a report type:","  hlint src --report"])
-Ann (Text "Suggest improvements to Haskell source code")
-Ann (ProgProgram "hlint")
-
-(Ctor HLint
-    [Ann (Text "Generate a report in HTML") (Ann (FldTyp "FILE") (Ann (FldEmpty "report.html") (Ctor [] [])))
-    ,Ann (Text "Hint/ignore file to use") (Ann (FldTyp "FILE") (Ctor [] []))
-    ,Ann (Text "Color the output (requires ANSI terminal)") (Ann (FldFlag "colour") (Ann (FldFlag "c") (Ctor False [])))
-    ,Ann (Text "Ignore a particular hint") (Ann (FldTyp "MESSAGE") (Ctor [] []))
-    ,Ann (Text "Show all ignored ideas") (Ctor False []),Ann (Text "Run in test mode") (Ctor False [])
-    ,Ann (Text "CPP #define") (Ann (FldTyp "NAME[=VALUE]") (Ctor [] []))
-    ,Ann (Text "CPP include path") (Ann (FldTyp "DIR") (Ctor [] []))
-    ,Ann (FldTyp "FILE/DIR") (Ann FldArgs (Ctor [] []))]))))
--}
diff --git a/System/Console/CmdArgs/Implicit/Step2.hs b/System/Console/CmdArgs/Implicit/Step2.hs
deleted file mode 100644
--- a/System/Console/CmdArgs/Implicit/Step2.hs
+++ /dev/null
@@ -1,128 +0,0 @@
-{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}
-
--- | This module takes the result of Capture, and forms the structure of
---   the arguments. This module supplies the most direct translation of
---   the annotations.
-module System.Console.CmdArgs.Implicit.Step2(
-    step2,
-    Prog2(..), Mode2(..), Flag2(..), Flag2Type(..), Arg2(..)
-    ) where
-
-import System.Console.CmdArgs.Implicit.Ann
-import System.Console.CmdArgs.Implicit.Read
-import System.Console.CmdArgs.Implicit.Step1
-import System.Console.CmdArgs.Explicit
-
-import Data.Char
-import Data.Generics.Any
-import Data.List
-import Data.Maybe
-
-
-data Prog2 a = Prog2
-    {prog2Summary :: String
-    ,prog2Name :: String
-    ,prog2Help :: String
-    ,prog2Verbosity :: Bool
-    ,prog2ModeDefault :: Maybe Int -- index in to prog2Modes
-    ,prog2Modes :: [Mode2 a]
-    }
-
-data Mode2 a = Mode2
-    {mode2Names :: [Name]
-    ,mode2Group :: String
-    ,mode2Value :: a
-    ,mode2Help :: Help
-    ,mode2Suffix :: [String]
-    ,mode2Flags :: [Flag2 a]
-    ,mode2Args :: [Arg2 a]
-    }
-
-data Flag2 a = Flag2
-    {flag2Names :: [Name]
-    ,flag2Group :: String
-    ,flag2Upd :: Flag2Type a
-    ,flag2Opt :: Maybe String
-    ,flag2FlagHelp :: FlagHelp
-    ,flag2Help :: Help
-    }
-
-data Flag2Type a
-    = Flag2String {fromFlag2String :: String -> a -> Either String a}
-    | Flag2Bool (Bool -> a -> a)
-    | Flag2Value (a -> a)
-
-data Arg2 a = Arg2
-    {arg2FlagHelp :: FlagHelp
-    ,arg2Upd :: String -> a -> Either String a
-    ,arg2Pos :: Maybe Int
-    ,arg2Opt :: Maybe String
-    }
-
-
-step2 :: Prog1 -> Prog2 Any
-step2 = transProg
-
-
-isArg FlagArgs = True
-isArg FlagArgPos{} = True
-isArg _ = False
-
-
----------------------------------------------------------------------
--- TRANSLATE
--- Translate in to the Mode domain
-
-transProg :: Prog1 -> Prog2 Any
-transProg (Prog1 ann xs) = Prog2 summary program hlp verb defMode (map transMode xs)
-    where
-        summary = let x = concat [x | ProgSummary x <- ann] in if null x then "The " ++ defProg ++ " program" else x
-        hlp = concat [x | Help x <- ann]
-        defMode = flip findIndex xs $ \(Mode1 an _ _) -> length xs /= 1 && ModeDefault `elem` an
-        verb = ProgVerbosity `elem` ann
-        program = last $ defProg : [x | ProgProgram x <- ann]
-        defProg = let Mode1 _ x _ = head xs in map toLower $ typeShell x
-
-
-transMode :: Mode1 -> Mode2 Any
-transMode (Mode1 an c xs) = Mode2
-    [x | Name x <- an]
-    (last $ "" : [x | GroupName x <- an])
-    c
-    (concat [x | Help x <- an])
-    (concat [x | ModeHelpSuffix x <- an])
-    (map transFlag rest)
-    (map transArg args)
-    where (args,rest) = partition (ann isArg) xs
-          ann f (Flag1 x _ _) = any f x
-
-
-transFlag :: Flag1 -> Flag2 Any
-transFlag flag@(Flag1 ann fld val)
-    | Just (flaghelpdef,upd) <- transFlagType flag =
-        Flag2 names grp upd opt (if null flaghelp then flaghelpdef else flaghelp) help
-    | otherwise = error $ "Don't know how to deal with field type, " ++ fld ++ " :: " ++ show val
-    where
-        opt = let a = [x | FlagOptional x <- ann] in if null a then Nothing else Just $ concat a
-        grp = last $ "" : [x | GroupName x <- ann]
-        help = concat [x | Help x <- ann] ++ concat [" (default=" ++ x ++ ")" | Just x <- [opt], x /= ""]
-        names = [x | Name x <- ann]
-        flaghelp = concat [x | FlagType x <- ann]
-
-
-transFlagType :: Flag1 -> Maybe (String,Flag2Type Any)
-transFlagType (Flag1 ann fld val)
-    | FlagEnum `elem` ann = Just $ (,) "" $ Flag2Value $ \x -> setField (fld,val) x
-    | isNothing mty = Nothing
-    | isReadBool ty = f $ Flag2Bool $ \b x -> setField (fld,addContainer ty (getField fld x) (Any b)) x
-    | otherwise = f $ Flag2String $ \s x -> fmap (\c -> setField (fld,c) x) $ reader ty s $ getField fld x
-    where
-        mty = toReadContainer val
-        ty = fromJust mty
-        f x = Just (readHelp ty, x)
-
-
-transArg :: Flag1 -> Arg2 Any
-transArg x@(Flag1 ann _ _) = Arg2 (flag2FlagHelp y) (fromFlag2String $ flag2Upd y) pos (flag2Opt y)
-    where y = transFlag x
-          pos = listToMaybe [i | FlagArgPos i <- ann]
diff --git a/System/Console/CmdArgs/Implicit/Step3.hs b/System/Console/CmdArgs/Implicit/Step3.hs
deleted file mode 100644
--- a/System/Console/CmdArgs/Implicit/Step3.hs
+++ /dev/null
@@ -1,189 +0,0 @@
-{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards, DeriveDataTypeable #-}
-
--- | This module takes the result of Structure, and traslates it to
---   the CmdArgs.Explicit format.
-module System.Console.CmdArgs.Implicit.Step3(
-    step3,
-    -- cmdArgs_privateArgsSeen is exported, otherwise Haddock
-    -- gets confused when using RecordWildCards
-    CmdArgs(..), cmdArgsHasValue
-    ) where
-
-import System.Console.CmdArgs.Implicit.Step2
-import System.Console.CmdArgs.Explicit
-import System.Console.CmdArgs.Verbosity
-import System.Console.CmdArgs.Text
-
-import Control.Arrow
-import Data.Data
-import Data.Maybe
-import Data.Monoid
-import Data.List
-import Data.Function
-
-
--- | A structure to store the additional data relating to @--help@,
---   @--version@, @--quiet@ and @--verbose@.
-data CmdArgs a = CmdArgs
-    {cmdArgsValue :: a -- ^ The underlying value being wrapped.
-    ,cmdArgsHelp :: Maybe String -- ^ @Just@ if @--help@ is given, then gives the help message for display.
-    ,cmdArgsVersion :: Maybe String -- ^ @Just@ if @--verion@ is given, then gives the version message for display.
-    ,cmdArgsVerbosity :: Maybe Verbosity -- ^ @Just@ if @--quiet@ or @--verbose@ is given, then gives the verbosity to use.
-    ,cmdArgsPrivate :: CmdArgsPrivate -- ^ Private: Only exported due to Haddock limitations.
-    }
-    deriving (Show,Data,Typeable)
-
-instance Functor CmdArgs where
-    fmap f x = x{cmdArgsValue = f $ cmdArgsValue x}
-
-cmdArgsHasValue :: CmdArgs a -> Bool
-cmdArgsHasValue x = isNothing (cmdArgsHelp x) && isNothing (cmdArgsVersion x)
-
-data CmdArgsPrivate = CmdArgsPrivate
-    Int -- ^ The number of arguments that have been seen
-    deriving (Data,Typeable)
-
-instance Show CmdArgsPrivate where show _ = "CmdArgsPrivate"
-
-incArgsSeen x = x{cmdArgsPrivate = CmdArgsPrivate $ getArgsSeen x + 1}
-getArgsSeen CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = i
-
-
-step3 :: Prog2 a -> Mode (CmdArgs a)
-step3 p = common p $ transProg $ liftProg p
-
-
----------------------------------------------------------------------
--- COMMON
--- Add common flags (--help/--version etc)
-
-common :: Prog2 a -> Mode (CmdArgs a) -> Mode (CmdArgs a)
-common p m
-    | null $ modeModes m = addNormal m $ commonFlags p $ addNormal m
-    | otherwise = addCommon m2 $ commonFlags p $ addCommon m2
-    where
-        add m xs = m{modeGroupFlags = xs `mappend` modeGroupFlags m}
-        addNormal m xs = add m $ toGroup xs
-        addCommon m xs = add m $ Group [] [] [("Common flags",xs)]
-        addHidden m xs = add m $ Group [] xs []
-
-        m2 = m{modeGroupModes = fmap f $ modeGroupModes m}
-        f m = addHidden m $ commonFlags p $ addCommon $ m{modeNames = map ((prog2Name p ++ " ") ++) $ modeNames m}
-
-
--- add common flags to a mode
-commonFlags :: Prog2 a -> ([Flag (CmdArgs a)] -> Mode (CmdArgs a)) -> [Flag (CmdArgs a)]
-commonFlags Prog2{..} add = flags
-    where
-        help hlp txt = showText txt $ Line prog2Summary : Line "" : helpText hlp (add flags)
-        flags = 
-            [flagHelpFormat $ \hlp txt x -> x{cmdArgsHelp = Just $ help hlp txt}
-            ,flagVersion $ \x -> x{cmdArgsVersion = Just prog2Summary}] ++
-            if not prog2Verbosity then [] else flagsVerbosity $ \v x -> x{cmdArgsVerbosity=Just v}
-
-
----------------------------------------------------------------------
--- TRANSLATE
--- Translate in to the CmdArgs.Explicit domain
-
-transProg :: Prog2 (CmdArgs a) -> Mode (CmdArgs a)
-transProg p = res{modeNames = [prog2Name p]}
-    where
-        res = if length ys == 1 then snd $ head ys else defMode{modeGroupModes = toGroups ys, modeHelp = prog2Help p}
-        defMode = maybe zeroMode (silentMode . snd . (ys!!)) $ prog2ModeDefault p
-        silentMode m = m{modeGroupFlags=Group [] (modeFlags m) [], modeArgs=fmap (\x -> x{argType=""}) (modeArgs m)}
-        ys = zip (map mode2Group $ prog2Modes p) $
-                 zipWith transMode (map ((==) (prog2ModeDefault p) . Just) [0..]) $ prog2Modes p
-
-        zeroMode = Mode (toGroup []) [] (embed $ error msg) chk "" [] Nothing $ toGroup []
-            where msg = "System.Console.CmdArgs.Implicit: No default mode given (see cmdArgsHelp/cmdArgsVersion)"
-                  chk x = if cmdArgsHasValue x then Left "No mode given and no default mode" else Right x
-
-
-transMode :: Bool -> Mode2 (CmdArgs a) -> Mode (CmdArgs a)
-transMode auto Mode2{..} = transArgs mode2Args $ Mode
-    (toGroup [])
-    (["[" ++ head mode2Names ++ "]" | auto] ++ mode2Names)
-    mode2Value
-    Right
-    mode2Help
-    mode2Suffix
-    Nothing
-    (toGroups $ map (flag2Group &&& transFlag) mode2Flags)
-
-
-toGroups :: [(String,a)] -> Group a
-toGroups xs = Group (f "") [] (map (id &&& f) names)
-    where names = filter (not . null) $ nub $ map fst xs
-          f x = map snd $ filter ((==) x . fst) xs
-
-
-transFlag :: Flag2 (CmdArgs a) -> Flag (CmdArgs a)
-transFlag Flag2{..} = case flag2Upd of
-    Flag2String upd -> (maybe flagReq flagOpt flag2Opt) flag2Names upd flag2FlagHelp flag2Help
-    Flag2Bool upd -> flagBool flag2Names upd flag2Help
-    Flag2Value upd -> flagNone flag2Names upd flag2Help
-
-
-transArgs :: [Arg2 (CmdArgs a)] -> Mode (CmdArgs a) -> Mode (CmdArgs a)
-transArgs [] x = x
-transArgs xs x = x{modeCheck=chk, modeArgs = Just $ flagArg upd hlp}
-    where
-        (ord,rep) = orderArgs xs
-        mn = length $ dropWhile (isJust . arg2Opt) $ reverse ord
-
-        chk v | not $ cmdArgsHasValue v = Right v
-              | n < mn = Left $ "Requires at least " ++ show mn ++ " arguments, got " ++ show n
-              | otherwise = foldl f (addOptArgs n v) (drop n ord)
-            where n = getArgsSeen v
-                  f (Right v) arg = arg2Upd arg (fromJust $ arg2Opt arg) v
-                  f x _ = x
-
-        -- if we have repeating args which is also opt, translate that here
-        addOptArgs n v
-            | Just x <- rep, Just o <- arg2Opt x, Just n <= findIndex (isNothing . arg2Pos) (ord ++ [x]) = arg2Upd x o v
-            | otherwise = Right v
-
-        hlp = unwords $ a ++ map (\x -> "["++x++"]") b
-            where (a,b) = splitAt mn $ map arg2FlagHelp $ ord ++ maybeToList rep
-
-        upd s v | n < length ord = arg2Upd (ord !! n) s v2
-                | Just x <- rep = arg2Upd x s v2
-                | otherwise = Left $ "expected at most " ++ show (length ord)
-            where n = getArgsSeen v
-                  v2 = incArgsSeen v
-
-
--- return the arguments in order, plus those at the end
-orderArgs :: [Arg2 a] -> ([Arg2 a], Maybe (Arg2 a))
-orderArgs args = (f 0 ord, listToMaybe rep)
-    where
-        (rep,ord) = span (isNothing . arg2Pos) $ sortBy (compare `on` arg2Pos) args
-        f i [] = []
-        f i (x:xs) = case fromJust (arg2Pos x) `compare` i of
-            LT -> f i xs
-            EQ -> x : f (i+1) xs
-            GT -> take 1 rep ++ f (i+1) (x:xs)
-
-
----------------------------------------------------------------------
--- LIFT
--- Add the CmdArgs structure
-
-embed x = CmdArgs x Nothing Nothing Nothing $ CmdArgsPrivate 0
-proj x = (cmdArgsValue x, \y -> x{cmdArgsValue=y})
-
-liftProg :: Prog2 a -> Prog2 (CmdArgs a)
-liftProg x = x{prog2Modes = map liftMode $ prog2Modes x}
-
-liftMode :: Mode2 a -> Mode2 (CmdArgs a)
-liftMode x = x
-    {mode2Value = embed $ mode2Value x
-    ,mode2Flags = map liftFlag $ mode2Flags x
-    ,mode2Args = map liftArg $ mode2Args x}
-
-liftFlag x = x{flag2Upd = liftType $ flag2Upd x}
-liftArg x = x{arg2Upd = fromFlag2String $ liftType $ Flag2String $ arg2Upd x}
-liftType (Flag2String upd) = Flag2String $ \s v -> let (a,b) = proj v in fmap b $ upd s a
-liftType (Flag2Bool upd) = Flag2Bool $ \s v -> let (a,b) = proj v in b $ upd s a
-liftType (Flag2Value upd) = Flag2Value $ \v -> let (a,b) = proj v in b $ upd a
diff --git a/System/Console/CmdArgs/Implicit/Type.hs b/System/Console/CmdArgs/Implicit/Type.hs
new file mode 100644
--- /dev/null
+++ b/System/Console/CmdArgs/Implicit/Type.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | The underlying CmdArgs type.
+module System.Console.CmdArgs.Implicit.Type(
+    -- cmdArgs_privateArgsSeen is exported, otherwise Haddock
+    -- gets confused when using RecordWildCards
+    CmdArgs(..), CmdArgsPrivate(..), cmdArgsHasValue, embed, reembed
+    ) where
+
+import System.Console.CmdArgs.Verbosity
+
+import Data.Data
+import Data.Maybe
+
+
+-- | A structure to store the additional data relating to @--help@,
+--   @--version@, @--quiet@ and @--verbose@.
+data CmdArgs a = CmdArgs
+    {cmdArgsValue :: a -- ^ The underlying value being wrapped.
+    ,cmdArgsHelp :: Maybe String -- ^ @Just@ if @--help@ is given, then gives the help message for display.
+    ,cmdArgsVersion :: Maybe String -- ^ @Just@ if @--verion@ is given, then gives the version message for display.
+    ,cmdArgsVerbosity :: Maybe Verbosity -- ^ @Just@ if @--quiet@ or @--verbose@ is given, then gives the verbosity to use.
+    ,cmdArgsPrivate :: CmdArgsPrivate -- ^ Private: Only exported due to Haddock limitations.
+    }
+    deriving (Show,Data,Typeable)
+
+cmdArgsHasValue :: CmdArgs a -> Bool
+cmdArgsHasValue x = isNothing (cmdArgsHelp x) && isNothing (cmdArgsVersion x)
+
+data CmdArgsPrivate = CmdArgsPrivate
+    Int -- ^ The number of arguments that have been seen
+    deriving (Data,Typeable)
+
+instance Show CmdArgsPrivate where show _ = "CmdArgsPrivate"
+
+instance Functor CmdArgs where
+    fmap f x = x{cmdArgsValue = f $ cmdArgsValue x}
+
+
+embed :: a -> CmdArgs a
+embed x = CmdArgs x Nothing Nothing Nothing (CmdArgsPrivate 0)
+
+reembed :: CmdArgs a -> (a, a -> CmdArgs a)
+reembed x = (cmdArgsValue x, \y -> x{cmdArgsValue=y})
+
diff --git a/System/Console/CmdArgs/Implicit/UI.hs b/System/Console/CmdArgs/Implicit/UI.hs
--- a/System/Console/CmdArgs/Implicit/UI.hs
+++ b/System/Console/CmdArgs/Implicit/UI.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
 {-|
     This module describes the attributes that can be specified on flags and modes.
 
@@ -6,7 +5,6 @@
 
     > data Sample = Sample {hello :: String}
 -}
-
 module System.Console.CmdArgs.Implicit.UI where
 
 import System.Console.CmdArgs.Implicit.Ann
@@ -148,7 +146,7 @@
 --   A field should not have any flag names guessed for it.
 --   All flag names must be specified by 'flag'.
 --
--- > {hello = def &= explicit &= flag "foo"}
+-- > {hello = def &= explicit &= name "foo"}
 -- >   --foo=VALUE
 explicit :: Ann
 explicit = Explicit
diff --git a/System/Console/CmdArgs/Test/Implicit/HLint.hs b/System/Console/CmdArgs/Test/Implicit/HLint.hs
--- a/System/Console/CmdArgs/Test/Implicit/HLint.hs
+++ b/System/Console/CmdArgs/Test/Implicit/HLint.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}
+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds #-}
 module System.Console.CmdArgs.Test.Implicit.HLint where
 import System.Console.CmdArgs
 import System.Console.CmdArgs.Test.Implicit.Util
@@ -42,20 +43,22 @@
     } &=
     verbosity &=
     help "Suggest improvements to Haskell source code" &=
-    summary "HLint v0.0.0, (C) Neil Mitchell 2006-2010" &=
+    summary "HLint v0.0.0, (C) Neil Mitchell" &=
     details ["Hlint gives hints on how to improve Haskell code",""
             ,"To check all Haskell files in 'src' and generate a report type:","  hlint src --report"]
 
 mode = cmdArgsMode hlint
 
 test = do
-    let Tester{(===),fails,isVerbosity} = tester "HLint" mode
+    let Tester{..} = tester "HLint" mode
     [] === hlint
     fails ["-ch"]
     isVerbosity ["--color","--quiet"] Quiet
     isVerbosity ["--color","--verbose"] Loud
     isVerbosity ["--color","--quiet","--verbose"] Loud
     isVerbosity [] Normal
+    isHelp ["-?"] ["HLint v0.0.0, (C) Neil Mitchell"]
+    isHelp ["--help"] ["  hlint src --report"]
     ["--colo"] === hlint{color=True}
     ["--colour","--colour=false"] === hlint
     ["--colour=true"] === hlint{color=True}
diff --git a/System/Console/CmdArgs/Test/Implicit/Maker.hs b/System/Console/CmdArgs/Test/Implicit/Maker.hs
--- a/System/Console/CmdArgs/Test/Implicit/Maker.hs
+++ b/System/Console/CmdArgs/Test/Implicit/Maker.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}
-{-# OPTIONS_GHC -fno-cse #-}
+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
+{-# OPTIONS_GHC -fno-cse -fno-warn-unused-binds #-}
 module System.Console.CmdArgs.Test.Implicit.Maker where
 import System.Console.CmdArgs
 import System.Console.CmdArgs.Test.Implicit.Util
@@ -33,9 +33,34 @@
 
 mode = cmdArgsMode $ modes [build,wipe,test_] &= help "Build helper program" &= program "maker" &= summary "Maker v1.0"
 
+mode_ = cmdArgsMode_ $ modes_ [build,wipe,test_] += help "Build helper program" += program "maker" += summary "Maker v1.0"
+  where
+    threads_ = threads := def += help "Number of threads to use" += name "j" += typ "NUM"
+
+    wipe = record Wipe{} [] += help "Clean all build objects"
+
+    test_ = record Test{}
+        [threads_
+        ,extra := def += typ "ANY" += args
+        ] += help "Run the test suite"
+
+    build = record Build{}
+        [threads_ 
+        ,enum_ method
+            [atom Release += help "Release build"
+            ,atom Debug += help "Debug build"
+            ,atom Profile += help "Profile build"]
+        ,files := def += args
+        ] += help "Build the project" += auto
+
+
 test = do
-    let Tester{(===),fails} = tester "Maker" mode
+    let Tester{..} = testers "Maker" [mode,mode_]
     [] === build
+    isHelp ["-?=one"] ["Common flags:"]
+    isHelpNot ["-?=one"] ["  -d --debug  Debug build"]
+    isHelp ["-?=all"] ["maker [build] [OPTIONS] [ITEM]"]
+    isHelp ["build","-?=one"] ["maker [build] [OPTIONS] [ITEM]"]
     ["build","foo","--profile"] === build{files=["foo"],method=Profile}
     ["foo","--profile"] === build{files=["foo"],method=Profile}
     ["foo","--profile","--release"] === build{files=["foo"],method=Release}
@@ -49,4 +74,10 @@
     ["test","foo"] === test_{extra=["foo"]}
     ["test","foo","-j3"] === test_{extra=["foo"],threads=3}
     fails ["test","foo","-baz","-j3","--what=1"]
-
+    ["test","foo","--","-baz","-j3","--what=1"] === test_{extra=["foo","-baz","-j3","--what=1"]}
+    ["test","--","foo","-baz","-j3","--what=1"] === test_{extra=["foo","-baz","-j3","--what=1"]}
+    ["--"] === build
+    ["test","--"] === test_
+    ["test","-j3","--","foo","-baz","-j3","--what=1"] === test_{extra=["foo","-baz","-j3","--what=1"],threads=3}
+    ["test","-"] === test_{extra=["-"]}
+    ["build","-"] === build{files=["-"]}
diff --git a/System/Console/CmdArgs/Test/Implicit/Tests.hs b/System/Console/CmdArgs/Test/Implicit/Tests.hs
--- a/System/Console/CmdArgs/Test/Implicit/Tests.hs
+++ b/System/Console/CmdArgs/Test/Implicit/Tests.hs
@@ -7,6 +7,7 @@
 import System.Console.CmdArgs.Explicit(modeHelp)
 import System.Console.CmdArgs.Test.Implicit.Util
 
+
 test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >> test11
 demos = zipWith f [1..]
         [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6
@@ -41,6 +42,7 @@
     ["--maybebool=off"] === def1{maybeBool=Just False}
     ["--listbool","--listbool=true","--listbool=false"] === def1{listBool=[True,True,False]}
     fails ["--listbool=fred"]
+    invalid $ \_ -> def1{listBool = def &= opt "yes"}
 
 
 -- from bug #230
@@ -140,9 +142,12 @@
              deriving (Eq,Show,Data,Typeable)
 
 mode8 = cmdArgsMode $ modes [Test8 1 (2 &= groupname "More flags") 3 &= groupname "Mode1", Test81, Test82 &= groupname "Mode2"]
+mode8_ = cmdArgsMode_ $ modes_ [record Test8{} [atom (1::Int), atom (2::Int) += groupname "More flags", atom (3::Int)] += groupname "Mode1"
+                               ,record Test81{} []
+                               ,record Test82{} [] += groupname "Mode2"]
 
 test8 = do
-    let Tester{..} = tester "Test8" mode8
+    let Tester{..} = testers "Test8" [mode8,mode8_]
     isHelp ["-?"] ["Flags:","  --test8a=INT","More flags:","  --test8b=INT"]
     fails []
     ["test8","--test8a=18"] === Test8 18 2 3
@@ -153,10 +158,11 @@
            | Test92 {foo :: XYZ}
              deriving (Eq,Show,Data,Typeable)
 
-mode9 = cmdArgsMode $ modes [Test91 {foo = enum [X &= help "pick X (default)", Y &= help "pick Y"] &= opt "Y"} &= auto, Test92{}]
+mode9 = cmdArgsMode $ modes [Test91 {foo = enum [X &= help "pick X (default)", Y &= help "pick Y"]} &= auto, Test92{}]
+mode9_ = cmdArgsMode_ $ modes_ [record Test91{} [enum_ foo [atom X += help "pick X (default)", atom Y += help "pick Y"]] += auto, record Test92{} []]
 
 test9 = do
-    let Tester{..} = tester "Test9" mode9
+    let Tester{..} = testers "Test9" [mode9,mode9_]
     [] === Test91 X
     ["test91","-x"] === Test91 X
     ["test91","-y"] === Test91 Y
@@ -164,6 +170,7 @@
     ["test92","-x"] === Test92 X
     ["test92","-y"] === Test92 Y
     ["test92"] === Test92 X
+    invalid $ \_ -> modes [Test91 {foo = enum [X &= help "pick X (default)"] &= opt "X"}]
 
 -- share common fields in the help message
 data Test10 = Test101 {food :: Int}
@@ -174,11 +181,10 @@
 
 test10 = do
     let Tester{..} = tester "Test10" mode10
-    -- FIXME: isHelp ["-?=one"] ["  -f --food=INT"]
+    isHelp ["-?=one"] ["  -f --food=INT"]
     isHelpNot ["-?=one"] ["  -b --bard=INT"]
 
 -- test for GHC over-optimising
-
 data Test11 = Test11A {test111 :: String}
             | Test11B {test111 :: String}
               deriving (Eq,Show,Data,Typeable)
@@ -187,8 +193,12 @@
 test11B = Test11B { test111 = def &= argPos 0 }
 mode11 = cmdArgsMode $ modes [test11A, test11B]
 
+mode11_ = cmdArgsMode_ $ modes_
+    [record Test11A{} [test111 := def += argPos 0]
+    ,record Test11B{} [test111 := def += argPos 0]]
+
 test11 = do
-    let Tester{..} = tester "Test11" mode11
+    let Tester{..} = testers "Test11" [mode11,mode11_]
     fails []
     ["test11a","test"] === Test11A "test"
     ["test11b","test"] === Test11B "test"
diff --git a/System/Console/CmdArgs/Test/Implicit/Util.hs b/System/Console/CmdArgs/Test/Implicit/Util.hs
--- a/System/Console/CmdArgs/Test/Implicit/Util.hs
+++ b/System/Console/CmdArgs/Test/Implicit/Util.hs
@@ -5,6 +5,7 @@
 import System.Console.CmdArgs.Implicit
 import System.Console.CmdArgs.Explicit
 import System.Console.CmdArgs.Test.Util
+import Control.Exception
 import Data.Char
 import Data.List
 import Data.Maybe
@@ -13,6 +14,14 @@
 toDemo = newDemo $ \x -> cmdArgsApply x >>= print
 
 
+invalid :: Data a => (() -> a) -> IO ()
+invalid a = do
+    res <- try $ evaluate $ length $ show $ cmdArgsMode $ a ()
+    case res of
+        Left (ErrorCall _) -> success
+        Right _ -> failure "Expected exception" []
+
+
 data Tester a = Tester
     {(===) :: [String] -> a -> IO ()
     ,fails :: [String] -> IO ()
@@ -21,6 +30,14 @@
     ,isVersion :: [String] -> String -> IO ()
     ,isVerbosity :: [String] -> Verbosity -> IO ()
     }
+
+testers :: (Show a, Eq a) => String -> [Mode (CmdArgs a)] -> Tester a
+testers name = foldr1 f . map (tester name)
+    where
+        f (Tester x1 x2 x3 x4 x5 x6) (Tester y1 y2 y3 y4 y5 y6) =
+            Tester (f2 x1 y1) (f1 x2 y2) (f2 x3 y3) (f2 x4 y4) (f2 x5 y5) (f2 x6 y6)
+        f1 x y a = x a >> y a
+        f2 x y a b = x a b >> y a b
 
 
 tester :: (Show a, Eq a) => String -> Mode (CmdArgs a) -> Tester a
diff --git a/System/Console/CmdArgs/Text.hs b/System/Console/CmdArgs/Text.hs
--- a/System/Console/CmdArgs/Text.hs
+++ b/System/Console/CmdArgs/Text.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
 
 -- | A module to represent text with very basic formatting. Values are of
 --   type ['Text'] and shown with 'showText'.
diff --git a/cmdargs.cabal b/cmdargs.cabal
--- a/cmdargs.cabal
+++ b/cmdargs.cabal
@@ -1,7 +1,7 @@
 cabal-version:      >= 1.6
 build-type:         Simple
 name:               cmdargs
-version:            0.3
+version:            0.4
 license:            BSD3
 license-file:       LICENSE
 category:           Console
@@ -42,6 +42,7 @@
 
     exposed-modules:
         System.Console.CmdArgs
+        System.Console.CmdArgs.Annotate
         System.Console.CmdArgs.Default
         System.Console.CmdArgs.Explicit
         System.Console.CmdArgs.GetOpt
@@ -56,11 +57,10 @@
         System.Console.CmdArgs.Explicit.Process
         System.Console.CmdArgs.Explicit.Type
         System.Console.CmdArgs.Implicit.Ann
-        System.Console.CmdArgs.Implicit.Capture
         System.Console.CmdArgs.Implicit.Read
-        System.Console.CmdArgs.Implicit.Step1
-        System.Console.CmdArgs.Implicit.Step2
-        System.Console.CmdArgs.Implicit.Step3
+        System.Console.CmdArgs.Implicit.Local
+        System.Console.CmdArgs.Implicit.Global
+        System.Console.CmdArgs.Implicit.Type
         System.Console.CmdArgs.Implicit.UI
 
 executable cmdargs