diff --git a/optparse-generic.cabal b/optparse-generic.cabal --- a/optparse-generic.cabal +++ b/optparse-generic.cabal @@ -1,5 +1,5 @@ Name: optparse-generic -Version: 1.2.2 +Version: 1.2.3 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3 @@ -23,16 +23,16 @@ Library Hs-Source-Dirs: src Build-Depends: - base >= 4.6 && < 5 , - system-filepath >= 0.3.1 && < 0.5 , - text < 1.3 , - transformers >= 0.2.0.0 && < 0.6 , - Only < 0.2 , - optparse-applicative >= 0.12.0 && < 0.15, - time >= 1.5 && < 1.9 , - void < 0.8 , - bytestring < 0.11, - semigroups >= 0.5.0 && < 0.19 + base >= 4.6 && < 5 , + system-filepath >= 0.3.1 && < 0.5 , + text < 1.3 , + transformers >= 0.2.0.0 && < 0.6 , + Only < 0.2 , + optparse-applicative >= 0.14.0.0 && < 0.15, + time >= 1.5 && < 1.9 , + void < 0.8 , + bytestring < 0.11, + semigroups >= 0.5.0 && < 0.19 if impl(ghc < 7.8) Build-Depends: diff --git a/src/Options/Generic.hs b/src/Options/Generic.hs --- a/src/Options/Generic.hs +++ b/src/Options/Generic.hs @@ -301,6 +301,7 @@ import Control.Applicative import Control.Monad.IO.Class (MonadIO(..)) import Data.Char (isUpper, toLower, toUpper) +import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid import Data.List.NonEmpty (NonEmpty((:|))) import Data.Proxy @@ -308,6 +309,7 @@ import Data.Tuple.Only (Only(..)) import Data.Typeable (Typeable) import Data.Void (Void) +import Data.Word (Word8, Word16, Word32, Word64) import Data.Foldable (foldMap) import Filesystem.Path (FilePath) import GHC.Generics @@ -334,6 +336,10 @@ import Data.Singletons.TypeLits #endif +#if MIN_VERSION_base(4,8,0) +import Numeric.Natural (Natural) +#endif + auto :: Read a => ReadM a auto = do s <- Options.readerAsk @@ -373,13 +379,13 @@ Nothing -> do let fs = Options.metavar metavar <> foldMap (Options.help . Data.Text.unpack) h - Options.argument auto fs + Options.argument readField fs Just name -> do let fs = Options.metavar metavar <> Options.long (Data.Text.unpack name) <> foldMap (Options.help . Data.Text.unpack) h <> foldMap Options.short c - Options.option auto fs + Options.option readField fs {-| The only reason for this method is to provide a special case for handling `String`s. All other instances should just fall back on the @@ -395,15 +401,51 @@ -> Parser [a] parseListOfField h m c = many (parseField h m c) + readField :: ReadM a + default readField :: Read a => ReadM a + readField = auto + instance ParseField Bool instance ParseField Double instance ParseField Float -instance ParseField Int instance ParseField Integer instance ParseField Ordering instance ParseField () instance ParseField Void +readIntegralBounded :: forall a. (Integral a, Bounded a, Typeable a) => ReadM a +readIntegralBounded = + auto >>= f + where + f i | i < lower = fail msg + | i > upper = fail msg + | otherwise = pure $ fromInteger i + lower = toInteger (minBound :: a) + upper = toInteger (maxBound :: a) + msg = map toUpper (show (Data.Typeable.typeOf (undefined :: a))) <> + " must be within the range [" <> + show lower <> " .. " <> show upper <> "]" + +instance ParseField Int where readField = readIntegralBounded +instance ParseField Int8 where readField = readIntegralBounded +instance ParseField Int16 where readField = readIntegralBounded +instance ParseField Int32 where readField = readIntegralBounded +instance ParseField Int64 where readField = readIntegralBounded +instance ParseField Word8 where readField = readIntegralBounded +instance ParseField Word16 where readField = readIntegralBounded +instance ParseField Word32 where readField = readIntegralBounded +instance ParseField Word64 where readField = readIntegralBounded + +#if MIN_VERSION_base(4,8,0) +instance ParseField Natural where + readField = + auto >>= f + where + f i | i < 0 = fail msg + | otherwise = pure $ fromInteger i + msg = "NATURAL cannot be negative" +#endif + instance ParseField String where parseField = parseHelpfulString "STRING" @@ -463,6 +505,7 @@ instance ParseField FilePath where parseField h m c = Filesystem.decodeString <$> parseHelpfulString "FILEPATH" h m c + readField = Options.str instance ParseField Data.Time.Calendar.Day where parseField h m c = do @@ -511,9 +554,17 @@ instance ParseFields Double instance ParseFields Float instance ParseFields Int +instance ParseFields Int8 +instance ParseFields Int16 +instance ParseFields Int32 +instance ParseFields Int64 instance ParseFields Integer instance ParseFields Ordering instance ParseFields Void +instance ParseFields Word8 +instance ParseFields Word16 +instance ParseFields Word32 +instance ParseFields Word64 instance ParseFields Data.ByteString.ByteString instance ParseFields Data.ByteString.Lazy.ByteString instance ParseFields Data.Text.Text @@ -521,6 +572,10 @@ instance ParseFields FilePath instance ParseFields Data.Time.Calendar.Day +#if MIN_VERSION_base(4,8,0) +instance ParseFields Natural +#endif + instance ParseFields Bool where parseFields h m c = case m of @@ -577,6 +632,7 @@ instance (ParseField a, KnownSymbol h) => ParseField (a h) where parseField _ m c = Helpful <$> parseField ((Just . Data.Text.pack .symbolVal) (Proxy :: Proxy h)) m c + readField = Helpful <$> readField instance (ParseFields a, KnownSymbol h) => ParseFields (a h) where parseFields _ m c = Helpful <$> @@ -629,9 +685,30 @@ parseRecord = fmap getOnly parseRecord instance ParseRecord Int where parseRecord = fmap getOnly parseRecord +instance ParseRecord Int8 where + parseRecord = fmap getOnly parseRecord +instance ParseRecord Int16 where + parseRecord = fmap getOnly parseRecord +instance ParseRecord Int32 where + parseRecord = fmap getOnly parseRecord +instance ParseRecord Int64 where + parseRecord = fmap getOnly parseRecord instance ParseRecord Ordering instance ParseRecord Void +instance ParseRecord Word8 where + parseRecord = fmap getOnly parseRecord +instance ParseRecord Word16 where + parseRecord = fmap getOnly parseRecord +instance ParseRecord Word32 where + parseRecord = fmap getOnly parseRecord +instance ParseRecord Word64 where + parseRecord = fmap getOnly parseRecord instance ParseRecord () + +#if MIN_VERSION_base(4,8,0) +instance ParseRecord Natural where + parseRecord = fmap getOnly parseRecord +#endif instance ParseRecord Bool where parseRecord = fmap getOnly parseRecord