harg 0.1.3.0 → 0.2.0.0

raw patch · 12 files changed

+170/−171 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.lhs +1/−0
• README.md +1/−0
• harg.cabal +1/−1
• src/Options/Harg/Cmdline.hs +24/−24
• src/Options/Harg/Config.hs +13/−14
• src/Options/Harg/Operations.hs +69/−51
• src/Options/Harg/Pretty.hs +5/−25
• src/Options/Harg/Sources/JSON.hs +21/−22
• src/Options/Harg/Sources/YAML.hs +16/−16
• src/Options/Harg/Subcommands.hs +8/−12
• src/Options/Harg/Util.hs +5/−6

@@ -1,5 +1,11 @@ # Changelog for harg +## 0.2.0.0 [2019.09.06]++- Trigger a parser failure when any option in the sources fails to parse+  NOTE: this introduces a breaking change, in that some parsers that failed silently+        and selected the default (if applicable) will now fail.+ ## 0.1.3.0 [2019.08.28]  - Add `manyParser` to parse list of options separated by delimiter

@@ -756,6 +756,7 @@  - Better errors using `optparse-applicative`'s internals - Allow user to pass `optparse-applicative` preferences+- Write tests - ~~Be able to provide and get back the same type for multiple subcommands~~ - ~~Integrate config files (e.g. JSON using aeson)~~ 

@@ -756,6 +756,7 @@  - Better errors using `optparse-applicative`'s internals - Allow user to pass `optparse-applicative` preferences+- Write tests - ~~Be able to provide and get back the same type for multiple subcommands~~ - ~~Integrate config files (e.g. JSON using aeson)~~ 

@@ -1,7 +1,7 @@ cabal-version: 2.2  name:           harg-version:        0.1.3.0+version:        0.2.0.0 synopsis:       Haskell program configuration using higher kinded data description:    Please see the README on GitHub at <https://github.com/alexpeits/harg#readme> homepage:       https://github.com/alexpeits/harg

@@ -25,13 +25,13 @@   -> a (Compose Opt f)      -- ^ Target configuration options   -> Optparse.Parser (a f) mkOptparseParser sources opts-  = let-      srcOpts-        = foldl'-            (B.bzipWith (<|>))-            (B.bmap (const (Compose Nothing)) opts)-            sources-    in B.bsequence $ B.bzipWith mkParser srcOpts opts+  = B.bsequence $ B.bzipWith mkParser srcOpts opts+  where+    srcOpts+      = foldl'+          (B.bzipWith (<|>))+          (B.bmap (const (Compose Nothing)) opts)+          sources  -- | Create a 'Optparse.Parser' for a single option, using the accumulated -- source results.@@ -70,23 +70,23 @@   -> f a   -> Compose Optparse.Parser f a toFlagParser sources (Compose opt@Opt{..}) active-  =-    let-      mDef-        = case getCompose sources of-            Nothing -> _optDefault-            Just x  -> Just x-      modifiers-        = foldMap (fromMaybe mempty)-            [ Optparse.long <$> _optLong-            , Optparse.short <$> _optShort-            , Optparse.help <$> ppHelp opt-            ]-      in Compose $ case mDef of-           Nothing ->-             Optparse.flag' active modifiers-           Just def ->-             Optparse.flag def active modifiers+  = Compose+    $ case mDef of+        Nothing ->+          Optparse.flag' active modifiers+        Just def ->+          Optparse.flag def active modifiers+  where+    mDef+      = case getCompose sources of+          Nothing -> _optDefault+          Just x  -> Just x+    modifiers+      = foldMap (fromMaybe mempty)+          [ Optparse.long <$> _optLong+          , Optparse.short <$> _optShort+          , Optparse.help <$> ppHelp opt+          ]  -- | Create a 'Optparse.Parser' for a 'ArgumentOpt', which results in an -- @optparse-applicative@ 'Optparse.argument'.

