Topic/remove plus

src/Options/Applicative/BashCompletion.purs

@@ -13,7 +13,7 @@ import Data.Array as Array
 import Data.Array.NonEmpty as NEA
 import Data.Either (Either(..))
 import Data.Exists (runExists)
-import Data.Foldable (fold, oneOf)
+import Data.Foldable (fold)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
 import Data.List as List
@@ -52,8 +52,8 @@ bashCompletionParser pinfo pprefs = complParser
     failure opts = CompletionResult
       { execCompletion: \progn -> unLines <$> opts progn }
 
-    complParser = oneOf
-      [ failure <$>
+    complParser =
+      ( failure <$>
         (  bashCompletionQuery pinfo pprefs
         -- To get rich completions, one just needs the first
         -- command. To customise the lengths, use either of
@@ -68,16 +68,16 @@ bashCompletionParser pinfo pprefs = complParser
         <*> (map Array.fromFoldable <<< many <<< strOption) (long "bash-completion-word"
                                   `append` internal)
         <*> option int (long "bash-completion-index" `append` internal) )
-      , failure <$>
+      ) <|> failure <$>
           (bashCompletionScript <$>
             strOption (long "bash-completion-script" `append` internal))
-      , failure <$>
+        <|> failure <$>
           (fishCompletionScript <$>
             strOption (long "fish-completion-script" `append` internal))
-      , failure <$>
+        <|> failure <$>
           (zshCompletionScript <$>
             strOption (long "zsh-completion-script" `append` internal))
-      ]
+
 
 bashCompletionQuery :: forall a. ParserInfo a -> ParserPrefs -> Richness -> Array String -> Int -> String -> Effect (Array String)
 bashCompletionQuery pinfo pprefs richness ws i _ = case runCompletion compl pprefs of

src/Options/Applicative/Builder/Internal.purs

@@ -27,7 +27,6 @@ import Prelude
 import Options.Applicative.Common (liftOpt)
 import Options.Applicative.Types (Completer, OptName, OptProperties(..), OptReader, OptVisibility(..), Option(..), ParseError, Parser, ParserInfo)
 import Control.Alt (alt)
-import Control.Plus (empty)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (class Newtype, over)
 import Data.Tuple (Tuple, fst, lookup)
@@ -169,9 +168,11 @@ mkParser :: forall a. DefaultProp a
          -> (OptProperties -> OptProperties)
          -> OptReader a
          -> Parser a
-mkParser d@(DefaultProp def _) g rdr = liftOpt opt `alt` maybe empty pure def
-  where
-    opt = mkOption d g rdr
+mkParser d@(DefaultProp def _) g rdr =
+  let
+    o = liftOpt $ mkOption d g rdr
+  in
+    maybe o (\a -> o `alt` pure a) def
 
 mkOption :: forall a. DefaultProp a
          -> (OptProperties -> OptProperties)

src/Options/Applicative/Common.purs

@@ -189,7 +189,7 @@ runParser policy isCmdStart p args = case args of
     prefs <- getPrefs
     (Tuple mp' args') <- do_step prefs arg argt
     case mp' of
-      Nothing -> hoistMaybe result <|> parseError arg p
+      Nothing -> hoistMaybe (unexpectedError arg p) result
       Just p' -> runParser (newPolicy arg) CmdCont p' args'
   where
     result = (Tuple) <$> evalParser p <*> pure args
@@ -201,8 +201,8 @@ runParser policy isCmdStart p args = case args of
       NoIntersperse -> if isJust (parseWord a) then NoIntersperse else AllPositionals
       x             -> x
 
-parseError :: forall m x a. MonadP m => String -> Parser x -> m a
-parseError arg p = errorP $ UnexpectedError arg $ SomeParser $ mkExists p
+unexpectedError :: forall x. String -> Parser x -> ParseError
+unexpectedError arg p = UnexpectedError arg $ SomeParser $ mkExists p
 
 runParserInfo :: forall m a. MonadP m => ParserInfo a -> Args -> m a
 runParserInfo i = runParserFully (un ParserInfo i).infoPolicy (un ParserInfo i).infoParser
