optparse-applicative 0.5 (fpco/stackage#27)
This commit is contained in:
parent
d9231ff5ad
commit
9886d0c5e7
@ -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
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user