ReadArgs-1.2.1/0000755000000000000000000000000012051504707011372 5ustar0000000000000000ReadArgs-1.2.1/LICENSE0000644000000000000000000000277512051504707012412 0ustar0000000000000000Copyright (c)2011, Noah Luck Easterly All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Noah Luck Easterly nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ReadArgs-1.2.1/ReadArgs.cabal0000644000000000000000000000571312051504707014054 0ustar0000000000000000Name: ReadArgs Version: 1.2.1 Synopsis: Simple command line argument parsing Description: ReadArgs provides the @readArgs@ IO action, which lets you tell the compiler to parse the command line arguments to fit the type signature you give. . For example @(a :: Int, b :: String, c :: Float) <- readArgs@ would parse the first runtime argument as an @Int@, the second as a @String@ (no quotes required) and the third as a @Float@. . If the runtime arguments are incompatible with the type signature, then a simple usage statement is given of the types needed. . Continuing the previous example, if it was used in a program named @Example@, the error message for the above action would be: . @ usage: Example Int String Float @ . Any type that has both @Typeable@ and @Read@ instances can be used. @Char@, @String@, and @Text@ are handled specially so that command line arguments for both do not require quotes (as their @Read@ instances do). A special instance is provided for @FilePath@ so that no constructor or quotes are required. . @readArgs@ also supports optional arguments and variadic arguments. Optional arguments are specified using @Maybe@, and variadic arguments using a list. @(a :: Int, b :: Maybe String, c :: [Float]) <- readArgs@ would successfully parse any of the following sets of command line arguments: . @ Example 1 Example 1 2 3 4 Example 1 foo Example 1 foo 2 3 4 @ . But not . @ Example Example foo Example 1.0 @ . Usage statements for optional and variadic arguments use command-line parlance: . @ usage: Example Int [String] [Float..] @ . Note that both optional and variadic parsers are greedy by default (so @Example 1 2 3 4@ was parsed as @(1, "2", [3.0,4.0])@. They may both be made non-greedy through use of the @NonGreedy@ constructor: . @ ( a :: Int , NonGreedy b :: NonGreedy Maybe String , NonGreedy c :: NonGreedy [] Float ) <- readArgs @ Homepage: http://github.com/rampion/ReadArgs License: BSD3 License-file: LICENSE Author: Noah Luck Easterly Maintainer: noah.easterly@gmail.com Category: Command Line Build-type: Simple Cabal-version: >=1.8 Source-repository head type: git location: git://github.com/rampion/ReadArgs.git Library Exposed-modules: ReadArgs Build-depends: base >= 4.3.1.0 && < 5, system-filepath >= 0.4.7 && < 0.5, text >= 0.11.1.13 && < 12 Test-Suite ReadArgsSpec type: exitcode-stdio-1.0 Main-Is: ReadArgsSpec.hs Build-depends: hspec >= 1.3 && < 2, base >= 4.3.1.0 && < 5, system-filepath >= 0.4.7 && < 0.5, text >= 0.11.1.13 && < 12 Executable ReadArgsEx Main-Is: ReadArgsEx.hs Build-depends: base >= 4.3.1.0 && < 5, system-filepath >= 0.4.7 && < 0.5, text >= 0.11.1.13 && < 12 ReadArgs-1.2.1/ReadArgs.hs0000644000000000000000000002373612051504707013431 0ustar0000000000000000{-# 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 = getArgs >>= 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 ss = let ma@(~(Just a)) = parseArgsFrom ss in case ma of Nothing -> do progName <- getProgName hPutStrLn stderr $ "usage: " ++ progName ++ usageFor a exitFailure _ -> return 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 s = case reads s of [(i,"")] -> Just i _ -> Nothing name t = showsTypeRep (typeOf t) "" -- |string is a special case, so that we don't force the user to double-quote -- their input instance Arguable String where parse = Just name _ = "String" -- |Text is a special case, so that we don't force the user to double-quote -- their input instance Arguable Text where parse = Just . pack name _ = "Text" -- |FilePath is a special case, so that we don't force the user to double-quote -- their input instance Arguable FilePath where parse = Just . fromText . pack name _ = "FilePath" -- |char is a special case, so that we don't force the user to single-quote -- their input instance Arguable Char where parse [x] = Just x parse _ = Nothing name _ = "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 [] = [] parseArg (s:ss) = do a <- maybeToList $ parse s return (a, ss) argName = name -- |use Maybe when it should be parsed from one or zero (greedily) instance Arguable a => Argument (Maybe a) where argName ~(Just x) = "["++name x++"]" parseArg [] = [(Nothing, [])] parseArg ss'@(s:ss) = case parse s of Nothing -> [(Nothing, ss')] justA -> [(justA, ss),(Nothing,ss')] -- |use a list when it should be parsed from zero or more (greedily) instance Arguable a => Argument [a] where argName ~(x:_) = "["++name x ++"...]" parseArg ss = reverse $ inits ss' `zip` tails ss where ss' = map fromJust . takeWhile isJust $ map parse ss -- |a wrapper type to indicate a non-greedy list or maybe newtype NonGreedy m a = NonGreedy { unNonGreedy :: m a } deriving (Show, 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) = argName m parseArg = map (first NonGreedy) . reverse . parseArg -- |make sure strings are handled as a separate type, not a list of chars instance Argument String where parseArg [] = [] parseArg (s:ss) = do a <- maybeToList $ parse s return (a, ss) argName = 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 [] = Just () parseArgsFrom _ = Nothing usageFor = const "" -- |use :& to construct arbitrary length tuples of any parsable arguments data a :& b = a :& b deriving (Show, Eq) infixr 5 :& instance (Argument a, ArgumentTuple y) => ArgumentTuple (a :& y) where parseArgsFrom ss = listToMaybe $ do (a, ss') <- parseArg ss y <- maybeToList $ parseArgsFrom ss' return $ a :& y usageFor ~(a :& y) = " " ++ argName a ++ usageFor y -- Use :& to derive an instance for single arguments instance (Argument a) => ArgumentTuple a where parseArgsFrom ss = do a :& () <- parseArgsFrom ss return a usageFor a = usageFor (a :& ()) -- Use :& to derive instances for all the normal tuple types instance (Argument b, Argument a) => ArgumentTuple (b,a) where parseArgsFrom ss = do b :& a :& () <- parseArgsFrom ss return (b,a) usageFor ~(b,a) = usageFor (b :& a :& ()) instance (Argument c, Argument b, Argument a) => ArgumentTuple (c,b,a) where parseArgsFrom ss = do c :& b :& a :& () <- parseArgsFrom ss return (c,b,a) usageFor ~(c,b,a) = usageFor (c :& b :& a :& ()) instance (Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (d,c,b,a) where parseArgsFrom ss = do d :& c :& b :& a :& () <- parseArgsFrom ss return (d,c,b,a) usageFor ~(d,c,b,a) = usageFor (d :& c :& b :& a :& ()) instance (Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (e,d,c,b,a) where parseArgsFrom ss = do e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (e,d,c,b,a) usageFor ~(e,d,c,b,a) = usageFor (e :& d :& c :& b :& a :& ()) instance (Argument f, Argument e, Argument d, Argument c, Argument b, Argument a) => ArgumentTuple (f,e,d,c,b,a) where parseArgsFrom ss = do f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (f,e,d,c,b,a) usageFor ~(f,e,d,c,b,a) = usageFor (f :& e :& d :& c :& b :& a :& ()) 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 ss = do g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (g,f,e,d,c,b,a) usageFor ~(g,f,e,d,c,b,a) = usageFor (g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (h,g,f,e,d,c,b,a) usageFor ~(h,g,f,e,d,c,b,a) = usageFor (h :& g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do i :& h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (i,h,g,f,e,d,c,b,a) usageFor ~(i,h,g,f,e,d,c,b,a) = usageFor (i :& h :& g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (j,i,h,g,f,e,d,c,b,a) usageFor ~(j,i,h,g,f,e,d,c,b,a) = usageFor (j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (k,j,i,h,g,f,e,d,c,b,a) usageFor ~(k,j,i,h,g,f,e,d,c,b,a) = usageFor (k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (l,k,j,i,h,g,f,e,d,c,b,a) usageFor ~(l,k,j,i,h,g,f,e,d,c,b,a) = usageFor (l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do m :& l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (m,l,k,j,i,h,g,f,e,d,c,b,a) usageFor ~(m,l,k,j,i,h,g,f,e,d,c,b,a) = usageFor (m :& l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do n :& m :& l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (n,m,l,k,j,i,h,g,f,e,d,c,b,a) usageFor ~(n,m,l,k,j,i,h,g,f,e,d,c,b,a) = usageFor (n :& m :& l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& ()) 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 ss = do o :& n :& m :& l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& () <- parseArgsFrom ss return (o,n,m,l,k,j,i,h,g,f,e,d,c,b,a) usageFor ~(o,n,m,l,k,j,i,h,g,f,e,d,c,b,a) = usageFor (o :& n :& m :& l :& k :& j :& i :& h :& g :& f :& e :& d :& c :& b :& a :& ()) ReadArgs-1.2.1/ReadArgsEx.hs0000644000000000000000000000103612051504707013713 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Main where import ReadArgs -- try running this with a couple sample inputs -- % ReadArgsEx -- usage: ReadArgsEx [Char] String [Int...] Char -- % ReadArgsEx hello x -- (Nothing, "hello", [], 'x') -- % ReadArgsEx a hello x -- (Just 'a', "hello", [], 'x') -- % ReadArgsEx hello 1 2 3 x -- (Nothing, "hello", [1,2,3], 'x') -- % ReadArgsEx a hello 1 2 3 x -- (Just 'a', "hello", [1,2,3], 'x') main = do (a :: Maybe Char, b :: String, c :: [Int], d :: Char) <- readArgs print (a,b,c,d) ReadArgs-1.2.1/ReadArgsSpec.hs0000644000000000000000000001101412051504707014226 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Main where import Test.Hspec import ReadArgs import Data.Text (pack) import Filesystem.Path.CurrentOS (fromText) spec :: Spec spec = describe "parseArgsFrom" $ do it "can parse zero arguments" $ parseArgsFrom [] `shouldBe` Just () it "can parse a single argument" $ parseArgsFrom ["3"] `shouldBe` Just ((3 :: Int) :& ()) it "can parse a pair of arguments" $ parseArgsFrom ["3", "4"] `shouldBe` Just (3 :: Int, 4 :: Int) it "can parse a string without double quotes" $ parseArgsFrom ["abe", "bar"] `shouldBe` Just ("abe", "bar") it "can parse text without double quotes" $ parseArgsFrom ["abe", "bar"] `shouldBe` Just (pack "abe", pack "bar") it "can parse a filepath without double quotes" $ parseArgsFrom ["abe", "bar"] `shouldBe` Just (fromText $ pack "abe", fromText $ pack "bar") it "can parse a character without single quotes" $ parseArgsFrom ["a", "b"] `shouldBe` Just ('a','b') it "can parse a triplet of arguments" $ parseArgsFrom ["3", "steve", "1.0"] `shouldBe` Just (3 :: Int, "steve", 1.0 :: Float) it "can parse an optional argument at the end" $ do parseArgsFrom ["3", "steve", "1.0"] `shouldBe` Just (3 :: Int, "steve", Just 1.0 :: Maybe Float) parseArgsFrom ["3", "steve"] `shouldBe` Just (3 :: Int, "steve", Nothing :: Maybe Float) it "can parse an optional argument in the middle" $ do parseArgsFrom ["3", "steve", "1.0"] `shouldBe` Just (3 :: Int, Just "steve", 1.0 :: Float) parseArgsFrom ["3", "1.0"] `shouldBe` Just (3 :: Int, Nothing :: Maybe String, 1.0 :: Float) it "can parse an optional argument at the front" $ do parseArgsFrom ["3", "steve", "1.0"] `shouldBe` Just (Just 3 :: Maybe Int, "steve", 1.0 :: Float) parseArgsFrom ["steve", "1.0"] `shouldBe` Just (Nothing:: Maybe Int, "steve", 1.0 :: Float) it "can parse optional arguments greedily" $ parseArgsFrom ["a", "b"] `shouldBe` Just (Just "a", Just "b", Nothing :: Maybe String) it "can parse optional arguments non-greedily" $ do parseArgsFrom ["a", "b"] `shouldBe` Just (Just "a", NonGreedy Nothing :: NonGreedy Maybe String, Just "b") parseArgsFrom ["a", "b"] `shouldBe` Just (NonGreedy Nothing :: NonGreedy Maybe String, Just "a", Just "b") it "can parse a variable number of arguments at the end" $ do parseArgsFrom ["3", "steve"] `shouldBe` Just (3 :: Int, "steve", [] :: [Float]) parseArgsFrom ["3", "steve", "1.0"] `shouldBe` Just (3 :: Int, "steve", [1.0] :: [Float]) parseArgsFrom ["3", "steve", "1.0", "2.0", "3.0"] `shouldBe` Just (3 :: Int, "steve", [1,2,3] :: [Float]) it "can parse a variable number of arguments in the middle" $ do parseArgsFrom ["3", "1.0"] `shouldBe` Just (3 :: Int, [] :: [String], 1.0 :: Float) parseArgsFrom ["3", "a", "1.0"] `shouldBe` Just (3 :: Int, ["a"], 1.0 :: Float) parseArgsFrom ["3", "a", "b", "c", "1.0"] `shouldBe` Just (3 :: Int, ["a","b","c"], 1.0 :: Float) it "can parse a variable number of arguments at the front" $ do parseArgsFrom ["steve", "1.0"] `shouldBe` Just ([] :: [Int], "steve", 1.0 :: Float) parseArgsFrom ["1", "steve", "1.0"] `shouldBe` Just ([1] :: [Int], "steve", 1.0 :: Float) parseArgsFrom ["1", "2", "3", "steve", "1.0"] `shouldBe` Just ([1,2,3] :: [Int], "steve", 1.0 :: Float) it "can parse variable arguments greedily" $ parseArgsFrom ["1", "2"] `shouldBe` Just ([1,2] :: [Int], [] :: [Int], [] :: [Int]) it "can parse variable arguments non-greedily" $ do parseArgsFrom ["1", "2"] `shouldBe` Just (NonGreedy [] :: NonGreedy [] Int, [1,2] :: [Int], [] :: [Int]) parseArgsFrom ["1", "2"] `shouldBe` Just (NonGreedy [] :: NonGreedy [] Int, NonGreedy [] :: NonGreedy [] Int, [1,2] :: [Int]) it "can parse adjacent sets of variable arguments" $ parseArgsFrom ["1", "2", "a", "b"] `shouldBe` Just ([1,2] :: [Int], ["a","b"] :: [String]) it "can parse a single argument without tuples" $ parseArgsFrom ["3"] `shouldBe` Just (3 :: Int) it "can parse an optional argument without tuples" $ do parseArgsFrom ["3"] `shouldBe` Just (Just 3 :: Maybe Int) parseArgsFrom [] `shouldBe` Just (Nothing :: Maybe Int) it "can parse a variable argument without tuples" $ do parseArgsFrom ["1","2","3"] `shouldBe` Just ([1,2,3] :: [Int]) parseArgsFrom [] `shouldBe` Just ([] :: [Int]) main :: IO () main = hspec spec ReadArgs-1.2.1/Setup.hs0000644000000000000000000000005612051504707013027 0ustar0000000000000000import Distribution.Simple main = defaultMain