@@ -212,12 +212,12 @@ runParserFully policy p args = do
   (Tuple r args') <- runParser policy CmdStart p args
   case args' of
     List.Nil -> pure r
-    List.Cons head _ -> parseError head (pure unit)
+    List.Cons head _ -> errorP $ unexpectedError head (pure unit)
 
 -- | The default value of a 'Parser'.  This function returns an error if any of
 -- | the options don't have a default value.
 evalParser :: forall a. Parser a -> Maybe a
-evalParser (NilP r) = r
+evalParser (NilP r) = Just r
 evalParser (OptP _) = Nothing
 evalParser (MultP e) = runExists (\(MultPE p1 p2) -> evalParser p1 <*> evalParser p2) e
 evalParser (AltP p1 p2) = evalParser p1 <|> evalParser p2

src/Options/Applicative/Extra.purs

@@ -170,7 +170,6 @@ parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn ->
   where
     exit_code = case msg of
       ErrorMsg _        -> (un ParserInfo pinfo).infoFailureCode
-      UnknownError       -> (un ParserInfo pinfo).infoFailureCode
       MissingError _ _    -> (un ParserInfo pinfo).infoFailureCode
       ExpectsArgError _ -> (un ParserInfo pinfo).infoFailureCode
       UnexpectedError _ _ -> (un ParserInfo pinfo).infoFailureCode
@@ -225,10 +224,6 @@ parserFailure pprefs pinfo msg ctx = ParserFailure $ \progn ->
               else "Invalid argument `" <> arg <> "'"
           in stringChunk msg'
 
-      UnknownError
-        -> mempty
-
-
     suggestion_help = suggestionsHelp $ case msg of
       UnexpectedError arg (SomeParser x)
         --

src/Options/Applicative/Internal.purs

@@ -53,7 +53,7 @@ import Data.Tuple (Tuple(..))
 import Options.Applicative.Types (ArgPolicy, Completer, Context(..), IsCmdStart, ParseError(..), Parser, ParserInfo, ParserPrefs, ReadM(..), SomeParser(..))
 import Options.Applicative.Types (ParseError(..)) as Reexport
 
-class (MonadPlus m) <= MonadP (m :: Type -> Type) where
+class (Monad m, Alt m) <= MonadP (m :: Type -> Type) where
   enterContext :: forall a. String -> ParserInfo a -> m Unit
   exitContext :: m Unit
   getPrefs :: m ParserPrefs
@@ -75,20 +75,11 @@ instance pApplicative :: Applicative P where
 instance pAlt :: Alt P where
   alt (P x) (P y) = P $ x `alt` y
 
-instance pPlus :: Plus P where
-  empty = P empty
-
-instance pAlternative :: Alternative P
-
 instance pBind :: Bind P where
   bind (P x) k = P $ x >>= \a -> case k a of P y -> y
 
 instance pMonad :: Monad P
 
-instance pMonadZero :: MonadZero P
-
-instance pMonadPlus :: MonadPlus P
-
 contextNames :: Array Context -> Array String
 contextNames ns =
   let go (Context n _) = n
@@ -103,8 +94,8 @@ instance pMonadP :: MonadP P where
   exitP i _ p = P <<< maybe (throwError <<< MissingError i <<< SomeParser $ mkExists p) pure
   errorP = P <<< throwError
 
-hoistMaybe :: forall a m. MonadPlus m => Maybe a -> m a
-hoistMaybe = maybe empty pure
+hoistMaybe :: forall a m. MonadP m => ParseError -> Maybe a -> m a
+hoistMaybe err = maybe (errorP err) pure
 
 hoistEither :: forall a m. MonadP m => Either ParseError a -> m a
 hoistEither = either errorP pure
@@ -160,18 +151,12 @@ instance completionApplicative :: Applicative Completion where
 
 instance completionAlt :: Alt Completion where
   alt (Completion x) (Completion y) = Completion $ x `alt` y
-instance completionPlus :: Plus Completion where
-  empty = Completion empty
-instance completionAlternative :: Alternative Completion
 
 instance completionBind :: Bind Completion where
   bind (Completion x) k = Completion $ x >>= \a -> case k a of Completion y -> y
 
 instance completionMonad :: Monad Completion
 
-instance completionMonadZero :: MonadZero Completion
-instance completionMonadPlus :: MonadPlus Completion
-
 instance completionMonadP :: MonadP Completion where
   enterContext _ _ = pure unit
   exitContext = pure unit

src/Options/Applicative/Types.purs

@@ -38,19 +38,19 @@ module Options.Applicative.Types (
   optShowDefault,
   optDescMod,
   many,
-  some
+  some,
+  optional
   ) where
 
 import Prelude
 
-import Control.Alternative (class Alt, class Alternative, class Plus, alt, empty, (<|>))
+import Control.Alternative (class Alt, alt, (<|>))
 import Control.Monad.Except (Except)
 import Control.Monad.Except.Trans (class MonadThrow, throwError)
 import Control.Monad.Free (Free, liftF)
 import Control.Monad.Reader.Trans (ReaderT, ask)
 import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
 import Control.Monad.Trans.Class (lift)
-import Control.MonadPlus (class MonadPlus, class MonadZero)
 import Data.Bifunctor (bimap)
 import Data.Exists (Exists, mkExists, runExists)
 import Data.Generic.Rep (class Generic)
@@ -74,7 +74,6 @@ data ParseError
   = ErrorMsg String
   | InfoMsg String
   | ShowHelpText
-  | UnknownError
   | MissingError IsCmdStart SomeParser
   | ExpectsArgError String
   | UnexpectedError String SomeParser
@@ -83,12 +82,7 @@ derive instance isCmdStartGeneric :: Generic IsCmdStart _
 instance isCmdStartShow :: Show IsCmdStart where show = genericShow
 data IsCmdStart = CmdStart | CmdCont
 
-
-instance parseErrorMonoid :: Monoid ParseError where
-  mempty = UnknownError
-
 instance parseErrorSemigroup :: Semigroup ParseError where
-  append m UnknownError = m
   append _ m = m
 
 
@@ -228,11 +222,6 @@ instance readMApplicative :: Applicative ReadM where
 instance readMAlt :: Alt ReadM where
   alt (ReadM x) (ReadM y) = ReadM $ alt x y
 
-instance readMPlus :: Plus ReadM where
-  empty = ReadM empty
-
-instance readMAlternative :: Alternative ReadM
-
 instance readMBind :: Bind ReadM where
   bind (ReadM r) f = ReadM $ r >>= un ReadM <<< f
 
@@ -241,9 +230,6 @@ instance readMMonad :: Monad ReadM
 instance readMMonadFail :: MonadThrow String ReadM where
   throwError = readerError
 
-instance readMMonadZero :: MonadZero ReadM
-instance readMMonadPlus :: MonadPlus ReadM
-
 -- | Return the value being read.
 readerAsk :: ReadM String
 readerAsk = ReadM ask
@@ -320,7 +306,7 @@ instance optReaderFunctor :: Functor OptReader where
 -- |
 -- | creates a parser for an option called \"output\".
 data Parser a
-  = NilP (Maybe a)
+  = NilP a
   | OptP (Option a)
   | MultP (Exists (MultPE a))
   | AltP (Parser a) (Parser a)
@@ -329,7 +315,7 @@ data Parser a
 data MultPE a x = MultPE (Parser (x -> a)) (Parser x)
 
 instance parserFunctor :: Functor Parser where
-  map f (NilP x) = NilP (map f x)
+  map f (NilP x) = NilP (f x)
   map f (OptP opt) = OptP (map f opt)
   map f (MultP e) = runExists (\(MultPE p1 p2) -> MultP $ mkExists $ MultPE (map (f <<< _) p1) p2) e
   map f (AltP p1 p2) = AltP (map f p1) (map f p2)
@@ -339,16 +325,11 @@ instance parserApply :: Apply Parser where
   apply a b = MultP (mkExists (MultPE a b))
 
 instance parserApplicative :: Applicative Parser where
-  pure = NilP <<< Just
+  pure = NilP
 
 instance parserAlt :: Alt Parser where
   alt = AltP
 
-instance parserPlus :: Plus Parser where
-  empty = NilP Nothing
-
-instance parserAlternative :: Alternative Parser
-
 newtype ParserM a = ParserM (Free Parser a)
 
 derive newtype instance parserMFunctor :: Functor ParserM
@@ -419,6 +400,9 @@ many = manyM >>> fromM
 some :: forall a. Parser a -> Parser (NonEmptyList a)
 some = someM >>> fromM
 
+optional :: forall f a. Alt f => Applicative f => f a -> f (Maybe a)
+optional a = map Just a <|> pure Nothing
+
 -- | optparse-applicative supplies a rich completion system for bash,
 -- | zsh, and fish shells.
 -- |

test/Main.purs

@@ -7,15 +7,14 @@ import Control.Lazy (defer)
 import Control.Monad.Gen (class MonadGen, chooseFloat, chooseInt, suchThat)
 import Control.Monad.Gen.Common (genMaybe)
 import Control.Monad.Rec.Class (class MonadRec)
-import Control.MonadZero (guard)
 import Data.Array (fold, foldl, replicate)
 import Data.Array as Array
 import Data.Char.Gen (genUnicodeChar)
 import Data.Either (Either(..))
 import Data.Foldable (elem)
 import Data.Int (even, odd)
 import Data.List as List
-import Data.Maybe (Maybe(..), fromMaybe, isJust, optional)
+import Data.Maybe (Maybe(..), fromMaybe, isJust)
 import Data.String (Pattern)
 import Data.String as String
 import Data.String.CodeUnits (toCharArray)
@@ -35,7 +34,7 @@ import ExitCodes as ExitCode
 import Options.Applicative (argument, briefDesc, columns, command, completeWith, defaultPrefs, disambiguate, execParserPure, flag', forwardOptions, header, help, (<**>), helper, hidden, info, int, long, metavar, noBacktrack, noIntersperse, option, prefs, progDesc, renderFailure, short, showDefault, showHelpOnEmpty, showHelpOnError, str, strArgument, strOption, subparser, subparserInline, switch, value)
 import Options.Applicative.Help (Chunk(..), editDistance, extractChunk, isEmpty, listToChunk, paragraph, stringChunk)
 import Options.Applicative.Internal.Utils (lines, words)
-import Options.Applicative.Types (CompletionResult(..), ParserFailure, ParserHelp, ParserInfo, ParserPrefs, ParserResult(..), ReadM, many, readerAsk, readerError, some)
+import Options.Applicative.Types (CompletionResult(..), ParserFailure, ParserHelp, ParserInfo, ParserPrefs, ParserResult(..), ReadM, many, readerAsk, readerError, some, optional)
 import Test.QuickCheck ((<?>), (===))
 import Test.QuickCheck as QC
 import Test.QuickCheck.Gen (Gen)
@@ -85,7 +84,7 @@ assertCompletion x f = case x of
     pure $ f completions
   Failure _   -> pure $ counterExample "unexpected failure"
   Success val -> pure $ counterExample ("unexpected result " <> show val)
-  
+
 assertHasLine :: String -> String -> QC.Result
 assertHasLine l s = l `elem` lines s <?> ("expected line:\n\t" <> l <> "\nnot found")
 
@@ -95,8 +94,10 @@ isInfixOf p = String.indexOf p >>> isJust
 condr :: (Int -> Boolean) -> ReadM Int
 condr f = do
   x <- int
-  guard (f x)
-  pure x
+  if (f x) then
+    pure x
+  else
+    readerError "oh no"
 
 type Asset = { name :: String, msg :: String }