{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances, OverlappingInstances, TypeOperators #-}
module ReadArgs where

import Control.Arrow (first)

import Data.Maybe 
import Data.List 
import Data.Typeable 

import Data.Text (Text, pack)
import Filesystem.Path (FilePath)
import Filesystem.Path.CurrentOS (fromText)
import Prelude hiding (FilePath)

import System.Environment
import System.Exit
import System.IO hiding (FilePath)

-- |parse the desired argument tuple from the command line or 
--  print a simple usage statment and quit
readArgs :: ArgumentTuple a => IO a
readArgs :: forall a. ArgumentTuple a => IO a
readArgs = IO [String]
getArgs IO [String] -> ([String] -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO a
forall a. ArgumentTuple a => [String] -> IO a
readArgsFrom

-- |read args from the given strings or 
--  print a simple usage statment and quit
--  (so you can do option parsing first)
readArgsFrom :: ArgumentTuple a => [String] -> IO a
readArgsFrom :: forall a. ArgumentTuple a => [String] -> IO a
readArgsFrom [String]
ss = 
  let ma :: Maybe a
ma@(~(Just a
a)) = [String] -> Maybe a
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss 
  in case Maybe a
ma of 
    Maybe a
Nothing -> do 
      String
progName <- IO String
getProgName
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"usage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
progName String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. ArgumentTuple a => a -> String
usageFor a
a
      IO a
forall a. IO a
exitFailure
    Maybe a
_ -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- |a class for types that can be parsed from exactly one command line argument
class Arguable a where
  parse :: String -> Maybe a
  -- |name's argument will usually be undefined, so when defining instances of
  -- Arguable, it should be lazy in its argument
  name :: a -> String

-- |all types that are typeable and readable can be used as simple arguments
instance (Typeable t, Read t) => Arguable t where
  parse :: String -> Maybe t
parse String
s = case ReadS t
forall a. Read a => ReadS a
reads String
s of
    [(t
i,String
"")] -> t -> Maybe t
forall a. a -> Maybe a
Just t
i
    [(t, String)]
_ -> Maybe t
forall a. Maybe a
Nothing
  name :: t -> String
name t
t = TypeRep -> String -> String
showsTypeRep (t -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf t
t) String
""

-- |string is a special case, so that we don't force the user to double-quote
-- their input
instance Arguable String where
  parse :: String -> Maybe String
parse = String -> Maybe String
forall a. a -> Maybe a
Just
  name :: String -> String
name String
_ = String
"String"

-- |Text is a special case, so that we don't force the user to double-quote
-- their input
instance Arguable Text where
  parse :: String -> Maybe Text
parse = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (String -> Text) -> String -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
  name :: Text -> String
name Text
_ = String
"Text"

-- |FilePath is a special case, so that we don't force the user to double-quote
-- their input
instance Arguable FilePath where
  parse :: String -> Maybe FilePath
parse = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (String -> FilePath) -> String -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
fromText (Text -> FilePath) -> (String -> Text) -> String -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack
  name :: FilePath -> String
name FilePath
_ = String
"FilePath"

-- |char is a special case, so that we don't force the user to single-quote
-- their input
instance Arguable Char where
  parse :: String -> Maybe Char
parse [Char
x] = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
  parse String
_ = Maybe Char
forall a. Maybe a
Nothing
  name :: Char -> String
name Char
_ = String
"Char"

-- |a class for types that can be parsed from some number of command line
-- arguments
class Argument a where
  parseArg :: [String] -> [(a, [String])]
  -- |argName's argument will usually be undefined, so when defining instances of
  -- Arguable, it should be lazy in its argument
  argName :: a -> String

-- |use the arguable tyep to just parse a single argument
instance Arguable a => Argument a where
  parseArg :: [String] -> [(a, [String])]
parseArg [] = []
  parseArg (String
s:[String]
ss) = do
    a
a <- Maybe a -> [a]
forall a. Maybe a -> [a]
maybeToList (Maybe a -> [a]) -> Maybe a -> [a]
forall a b. (a -> b) -> a -> b
$ String -> Maybe a
forall a. Arguable a => String -> Maybe a
parse String
s
    (a, [String]) -> [(a, [String])]
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, [String]
ss)
  argName :: a -> String
argName = a -> String
forall a. Arguable a => a -> String
name

-- |use Maybe when it should be parsed from one or zero (greedily)
instance Arguable a => Argument (Maybe a) where
  argName :: Maybe a -> String
argName ~(Just a
x) = String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Arguable a => a -> String
name a
xString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"]"
  parseArg :: [String] -> [(Maybe a, [String])]
parseArg [] = [(Maybe a
forall a. Maybe a
Nothing, [])]
  parseArg ss' :: [String]
ss'@(String
s:[String]
ss) = case String -> Maybe a
forall a. Arguable a => String -> Maybe a
parse String
s of
    Maybe a