@@ -25,11 +25,11 @@   -> c (Compose Opt f)   -> Optparse.Parser (c f) mkConfigParser HargCtx{..} conf-  = let-      (_, envC)-        = accumSourceResults+  = mkOptparseParser envC conf+  where+    (_, envC)+      = accumSourceResults         $ runSource (EnvSourceVal _hcEnv) conf-    in mkOptparseParser envC conf  -- | Run two option parsers in parallel and return the result of the -- first one. This is used with the configuration parser being the first@@ -41,13 +41,12 @@   -> Optparse.Parser (c (f :: Type -> Type))   -> Optparse.Parser (a (g :: Type -> Type))   -> IO (c f)-getConfig HargCtx{..} confParser optParser-  = do-      let-        parser-          = (,) <$> confParser <*> optParser-        parserInfo-          = Optparse.info (Optparse.helper <*> parser) mempty-        res-          = Optparse.execParserPure Optparse.defaultPrefs parserInfo _hcArgs-      fst <$> Optparse.handleParseResult res+getConfig HargCtx{..} confParser optParser = do+  let+    parser+      = (,) <$> confParser <*> optParser+    parserInfo+      = Optparse.info (Optparse.helper <*> parser) mempty+    res+      = Optparse.execParserPure Optparse.defaultPrefs parserInfo _hcArgs+  fst <$> Optparse.handleParseResult res

