haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

restore default options injection

Browse Source
This commit is contained in:
Luite Stegeman 2014-10-29 14:18:41 +01:00
parent 898c0a1e18
commit 87e06494ea
2 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
yesod-bin/Options.hs
View File

@ -7,6 +7,8 @@ module Options (injectDefaults) where
import Control.Applicative import Control.Applicative
import qualified Control.Exception as E import qualified Control.Exception as E
import Control.Monad import Control.Monad
import Control.Monad.Trans.Except
import Control.Monad.Trans.Reader
import Data.Char (isAlphaNum, isSpace, toLower) import Data.Char (isAlphaNum, isSpace, toLower)
import Data.List (foldl') import Data.List (foldl')
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
@ -62,8 +64,6 @@ configLines = mapMaybe (mkLine . takeWhile (/='#')) . lines
-- the map contains the paths with the value that's passed into the reader if the -- the map contains the paths with the value that's passed into the reader if the
-- command line parser gives no result -- command line parser gives no result
injectDefaultP :: M.Map [String] String -> [String] -> Parser a -> Parser a injectDefaultP :: M.Map [String] String -> [String] -> Parser a -> Parser a
injectDefaultP _ _ = id
{- FIXME Disabled due to changes in optparse-applicative 0.11
injectDefaultP _env _path n@(NilP{}) = n injectDefaultP _env _path n@(NilP{}) = n
injectDefaultP env path p@(OptP o) injectDefaultP env path p@(OptP o)
| (Option (CmdReader cmds f) props) <- o = | (Option (CmdReader cmds f) props) <- o =
@ -73,20 +73,21 @@ injectDefaultP env path p@(OptP o)
in parseri { infoParser = injectDefaultP env (path ++ [normalizeName cmd]) (infoParser parseri) } in parseri { infoParser = injectDefaultP env (path ++ [normalizeName cmd]) (infoParser parseri) }
in OptP (Option (CmdReader cmds (`M.lookup` cmdMap)) props) in OptP (Option (CmdReader cmds (`M.lookup` cmdMap)) props)
| (Option (OptReader names (CReader _ rdr) _) _) <- o = | (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) p <|> either (const empty)
pure
(runExcept . msum $
map (maybe (throwE $ ErrorMsg "Missing environment variable")
(runReaderT (unReadM rdr))
. getEnvValue env path)
names)
| (Option (FlagReader names a) _) <- o = | (Option (FlagReader names a) _) <- o =
p <|> if any ((==Just "1") . getEnvValue env path) names then pure a else empty p <|> if any ((==Just "1") . getEnvValue env path) names then pure a else empty
| otherwise = p | otherwise = p
where
right= ReadM . Right
left = ReadM . Left
either' f g (ReadM x) = either f g x
injectDefaultP env path (MultP p1 p2) = injectDefaultP env path (MultP p1 p2) =
MultP (injectDefaultP env path p1) (injectDefaultP env path p2) MultP (injectDefaultP env path p1) (injectDefaultP env path p2)
injectDefaultP env path (AltP p1 p2) = injectDefaultP env path (AltP p1 p2) =
AltP (injectDefaultP env path p1) (injectDefaultP env path p2) AltP (injectDefaultP env path p1) (injectDefaultP env path p2)
injectDefaultP _env _path b@(BindP {}) = b injectDefaultP _env _path b@(BindP {}) = b
-}
getEnvValue :: M.Map [String] String -> [String] -> OptName -> Maybe String getEnvValue :: M.Map [String] String -> [String] -> OptName -> Maybe String
getEnvValue env path (OptLong l) = M.lookup (path ++ [normalizeName l]) env getEnvValue env path (OptLong l) = M.lookup (path ++ [normalizeName l]) env

1
yesod-bin/yesod-bin.cabal
View File

@ -84,6 +84,7 @@ executable yesod
, http-conduit >= 2.1.4 , http-conduit >= 2.1.4
, project-template >= 0.1.1 , project-template >= 0.1.1
, transformers , transformers
, transformers-compat
, warp >= 1.3.7.5 , warp >= 1.3.7.5
, wai >= 1.4 , wai >= 1.4
, wai-extra , wai-extra