Nothing -> [(Maybe a
forall a. Maybe a
Nothing, [String]
ss')]
    Maybe a
justA   -> [(Maybe a
justA, [String]
ss),(Maybe a
forall a. Maybe a
Nothing,[String]
ss')]

-- |use a list when it should be parsed from zero or more (greedily)
instance Arguable a => Argument [a] where
  argName :: [a] -> String
argName ~(a
x:[a]
_) = String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Arguable a => a -> String
name a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"...]"
  parseArg :: [String] -> [([a], [String])]
parseArg [String]
ss = [([a], [String])] -> [([a], [String])]
forall a. [a] -> [a]
reverse ([([a], [String])] -> [([a], [String])])
-> [([a], [String])] -> [([a], [String])]
forall a b. (a -> b) -> a -> b
$ [a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
ss' [[a]] -> [[String]] -> [([a], [String])]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [String] -> [[String]]
forall a. [a] -> [[a]]
tails [String]
ss
    where ss' :: [a]
ss' = (Maybe a -> a) -> [Maybe a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe a] -> [a]) -> ([Maybe a] -> [Maybe a]) -> [Maybe a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Bool) -> [Maybe a] -> [Maybe a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Maybe a -> Bool
forall a. Maybe a -> Bool
isJust ([Maybe a] -> [a]) -> [Maybe a] -> [a]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe a) -> [String] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe a
forall a. Arguable a => String -> Maybe a
parse [String]
ss

-- |a wrapper type to indicate a non-greedy list or maybe
newtype NonGreedy m a = NonGreedy { forall (m :: * -> *) a. NonGreedy m a -> m a
unNonGreedy :: m a } deriving (Int -> NonGreedy m a -> String -> String
[NonGreedy m a] -> String -> String
NonGreedy m a -> String
(Int -> NonGreedy m a -> String -> String)
-> (NonGreedy m a -> String)
-> ([NonGreedy m a] -> String -> String)
-> Show (NonGreedy m a)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall (m :: * -> *) a.
Show (m a) =>
Int -> NonGreedy m a -> String -> String
forall (m :: * -> *) a.
Show (m a) =>
[NonGreedy m a] -> String -> String
forall (m :: * -> *) a. Show (m a) => NonGreedy m a -> String
showList :: [NonGreedy m a] -> String -> String
$cshowList :: forall (m :: * -> *) a.
Show (m a) =>
[NonGreedy m a] -> String -> String
show :: NonGreedy m a -> String
$cshow :: forall (m :: * -> *) a. Show (m a) => NonGreedy m a -> String
showsPrec :: Int -> NonGreedy m a -> String -> String
$cshowsPrec :: forall (m :: * -> *) a.
Show (m a) =>
Int -> NonGreedy m a -> String -> String
Show, NonGreedy m a -> NonGreedy m a -> Bool
(NonGreedy m a -> NonGreedy m a -> Bool)
-> (NonGreedy m a -> NonGreedy m a -> Bool) -> Eq (NonGreedy m a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *) a.
Eq (m a) =>
NonGreedy m a -> NonGreedy m a -> Bool
/= :: NonGreedy m a -> NonGreedy m a -> Bool
$c/= :: forall (m :: * -> *) a.
Eq (m a) =>
NonGreedy m a -> NonGreedy m a -> Bool
== :: NonGreedy m a -> NonGreedy m a -> Bool
$c== :: forall (m :: * -> *) a.
Eq (m a) =>
NonGreedy m a -> NonGreedy m a -> Bool
Eq)
-- |use NonGreedy when it should be parsed non-greedily
--  (e.g. @(NonGreedy xs :: NonGreedy [] Int, x :: Maybe Float) <- readArgs@)
instance Argument (m a) => Argument (NonGreedy m a) where
  argName :: NonGreedy m a -> String
argName ~(NonGreedy m a
m) = m a -> String
forall a. Argument a => a -> String
argName m a
m
  parseArg :: [String] -> [(NonGreedy m a, [String])]
parseArg = ((m a, [String]) -> (NonGreedy m a, [String]))
-> [(m a, [String])] -> [(NonGreedy m a, [String])]
forall a b. (a -> b) -> [a] -> [b]
map ((m a -> NonGreedy m a)
-> (m a, [String]) -> (NonGreedy m a, [String])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first m a -> NonGreedy m a
forall (m :: * -> *) a. m a -> NonGreedy m a
NonGreedy) ([(m a, [String])] -> [(NonGreedy m a, [String])])
-> ([String] -> [(m a, [String])])
-> [String]
-> [(NonGreedy m a, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(m a, [String])] -> [(m a, [String])]
forall a. [a] -> [a]
reverse ([(m a, [String])] -> [(m a, [String])])
-> ([String] -> [(m a, [String])]) -> [String] -> [(m a, [String])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [(m a, [String])]
forall a. Argument a => [String] -> [(a, [String])]
parseArg

-- |make sure strings are handled as a separate type, not a list of chars
instance Argument String where
  parseArg :: [String] -> [(String, [String])]
parseArg [] = []
  parseArg (String
s:[String]
ss) = do
    String
a <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. Arguable a => String -> Maybe a
parse String
s
    (String, [String]) -> [(String, [String])]
forall (m :: * -> *) a. Monad m => a -> m a
return (String
a, [String]
ss)
  argName :: String -> String
argName = String -> String
forall a. Arguable a => a -> String
name

-- |a class for tuples of types that can be parsed from the entire list
-- of arguments
class ArgumentTuple a where
  parseArgsFrom :: [String] -> Maybe a
  -- |usageFor's argument will usually be undefined, so when defining instances of
  -- Arguable, it should be lazy in its argument
  usageFor :: a -> String

-- |use () for no arguments
instance ArgumentTuple () where
  parseArgsFrom :: [String] -> Maybe ()
parseArgsFrom [] = () -> Maybe ()
forall a. a -> Maybe a
Just ()
  parseArgsFrom [String]
_ = Maybe ()
forall a. Maybe a
Nothing
  usageFor :: () -> String
usageFor = String -> () -> String
forall a b. a -> b -> a
const String
""

-- |use :& to construct arbitrary length tuples of any parsable arguments
data a :& b = a :& b deriving (Int -> (a :& b) -> String -> String
[a :& b] -> String -> String
(a :& b) -> String
(Int -> (a :& b) -> String -> String)
-> ((a :& b) -> String)
-> ([a :& b] -> String -> String)
-> Show (a :& b)
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
forall a b. (Show a, Show b) => Int -> (a :& b) -> String -> String
forall a b. (Show a, Show b) => [a :& b] -> String -> String
forall a b. (Show a, Show b) => (a :& b) -> String
showList :: [a :& b] -> String -> String
$cshowList :: forall a b. (Show a, Show b) => [a :& b] -> String -> String
show :: (a :& b) -> String
$cshow :: forall a b. (Show a, Show b) => (a :& b) -> String
showsPrec :: Int -> (a :& b) -> String -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a :& b) -> String -> String
Show, (a :& b) -> (a :& b) -> Bool
((a :& b) -> (a :& b) -> Bool)
-> ((a :& b) -> (a :& b) -> Bool) -> Eq (a :& b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
/= :: (a :& b) -> (a :& b) -> Bool
$c/= :: forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
== :: (a :& b) -> (a :& b) -> Bool
$c== :: forall a b. (Eq a, Eq b) => (a :& b) -> (a :& b) -> Bool
Eq)
infixr 5 :&
instance (Argument a, ArgumentTuple y) => ArgumentTuple (a :& y) where
  parseArgsFrom :: [String] -> Maybe (a :& y)
parseArgsFrom [String]
ss = [a :& y] -> Maybe (a :& y)
forall a. [a] -> Maybe a
listToMaybe ([a :& y] -> Maybe (a :& y)) -> [a :& y] -> Maybe (a :& y)
forall a b. (a -> b) -> a -> b
$ do
    (a
a, [String]
ss') <- [String] -> [(a, [String])]
forall a. Argument a => [String] -> [(a, [String])]
parseArg [String]
ss
    y
y <- Maybe y -> [y]
forall a. Maybe a -> [a]
maybeToList (Maybe y -> [y]) -> Maybe y -> [y]
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe y
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss'
    (a :& y) -> [a :& y]
forall (m :: * -> *) a. Monad m => a -> m a
return ((a :& y) -> [a :& y]) -> (a :& y) -> [a :& y]
forall a b. (a -> b) -> a -> b
$ a
a a -> y -> a :& y
forall a b. a -> b -> a :& b
:& y
y
  usageFor :: (a :& y) -> String
usageFor ~(a
a :& y
y) = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Argument a => a -> String
argName a
a  String -> String -> String
forall a. [a] -> [a] -> [a]
++ y -> String
forall a. ArgumentTuple a => a -> String
usageFor y
y

-- Use :& to derive an instance for single arguments
instance (Argument a) => ArgumentTuple a where
  parseArgsFrom :: [String] -> Maybe a
parseArgsFrom [String]
ss = do
    a
a :& () <- [String] -> Maybe (a :& ())
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  usageFor :: a -> String
usageFor a
a = (a :& ()) -> String
forall a. ArgumentTuple a => a -> String
usageFor (a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

-- Use :& to derive instances for all the normal tuple types
instance (Argument b, Argument a) => ArgumentTuple (b,a) where
  parseArgsFrom :: [String] -> Maybe (b, a)
parseArgsFrom [String]
ss = do
    b
b :& a
a :& () <- [String] -> Maybe (b :& (a :& ()))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (b, a) -> Maybe (b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b,a
a)
  usageFor :: (b, a) -> String
usageFor ~(b
b,a
a) = (b :& (a :& ())) -> String
forall a. ArgumentTuple a => a -> String
usageFor (b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument c, Argument b, Argument a) => ArgumentTuple (c,b,a) where
  parseArgsFrom :: [String] -> Maybe (c, b, a)
parseArgsFrom [String]
ss = do
    c
c :& b
b :& a
a :& () <- [String] -> Maybe (c :& (b :& (a :& ())))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (c, b, a) -> Maybe (c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (c
c,b
b,a
a)
  usageFor :: (c, b, a) -> String
usageFor ~(c
c,b
b,a
a) = (c :& (b :& (a :& ()))) -> String
forall a. ArgumentTuple a => a -> String
usageFor (c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (d, c, b, a)
parseArgsFrom [String]
ss = do
    d
d :& c
c :& b
b :& a
a :& () <- [String] -> Maybe (d :& (c :& (b :& (a :& ()))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (d, c, b, a) -> Maybe (d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (d
d,c
c,b
b,a
a)
  usageFor :: (d, c, b, a) -> String
usageFor ~(d
d,c
c,b
b,a
a) = (d :& (c :& (b :& (a :& ())))) -> String
forall a. ArgumentTuple a => a -> String
usageFor (d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (e, d, c, b, a)
parseArgsFrom [String]
ss = do
    e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String] -> Maybe (e :& (d :& (c :& (b :& (a :& ())))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (e, d, c, b, a) -> Maybe (e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (e
e,d
d,c
c,b
b,a
a)
  usageFor :: (e, d, c, b, a) -> String
usageFor ~(e
e,d
d,c
c,b
b,a
a) = (e :& (d :& (c :& (b :& (a :& ()))))) -> String
forall a. ArgumentTuple a => a -> String
usageFor (e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String] -> Maybe (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (f, e, d, c, b, a) -> Maybe (f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (f, e, d, c, b, a) -> String
usageFor ~(f
f,e
e,d
d,c
c,b
b,a
a) = (f :& (e :& (d :& (c :& (b :& (a :& ())))))) -> String
forall a. ArgumentTuple a => a -> String
usageFor (f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (g, f, e, d, c, b, a) -> Maybe (g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (g, f, e, d, c, b, a) -> String
usageFor ~(g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))) -> String
forall a. ArgumentTuple a => a -> String
usageFor (g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (h, g, f, e, d, c, b, a) -> Maybe (h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (h, g, f, e, d, c, b, a) -> String
usageFor ~(h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument i, Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (i,h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (i, h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    i
i :& h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe
     (i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (i, h, g, f, e, d, c, b, a) -> Maybe (i, h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (i, h, g, f, e, d, c, b, a) -> String
usageFor ~(i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (i
i i
-> (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a b. a -> b -> a :& b
:& h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument j, Argument i, Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (j,i,h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (j, i, h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    j
j :& i
i :& h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe
     (j
      :& (i
          :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (j, i, h, g, f, e, d, c, b, a)
-> Maybe (j, i, h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (j, i, h, g, f, e, d, c, b, a) -> String
usageFor ~(j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (j
 :& (i
     :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (j
j j
-> (i
    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
-> j
   :& (i
       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
forall a b. a -> b -> a :& b
:& i
i i
-> (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a b. a -> b -> a :& b
:& h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument k, Argument j, Argument i, Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (k,j,i,h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (k, j, i, h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    k
k :& j
j :& i
i :& h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe
     (k
      :& (j
          :& (i
              :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (k, j, i, h, g, f, e, d, c, b, a)
-> Maybe (k, j, i, h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (k, j, i, h, g, f, e, d, c, b, a) -> String
usageFor ~(k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (k
 :& (j
     :& (i
         :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (k
k k
-> (j
    :& (i
        :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
-> k
   :& (j
       :& (i
           :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
forall a b. a -> b -> a :& b
:& j
j j
-> (i
    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
-> j
   :& (i
       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
forall a b. a -> b -> a :& b
:& i
i i
-> (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a b. a -> b -> a :& b
:& h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument l, Argument k, Argument j, Argument i, Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (l,k,j,i,h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (l, k, j, i, h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    l
l :& k
k :& j
j :& i
i :& h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe
     (l
      :& (k
          :& (j
              :& (i
                  :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (l, k, j, i, h, g, f, e, d, c, b, a)
-> Maybe (l, k, j, i, h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (l, k, j, i, h, g, f, e, d, c, b, a) -> String
usageFor ~(l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (l
 :& (k
     :& (j
         :& (i
             :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (l
l l
-> (k
    :& (j
        :& (i
            :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
-> l
   :& (k
       :& (j
           :& (i
               :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
forall a b. a -> b -> a :& b
:& k
k k
-> (j
    :& (i
        :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
-> k
   :& (j
       :& (i
           :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
forall a b. a -> b -> a :& b
:& j
j j
-> (i
    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
-> j
   :& (i
       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
forall a b. a -> b -> a :& b
:& i
i i
-> (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a b. a -> b -> a :& b
:& h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument m, Argument l, Argument k, Argument j, Argument i, Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (m,l,k,j,i,h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (m, l, k, j, i, h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    m
m :& l
l :& k
k :& j
j :& i
i :& h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe
     (m
      :& (l
          :& (k
              :& (j
                  :& (i
                      :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (m, l, k, j, i, h, g, f, e, d, c, b, a)
-> Maybe (m, l, k, j, i, h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (m
m,l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (m, l, k, j, i, h, g, f, e, d, c, b, a) -> String
usageFor ~(m
m,l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (m
 :& (l
     :& (k
         :& (j
             :& (i
                 :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (m
m m
-> (l
    :& (k
        :& (j
            :& (i
                :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
-> m
   :& (l
       :& (k
           :& (j
               :& (i
                   :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
forall a b. a -> b -> a :& b
:& l
l l
-> (k
    :& (j
        :& (i
            :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
-> l
   :& (k
       :& (j
           :& (i
               :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
forall a b. a -> b -> a :& b
:& k
k k
-> (j
    :& (i
        :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
-> k
   :& (j
       :& (i
           :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
forall a b. a -> b -> a :& b
:& j
j j
-> (i
    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
-> j
   :& (i
       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
forall a b. a -> b -> a :& b
:& i
i i
-> (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a b. a -> b -> a :& b
:& h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument n, Argument m, Argument l, Argument k, Argument j, Argument i, Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (n,m,l,k,j,i,h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (n, m, l, k, j, i, h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    n
n :& m
m :& l
l :& k
k :& j
j :& i
i :& h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe
     (n
      :& (m
          :& (l
              :& (k
                  :& (j
                      :& (i
                          :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (n, m, l, k, j, i, h, g, f, e, d, c, b, a)
-> Maybe (n, m, l, k, j, i, h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (n
n,m
m,l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (n, m, l, k, j, i, h, g, f, e, d, c, b, a) -> String
usageFor ~(n
n,m
m,l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (n
 :& (m
     :& (l
         :& (k
             :& (j
                 :& (i
                     :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (n
n n
-> (m
    :& (l
        :& (k
            :& (j
                :& (i
                    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))
-> n
   :& (m
       :& (l
           :& (k
               :& (j
                   :& (i
                       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))
forall a b. a -> b -> a :& b
:& m
m m
-> (l
    :& (k
        :& (j
            :& (i
                :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
-> m
   :& (l
       :& (k
           :& (j
               :& (i
                   :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
forall a b. a -> b -> a :& b
:& l
l l
-> (k
    :& (j
        :& (i
            :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
-> l
   :& (k
       :& (j
           :& (i
               :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
forall a b. a -> b -> a :& b
:& k
k k
-> (j
    :& (i
        :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
-> k
   :& (j
       :& (i
           :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
forall a b. a -> b -> a :& b
:& j
j j
-> (i
    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
-> j
   :& (i
       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
forall a b. a -> b -> a :& b
:& i
i i
-> (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a b. a -> b -> a :& b
:& h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())

instance (Argument o, Argument n, Argument m, Argument l, Argument k, Argument j, Argument i, Argument h, Argument g, Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (o,n,m,l,k,j,i,h,g,f,e,d,c,b,a) where
  parseArgsFrom :: [String] -> Maybe (o, n, m, l, k, j, i, h, g, f, e, d, c, b, a)
parseArgsFrom [String]
ss = do
    o
o :& n
n :& m
m :& l
l :& k
k :& j
j :& i
i :& h
h :& g
g :& f
f :& e
e :& d
d :& c
c :& b
b :& a
a :& () <- [String]
-> Maybe
     (o
      :& (n
          :& (m
              :& (l
                  :& (k
                      :& (j
                          :& (i
                              :& (h
                                  :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))))
forall a. ArgumentTuple a => [String] -> Maybe a
parseArgsFrom [String]
ss
    (o, n, m, l, k, j, i, h, g, f, e, d, c, b, a)
-> Maybe (o, n, m, l, k, j, i, h, g, f, e, d, c, b, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (o
o,n
n,m
m,l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a)
  usageFor :: (o, n, m, l, k, j, i, h, g, f, e, d, c, b, a) -> String
usageFor ~(o
o,n
n,m
m,l
l,k
k,j
j,i
i,h
h,g
g,f
f,e
e,d
d,c
c,b
b,a
a) = (o
 :& (n
     :& (m
         :& (l
             :& (k
                 :& (j
                     :& (i
                         :& (h
                             :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))))
-> String
forall a. ArgumentTuple a => a -> String
usageFor (o
o o
-> (n
    :& (m
        :& (l
            :& (k
                :& (j
                    :& (i
                        :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))))
-> o
   :& (n
       :& (m
           :& (l
               :& (k
                   :& (j
                       :& (i
                           :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))))
forall a b. a -> b -> a :& b
:& n
n n
-> (m
    :& (l
        :& (k
            :& (j
                :& (i
                    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))
-> n
   :& (m
       :& (l
           :& (k
               :& (j
                   :& (i
                       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))))
forall a b. a -> b -> a :& b
:& m
m m
-> (l
    :& (k
        :& (j
            :& (i
                :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
-> m
   :& (l
       :& (k
           :& (j
               :& (i
                   :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))))
forall a b. a -> b -> a :& b
:& l
l l
-> (k
    :& (j
        :& (i
            :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
-> l
   :& (k
       :& (j
           :& (i
               :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))))
forall a b. a -> b -> a :& b
:& k
k k
-> (j
    :& (i
        :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
-> k
   :& (j
       :& (i
           :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))))
forall a b. a -> b -> a :& b
:& j
j j
-> (i
    :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
-> j
   :& (i
       :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))))
forall a b. a -> b -> a :& b
:& i
i i
-> (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
-> i :& (h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))))
forall a b. a -> b -> a :& b
:& h
h h
-> (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
-> h :& (g :& (f :& (e :& (d :& (c :& (b :& (a :& ())))))))
forall a b. a -> b -> a :& b
:& g
g g
-> (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
-> g :& (f :& (e :& (d :& (c :& (b :& (a :& ()))))))
forall a b. a -> b -> a :& b
:& f
f f
-> (e :& (d :& (c :& (b :& (a :& ())))))
-> f :& (e :& (d :& (c :& (b :& (a :& ())))))
forall a b. a -> b -> a :& b
:& e
e e
-> (d :& (c :& (b :& (a :& ()))))
-> e :& (d :& (c :& (b :& (a :& ()))))
forall a b. a -> b -> a :& b
:& d
d d -> (c :& (b :& (a :& ()))) -> d :& (c :& (b :& (a :& ())))
forall a b. a -> b -> a :& b
:& c
c c -> (b :& (a :& ())) -> c :& (b :& (a :& ()))
forall a b. a -> b -> a :& b
:& b
b b -> (a :& ()) -> b :& (a :& ())
forall a b. a -> b -> a :& b
:& a
a a -> () -> a :& ()
forall a b. a -> b -> a :& b
:& ())