@@ -17,7 +17,7 @@ import           Options.Harg.Het.HList          (AssocListF, MapAssocList(..)) import           Options.Harg.Het.Prod           ((:*)(..)) import           Options.Harg.Het.Variant        (VariantF)-import           Options.Harg.Pretty             (ppWarning, ppError)+import           Options.Harg.Pretty             (ppOptErrors) import           Options.Harg.Sources            ( accumSourceResults                                                  , DefaultSources, defaultSources                                                  , HiddenSources, hiddenSources@@ -27,7 +27,6 @@ import           Options.Harg.Types              (HargCtx(..), getCtx, Opt, OptError) import           Options.Harg.Util               (toDummyOpts, allToDummyOpts, compose) - -- | Run the option parser and combine with values from the specified sources, -- passing the context explicitly. execOptWithCtx@@ -43,21 +42,27 @@   -> c Opt    -- ^ Source options   -> a Opt    -- ^ Target configuration options   -> IO (a Identity)-execOptWithCtx ctx conf opts-  = do-      let-        configParser = mkConfigParser ctx $ compose Identity (conf :* hiddenSources)-        dummyParser = mkOptparseParser [] (toDummyOpts @String opts)-      config <- getConfig ctx configParser dummyParser-      sourceVals <- getSource ctx config-      let-        (errs, sources)-          = accumSourceResults-          $ runSource sourceVals (compose Identity opts)-        parser-          = mkOptparseParser sources (compose Identity opts)-      (res, _) <- execParser ctx ((,) <$> parser <*> configParser) errs-      pure res+execOptWithCtx ctx conf opts = do+  let+    configParser+      = mkConfigParser ctx $ compose Identity (conf :* hiddenSources)+    dummyParser+      = mkOptparseParser [] (toDummyOpts @String opts)+  config <- getConfig ctx configParser dummyParser+  sourceVals <- getSource ctx config+  let+    (errs, sources)+      = accumSourceResults+        $ runSource sourceVals (compose Identity opts)+    optParser+      = mkOptparseParser sources (compose Identity opts)+    -- parser that includes the configuration options, otherwise parsing+    -- will find more options and fail+    allParser+      = (,) <$> optParser <*> configParser+  fst <$> if null errs+          then execParser ctx allParser+          else failParser allParser errs  -- | Run the option parser and combine with values from the specified sources execOpt@@ -72,10 +77,9 @@   => c Opt  -- ^ Source options   -> a Opt  -- ^ Target configuration options   -> IO (a Identity)-execOpt conf opts-  = do-      ctx <- getCtx-      execOptWithCtx ctx conf opts+execOpt conf opts = do+  ctx <- getCtx+  execOptWithCtx ctx conf opts  -- | Run the option parser only with default sources (environment variables), -- passing the context explicitly.@@ -118,25 +122,30 @@   -> c Opt    -- ^ Source options   -> AssocListF ts xs Opt  -- ^ Target options associated with subcommands   -> IO (VariantF xs Identity)-execCommandsWithCtx ctx conf opts-  = do-      let-        configParser = mkConfigParser ctx $ compose Identity (conf :* hiddenSources)-        (_, dummyCommands)-          = mapSubcommand () (allToDummyOpts @String opts)-        dummyParser-          = Optparse.subparser (mconcat dummyCommands)+execCommandsWithCtx ctx conf opts = do+  let+    configParser+      = mkConfigParser ctx $ compose Identity (conf :* hiddenSources)+    (_, dummyCommands)+      = mapSubcommand () (allToDummyOpts @String opts)+    dummyParser+      = Optparse.subparser (mconcat dummyCommands) -      config <- getConfig ctx configParser dummyParser-      sourceVals <- getSource ctx config+  config <- getConfig ctx configParser dummyParser+  sourceVals <- getSource ctx config -      let-        (errs, commands)-          = mapSubcommand sourceVals (mapAssocList (compose Identity) opts)-        parser-          = Optparse.subparser (mconcat commands)-      (res, _) <- execParser ctx ((,) <$> parser <*> configParser) errs-      pure res+  let+    (errs, commands)+      = mapSubcommand sourceVals (mapAssocList (compose Identity) opts)+    optParser+      = Optparse.subparser (mconcat commands)+    -- parser that includes the configuration options, otherwise parsing+    -- will find more options and fail+    allParser+      = (,) <$> optParser <*> configParser+  fst <$> if null errs+          then execParser ctx allParser+          else failParser allParser errs  -- | Run the subcommand parser and combine with values from the specified -- sources@@ -154,10 +163,9 @@   => c Opt  -- ^ Source options   -> AssocListF ts xs Opt  -- ^ Target options associated with subcommands   -> IO (VariantF xs Identity)-execCommands conf opts-  = do-      ctx <- getCtx-      execCommandsWithCtx ctx conf opts+execCommands conf opts = do+  ctx <- getCtx+  execCommandsWithCtx ctx conf opts  -- | Run the subcommand parser only with default sources (environment -- variables), passing the context explicitly.@@ -195,17 +203,27 @@ execParser   :: HargCtx   -> Optparse.Parser a+  -> IO a+execParser HargCtx{..} parser+  = Optparse.handleParseResult (execParserPure _hcArgs parser)++failParser+  :: Optparse.Parser a   -> [OptError]   -> IO a-execParser HargCtx{..} parser errs-  = do-      let-        res = execParserPure _hcArgs parser-      case res of-        Optparse.Success a-          -> ppWarning errs >> pure a-        _-          -> ppError errs >> Optparse.handleParseResult res+failParser parser errs+  = Optparse.handleParseResult (Optparse.Failure failure)+  where+    failure+      = Optparse.parserFailure+          Optparse.defaultPrefs+          parserInfo+          (Optparse.ErrorMsg errStr)+          []+    parserInfo+      = Optparse.info (Optparse.helper <*> parser) Optparse.forwardOptions+    errStr+      = ppOptErrors errs  -- | Run the optparse-applicative parser and return the -- 'Optparse.ParserResult'

@@ -12,32 +12,11 @@ ppHelp Opt{..}   = (<> ppEnvVar _optEnvVar) <$> _optHelp -ppWarning-  :: [OptError]-  -> IO ()-ppWarning []-  = pure ()-ppWarning err-  =  putStrLn "Parser succeeded with warnings:"-  >> ppOptErrors err-  >> putStrLn ""--ppError-  :: [OptError]-  -> IO ()-ppError []-  = pure ()-ppError err-  =  putStrLn "Parser errors:"-  >> ppOptErrors err-  >> putStrLn ""- ppOptErrors   :: [OptError]-  -> IO ()+  -> String ppOptErrors-  = putStrLn-  . intercalate "\n"+  = intercalate "\n\n"   . map ppOptError   . nubBy cmpOptErr   where@@ -45,10 +24,11 @@       =  _optLong l == _optLong r && sl == sr && dl == dr     ppOptError :: OptError -> String     ppOptError (OptError (SomeOpt opt) src desc)-      =  "\t"+      =  "option "       <> fromMaybe "<no opt name>" (_optLong opt)-      <> "\t\t"+      <> ": "       <> desc+      <> "\n\t"       <> ppSource src       <> ppEnvVar (_optEnvVar opt) 

@@ -28,15 +28,14 @@  instance GetSource JSONSource Identity where   type SourceVal JSONSource = JSONSourceVal-  getSource _ctx (JSONSource (Identity (ConfigFile path)))-    = do-        contents <- readFileLBS path-        case JSON.eitherDecode contents of-          Right json-            -> pure $ JSONSourceVal json-          Left err-            -> printErrAndExit-               $ "Error decoding " <> path <> " to JSON: " <> err+  getSource _ctx (JSONSource (Identity (ConfigFile path))) = do+    contents <- readFileLBS path+    case JSON.eitherDecode contents of+      Right json+        -> pure $ JSONSourceVal json+      Left err+        -> printErrAndExit+            $ "Error decoding " <> path <> " to JSON: " <> err   getSource _ctx (JSONSource (Identity NoConfigFile))     = pure JSONSourceNotRequired @@ -59,16 +58,16 @@   -> a (Compose Opt f)   -> a (Compose SourceRunResult f) runJSONSource json opt-  = let-      res :: JSON.Result (a Maybe)-      res-        = JSON.fromJSON json-      toSuccess :: Maybe x -> Compose SourceRunResult f x-      toSuccess mx-        = Compose $ pure <$> maybe OptNotFound OptParsed mx-      toFailure :: Compose Opt f x -> Compose SourceRunResult f x-      toFailure _-        = Compose $ pure <$> OptNotFound-    in case res of-         JSON.Success v -> B.bmap toSuccess v-         JSON.Error _e  -> B.bmap toFailure opt+  = case res of+      JSON.Success v -> B.bmap toSuccess v+      JSON.Error _e  -> B.bmap toFailure opt+  where+    res :: JSON.Result (a Maybe)+    res+      = JSON.fromJSON json+    toSuccess :: Maybe x -> Compose SourceRunResult f x+    toSuccess mx+      = Compose $ pure <$> maybe OptNotFound OptParsed mx+    toFailure :: Compose Opt f x -> Compose SourceRunResult f x+    toFailure _+      = Compose $ pure <$> OptNotFound

@@ -55,20 +55,20 @@   -> a (Compose Opt f)   -> a (Compose SourceRunResult f) runYAMLSource yaml opt-  = let-      res :: Either YAML.ParseException (a Maybe)-      res-        = YAML.decodeEither' yaml-      toSuccess :: Maybe x -> Compose SourceRunResult f x-      toSuccess mx-        = Compose $ pure <$> maybe OptNotFound OptParsed mx-      toFailure-        :: YAML.ParseException-        -> Compose Opt f x-        -> Compose SourceRunResult f x-      toFailure exc (Compose o)-        = Compose+  = case res of+      Right v  -> B.bmap toSuccess v+      Left exc -> B.bmap (toFailure exc) opt+  where+    res :: Either YAML.ParseException (a Maybe)+    res+      = YAML.decodeEither' yaml+    toSuccess :: Maybe x -> Compose SourceRunResult f x+    toSuccess mx+      = Compose $ pure <$> maybe OptNotFound OptParsed mx+    toFailure+      :: YAML.ParseException+      -> Compose Opt f x+      -> Compose SourceRunResult f x+    toFailure exc (Compose o)+      = Compose         $ OptFoundNoParse (toOptError o (Just "YAMLSource") (displayException exc))-    in case res of-         Right v  -> B.bmap toSuccess v-         Left exc -> B.bmap (toFailure exc) opt

@@ -98,21 +98,17 @@     ) => ExplSubcommands n (t ': ts) (x ': xs) as where    explMapSubcommand n srcs (ACons opt opts)-    = let-        (errs, sc)-          = subcommand-        (errs', rest)-          = hgcastWith (proof @as @x @xs)+    = (thisErr ++ restErr, sc : rest)+    where+      (thisErr, sc)+        = subcommand+      (restErr, rest)+        = hgcastWith (proof @as @x @xs)           $ explMapSubcommand               @(S n) @ts @xs @(as ++ '[x])               (SS n) srcs opts--      in (errs ++ errs', sc : rest)--    where       subcommand         = let-            -- TODO: accumulate errors             (errs, src)               = accumSourceResults $ runSource srcs opt             parser@@ -121,6 +117,6 @@               = symbolVal (Proxy :: Proxy t)             cmd               = Optparse.command tag-              $ injectPosF n-              <$> Optparse.info (Optparse.helper <*> parser) mempty+                $ injectPosF n+                  <$> Optparse.info (Optparse.helper <*> parser) mempty           in (errs, cmd)

@@ -76,12 +76,11 @@   :: (FilePath -> IO a)   -> FilePath   -> IO a-readFileWith f path-  = do-      exists <- doesFileExist path-      if exists-        then readFile_-        else printErrAndExit ("File not found: " <> path)+readFileWith f path = do+  exists <- doesFileExist path+  if exists+    then readFile_+    else printErrAndExit ("File not found: " <> path)   where     readFile_       = f path