diff --git a/System/Console/ParseArgs.hs b/System/Console/ParseArgs.hs --- a/System/Console/ParseArgs.hs +++ b/System/Console/ParseArgs.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, Safe, CPP #-} +{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, CPP #-} +#if __GLASGOW_HASKELL__ > 720 +{-# LANGUAGE Safe #-} +#endif ------------------------------------------------------------ -- | -- Module : System.Console.ParseArgs @@ -63,11 +66,7 @@ import Control.Exception import Control.Monad -#if __GLASGOW_HASKELL__ < 710 -import Control.Monad.ST.Safe -#else import Control.Monad.ST -#endif import Data.List import qualified Data.Map as Map import Data.Maybe @@ -606,10 +605,18 @@ Map.lookup k am >>= decons instance ArgType () where - getArg = getArgPrimitive (\ArgvalFlag -> return ()) + getArg = + getArgPrimitive flagArg + where + flagArg ArgvalFlag = return () + flagArg _ = error "internal error: flag arg at wrong type" instance ArgType ([] Char) where - getArg = getArgPrimitive (\(ArgvalString s) -> return s) + getArg = + getArgPrimitive stringArg + where + stringArg (ArgvalString s) = return s + stringArg _ = error "internal error: string arg at wrong type" -- |[Deprecated] Return the `String` value, if any, of the given argument. getArgString :: (Show a, Ord a) => @@ -619,7 +626,11 @@ getArgString = getArg instance ArgType Integer where - getArg = getArgPrimitive (\(ArgvalInteger i) -> return i) + getArg = + getArgPrimitive integerArg + where + integerArg (ArgvalInteger i) = return i + integerArg _ = error "internal error: integer arg at wrong type" -- |[Deprecated] Return the `Integer` value, if any, of the given argument. getArgInteger :: (Show a, Ord a) => @@ -629,7 +640,11 @@ getArgInteger = getArg instance ArgType Int where - getArg = getArgPrimitive (\(ArgvalInt i) -> return i) + getArg = + getArgPrimitive intArg + where + intArg (ArgvalInt i) = return i + intArg _ = error "internal error: int arg at wrong type" -- |[Deprecated] Return the `Int` value, if any, of the given argument. getArgInt :: (Show a, Ord a) => @@ -639,7 +654,11 @@ getArgInt = getArg instance ArgType Double where - getArg = getArgPrimitive (\(ArgvalDouble i) -> return i) + getArg = + getArgPrimitive doubleArg + where + doubleArg (ArgvalDouble d) = return d + doubleArg _ = error "internal error: double arg at wrong type" -- |[Deprecated] Return the `Double` value, if any, of the given argument. getArgDouble :: (Show a, Ord a) => @@ -649,7 +668,11 @@ getArgDouble = getArg instance ArgType Float where - getArg = getArgPrimitive (\(ArgvalFloat i) -> return i) + getArg = + getArgPrimitive floatArg + where + floatArg (ArgvalFloat f) = return f + floatArg _ = error "internal error: float arg at wrong type" -- |[Deprecated] Return the `Float` value, if any, of the given argument. getArgFloat :: (Show a, Ord a) => diff --git a/parseargs.cabal b/parseargs.cabal --- a/parseargs.cabal +++ b/parseargs.cabal @@ -6,8 +6,8 @@ Build-Type: Simple Description: Parse command-line arguments -- Don't forget to bump the source-repository this below -Version: 0.2.0.4 -Cabal-Version: >= 1.6 +Version: 0.2.0.7 +Cabal-Version: >= 1.8 License: BSD3 License-File: COPYING Author: Bart Massey @@ -16,7 +16,8 @@ Homepage: http://github.com/BartMassey/parseargs Category: Console Synopsis: Full-featured command-line argument parsing library. -Extra-Source-Files: README.md +Extra-Source-Files: README.md test-parseargs.sh tests/*.in tests/*.out +Tested-With: GHC >= 6 && < 8.1 Library Build-Depends: base < 5, containers < 1 @@ -24,11 +25,16 @@ GHC-Options: -Wall Executable parseargs-example - Build-Depends: base < 5 + Build-Depends: base < 5, containers < 1 Main-Is: parseargs-example.hs Other-Modules: System.Console.ParseArgs GHC-Options: -Wall +Test-Suite test-parseargs + Type: exitcode-stdio-1.0 + Main-Is: test-parseargs.hs + build-depends: base < 5, process < 2 + Source-repository head Type: git Location: git://github.com/BartMassey/parseargs.git @@ -36,4 +42,4 @@ Source-repository this Type: git Location: git://github.com/BartMassey/parseargs.git - Tag: v0.2.0.4 + Tag: v0.2.0.7 diff --git a/test-parseargs.hs b/test-parseargs.hs new file mode 100644 --- /dev/null +++ b/test-parseargs.hs @@ -0,0 +1,11 @@ +-- Stupid glue for "cabal test" +-- http://stackoverflow.com/a/31214045/364875 + +import System.Exit +import System.Process + +main = do + result <- system "./test-parseargs.sh" + case result of + ExitSuccess -> return () + _ -> exitFailure diff --git a/test-parseargs.sh b/test-parseargs.sh new file mode 100644 --- /dev/null +++ b/test-parseargs.sh @@ -0,0 +1,21 @@ +#!/bin/sh +# Copyright © 2016 Bart Massey +# Run simple parseargs tests +PA=dist/build/parseargs-example/parseargs-example +TMP=/tmp/test-parseargs-$$ +trap "rm -f $TMP" 0 1 2 3 15 +for f in tests/*.in +do + T="`basename $f .in`" + $PA `cat $f` >$TMP + if ! cmp $TMP tests/$T.out + then + echo "test $T failed" + echo "expected:" + cat tests/$T.out + echo "got:" + cat $TMP + exit 1 + fi +done +exit 0 diff --git a/tests/t1.in b/tests/t1.in new file mode 100644 --- /dev/null +++ b/tests/t1.in @@ -0,0 +1,1 @@ +x diff --git a/tests/t1.out b/tests/t1.out new file mode 100644 --- /dev/null +++ b/tests/t1.out @@ -0,0 +1,4 @@ +parse successful +saw int 7 +saw fixed x +saw rest: [] diff --git a/tests/t2.in b/tests/t2.in new file mode 100644 --- /dev/null +++ b/tests/t2.in @@ -0,0 +1,1 @@ +x y diff --git a/tests/t2.out b/tests/t2.out new file mode 100644 --- /dev/null +++ b/tests/t2.out @@ -0,0 +1,5 @@ +parse successful +saw int 7 +saw pre-optional x +saw fixed y +saw rest: [] diff --git a/tests/t3.in b/tests/t3.in new file mode 100644 --- /dev/null +++ b/tests/t3.in @@ -0,0 +1,1 @@ +x y z diff --git a/tests/t3.out b/tests/t3.out new file mode 100644 --- /dev/null +++ b/tests/t3.out @@ -0,0 +1,6 @@ +parse successful +saw int 7 +saw pre-optional x +saw fixed y +saw optional z +saw rest: []