optparse-applicative 0.5 (fpco/stackage#27)

This commit is contained in:
Michael Snoyman 2012-12-24 09:13:35 +02:00
parent d9231ff5ad
commit 9886d0c5e7
3 changed files with 20 additions and 3 deletions

View File

@ -1,5 +1,6 @@
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Options (injectDefaults) where
@ -69,8 +70,13 @@ injectDefaultP env path p@(OptP o)
let (Just parseri) = f cmd
in parseri { infoParser = injectDefaultP env (path ++ [normalizeName cmd]) (infoParser parseri) }
in OptP (Option (CmdReader cmds (`M.lookup` cmdMap)) props)
#if MIN_VERSION_optparse_applicative(0, 5, 0)
| (Option (OptReader names (CReader _ rdr) _) _) <- o =
p <|> either (const empty) pure (msum $ map (rdr <=< (maybe (Left $ ErrorMsg "Missing environment variable") Right . getEnvValue env path)) names)
#else
| (Option (OptReader names (CReader _ rdr)) _) <- o =
p <|> maybe empty pure (msum $ map (rdr <=< getEnvValue env path) names)
#endif
| (Option (FlagReader names a) _) <- o =
p <|> if any ((==Just "1") . getEnvValue env path) names then pure a else empty
| otherwise = p

View File

@ -17,6 +17,10 @@ import Options (injectDefaults)
import qualified Paths_yesod
import Scaffolding.Scaffolder
#if MIN_VERSION_optparse_applicative(0, 5, 0)
import Options.Applicative.Builder.Internal (Mod, OptionFields)
#endif
#ifndef WINDOWS
import Build (touch)
@ -156,7 +160,14 @@ extraCabalArgs = many (strOption ( long "extra-cabal-arg" <> short 'e' <> metava
-- | Optional @String@ argument
optStr :: Mod OptionFields (Maybe String) -> Parser (Maybe String)
optStr m = nullOption $ value Nothing <> reader (Just . str) <> m
optStr m =
nullOption $ value Nothing <> reader (success . str) <> m
where
#if MIN_VERSION_optparse_applicative(0, 5, 0)
success = Right
#else
success = Just
#endif
-- | Like @rawSystem@, but exits if it receives a non-success result.
rawSystem' :: String -> [String] -> IO ()

View File

@ -1,5 +1,5 @@
name: yesod
version: 1.1.7
version: 1.1.7.1
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -97,7 +97,7 @@ executable yesod
, system-fileio >= 0.3 && < 0.4
, unordered-containers
, yaml >= 0.8 && < 0.9
, optparse-applicative >= 0.4 && < 0.5
, optparse-applicative >= 0.4
, fsnotify >= 0.0 && < 0.1
, split >= 0.2 && < 0.3
, file-embed