diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,4 @@
+import Distribution.Simple
+
+
+main = defaultMain
diff --git a/console-program.cabal b/console-program.cabal
new file mode 100644
--- /dev/null
+++ b/console-program.cabal
@@ -0,0 +1,43 @@
+Name:            console-program
+Version:         0.1.0.0
+Cabal-Version:   >= 1.6
+License:         BSD3
+Author:          Arie Peterson
+Maintainer:      ariep@xs4all.nl
+Category:        Console
+Synopsis:        Interprets the command line and a config file as commands and options
+Description:
+  This library provides an infrastructure to build command line programs. It provides the following features:
+  - declare any number of "actions" (commands, or modes of operation, of the program);
+  - declare options of the program;
+  - collect options and actions from a configuration file and the command line, and execute the proper action.
+  
+  It provides functionality similar to the "cmdargs" package. Main differences:
+  - console-program does not use unsafePerformIO, and tries to give a more haskellish, referentially transparent interface;
+  - it allows a full tree of "modes", instead of a list, so a command can have subcommands;
+  - it parses a configuration file, in addition to the command line arguments.
+Category:        System
+Build-Type:      Simple
+
+Source-repository head
+  Type:     darcs
+  Location: http://patch-tag.com/r/AriePeterson/console-program
+
+Library
+  Build-Depends:
+    base == 4.*,
+    transformers == 0.2.*,
+    containers >= 0.1 && < 0.4,
+    directory == 1.0.*,
+    utf8-string >= 0.3.5 && < 0.4,
+    fez-conf == 1.0.*,
+    template-haskell,
+    ansi-wl-pprint == 0.5.*,
+    utility-ht == 0.0.5.*,
+    parsec-extra == 0.1.*
+  Exposed-Modules:
+    System.Console.Command,
+    System.Console.Action,
+    System.Console.Argument,
+    System.Console.Options
+  Hs-Source-Dirs:  src
diff --git a/src/System/Console/Action.hs b/src/System/Console/Action.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Console/Action.hs
@@ -0,0 +1,33 @@
+module System.Console.Action
+  (
+    Action
+  , run
+  
+  , readerT
+  , simple
+  , withArgument
+  ) where
+
+
+import qualified System.Console.Argument as Argument
+
+import qualified Control.Monad.Trans.Reader as Reader
+import           System.Exit             (exitFailure)
+
+
+data Action o
+  = Action { run :: [String] -> o -> IO () }
+
+readerT :: Reader.ReaderT o IO () -> Action o
+readerT f = Action (const $ Reader.runReaderT f)
+
+simple :: IO () -> Action o
+simple = Action . const . const
+
+withArgument :: Argument.Type x -> (x -> Action o) -> Action o
+withArgument at f = Action g where
+  g (x : xs) = either
+    (const . (>> exitFailure) . putStrLn) -- Show errors and exit.
+    (\ y -> run (f y) xs)                 -- Argument parsing succeeded; run the action.
+    (Argument.parser at (Argument.name at) x)
+  g []       = const $ putStrLn $ "Error: missing argument of type " ++ Argument.name at
diff --git a/src/System/Console/Argument.hs b/src/System/Console/Argument.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Console/Argument.hs
@@ -0,0 +1,79 @@
+module System.Console.Argument
+  (
+    Type (Type,parser,name,defaultValue)
+  
+  , option
+  
+  , optional
+  , string
+  , boolean
+  , directory
+  , file
+  , device
+  , natural
+  , integer
+  ) where
+
+
+import           Data.Char      (toLower)
+import           Data.List.HT   (viewR)
+import qualified Data.Map              as Map
+import qualified System.Console.GetOpt as GetOpt
+import qualified Text.Parsec.Extra     as P
+
+
+data Type a
+  = Type
+  {
+    parser       :: String -> String -> Either String a
+  , name         :: String
+  , defaultValue :: Maybe a
+  }
+
+instance Functor Type where
+  fmap f t = t { parser = ((.) . (.)) (fmap f) (parser t), defaultValue = fmap f (defaultValue t) }
+
+option :: (a -> s) -> [Char] -> [String] -> Type a -> String -> GetOpt.OptDescr (Either String s)
+option inj short long t description = case defaultValue t of
+  Nothing -> GetOpt.Option short long (GetOpt.ReqArg                         (fmap inj . parser t (name t)) (name t)) description
+  Just a  -> GetOpt.Option short long (GetOpt.OptArg (maybe (Right $ inj a) $ fmap inj . parser t (name t)) (name t)) description
+
+-- Common argument types
+
+optional :: a -> Type a -> Type a
+optional x t = t { defaultValue = Just x }
+
+string :: Type String
+string = Type (const Right) "STRING" Nothing
+
+boolean :: Type Bool
+boolean = Type
+  {
+    name    = "BOOL"
+  , parser  = \ _ y -> maybe (e y) Right . flip Map.lookup m . map toLower $ y
+  , defaultValue = Just True
+  }
+ where
+  m = Map.fromList [("1",True),("0",False),("true",True),("false",False)]
+  e y = Left $ "Argument " ++ show y ++ " could not be recognised as a boolean."
+
+natural :: Type Integer
+natural = Type { name = "INT (natural)", parser = const (P.parseM P.natural ""), defaultValue = Nothing }
+
+integer :: Type Integer
+integer = Type { name = "INT", parser = const (P.parseM P.integer ""), defaultValue = Nothing }
+
+directory :: Type FilePath
+directory = Type { name = "DIR", parser = const (Right . stripTrailingSlash), defaultValue = Nothing }
+ where
+  stripTrailingSlash x = case viewR x of
+    Nothing       -> ""
+    Just (i,l)
+      | l == '/'  -> i
+      | otherwise -> x
+
+file :: Type FilePath
+file = string { name = "FILE" }
+
+device :: Type FilePath
+device = string { name = "DEVICE" }
diff --git a/src/System/Console/Command.hs b/src/System/Console/Command.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Console/Command.hs
@@ -0,0 +1,105 @@
+module System.Console.Command
+  (
+    Commands
+  , Command (Command,name,applicableNonOptions,applicableOptions,description,action)
+  
+  , single
+  , showUsage
+  ) where
+
+
+import qualified System.Console.Action  as Action
+import qualified System.Console.Options as Options
+
+import           Control.Applicative     ((<$>))
+import           Control.Arrow           ((&&&),second)
+import           Control.Exception       (tryJust)
+import           Control.Monad           (guard,join)
+import qualified Data.Set                     as Set
+import qualified Data.Tree                    as Tree
+import           Data.Foldable           (foldMap)
+import           Data.Traversable        (traverse)
+import qualified Fez.Data.Conf                as Conf
+import qualified System.Console.GetOpt        as GetOpt
+import           System.Directory        (getHomeDirectory)
+import           System.Environment.UTF8 (getArgs)
+import           System.Exit             (exitFailure)
+import           System.IO               (readFile)
+import           System.IO.Error         (isDoesNotExistError)
+import qualified Text.PrettyPrint.ANSI.Leijen as PP
+
+
+-- | @Commands s@ is a tree of commands. It represents the whole set of
+-- possible commands of a program.
+type Commands setting
+  = Tree.Tree (Command setting)
+
+-- | A @Command s@ is an action, together with some descriptive information:
+-- name (this is the textual command that invokes the action), description,
+-- and lists of applicable options and non-options. @s@ is the type of setting.
+data Command s
+  = Command
+    {
+      name :: String
+    , applicableNonOptions :: [String]
+    , applicableOptions :: [GetOpt.OptDescr (Either String s)]
+    , description :: String
+    , action :: Action.Action (Options.Options s)
+    }
+
+fromDisk :: String -> IO [String]
+fromDisk configFile = do
+  home <- getHomeDirectory
+  result <- tryJust (guard . isDoesNotExistError) (readFile $ home ++ "/" ++ configFile)
+  return $ either (const []) Conf.parseToArgs result
+
+-- Load configuration file and parse the command line into settings
+-- and non-options.
+load :: Commands s -> IO ([String],[s])
+load commands = do
+  let options = Set.toList $ collectOptions commands
+  fileArgs <- fromDisk $ '.' : name (Tree.rootLabel commands)
+  (opts,nonOpts,errors) <- GetOpt.getOpt GetOpt.Permute options . (++) fileArgs <$> getArgs
+  if null errors
+    then either ((>> exitFailure) . putStrLn) (return . (,) nonOpts) $ sequence opts
+    else traverse putStrLn errors >> showUsage commands >> exitFailure
+
+-- | Load the configuration file (if present), and run the action given on the command line.
+single :: (Options.Setting s) => Options.Options s -> Commands s -> IO ()
+single defaults commands = uncurry (select commands) . second (flip Options.apply defaults) =<< load commands
+
+-- Select the right command from the command tree, given a list of non-options, and the options.
+select :: (Options.Setting s) => Commands s -> [String] -> Options.Options s -> IO ()
+select (Tree.Node root _     ) []           = Action.run (action root) []
+select (Tree.Node root forest) nos@(x : xs) = case lookup x $ map (name . Tree.rootLabel &&& id) forest of
+  Nothing -> Action.run (action root) nos
+  Just cs -> select cs xs
+
+-- | Show usage info for the program.
+showUsage :: Commands o -> IO ()
+showUsage = PP.putDoc . usage
+ where
+  usage (Tree.Node c ns) = subcs ns . (PP.<> PP.line) . opts c . descr c . nonOpts c $ PP.bold (PP.text $ name c)
+  descr c = flip (PP.<$>) $ PP.string (description c)
+  nonOpts c = if null (applicableNonOptions c)
+    then id
+    else flip (PP.<+>) $ PP.cat . PP.punctuate PP.space . map PP.text $ applicableNonOptions c
+  opts c = if null (applicableOptions c)
+    then id
+    else flip (PP.<$>) . PP.indent 2 . PP.vsep . map opt $ applicableOptions c
+  opt (GetOpt.Option short long a descr) = list 5 "-" arg (map (: []) short)
+    PP.<+> list 20 "--" arg long PP.<+> PP.string descr where
+    arg = case a of
+      GetOpt.NoArg _    -> PP.empty
+      GetOpt.ReqArg _ x -> PP.equals PP.<> PP.string x
+      GetOpt.OptArg _ x -> PP.brackets (PP.equals PP.<> PP.string x)
+  list i p a = PP.fill i . PP.cat . PP.punctuate PP.comma . map (\ x -> PP.text p PP.<> PP.text x PP.<> a)
+  subcs ns = if null ns then id else flip (PP.<$>) $ PP.indent 2 (PP.vsep $ map usage ns)
+
+collectOptions :: Commands o -> Set.Set (GetOpt.OptDescr (Either String o))
+collectOptions = foldMap (Set.fromList . applicableOptions)
+
+instance Eq (GetOpt.OptDescr a) where
+  (GetOpt.Option _ x _ _) == (GetOpt.Option _ y _ _) = head x == head y
+instance Ord (GetOpt.OptDescr a) where
+  (GetOpt.Option _ x _ _) `compare` (GetOpt.Option _ y _ _) = compare (head x) (head y)
diff --git a/src/System/Console/Options.hs b/src/System/Console/Options.hs
new file mode 100644
--- /dev/null
+++ b/src/System/Console/Options.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE TypeFamilies,TemplateHaskell,ScopedTypeVariables #-}
+module System.Console.Options
+  (
+    Options
+  , Setting(set)
+  , apply
+  
+  , create
+  
+  , Type(ConT) -- Useful for passing types of settings to 'create'.
+  ) where
+
+
+import           Data.Char (toUpper)
+import           Data.List (foldl')
+import           Language.Haskell.TH
+
+
+ -- | An instance @s@ of 'Setting' has as values /partial/ sets of option assignments,
+ -- as given by the user in a configuration file or command line options.
+ -- @'Options' s@ is the associated type of complete configurations, as the
+ -- program needs.
+class Setting s where
+  type Options s
+  set :: s -> Options s -> Options s
+
+setName = 'set
+
+apply :: forall s. (Setting s) => [s] -> Options s -> Options s
+apply = flip (foldl' (flip set))
+
+{-
+instance Setting (Endo a) where
+  type Options (Endo a) = a
+  set (Endo f) = f
+-}
+
+-- | 'create' is a template haskell computation. Given names for the \"options\"
+-- type, the \"settings\" type and the \"set\" function, and a list of settings
+-- (pairs of their names and types), it creates those datatypes and function,
+-- and an instance of the 'Settings' class.
+create :: String -> String -> String -> [(String,Type)] -> Q [Dec]
+create optionsName settingName set settings = do
+  x <- newName "x"
+  y <- newName "y"
+  let optionType = DataD [] (mkName optionsName) [] [RecC (mkName optionsName) $ flip map settings $ \ (n,t) -> (mkName $ n ++ "_",NotStrict,t)] []
+  let settingType = DataD [] (mkName settingName) [] (flip map settings $ \ (n,t) -> NormalC (mkName $ capitalise n) [(NotStrict,t)]) []
+  let setFunction = FunD (mkName set) $ flip map settings $ \ (n,_) -> Clause
+        [ConP (mkName $ capitalise n) [VarP x],VarP y]
+        (NormalB $ RecUpdE (VarE y) [(mkName $ n ++ "_",VarE x)]  )
+        []
+  let settingsInstance = InstanceD [] (ConT ''Setting `AppT` ConT (mkName settingName))
+        [
+          TySynInstD ''Options [ConT $ mkName settingName] (ConT $ mkName optionsName)
+        , FunD setName [Clause [] (NormalB $ VarE $ mkName set) []]
+        ]
+  return $ optionType : settingType : setFunction : settingsInstance : []
+ where
+  capitalise :: String -> String
+  capitalise []       = []
+  capitalise (x : xs) = toUpper x : xs