packages feed

repl-toolkit 0.5.0.0 → 1.0.0.0

raw patch · 11 files changed

+1769/−1362 lines, 11 filesdep −numericpeanodep ~aesondep ~basedep ~bytestringsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: numericpeano

Dependency ranges changed: aeson, base, bytestring, directory, exceptions, monad-loops, mtl, parsec, transformers

API changes (from Hackage documentation)

- System.REPL: AbortFailure :: AskFailure
- System.REPL: Asker :: Text -> Parser a -> (a -> m (Either Text ())) -> Asker m a
- System.REPL: NothingFoundFailure :: AskFailure
- System.REPL: ParamFailure :: Text -> AskFailure
- System.REPL: PredicateFailure :: PredicateErrorMsg -> AskFailure
- System.REPL: TypeFailure :: TypeErrorMsg -> AskFailure
- System.REPL: Verbatim :: Text -> Verbatim
- System.REPL: ask :: (MonadIO m, MonadCatch m, Functor m) => Asker m a -> Maybe Text -> m a
- System.REPL: ask' :: (MonadIO m, MonadCatch m, Functor m) => Asker m a -> m a
- System.REPL: askEither :: (MonadIO m, MonadCatch m, Functor m) => Asker m a -> Maybe Text -> m (Either AskFailure a)
- System.REPL: asker :: (Monad m, Functor m, Read a) => PromptMsg -> TypeErrorMsg -> PredicateErrorMsg -> Predicate m a -> Asker m a
- System.REPL: askerP :: (Monad m, Functor m) => PromptMsg -> PredicateErrorMsg -> Parser a -> Predicate m a -> Asker m a
- System.REPL: askerParser :: Asker m a -> Parser a
- System.REPL: askerPredicate :: Asker m a -> a -> m (Either Text ())
- System.REPL: askerPrompt :: Asker m a -> Text
- System.REPL: data AskFailure
- System.REPL: data Asker m a
- System.REPL: fromVerbatim :: Verbatim -> Text
- System.REPL: instance Eq AskFailure
- System.REPL: instance Exception AskFailure
- System.REPL: instance Read Verbatim
- System.REPL: instance Show AskFailure
- System.REPL: instance Typeable AskFailure
- System.REPL: maybeAsker :: (Monad m, Functor m, Read a) => PromptMsg -> TypeErrorMsg -> PredicateErrorMsg -> Predicate m a -> Asker m (Maybe a)
- System.REPL: maybeAskerP :: (Monad m, Functor m) => PromptMsg -> PredicateErrorMsg -> Parser a -> Predicate m a -> Asker m (Maybe a)
- System.REPL: newtype Verbatim
- System.REPL: predAsker :: (Monad m, Functor m) => PromptMsg -> Text -> (Text -> m Bool) -> Asker m Verbatim
- System.REPL: prompt :: (MonadIO m, ListLikeIO full item) => m full
- System.REPL: prompt' :: (MonadIO m, ListLikeIO full item, ListLikeIO full' item') => full -> m full'
- System.REPL: promptAbort :: (MonadIO m, ListLikeIO full item, ListLikeIO full' Char, MonadCatch m) => Char -> full -> m full'
- System.REPL: putErr :: ListLikeIO full item => full -> IO ()
- System.REPL: putErrLn :: ListLikeIO full item => full -> IO ()
- System.REPL: readParser :: Read a => TypeErrorMsg -> Text -> (Either Text a)
- System.REPL: type Parser a = Text -> Either Text a
- System.REPL: type Predicate m a = a -> m Bool
- System.REPL: type PredicateErrorMsg = Text
- System.REPL: type PromptMsg = Text
- System.REPL: type TypeErrorMsg = Text
- System.REPL: typeAsker :: (Monad m, Functor m, Read a) => PromptMsg -> TypeErrorMsg -> Asker m a
- System.REPL: typeAskerP :: (Monad m, Functor m) => PromptMsg -> Parser a -> Asker m a
- System.REPL: untilValid :: (MonadIO m, MonadCatch m, Functor m, Read a) => m a -> m a
- System.REPL.Command: commandDesc :: Command m i a -> Text
- System.REPL.Command: commandName :: Command m i a -> Text
- System.REPL.Command: commandTest :: Command m i a -> i -> Bool
- System.REPL.Command: instance (Functor m, Monad m) => Apply (Command m i)
- System.REPL.Command: instance (Functor m, Monad m) => Bind (Command m i)
- System.REPL.Command: instance Eq MalformedParamsError
- System.REPL.Command: instance Eq TooFewParamsError
- System.REPL.Command: instance Eq TooManyParamsError
- System.REPL.Command: instance Exception MalformedParamsError
- System.REPL.Command: instance Exception SomeCommandError
- System.REPL.Command: instance Exception TooFewParamsError
- System.REPL.Command: instance Exception TooManyParamsError
- System.REPL.Command: instance Functor m => Functor (Command m i)
- System.REPL.Command: instance Ord MalformedParamsError
- System.REPL.Command: instance Ord TooFewParamsError
- System.REPL.Command: instance Ord TooManyParamsError
- System.REPL.Command: instance Show MalformedParamsError
- System.REPL.Command: instance Show SomeCommandError
- System.REPL.Command: instance Show TooFewParamsError
- System.REPL.Command: instance Show TooManyParamsError
- System.REPL.Command: instance Typeable MalformedParamsError
- System.REPL.Command: instance Typeable SomeCommandError
- System.REPL.Command: instance Typeable TooFewParamsError
- System.REPL.Command: instance Typeable TooManyParamsError
- System.REPL.Command: runPartialCommand :: Command m i a -> [i] -> m (a, [i])
- System.REPL.Config: NoParseError :: Text -> NoParseError
- System.REPL.Config: data NoParseError
- System.REPL.Config: instance Eq NoParseError
- System.REPL.Config: instance Exception NoParseError
- System.REPL.Config: instance Read NoParseError
- System.REPL.Config: instance Show NoParseError
- System.REPL.Config: instance Typeable NoParseError
+ System.REPL.Ask: Asker :: Text -> Parser a -> Predicate m a b -> Asker m a b
+ System.REPL.Ask: AskerPredicateError :: SomeException -> AskerPredicateError
+ System.REPL.Ask: AskerTypeError :: SomeException -> AskerTypeError
+ System.REPL.Ask: GenericPredicateError :: Text -> GenericPredicateError
+ System.REPL.Ask: GenericTypeError :: Text -> GenericTypeError
+ System.REPL.Ask: PathIsNotWritable :: FilePath -> PathIsNotWritable
+ System.REPL.Ask: PathRootDoesNotExist :: FilePath -> PathRootDoesNotExist
+ System.REPL.Ask: SomeAskerError :: e -> SomeAskerError
+ System.REPL.Ask: SomeREPLError :: e -> SomeREPLError
+ System.REPL.Ask: Verbatim :: Text -> Verbatim
+ System.REPL.Ask: [askerParser] :: Asker m a b -> Parser a
+ System.REPL.Ask: [askerPredicate] :: Asker m a b -> Predicate m a b
+ System.REPL.Ask: [askerPrompt] :: Asker m a b -> Text
+ System.REPL.Ask: [fromVerbatim] :: Verbatim -> Text
+ System.REPL.Ask: ask :: (MonadIO m, MonadCatch m) => Asker m a b -> Maybe Text -> m b
+ System.REPL.Ask: ask' :: (MonadIO m, MonadCatch m) => Asker m a b -> m b
+ System.REPL.Ask: askEither :: (MonadIO m, MonadCatch m) => Asker m a b -> Maybe Text -> m (Either SomeAskerError b)
+ System.REPL.Ask: asker :: (Functor m, Read a) => PromptMsg -> (Text -> TypeError) -> Predicate' m a -> Asker' m a
+ System.REPL.Ask: boolPredicate :: Functor m => (a -> m Bool) -> (a -> PredicateError) -> Predicate' m a
+ System.REPL.Ask: data Asker m a b
+ System.REPL.Ask: data AskerPredicateError
+ System.REPL.Ask: data AskerTypeError
+ System.REPL.Ask: data GenericPredicateError
+ System.REPL.Ask: data GenericTypeError
+ System.REPL.Ask: data PathIsNotWritable
+ System.REPL.Ask: data PathRootDoesNotExist
+ System.REPL.Ask: data SomeAskerError
+ System.REPL.Ask: data SomeREPLError
+ System.REPL.Ask: filepathAsker :: MonadIO m => PromptMsg -> (FilePath -> TypeError) -> Predicate m (PathExistenceType, FilePath) b -> Asker m FilePath b
+ System.REPL.Ask: genericPredicateError :: Text -> SomeException
+ System.REPL.Ask: genericTypeError :: Text -> SomeException
+ System.REPL.Ask: lineAsker :: Applicative m => Asker' m Text
+ System.REPL.Ask: maybeAsker :: (Applicative m, Read a) => PromptMsg -> (Text -> TypeError) -> Predicate' m a -> Asker' m (Maybe a)
+ System.REPL.Ask: maybeAskerP :: Applicative m => PromptMsg -> Parser a -> Predicate m a b -> Asker m (Maybe a) (Maybe b)
+ System.REPL.Ask: newtype Verbatim
+ System.REPL.Ask: predAsker :: (Functor m) => PromptMsg -> Predicate m Text b -> Asker m Text b
+ System.REPL.Ask: readParser :: Read a => (Text -> TypeError) -> Parser a
+ System.REPL.Ask: type Asker' m a = Asker m a a
+ System.REPL.Ask: type Parser a = Text -> Either TypeError a
+ System.REPL.Ask: type Predicate m a b = a -> m (Either PredicateError b)
+ System.REPL.Ask: type Predicate' m a = Predicate m a a
+ System.REPL.Ask: type PredicateError = SomeException
+ System.REPL.Ask: type PromptMsg = Text
+ System.REPL.Ask: type TypeError = SomeException
+ System.REPL.Ask: typeAsker :: (Applicative m, Read a) => PromptMsg -> (Text -> TypeError) -> Asker' m a
+ System.REPL.Ask: typeAskerP :: Applicative m => PromptMsg -> Parser a -> Asker' m a
+ System.REPL.Ask: untilValid :: (MonadIO m, MonadCatch m, Read a) => m a -> m a
+ System.REPL.Ask: writablefilepathAsker :: MonadIO m => PromptMsg -> (FilePath -> TypeError) -> Predicate m (PathExistenceType, FilePath) b -> Asker m FilePath b
+ System.REPL.Command: SomeREPLError :: e -> SomeREPLError
+ System.REPL.Command: [commandDesc] :: Command m i a -> Text
+ System.REPL.Command: [commandName] :: Command m i a -> Text
+ System.REPL.Command: [commandTest] :: Command m i a -> i -> Bool
+ System.REPL.Command: [runPartialCommand] :: Command m i a -> [i] -> m (a, [i])
+ System.REPL.Command: data SomeREPLError
+ System.REPL.Command: defCommandTest :: [Text] -> Text -> Bool
+ System.REPL.Command: defErrorHandler :: MonadIO m => [Handler m ()]
+ System.REPL.Command: defExitCmd :: (MonadIO m, MonadCatch m) => Command m Text ()
+ System.REPL.Command: defHelpCmd :: (MonadIO m, MonadCatch m, Foldable f) => f (Command m0 a b) -> Command m Text ()
+ System.REPL.Command: makeREPLSimple :: (MonadIO m, MonadCatch m) => [Command m Text a] -> m ()
+ System.REPL.Command: noOpCmd :: (MonadIO m, MonadCatch m) => Text -> [Text] -> Command m Text ()
+ System.REPL.Command: runSingleCommandIf :: MonadThrow m => Command m Text a -> Text -> m (Maybe a)
+ System.REPL.Config: NoConfigFileParseError :: Text -> NoConfigFileParseError
+ System.REPL.Config: data NoConfigFileParseError
+ System.REPL.Prompt: prompt :: (MonadIO m, ListLikeIO full item) => m full
+ System.REPL.Prompt: prompt' :: (MonadIO m, ListLikeIO full item, ListLikeIO full' item') => full -> m full'
+ System.REPL.Prompt: promptAbort :: (MonadIO m, ListLikeIO full item, ListLikeIO full' Char, MonadCatch m) => Char -> full -> m full'
+ System.REPL.Prompt: putErr :: ListLikeIO full item => full -> IO ()
+ System.REPL.Prompt: putErrLn :: ListLikeIO full item => full -> IO ()
+ System.REPL.Types: Asker :: Text -> Parser a -> Predicate m a b -> Asker m a b
+ System.REPL.Types: AskerInputAbortedError :: AskerInputAbortedError
+ System.REPL.Types: AskerPredicateError :: SomeException -> AskerPredicateError
+ System.REPL.Types: AskerTypeError :: SomeException -> AskerTypeError
+ System.REPL.Types: Command :: Text -> (i -> Bool) -> Text -> ([i] -> m (a, [i])) -> Command m i a
+ System.REPL.Types: DoesNotExist :: PathExistenceType
+ System.REPL.Types: GenericPredicateError :: Text -> GenericPredicateError
+ System.REPL.Types: GenericTypeError :: Text -> GenericTypeError
+ System.REPL.Types: IsDirectory :: PathExistenceType
+ System.REPL.Types: IsFile :: PathExistenceType
+ System.REPL.Types: MalformedParamsError :: Text -> MalformedParamsError
+ System.REPL.Types: NoConfigFileParseError :: Text -> NoConfigFileParseError
+ System.REPL.Types: PathIsNotWritable :: FilePath -> PathIsNotWritable
+ System.REPL.Types: PathRootDoesNotExist :: FilePath -> PathRootDoesNotExist
+ System.REPL.Types: SomeAskerError :: e -> SomeAskerError
+ System.REPL.Types: SomeCommandError :: e -> SomeCommandError
+ System.REPL.Types: SomeREPLError :: e -> SomeREPLError
+ System.REPL.Types: TooFewParamsError :: Int -> Int -> TooFewParamsError
+ System.REPL.Types: TooManyParamsError :: Int -> Int -> TooManyParamsError
+ System.REPL.Types: Verbatim :: Text -> Verbatim
+ System.REPL.Types: [askerParser] :: Asker m a b -> Parser a
+ System.REPL.Types: [askerPredicate] :: Asker m a b -> Predicate m a b
+ System.REPL.Types: [askerPrompt] :: Asker m a b -> Text
+ System.REPL.Types: [commandDesc] :: Command m i a -> Text
+ System.REPL.Types: [commandName] :: Command m i a -> Text
+ System.REPL.Types: [commandTest] :: Command m i a -> i -> Bool
+ System.REPL.Types: [fromVerbatim] :: Verbatim -> Text
+ System.REPL.Types: [runPartialCommand] :: Command m i a -> [i] -> m (a, [i])
+ System.REPL.Types: askerErrorDowncast :: (Exception a) => SomeException -> Maybe a
+ System.REPL.Types: askerErrorUpcast :: (Exception a) => a -> SomeException
+ System.REPL.Types: commandErrorDowncast :: (Exception a) => SomeException -> Maybe a
+ System.REPL.Types: commandErrorUpcast :: (Exception a) => a -> SomeException
+ System.REPL.Types: data Asker m a b
+ System.REPL.Types: data AskerInputAbortedError
+ System.REPL.Types: data AskerPredicateError
+ System.REPL.Types: data AskerTypeError
+ System.REPL.Types: data Command m i a
+ System.REPL.Types: data GenericPredicateError
+ System.REPL.Types: data GenericTypeError
+ System.REPL.Types: data MalformedParamsError
+ System.REPL.Types: data NoConfigFileParseError
+ System.REPL.Types: data PathExistenceType
+ System.REPL.Types: data PathIsNotWritable
+ System.REPL.Types: data PathRootDoesNotExist
+ System.REPL.Types: data SomeAskerError
+ System.REPL.Types: data SomeCommandError
+ System.REPL.Types: data SomeREPLError
+ System.REPL.Types: data TooFewParamsError
+ System.REPL.Types: data TooManyParamsError
+ System.REPL.Types: genericPredicateError :: Text -> SomeException
+ System.REPL.Types: genericTypeError :: Text -> SomeException
+ System.REPL.Types: instance GHC.Base.Functor m => GHC.Base.Functor (System.REPL.Types.Command m i)
+ System.REPL.Types: instance GHC.Base.Monad m => Data.Functor.Bind.Class.Apply (System.REPL.Types.Command m i)
+ System.REPL.Types: instance GHC.Base.Monad m => Data.Functor.Bind.Class.Bind (System.REPL.Types.Command m i)
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.GenericPredicateError
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.GenericTypeError
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.MalformedParamsError
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.NoConfigFileParseError
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.PathExistenceType
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.PathIsNotWritable
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.PathRootDoesNotExist
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.TooFewParamsError
+ System.REPL.Types: instance GHC.Classes.Eq System.REPL.Types.TooManyParamsError
+ System.REPL.Types: instance GHC.Classes.Ord System.REPL.Types.MalformedParamsError
+ System.REPL.Types: instance GHC.Classes.Ord System.REPL.Types.PathExistenceType
+ System.REPL.Types: instance GHC.Classes.Ord System.REPL.Types.TooFewParamsError
+ System.REPL.Types: instance GHC.Classes.Ord System.REPL.Types.TooManyParamsError
+ System.REPL.Types: instance GHC.Enum.Bounded System.REPL.Types.PathExistenceType
+ System.REPL.Types: instance GHC.Enum.Enum System.REPL.Types.PathExistenceType
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.AskerInputAbortedError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.AskerPredicateError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.AskerTypeError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.GenericPredicateError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.GenericTypeError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.MalformedParamsError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.NoConfigFileParseError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.PathIsNotWritable
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.PathRootDoesNotExist
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.SomeAskerError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.SomeCommandError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.SomeREPLError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.TooFewParamsError
+ System.REPL.Types: instance GHC.Exception.Exception System.REPL.Types.TooManyParamsError
+ System.REPL.Types: instance GHC.Read.Read System.REPL.Types.NoConfigFileParseError
+ System.REPL.Types: instance GHC.Read.Read System.REPL.Types.PathExistenceType
+ System.REPL.Types: instance GHC.Read.Read System.REPL.Types.Verbatim
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.AskerInputAbortedError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.AskerPredicateError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.AskerTypeError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.GenericPredicateError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.GenericTypeError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.MalformedParamsError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.NoConfigFileParseError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.PathExistenceType
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.PathIsNotWritable
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.PathRootDoesNotExist
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.SomeAskerError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.SomeCommandError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.SomeREPLError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.TooFewParamsError
+ System.REPL.Types: instance GHC.Show.Show System.REPL.Types.TooManyParamsError
+ System.REPL.Types: newtype Verbatim
+ System.REPL.Types: replErrorDowncast :: (Exception a) => SomeException -> Maybe a
+ System.REPL.Types: replErrorUpcast :: (Exception a) => a -> SomeException
+ System.REPL.Types: type Asker' m a = Asker m a a
+ System.REPL.Types: type Parser a = Text -> Either TypeError a
+ System.REPL.Types: type Predicate m a b = a -> m (Either PredicateError b)
+ System.REPL.Types: type Predicate' m a = Predicate m a a
+ System.REPL.Types: type PredicateError = SomeException
+ System.REPL.Types: type PromptMsg = Text
+ System.REPL.Types: type TypeError = SomeException
- System.REPL.Command: getName :: (Functor m, MonadThrow m) => Text -> m Text
+ System.REPL.Command: getName :: Text -> Maybe Text
- System.REPL.Command: makeCommand :: (MonadIO m, MonadCatch m, Functor m, Monoid i) => Text -> (i -> Bool) -> Text -> (i -> m z) -> Command m i z
+ System.REPL.Command: makeCommand :: (MonadIO m, MonadCatch m, Monoid i) => Text -> (i -> Bool) -> Text -> (i -> m z) -> Command m i z
- System.REPL.Command: makeCommand1 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> (Text -> a -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand1 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> (Text -> a -> m z) -> Command m Text z
- System.REPL.Command: makeCommand2 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> Asker m b -> (Text -> a -> b -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand2 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> Asker m b0 b -> (Text -> a -> b -> m z) -> Command m Text z
- System.REPL.Command: makeCommand3 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> Asker m b -> Asker m c -> (Text -> a -> b -> c -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand3 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> Asker m b0 b -> Asker m c0 c -> (Text -> a -> b -> c -> m z) -> Command m Text z
- System.REPL.Command: makeCommand4 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> Asker m b -> Asker m c -> Asker m d -> (Text -> a -> b -> c -> d -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand4 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> Asker m b0 b -> Asker m c0 c -> Asker m d0 d -> (Text -> a -> b -> c -> d -> m z) -> Command m Text z
- System.REPL.Command: makeCommand5 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> Asker m b -> Asker m c -> Asker m d -> Asker m e -> (Text -> a -> b -> c -> d -> e -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand5 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> Asker m b0 b -> Asker m c0 c -> Asker m d0 d -> Asker m e0 e -> (Text -> a -> b -> c -> d -> e -> m z) -> Command m Text z
- System.REPL.Command: makeCommand6 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> Asker m b -> Asker m c -> Asker m d -> Asker m e -> Asker m f -> (Text -> a -> b -> c -> d -> e -> f -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand6 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> Asker m b0 b -> Asker m c0 c -> Asker m d0 d -> Asker m e0 e -> Asker m f0 f -> (Text -> a -> b -> c -> d -> e -> f -> m z) -> Command m Text z
- System.REPL.Command: makeCommand7 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> Asker m b -> Asker m c -> Asker m d -> Asker m e -> Asker m f -> Asker m g -> (Text -> a -> b -> c -> d -> e -> f -> g -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand7 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> Asker m b0 b -> Asker m c0 c -> Asker m d0 d -> Asker m e0 e -> Asker m f0 f -> Asker m g0 g -> (Text -> a -> b -> c -> d -> e -> f -> g -> m z) -> Command m Text z
- System.REPL.Command: makeCommand8 :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a -> Asker m b -> Asker m c -> Asker m d -> Asker m e -> Asker m f -> Asker m g -> Asker m h -> (Text -> a -> b -> c -> d -> e -> f -> g -> h -> m z) -> Command m Text z
+ System.REPL.Command: makeCommand8 :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> Asker m a0 a -> Asker m b0 b -> Asker m c0 c -> Asker m d0 d -> Asker m e0 e -> Asker m f0 f -> Asker m g0 g -> Asker m h0 h -> (Text -> a -> b -> c -> d -> e -> f -> g -> h -> m z) -> Command m Text z
- System.REPL.Command: makeCommandN :: (MonadIO m, MonadCatch m, Functor m) => Text -> (Text -> Bool) -> Text -> Bool -> [Asker m a] -> [Asker m a] -> (Text -> [a] -> m z) -> Command m Text z
+ System.REPL.Command: makeCommandN :: (MonadIO m, MonadCatch m) => Text -> (Text -> Bool) -> Text -> Bool -> [Asker m a0 a] -> [Asker m b0 a] -> (Text -> [a] -> m z) -> Command m Text z
- System.REPL.Command: makeREPL :: (Functor m, MonadIO m, MonadCatch m, Functor f, Foldable f) => [Command m Text a] -> Command m Text b -> Command m Text c -> m Text -> f (Handler m ()) -> m ()
+ System.REPL.Command: makeREPL :: (MonadIO m, MonadCatch m) => [Command m Text a] -> Command m Text b -> Command m Text c -> m Text -> [Handler m ()] -> m ()
- System.REPL.Command: runCommand :: (Functor m, Monad m, MonadThrow m) => Command m Text a -> Text -> m a
+ System.REPL.Command: runCommand :: (MonadThrow m) => Command m Text a -> Text -> m a
- System.REPL.Command: runSingleCommand :: (MonadThrow m, Functor m) => Command m Text a -> Text -> m a
+ System.REPL.Command: runSingleCommand :: (MonadThrow m) => Command m Text a -> Text -> m a
- System.REPL.Command: subcommand :: (Functor m, Monad m, Monoid i) => Command m i a -> [a -> Command m i b] -> Command m i b
+ System.REPL.Command: subcommand :: (Monad m, Monoid i) => Command m i a -> [a -> Command m i b] -> Command m i b

Files

LICENSE.md view
@@ -1,201 +1,201 @@-Apache License
-                           Version 2.0, January 2004
-                        http://www.apache.org/licenses/
-
-   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
-
-   1. Definitions.
-
-      "License" shall mean the terms and conditions for use, reproduction,
-      and distribution as defined by Sections 1 through 9 of this document.
-
-      "Licensor" shall mean the copyright owner or entity authorized by
-      the copyright owner that is granting the License.
-
-      "Legal Entity" shall mean the union of the acting entity and all
-      other entities that control, are controlled by, or are under common
-      control with that entity. For the purposes of this definition,
-      "control" means (i) the power, direct or indirect, to cause the
-      direction or management of such entity, whether by contract or
-      otherwise, or (ii) ownership of fifty percent (50%) or more of the
-      outstanding shares, or (iii) beneficial ownership of such entity.
-
-      "You" (or "Your") shall mean an individual or Legal Entity
-      exercising permissions granted by this License.
-
-      "Source" form shall mean the preferred form for making modifications,
-      including but not limited to software source code, documentation
-      source, and configuration files.
-
-      "Object" form shall mean any form resulting from mechanical
-      transformation or translation of a Source form, including but
-      not limited to compiled object code, generated documentation,
-      and conversions to other media types.
-
-      "Work" shall mean the work of authorship, whether in Source or
-      Object form, made available under the License, as indicated by a
-      copyright notice that is included in or attached to the work
-      (an example is provided in the Appendix below).
-
-      "Derivative Works" shall mean any work, whether in Source or Object
-      form, that is based on (or derived from) the Work and for which the
-      editorial revisions, annotations, elaborations, or other modifications
-      represent, as a whole, an original work of authorship. For the purposes
-      of this License, Derivative Works shall not include works that remain
-      separable from, or merely link (or bind by name) to the interfaces of,
-      the Work and Derivative Works thereof.
-
-      "Contribution" shall mean any work of authorship, including
-      the original version of the Work and any modifications or additions
-      to that Work or Derivative Works thereof, that is intentionally
-      submitted to Licensor for inclusion in the Work by the copyright owner
-      or by an individual or Legal Entity authorized to submit on behalf of
-      the copyright owner. For the purposes of this definition, "submitted"
-      means any form of electronic, verbal, or written communication sent
-      to the Licensor or its representatives, including but not limited to
-      communication on electronic mailing lists, source code control systems,
-      and issue tracking systems that are managed by, or on behalf of, the
-      Licensor for the purpose of discussing and improving the Work, but
-      excluding communication that is conspicuously marked or otherwise
-      designated in writing by the copyright owner as "Not a Contribution."
-
-      "Contributor" shall mean Licensor and any individual or Legal Entity
-      on behalf of whom a Contribution has been received by Licensor and
-      subsequently incorporated within the Work.
-
-   2. Grant of Copyright License. Subject to the terms and conditions of
-      this License, each Contributor hereby grants to You a perpetual,
-      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
-      copyright license to reproduce, prepare Derivative Works of,
-      publicly display, publicly perform, sublicense, and distribute the
-      Work and such Derivative Works in Source or Object form.
-
-   3. Grant of Patent License. Subject to the terms and conditions of
-      this License, each Contributor hereby grants to You a perpetual,
-      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
-      (except as stated in this section) patent license to make, have made,
-      use, offer to sell, sell, import, and otherwise transfer the Work,
-      where such license applies only to those patent claims licensable
-      by such Contributor that are necessarily infringed by their
-      Contribution(s) alone or by combination of their Contribution(s)
-      with the Work to which such Contribution(s) was submitted. If You
-      institute patent litigation against any entity (including a
-      cross-claim or counterclaim in a lawsuit) alleging that the Work
-      or a Contribution incorporated within the Work constitutes direct
-      or contributory patent infringement, then any patent licenses
-      granted to You under this License for that Work shall terminate
-      as of the date such litigation is filed.
-
-   4. Redistribution. You may reproduce and distribute copies of the
-      Work or Derivative Works thereof in any medium, with or without
-      modifications, and in Source or Object form, provided that You
-      meet the following conditions:
-
-      (a) You must give any other recipients of the Work or
-          Derivative Works a copy of this License; and
-
-      (b) You must cause any modified files to carry prominent notices
-          stating that You changed the files; and
-
-      (c) You must retain, in the Source form of any Derivative Works
-          that You distribute, all copyright, patent, trademark, and
-          attribution notices from the Source form of the Work,
-          excluding those notices that do not pertain to any part of
-          the Derivative Works; and
-
-      (d) If the Work includes a "NOTICE" text file as part of its
-          distribution, then any Derivative Works that You distribute must
-          include a readable copy of the attribution notices contained
-          within such NOTICE file, excluding those notices that do not
-          pertain to any part of the Derivative Works, in at least one
-          of the following places: within a NOTICE text file distributed
-          as part of the Derivative Works; within the Source form or
-          documentation, if provided along with the Derivative Works; or,
-          within a display generated by the Derivative Works, if and
-          wherever such third-party notices normally appear. The contents
-          of the NOTICE file are for informational purposes only and
-          do not modify the License. You may add Your own attribution
-          notices within Derivative Works that You distribute, alongside
-          or as an addendum to the NOTICE text from the Work, provided
-          that such additional attribution notices cannot be construed
-          as modifying the License.
-
-      You may add Your own copyright statement to Your modifications and
-      may provide additional or different license terms and conditions
-      for use, reproduction, or distribution of Your modifications, or
-      for any such Derivative Works as a whole, provided Your use,
-      reproduction, and distribution of the Work otherwise complies with
-      the conditions stated in this License.
-
-   5. Submission of Contributions. Unless You explicitly state otherwise,
-      any Contribution intentionally submitted for inclusion in the Work
-      by You to the Licensor shall be under the terms and conditions of
-      this License, without any additional terms or conditions.
-      Notwithstanding the above, nothing herein shall supersede or modify
-      the terms of any separate license agreement you may have executed
-      with Licensor regarding such Contributions.
-
-   6. Trademarks. This License does not grant permission to use the trade
-      names, trademarks, service marks, or product names of the Licensor,
-      except as required for reasonable and customary use in describing the
-      origin of the Work and reproducing the content of the NOTICE file.
-
-   7. Disclaimer of Warranty. Unless required by applicable law or
-      agreed to in writing, Licensor provides the Work (and each
-      Contributor provides its Contributions) on an "AS IS" BASIS,
-      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
-      implied, including, without limitation, any warranties or conditions
-      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
-      PARTICULAR PURPOSE. You are solely responsible for determining the
-      appropriateness of using or redistributing the Work and assume any
-      risks associated with Your exercise of permissions under this License.
-
-   8. Limitation of Liability. In no event and under no legal theory,
-      whether in tort (including negligence), contract, or otherwise,
-      unless required by applicable law (such as deliberate and grossly
-      negligent acts) or agreed to in writing, shall any Contributor be
-      liable to You for damages, including any direct, indirect, special,
-      incidental, or consequential damages of any character arising as a
-      result of this License or out of the use or inability to use the
-      Work (including but not limited to damages for loss of goodwill,
-      work stoppage, computer failure or malfunction, or any and all
-      other commercial damages or losses), even if such Contributor
-      has been advised of the possibility of such damages.
-
-   9. Accepting Warranty or Additional Liability. While redistributing
-      the Work or Derivative Works thereof, You may choose to offer,
-      and charge a fee for, acceptance of support, warranty, indemnity,
-      or other liability obligations and/or rights consistent with this
-      License. However, in accepting such obligations, You may act only
-      on Your own behalf and on Your sole responsibility, not on behalf
-      of any other Contributor, and only if You agree to indemnify,
-      defend, and hold each Contributor harmless for any liability
-      incurred by, or claims asserted against, such Contributor by reason
-      of your accepting any such warranty or additional liability.
-
-   END OF TERMS AND CONDITIONS
-
-   APPENDIX: How to apply the Apache License to your work.
-
-      To apply the Apache License to your work, attach the following
-      boilerplate notice, with the fields enclosed by brackets "{}"
-      replaced with your own identifying information. (Don't include
-      the brackets!)  The text should be enclosed in the appropriate
-      comment syntax for the file format. We also recommend that a
-      file or class name and description of purpose be included on the
-      same "printed page" as the copyright notice for easier
-      identification within third-party archives.
-
-   Copyright 2014 Janos Tapolczai
-
-   Licensed under the Apache License, Version 2.0 (the "License");
-   you may not use this file except in compliance with the License.
-   You may obtain a copy of the License at
-
-       http://www.apache.org/licenses/LICENSE-2.0
-
-   Unless required by applicable law or agreed to in writing, software
-   distributed under the License is distributed on an "AS IS" BASIS,
-   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-   See the License for the specific language governing permissions and
-   limitations under the License.
+Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "{}"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright 2014-2015 Janos Tapolczai++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain
System/REPL.hs view
@@ -1,331 +1,22 @@-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE LambdaCase #-}
-
--- |Functions to expedite the building of REPLs.
-module System.REPL (
-   -- *String-generic versions of Prelude Functions
-   module Data.ListLike.IO,
-   putErr,
-   putErrLn,
-   prompt,
-   -- * Prompts
-   prompt',
-   promptAbort,
-   -- *Feture-rich reading of user-input
-   -- |These functions automate parsing and validating command-line
-   --  input via the 'Asker' type.
-   PromptMsg,
-   TypeErrorMsg,
-   PredicateErrorMsg,
-   Predicate,
-   Parser,
-   Asker(..),
-   AskFailure(..),
-   askerP,
-   typeAskerP,
-   maybeAskerP,
-   -- **Asking based on 'Read'
-   -- |These askers use 'Text.Read.readMaybe' as their parser.
-   --
-   --  It is possible to ask for Strings, but then quotes will be required
-   --  around them (per their Read-instance). To get the user's
-   --  input as-is, use the 'Verbatim' type.
-   readParser,
-   asker,
-   typeAsker,
-   predAsker,
-   maybeAsker,
-   Verbatim(..),
-   -- **Running askers
-   -- |Since the parsing depends on the Read-instance, the expected result type
-   --  must be explicitly given. E.g.:
-   --
-   -- @
-   --   intAsker :: Asker IO Int
-   --   intAsker = typeAsker "> " "Expected Int!"
-   -- @
-   --
-   -- or, for polymorphic askers,
-   --
-   -- @
-   --   genericAsk :: Read a => Asker IO a
-   --   genericAsk = typeAsker "> " "Couldn't parse value!"
-   --   ...
-   --   do (x :: Int) <- genericAsk
-   --      (y :: Int) <- genericAsk
-   --      putStrLn $ "The sum is: " ++ show (x+y)
-   -- @
-   ask,
-   ask',
-   askEither,
-   untilValid,
-   ) where
-
-import Prelude hiding (putStrLn, putStr, getLine, reverse)
-
-import Control.Arrow (right, (|||))
-import Control.Monad.Catch
-import Control.Monad.IO.Class (MonadIO(liftIO))
-import Data.Char (isSpace)
-import Data.Functor.Monadic
-import Data.ListLike(ListLike(empty, cons, reverse))
-import Data.ListLike.IO (ListLikeIO(..))
-import Data.Text.Lazy (Text)
-import qualified Data.Text.Lazy as T
-import Data.Typeable
-import qualified System.IO as IO
-import Text.Read (readMaybe)
-
--- Stdio
--------------------------------------------------------------------------------
-
--- |Prints a string to stderr.
-putErr :: ListLikeIO full item => full -> IO ()
-putErr = hPutStr IO.stderr
-
--- |Prints a string, followed by a newline character, to stderr.
-putErrLn :: ListLikeIO full item => full -> IO ()
-putErrLn = hPutStrLn IO.stderr
-
--- |Prints @> @ and asks the user to input a line.
-prompt :: (MonadIO m, ListLikeIO full item) => m full
-prompt = prompt' ("> " :: String)
-
--- |Prints its first argument and, in the same line, asks the user
---  to input a line.
-prompt' :: (MonadIO m, ListLikeIO full item, ListLikeIO full' item')
-        => full -> m full'
-prompt' s = liftIO (putStr s >> IO.hFlush IO.stdout >> getLine)
-
--- |The same as prompt, but aborts as soon as the user presses a given key
---  (commonly @'\ESC'@). This function temporarily tries to set the buffering mode
---  to NoBuffering via 'System.IO.hSetBuffering', which may not be supported.
---  See the documentation of 'System.IO.hSetBuffering' for details.
-promptAbort :: (MonadIO m, ListLikeIO full item, ListLikeIO full' Char,
-                MonadCatch m)
-            => Char -> full -> m full'
-promptAbort abortChar s = do
-   liftIO $ putStr s
-   liftIO $ IO.hFlush IO.stdout
-   bufMode <- liftIO $ IO.hGetBuffering IO.stdin
-   liftIO $ IO.hSetBuffering IO.stdin IO.NoBuffering
-   input <- getUntil empty
-            `catch` (\(e :: AskFailure) ->
-                        liftIO (IO.hSetBuffering IO.stdin bufMode) >> throwM e)
-   liftIO $ IO.hSetBuffering IO.stdin bufMode
-   return $ reverse input
-   where
-      getUntil acc = do c <- liftIO $ getChar
-                        if c == abortChar then throwM AbortFailure
-                        else if c == '\n' then return acc
-                        else                   getUntil (cons c acc)
-
--- Askers
--------------------------------------------------------------------------------
-
--- |An error message indicating that a value wasn't able to be parsed.
-type TypeErrorMsg = Text
--- |An error message indicating that a value failied a predicate.
-type PredicateErrorMsg = Text
--- |A prompt.
-type PromptMsg = Text
-
--- |A predicate which a value has to fulfil.
-type Predicate m a = a -> m Bool
-
--- |A parser which either returns a parsed value or an error message.
-type Parser a = Text -> Either Text a
-
--- |The description of an \'ask for user input\'-action.
---  The type parameters are the used monad (typically 'IO' or 'ExceptT'),
---  the type of the read value and the type of the error that is thrown
---  in case of failures.
---
---  The components are a prompt, a parser, and a predicate that
---  the parsed value must fulfil. The predicate, being monadic, can
---  perform arbitrarily complex tests, such as checking whether a given
---  date is in the future, whether an item is in a database, whether
---  a file with a given name exists, etc.
-data Asker m a = Asker{ -- |The prompt to be displayed to the user.
-                        askerPrompt::Text,
-                        -- |The parser for the input value.
-                        askerParser::Parser a,
-                        -- |The predicate which the input, once read,
-                        --  must fulfill. The Left side is an error message.
-                        askerPredicate::a -> m (Either Text ())}
-
-
--- |Represents a failure during the running of an asking function.
---  Either the input was incorrect in some way, or the process was aborted
---  by the user.
-data AskFailure = -- |The input wasn't able to be parsed.
-                  TypeFailure TypeErrorMsg
-                  -- |The parsed value failed a predicate.
-                  | PredicateFailure PredicateErrorMsg
-                  -- |An incorrect number of parameters was passed.
-                  | ParamFailure Text
-                  -- |No action was appropriate for the given input.
-                  | NothingFoundFailure
-                  -- |The input was aborted by the user.
-                  | AbortFailure
-   deriving (Typeable, Eq)
-
-instance Exception AskFailure
-
-instance Show AskFailure where
-   show (ParamFailure t) = T.unpack t
-   show NothingFoundFailure = "No appropriate action found!"
-   show (PredicateFailure t) = T.unpack t
-   show (TypeFailure t) = T.unpack t
-   show AbortFailure = "Input aborted."
-
--- |A verbatim Text whose Read instance simply returns the read
---  string, as-is.
---  This is useful for askers which ask for strings without quotes.
-newtype Verbatim = Verbatim{fromVerbatim::Text}
-
--- |Read-instance for 'Verbatim'. Wraps the given value into quotes and
---  reads it a a 'Text'.
-instance Read Verbatim where
-   readsPrec _ s = [(Verbatim $ T.pack s,"")]
-
--- |Creates a general 'Asker' with a custom parsing function and a predicate
---  that the parsed value has to pass. If either the parsing or the predicate
---  fail, one of the given error messages is displayed.
-askerP :: (Monad m, Functor m)
-       => PromptMsg
-       -> PredicateErrorMsg
-       -> Parser a
-       -> Predicate m a
-       -> Asker m a
-askerP pr errP parse pred = Asker pr parse check
-   where
-      check = pred >=$> (\case True  -> Right ()
-                               False -> Left errP)
-
--- |Creates an 'Asker' which only cares about the type of the input.
-typeAskerP :: (Monad m, Functor m)
-            => PromptMsg
-            -> Parser a
-            -> Asker m a
-typeAskerP pr parse = askerP pr undefined parse (const $ return True)
-
--- |An asker which asks for an optional value. If only whitespace
---  is entered (according to 'Data.Char.isSpace'), it returns 'Nothing'
---  without further parsing or checking; otherwise, it behaves identically
---  to 'asker'.
-maybeAskerP :: (Monad m, Functor m)
-           => PromptMsg
-           -> PredicateErrorMsg
-           -> Parser a
-           -> Predicate m a
-           -> Asker m (Maybe a)
-maybeAskerP pr errP parse pred = Asker pr parse' check
-   where
-      parse' t = if T.all isSpace t then Right Nothing
-                                    else right Just $ parse t
-
-      check Nothing = return $ Right ()
-      check (Just t) = pred t >$> (\case True  -> Right ()
-                                         False -> Left errP)
-
--- Parsers based on Read
--------------------------------------------------------------------------------
-
--- |A parser based on 'Text.Read.readMaybe'. This suffices for the parsing of
---  most data types.
-readParser :: Read a
-           => TypeErrorMsg
-           -> Text
-           -> (Either Text a)
-readParser errT = maybe (Left errT) Right . readMaybe . T.unpack
-
--- |Creates a general 'Asker' with 'Text.Read.readMaybe' as its parser.
---  Using 'Data.Read.readMaybe' is perfectly fine for most values, but it has
---  two drawbacks:
---
---  1. The user input is unpacked into a String and then parsed. This can
---     incur a performance hit for large inputs.
---  2. A Read-instance must be available for the expected type.
-asker :: (Monad m, Functor m, Read a)
-      => PromptMsg
-      -> TypeErrorMsg
-      -> PredicateErrorMsg
-      -> Predicate m a
-      -> Asker m a
-asker pr errT errP pred = askerP pr errP (readParser errT) pred
-
--- |Creates an 'Asker' based on Read which just cares about the type of the input.
-typeAsker :: (Monad m, Functor m, Read a)
-          => PromptMsg
-          -> TypeErrorMsg
-          -> Asker m a
-typeAsker p errT = asker p errT undefined (const $ return True)
-
--- |Creates an 'Asker' which takes its input verbatim as 'Text'. The input
---  thus only has to pass a predicate, not any parsing.
-predAsker :: (Monad m, Functor m)
-          => PromptMsg
-          -> Text -- ^Predicate error message.
-          -> (Text -> m Bool) -- ^The predicate.
-          -> Asker m Verbatim
-predAsker p errP f = asker p (error "Type error in predAsker. This is a bug.")
-                           errP (f . fromVerbatim)
-
--- |An asker based on Read which asks for an optional value.
-maybeAsker :: (Monad m, Functor m, Read a)
-           => PromptMsg
-           -> TypeErrorMsg
-           -> PredicateErrorMsg
-           -> Predicate m a
-           -> Asker m (Maybe a)
-maybeAsker pr errT errP pred = maybeAskerP pr errP (readParser errT) pred
-
--- Running askers
---------------------------------------------------------------------------------
-
--- |Executes an Asker. If the process fails, an exception is thrown.
-ask :: (MonadIO m, MonadCatch m, Functor m)
-    => Asker m a
-    -> Maybe Text
-    -> m a
-ask a v = askEither a v >>= either throwM return
-
--- |See 'ask'. Always reads the input from stdin.
---
--- @
--- ask' a = ask a Nothing
--- @
-ask' :: (MonadIO m, MonadCatch m, Functor m)
-     => Asker m a
-     -> m a
-ask' a = ask a Nothing
-
--- |Executes an 'Asker'. If the Text argument is Nothing, the user is asked
---  to enter a line on stdin. If it is @Just x@, @x@ is taken to be input.
-askEither :: (MonadIO m, MonadCatch m, Functor m)
-          => Asker m a
-          -> Maybe Text
-          -> m (Either AskFailure a)
-askEither a = maybe getInput check
-   where
-      getInput = (promptAbort '\ESC' (askerPrompt a) >>= check)
-                 `catch` (return . Left)
-
-      check inp = case askerParser a inp of
-         Left err -> return $ Left $ TypeFailure err
-         Right t -> askerPredicate a t
-                    >>= return . (Left . PredicateFailure ||| Right . const t)
-
--- |Repeatedly executes an ask action until the user enters a valid value.
---  Error messages are printed each time.
-untilValid :: forall m a.(MonadIO m, MonadCatch m, Functor m, Read a)
-           => m a
-           -> m a
-untilValid m = m `catch` handler
-   where
-      handler :: AskFailure -> m a
-      handler l = liftIO (putStrLn $ show l) >> untilValid m
+-- |Contents:+--  +--  [/Ask/]+--     Asking the user for input in a principled way.+--     Reading, parsing errors, predicate checks are all handled.+--+--  [/Command/]+--     The main module of the package. Functions for creating+--     commands, which can receive and ask for arguments.+--     Commands are composable and can be built into a REPL.+--+--  [/Config/]+--     Read configuration files in various formats.+module System.REPL (+   module System.REPL.Ask,+   module System.REPL.Command,+   module System.REPL.Config,+   ) where++import System.REPL.Ask+import System.REPL.Command+import System.REPL.Config
+ System/REPL/Ask.hs view
@@ -0,0 +1,317 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}++-- |Asking the user for input on the console.+--+--  The main type is 'Asker', which takes care of parsing+--  and verifying user input.+module System.REPL.Ask (+   -- *Types+   PromptMsg,+   TypeError,+   PredicateError,+   Predicate,+   Predicate',+   Parser,+   Asker(..),+   Asker',+   -- ** Exceptions+   SomeREPLError(..),+   SomeAskerError(..),+   AskerTypeError(..),+   AskerPredicateError(..),+   GenericTypeError(..),+   GenericPredicateError(..),+   genericTypeError,+   genericPredicateError,+   -- * Creating askers+   -- |These are all just convenience functions.+   --  You can also create 'Asker's directly via the constructor.+   --+   --  For errors, you can supply a custom exception or use 'GenericTypeError',+   --  'GenericPredicateError'.+   typeAskerP,+   maybeAskerP,+   -- **Creating askers via 'Read'+   -- |These askers use 'Text.Read.readMaybe' as their parser.+   --+   --  It is possible to ask for Strings, but then quotes will be required+   --  around them (per their Read-instance). To get the user's+   --  input as-is, use the 'Verbatim' type or 'predAsker'.+   Verbatim(..),+   readParser,+   asker,+   lineAsker,+   typeAsker,+   predAsker,+   maybeAsker,+   -- *Running askers+   -- |Created askers can be run via these functions.+   --  Since the parsing depends on the Read-instance, the expected result type+   --  must be explicitly given. E.g.:+   --+   -- @+   --   intAsker :: Asker IO Int+   --   intAsker = typeAsker "> " "Expected Int!"+   -- @+   --+   -- or, for polymorphic askers,+   --+   -- @+   --   genericAsk :: Read a => Asker IO a+   --   genericAsk = typeAsker "> " "Couldn't parse value!"+   --   ...+   --   do (x :: Int) <- genericAsk+   --      (y :: Int) <- genericAsk+   --      putStrLn $ "The sum is: " ++ show (x+y)+   -- @+   ask,+   ask',+   askEither,+   untilValid,+   -- *Creating predicates+   boolPredicate,+   -- *Example askers+   -- |A few askers for convenience.+   PathRootDoesNotExist(..),+   PathIsNotWritable(..),+   filepathAsker,+   writablefilepathAsker,+   ) where++import Prelude hiding (putStrLn, putStr, getLine, reverse)++import Control.Arrow (right, (|||))+import Control.Monad.Catch+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Char (isSpace)+import Data.Functor.Monadic+import qualified Data.List as L+import qualified Data.Text as T+import qualified System.Directory as D+import qualified System.FilePath as FP+import qualified System.IO.Error as ERR+import System.REPL.Prompt+import System.REPL.Types+import Text.Read (readMaybe)++-- Askers+-------------------------------------------------------------------------------++-- |Creates an 'Asker' which only cares about the type of the input.+typeAskerP :: Applicative m+           => PromptMsg+           -> Parser a+           -> Asker' m a+typeAskerP pr parse = Asker pr parse (pure . Right)++-- |An asker which asks for an optional value. If only whitespace+--  is entered (according to 'Data.Char.isSpace'), it returns 'Nothing'+--  without further parsing or checking; otherwise, it behaves identically+--  to 'asker'.+maybeAskerP :: Applicative m+            => PromptMsg+            -> Parser a+            -> Predicate m a b+            -> Asker m (Maybe a) (Maybe b)+maybeAskerP pr parse pred = Asker pr parse' check+   where+      parse' t = if T.all isSpace t then Right Nothing+                                    else right Just $ parse t++      check Nothing = pure $ Right Nothing+      check (Just t) = pred t >$> (\case Right t -> Right (Just t)+                                         Left err -> Left err)++-- Parsers based on Read+-------------------------------------------------------------------------------++-- |A parser based on 'Text.Read.readMaybe'. This suffices for the parsing of+--  most data types.+readParser :: Read a+           => (T.Text -> TypeError)+           -> Parser a+readParser errT t = maybe (Left $ errT t) Right . readMaybe . T.unpack $ t++-- |Creates a general 'Asker' with 'Text.Read.readMaybe' as its parser.+--  Using 'Data.Read.readMaybe' is perfectly fine for most values, keep in mind+--  that the input Text has to be unpacked into a string. This can be costly+--  on very large inputs.+--+--  __NOTE:__ Instances of String/Text have to be surrounded with quotes (\").+--  You practically never want this when asking for input.+--  If you want to get the user input as-is, restrict the return type to+--  @Asker m Verbatim@ or use 'predAsker'/'lineAsker'.+asker :: (Functor m, Read a)+      => PromptMsg+      -> (T.Text -> TypeError)+      -> Predicate' m a+      -> Asker' m a+asker pr errT pred = Asker pr (readParser errT) pred++-- |Creates an 'Asker' based on Read which just cares about the type of the input.+typeAsker :: (Applicative m, Read a)+          => PromptMsg+          -> (T.Text -> TypeError)+          -> Asker' m a+typeAsker p errT = asker p errT (pure . Right)++-- |Creates an 'Asker' which takes its input verbatim as 'Text'.+--  Quotes around the input are not required.+--  The input thus only has to pass a predicate, not any parsing.+predAsker :: (Functor m)+          => PromptMsg+          -> Predicate m T.Text b+          -> Asker m T.Text b+predAsker pr f = Asker pr Right f++-- |A wrapper aroung 'getLine'. Prints no prompt and returns the user input as-is.+lineAsker :: Applicative m+          => Asker' m T.Text+lineAsker = predAsker "" (pure . Right)++-- |An asker based on Read which asks for an optional value.+maybeAsker :: (Applicative m, Read a)+           => PromptMsg+           -> (T.Text -> TypeError)+           -> Predicate' m a+           -> Asker' m (Maybe a)+maybeAsker pr errT pred = maybeAskerP pr (readParser errT) pred++-- Running askers+--------------------------------------------------------------------------------++-- |Executes an Asker. A 'SomeAskerError' is thrown if the inpout can't be+--  parsing into a value of the correct type, if the input fails the 'Asker''s+--  predicate, or if the escape key is pressed.+ask :: (MonadIO m, MonadCatch m)+    => Asker m a b+    -> Maybe T.Text+    -> m b+ask a v = askEither a v >>= either throwM return++-- |See 'ask'. Always reads the input from stdin.+--+-- @+-- ask' a = ask a Nothing+-- @+ask' :: (MonadIO m, MonadCatch m)+     => Asker m a b+     -> m b+ask' a = ask a Nothing++-- |Executes an 'Asker'. If the Text argument is Nothing, the user is asked+--  to enter a line on stdin. If it is @Just x@, @x@ is taken to be input.+--  +--  Pressing the escape key returns a 'AskerInputAborterError' (if supported).+askEither :: (MonadIO m, MonadCatch m)+          => Asker m a b+          -> Maybe T.Text+          -> m (Either SomeAskerError b)+askEither a = maybe getInput check+   where+      getInput = (promptAbort '\ESC' (askerPrompt a) >>= check)+                 `catch` (return . Left)++      check inp = case askerParser a inp of+         Left err -> return . Left . SomeAskerError . AskerTypeError $ err+         Right t -> askerPredicate a t+                    >>= return . (Left . SomeAskerError . AskerPredicateError ||| Right)++-- |Repeatedly executes an ask action until the user enters a valid value.+--  Error messages are printed each time.+untilValid :: forall m a.(MonadIO m, MonadCatch m, Read a)+           => m a+           -> m a+untilValid m = m `catch` handler+   where+      handler :: SomeAskerError -> m a+      handler l = liftIO (putStrLn $ show l) >> untilValid m++-- Creating predicates+-------------------------------------------------------------------------------++-- |Creates a predicate from a boolean function and an error message.+boolPredicate :: Functor m+              => (a -> m Bool)+              -> (a -> PredicateError)+              -> Predicate' m a+boolPredicate f errP t = (\case {True -> Right t; False -> Left (errP t)}) <$> f t++-- Example askers+-------------------------------------------------------------------------------++-- |Asks the user for a file or a directory.+-- +--  Parsing checks for basic validity via 'System.FilePath.isValid'. Invalid paths are rejected.+--+--  After that, the asker determines whether the target exists and what type+--  it has. You can run a predicate on that information.+filepathAsker :: MonadIO m+              => PromptMsg+              -> (FilePath -> TypeError)+              -> Predicate m (PathExistenceType, FilePath) b+              -> Asker m FilePath b+filepathAsker pr errT pred = Asker pr parse pred'+   where+      parse = (\fp -> if FP.isValid fp then Right fp else Left $ errT fp) . T.unpack++      pred' fp = do+         exType <- liftIO $ getExistenceType fp+         pred (exType, fp)+         --return $ if ok then Right (exType, fp)+         --         else Left $ errP (exType, fp)++      getExistenceType :: FilePath -> IO PathExistenceType+      getExistenceType fp = do+         isDir <- D.doesDirectoryExist fp+         if isDir then return IsDirectory+         else do isFile <- D.doesFileExist fp+                 return $ if isFile then IsFile+                                    else DoesNotExist++-- |See 'filepathAsker'. This 'Asker' also ensures that the given path+--  is writeable in the following sense:+--+--  * at least some initial part of the path exists and+--  * the last existing part of the path is writeable.+--+--  'PathRootDoesNotExist' and 'PathIsNotWritable' exceptions are thrown if the+--  first or second of these conditions is violated.+--+--  For relative paths, we only check that the current directory is writable.+--+--  Handled exceptions:+--+--  * 'System.IO.Error.isPermissionError'+--  * 'System.IO.Error.isDoesNotExistError'+writablefilepathAsker+   :: MonadIO m+   => PromptMsg+   -> (FilePath -> TypeError)+   -> Predicate m (PathExistenceType, FilePath) b+   -> Asker m FilePath b+writablefilepathAsker pr errT pred = filepathAsker pr errT pred'+   where+      permError e = if ERR.isPermissionErrorType (ERR.ioeGetErrorType e) ||+                       ERR.isDoesNotExistErrorType (ERR.ioeGetErrorType e)+                    then Just () else Nothing+      conc :: [FilePath] -> FilePath+      conc = L.foldl' (FP.</>) ""+      doesExist fp = (||) <$> D.doesDirectoryExist (conc fp) <*> D.doesFileExist (conc fp)++      isWritable fp = catchJust permError (fp >>= D.getPermissions >$> D.writable) (const $ return False)++      -- A utility function which gets a bool and returns the second argument if its value is false,+      -- and the third if its true.+      boolEither :: (Monad m, Exception a) => (m Bool) -> a -> m (Either SomeException b) -> m (Either SomeException b)+      boolEither x falseCase trueCase = x >>= (\case{True -> trueCase; False -> return $ Left $ SomeException falseCase})++      pred' args@(_, fp) = +         if FP.isRelative fp then boolEither (liftIO $ isWritable D.getCurrentDirectory) (PathIsNotWritable fp) (pred args)+         else do+            existingRoot <- liftIO $ takeWhile snd <$> mapM (\x -> (x,) <$> doesExist x) (L.inits $ FP.splitDirectories fp)+            if null existingRoot then return (Left $ SomeException $ PathRootDoesNotExist fp)+            else boolEither (liftIO $ isWritable (return . conc . fst . last $ existingRoot)) (PathIsNotWritable fp) (pred args)
System/REPL/Command.hs view
@@ -1,606 +1,685 @@-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE RankNTypes #-}
-
--- |Provides Commands for REPLs. Commands are there to provide high-level
---  handling of user input and to offer functionality in a standard, composable
---  way.
---
---  Use cases:
---
---  1. Asking the user for input that has to be of the right format or fulfil
---     specific constraints, such as asking for an @Int@ between 0 and 10, or
---     asking for a username that has to exist in some database.
---  2. Creating command hierarchies, e.g.
---
---     >>> myVersionControl commit "my first commit" only-binaries
---
---     In this example, we could have @commit@ as a root command that
---     consumes the commit name "my first commit" and hands over to
---     the sub-command @only-binaries@.
---
---  3. Creating a REPL out of individual commands. Let us say that we have
---     a version control system with @commit, revert, diff@ commands, plus
---     an exit command like "exit", and one that prints some
---     "command not recognized" message if the user's input doesn't match
---     any commands. We can compose these commands with 'makeREPL', providing
---     robust command selection and obviating the need for manually writing the
---     input handling loop.
---
---  Commands can take their input in one line, e.g.
---
--- >>>:cmd param1 "param2 with spaces" param3
---
---  or they can ask for missing parameters if so configured:
---
--- >>>:cmd param1 "param2 with spaces"
--- Please enter param3:
-module System.REPL.Command (
-   -- *Command class
-   Command(..),
-   runCommand,
-   runSingleCommand,
-   oneOf,
-   subcommand,
-   makeREPL,
-   -- *Exceptions
-   -- |These are the exceptions that can be thrown during the course of command
-   --  invocation (in addition to those that you throw yourself, of course).
-   --
-   --  SomeCommandError is an abstract exception and all others are its concrete
-   --  subclasses. See the example in "Control.Exception" for details.
-   SomeCommandError(..),
-   MalformedParamsError(..),
-   TooFewParamsError(..),
-   TooManyParamsError(..),
-   -- * Dealing with arguments
-   readArgs,
-   getName,
-   quoteArg,
-   -- * Helpers
-   summarizeCommands,
-   -- * Making commands
-   makeCommand,
-   makeCommand1,
-   makeCommand2,
-   makeCommand3,
-   makeCommand4,
-   makeCommand5,
-   makeCommand6,
-   makeCommand7,
-   makeCommand8,
-   makeCommandN,
-   ) where
-
-import Prelude hiding (putStrLn, putStr, (++), length, replicate)
-import qualified Prelude as P
-
-import Control.Arrow (first)
-import Control.Monad
-import Control.Monad.Catch
-import Control.Monad.IO.Class (MonadIO(liftIO))
-import Control.Monad.Loops (unfoldrM, iterateUntil)
-import Data.Char (isSpace)
-import Data.Foldable (Foldable)
-import qualified Data.Functor.Apply as Ap
-import qualified Data.Functor.Bind as Bi
-import Data.Functor.Monadic
-import qualified Data.List as LU
-import qualified Data.List.Safe as L
-import Data.ListLike(ListLike(..))
-import Data.Maybe (fromJust, isJust, fromMaybe)
-import Data.Monoid (mempty, Monoid)
-import Data.Ord
-import Data.Text.Lazy (Text)
-import qualified Data.Text.Lazy as T
-import Data.Typeable
-import Numeric.Peano
-import System.REPL
-import qualified Text.Parsec as P
-import qualified Text.Parsec.Language as P
-import qualified Text.Parsec.Token as P
-
--- alias for Data.ListLike.append
-(++) :: (ListLike full item) => full -> full -> full
-(++) = append
-
--- Exceptions
--------------------------------------------------------------------------------
-
--- |Generic error related to command execution.
-data SomeCommandError = forall e.Exception e => SomeCommandError e deriving (Typeable)
-instance Show SomeCommandError where show (SomeCommandError e) = show e
-instance Exception SomeCommandError
-
-commandErrorUpcast :: (Exception a) => a -> SomeException
-commandErrorUpcast = toException . SomeCommandError
-commandErrorDowncast :: (Exception a) => SomeException -> Maybe a
-commandErrorDowncast x = do {SomeCommandError y <- fromException x; cast y}
-
--- |The input of a command was malformed and could not interpreted. I.e.
---  the input contained inadmissible characters, or quotes were mismatched.
---  The 'Text' argument contains the parser error.
-data MalformedParamsError = MalformedParamsError Text deriving (Show, Eq, Typeable, Ord)
-instance Exception MalformedParamsError where
-   toException = commandErrorUpcast
-   fromException = commandErrorDowncast
-
--- |Too many parameters were given to a command. The first value is the maximum,
---  the second the actual number.
-data TooManyParamsError = TooManyParamsError Int Int deriving (Show, Eq, Typeable, Ord)
-instance Exception TooManyParamsError where
-   toException = commandErrorUpcast
-   fromException = commandErrorDowncast
-
--- |Too few parameters were given to a command. The first value is the minium,
---  the second the actual number.
-data TooFewParamsError = TooFewParamsError Int Int deriving (Show, Eq, Typeable, Ord)
-instance Exception TooFewParamsError where
-   toException = commandErrorUpcast
-   fromException = commandErrorDowncast
-
--- Command type
--------------------------------------------------------------------------------
-
--- |A REPL command, possibly with parameters.
-data Command m i a = Command{
-                     -- |The short name of the command. Purely informative.
-                     commandName :: Text,
-                     -- |Returns whether the first part of an input
-                     --  (the command name) matches
-                     --  a the command. The simplest form is
-                     --  @((==) . getPart) s@ for some string s, but more liberal
-                     --  matchings are possible.
-                     commandTest :: i -> Bool,
-                     -- |A description of the command.
-                     commandDesc :: Text,
-                     -- |Runs the command with the input text as parameter,
-                     --  returning the unconsumed input.
-                     runPartialCommand :: [i] -> m (a, [i])}
-
-instance Functor m => Functor (Command m i) where
-   fmap f c@Command{runPartialCommand=run} = c{runPartialCommand=(fmap (first f)  . run)}
-
-instance (Functor m, Monad m) => Ap.Apply (Command m i) where
-   -- |Runs the first command, then the second with the left-over input.
-   --  The result of the first command is applied to that of the second.
-   --
-   --  All other fields (name, description,...) of the second command are
-   --  ignored.
-   f <.> g = f{runPartialCommand = h}
-      where
-         h input = do (func, output) <- runPartialCommand f input
-                      (arg, output') <- runPartialCommand g output
-                      return (func arg, output')
-
-
-instance (Functor m, Monad m) => Bi.Bind (Command m i) where
-   -- |The same as 'Ap.<.>', but the second argument can read the result of the
-   --  first.
-   f >>- g = f{runPartialCommand = h}
-      where
-         h input = do (res, output)   <- runPartialCommand f input
-                      (res', output') <- runPartialCommand (g res) output
-                      return (res', output')
-
--- |Runs the command with the input text as parameter, discarding any left-over
---  input.
-runCommand :: (Functor m, Monad m, MonadThrow m) => Command m Text a -> Text -> m a
-runCommand c = fmap fst . runPartialCommand c <=< readArgs
-
--- |Runs the command with the input text as parameter. If any input is left
---  unconsumed, an error is thrown.
-runSingleCommand :: (MonadThrow m, Functor m) => Command m Text a -> Text -> m a
-runSingleCommand c t = do
-   t' <- readArgs t
-   (res, output) <- runPartialCommand c t'
-   let act = length t'
-       mx  = act - length output
-   when (not . L.null $ output) (throwM $ TooManyParamsError mx act)
-   return res
-
-
--- |Takes a list @xs@ and executes the first command in a list whose
---  'commandTest' matches the input.
---
---  Note that the resultant command @c@'s' 'runPartialCommand' should only be
---  executed with an input @t@ if 'commandTest c t' == True', where @t'@ is either
---  @head (readArgs t)@ or @mempty@ if @t@ is empty.
---  Otherwise, the result is undefined.
-oneOf :: Monoid i
-      => Text
-         -- ^Command name.
-      -> Text
-         -- ^Command description.
-      -> [Command m i a]
-      -> Command m i a
-oneOf n d xs = Command n test d cmd
-   where
-      test t = L.any (($ t) . commandTest) xs
-      -- because of @test@, the list is guaranteed to be non-empty
-      cmd input = (`runPartialCommand` input)
-                  . LU.head
-                  . L.dropWhile (not . ($ fromMaybe mempty (L.head input)) . commandTest) $ xs
-
--- |Adds a list of possible subcommands after a command (that should leave
---  some input unconsumed). Ignoring all the required parameters for a moment,
---
---  > subcommand x xs = x >>- oneOf xs
-subcommand :: (Functor m, Monad m, Monoid i)
-           => Command m i a
-              -- ^The root command.
-           -> [a -> Command m i b]
-              -- ^The subcommands that may follow it. This list must be finite.
-           -> Command m i b
-subcommand x xs = x Bi.>>- \y -> oneOf "" "" (L.map ($ y) xs)
-
-
--- |Splits and trims the input of a command. If the input cannot be parsed, a
---  'MalformedCommand' exception is thrown.
---
---  -- * Format
---
---  Any non-whitespace sequence of characters is interpreted as
---  one argument, unless double quotes (") are used, in which case
---  they demarcate an argument. Each argument is parsed as a haskell
---  string literal (quote-less arguments have quotes inserted around them).
---
---  Arguments are parsed using parsec's @stringLiteral@ (haskell-style),
---  meaning that escape sequences and unicode characters are handled automatically.
-readArgs :: MonadThrow m => Text -> m [Text]
-readArgs = either err return . P.parse parser "" . T.unpack
-   where
-      err = throwM . MalformedParamsError . T.pack . show
-      -- Main parser.
-      parser = P.many (stringLiteral P.<|> unquotedLiteral)
-
-      stringLiteral = P.stringLiteral P.haskell >$> T.pack
-
-      -- The parser for string literals without quotes around them.
-      --
-      -- First we read a bunch of characters and then we pass the result,
-      -- wrapped in quotes, to the stringLiteral parser AGAIN.
-      -- This might seem strange, but this way, escape sequences are correctly
-      -- handled. The alternative would have been to copy the (private) logic
-      -- found in Text.Parsec.Token's source.
-      unquotedLiteral =
-         do raw <- P.many1 $ P.satisfy $ not . isSpace
-            P.eof P.<|> (P.many1 P.space >> return ())
-            let lit = stringLiteral
-                res = P.parse lit "" ("\"" ++ raw ++ "\"")
-            case res of (Right r) -> return r
-                        (Left l) -> fail (show l)
-
--- |Gets the first part of a command string, or the empty string, if the comand
---  string is empty.
-getName :: (Functor m, MonadThrow m) => Text -> m Text
-getName = fromMaybe mempty . L.head <$=< readArgs
-
--- |Surrounds an argument in quote marks, if necessary.
---  This is useful when arguments were extracted via 'readArgs', which deletes
---  quote marks. Quotes are placed around the input iff it is empty or contains
---  whitespace.
-quoteArg :: Text -> Text
-quoteArg x = if T.null x || T.any isSpace x then '\"' `T.cons` x `T.snoc` '\"'
-                                            else x
-
-
--- |Creates a command without parameters.
-makeCommand :: (MonadIO m, MonadCatch m,
-                Functor m, Monoid i)
-            => Text -- ^Command name.
-            -> (i -> Bool) -- ^Command test.
-            -> Text -- ^Command description.
-            -> (i -> m z)
-               -- ^Command function. It will receive the first part of the input
-               --  (customarily the command name), or the empty string if the
-               --  input only contained whitespace.
-            -> Command m i z
-makeCommand n t d f = Command n t d f'
-   where
-      f' args = do res <- f $ fromMaybe mempty $ L.head args
-                   return (res, L.drop 1 args)
-
-
--- |Creates a command with one parameter.
-makeCommand1 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-                     -- ^If True, running the command will run the Asker's
-                     --  IO action if not enough input is provided. If False
-                     --  a 'ParamNumError' will be thrown.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> (Text -> a -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand1 n t d canAsk p1 f = Command n t d f'
-   where
-      mx = 1
-      f' args = do let x0 = fromMaybe mempty $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   res <- f x0 x1
-                   return (res, L.drop (mx+1) args)
-
--- |Creates a command with two parameters.
-makeCommand2 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> Asker m b -- ^'Asker' for the second parameter.
-             -> (Text -> a -> b -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand2 n t d canAsk p1 p2 f = Command n t d f'
-   where
-      mx = 2
-      f' args = do let x0 = fromMaybe mempty $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   x2 <- askC canAsk p2 args mx 2
-                   res <- f x0 x1 x2
-                   return (res, L.drop (mx+1) args)
-
--- |Creates a command with three parameters.
-makeCommand3 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> Asker m b -- ^'Asker' for the second parameter.
-             -> Asker m c -- ^'Asker' for the third parameter.
-             -> (Text -> a -> b -> c -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand3 n t d canAsk p1 p2 p3 f = Command n t d f'
-   where
-      mx = 3
-      f' args = do let x0 = fromMaybe "" $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   x2 <- askC canAsk p2 args mx 2
-                   x3 <- askC canAsk p3 args mx 3
-                   res <- f x0 x1 x2 x3
-                   return (res, L.drop (mx+1) args)
-
--- |Creates a command with four parameters.
-makeCommand4 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> Asker m b -- ^'Asker' for the second parameter.
-             -> Asker m c -- ^'Asker' for the third parameter.
-             -> Asker m d -- ^'Asker' for the fourth parameter.
-             -> (Text -> a -> b -> c -> d -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand4 n t d canAsk p1 p2 p3 p4 f = Command n t d f'
-   where
-      mx = 4
-      f' args = do let x0 = fromMaybe "" $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   x2 <- askC canAsk p2 args mx 2
-                   x3 <- askC canAsk p3 args mx 3
-                   x4 <- askC canAsk p4 args mx 4
-                   res <- f x0 x1 x2 x3 x4
-                   return (res, L.drop (mx+1) args)
-
--- |Creates a command with five parameters.
-makeCommand5 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> Asker m b -- ^'Asker' for the second parameter.
-             -> Asker m c -- ^'Asker' for the third parameter.
-             -> Asker m d -- ^'Asker' for the fourth parameter.
-             -> Asker m e -- ^'Asker' for the fifth parameter.
-             -> (Text -> a -> b -> c -> d -> e -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand5 n t d canAsk p1 p2 p3 p4 p5 f = Command n t d f'
-   where
-      mx = 5
-      f' args = do let x0 = fromMaybe "" $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   x2 <- askC canAsk p2 args mx 2
-                   x3 <- askC canAsk p3 args mx 3
-                   x4 <- askC canAsk p4 args mx 4
-                   x5 <- askC canAsk p5 args mx 5
-                   res <- f x0 x1 x2 x3 x4 x5
-                   return (res, L.drop (mx+1) args)
-
--- |Creates a command with six parameters.
-makeCommand6 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> Asker m b -- ^'Asker' for the second parameter.
-             -> Asker m c -- ^'Asker' for the third parameter.
-             -> Asker m d -- ^'Asker' for the fourth parameter.
-             -> Asker m e -- ^'Asker' for the fifth parameter.
-             -> Asker m f -- ^'Asker' for the sixth parameter.
-             -> (Text -> a -> b -> c -> d -> e -> f -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand6 n t d canAsk p1 p2 p3 p4 p5 p6 f = Command n t d f'
-   where
-      mx = 6
-      f' args = do let x0 = fromMaybe mempty $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   x2 <- askC canAsk p2 args mx 2
-                   x3 <- askC canAsk p3 args mx 3
-                   x4 <- askC canAsk p4 args mx 4
-                   x5 <- askC canAsk p5 args mx 5
-                   x6 <- askC canAsk p6 args mx 6
-                   res <- f x0 x1 x2 x3 x4 x5 x6
-                   return (res, L.drop (mx+1) args)
-
--- |Creates a command with seven parameters.
-makeCommand7 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> Asker m b -- ^'Asker' for the second parameter.
-             -> Asker m c -- ^'Asker' for the third parameter.
-             -> Asker m d -- ^'Asker' for the fourth parameter.
-             -> Asker m e -- ^'Asker' for the fifth parameter.
-             -> Asker m f -- ^'Asker' for the sixth parameter.
-             -> Asker m g -- ^'Asker' for the seventh parameter.
-             -> (Text -> a -> b -> c -> d -> e -> f -> g -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand7 n t d canAsk p1 p2 p3 p4 p5 p6 p7 f = Command n t d f'
-   where
-      mx = 7
-      f' args = do let x0 = fromMaybe "" $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   x2 <- askC canAsk p2 args mx 2
-                   x3 <- askC canAsk p3 args mx 3
-                   x4 <- askC canAsk p4 args mx 4
-                   x5 <- askC canAsk p5 args mx 5
-                   x6 <- askC canAsk p6 args mx 6
-                   x7 <- askC canAsk p7 args mx 7
-                   res <- f x0 x1 x2 x3 x4 x5 x6 x7
-                   return (res, L.drop (mx+1) args)
-
--- |Creates a command with eight parameters.
-makeCommand8 :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input.
-             -> Asker m a -- ^'Asker' for the first parameter.
-             -> Asker m b -- ^'Asker' for the second parameter.
-             -> Asker m c -- ^'Asker' for the third parameter.
-             -> Asker m d -- ^'Asker' for the fourth parameter.
-             -> Asker m e -- ^'Asker' for the fifth parameter.
-             -> Asker m f -- ^'Asker' for the sixth parameter.
-             -> Asker m g -- ^'Asker' for the seventh parameter.
-             -> Asker m h -- ^'Asker' for the eighth parameter.
-             -> (Text -> a -> b -> c -> d -> e -> f -> g -> h -> m z) -- ^Command function.
-             -> Command m Text z
-makeCommand8 n t d canAsk p1 p2 p3 p4 p5 p6 p7 p8 f = Command n t d f'
-   where
-      mx = 8
-      f' args = do let x0 = fromMaybe "" $ L.head args
-                   x1 <- askC canAsk p1 args mx 1
-                   x2 <- askC canAsk p2 args mx 2
-                   x3 <- askC canAsk p3 args mx 3
-                   x4 <- askC canAsk p4 args mx 4
-                   x5 <- askC canAsk p5 args mx 5
-                   x6 <- askC canAsk p6 args mx 6
-                   x7 <- askC canAsk p7 args mx 7
-                   x8 <- askC canAsk p8 args mx 8
-                   res <- f x0 x1 x2 x3 x4 x5 x6 x7 x8
-                   return (res, L.drop (mx+1) args)
-
-
--- |Creates a command with a list of parameters.
---  The first list @necc@ of 'Asker's indicates the necessary parameters;
---  the user must at least provide this many. The second list @opt@ contains
---  'Asker's for additional, optional parameters, and may be infinite.
---  If the number of passed parameters exceeds
---  @length necc + length opt@, or if any 'Asker' fails,
---  the command returns an 'AskFailure'.
-makeCommandN :: (MonadIO m, MonadCatch m, Functor m)
-             => Text -- ^Command name.
-             -> (Text -> Bool) -- ^Command test.
-             -> Text -- ^Command description
-             -> Bool -- ^Whether the command can ask for input. This only
-                     --  affects the necessary parameters.
-             -> [Asker m a] -- ^'Asker's for the necessary parameters.
-             -> [Asker m a] -- ^'Asker's for the optional parameters.
-             -> (Text -> [a] -> m z)
-             -> Command m Text z
-makeCommandN n t d canAsk necc opt f = Command n t d f'
-   where
-      min = P.length necc
-      max = natLength necc + natLength opt
-
-      f' args = do neccParams <- unfoldrM (comb args) (necc,1, Nothing)
-                   let x0 = maybe "" id (L.head args)
-                       from = L.length neccParams + 1
-                       to = Just $ L.length args - 1
-                   optParams <- unfoldrM (comb args) (opt, from, to)
-                   let params = neccParams L.++ optParams
-                   res <- f x0 params
-                   return (res, L.drop (length params + 1) args)
-
-      -- |Goes through the list of askers until all are done or until the first
-      --  AskFailure occurs. The results are of type @Either (AskFailure e) z@,
-      --  the state is of type @([Asker m a e], Int)@. The second component @i@
-      --  indicates that the @i@th parameter is to be read.
-      comb _ ([],_,_) = return Nothing
-      comb inp (x:xs, i, j) =
-         if isJust j && fromJust j < i then return Nothing
-         else askC canAsk x inp min i >$> args xs >$> Just
-
-         where args ys y = (y,(ys,i+1,j))
-
-      askC True f xs _ i = ask f (xs L.!! i)
-      askC False f xs j i = maybe (throwM $ TooFewParamsError j (length xs - 1)) (ask f . Just) (xs L.!! i)
-
--- |Prints out a list of command names, with their descriptions.
-summarizeCommands :: MonadIO m
-                  => [Command m2 i z]
-                  -> m ()
-summarizeCommands [] = return ()
-summarizeCommands xs = liftIO $ mapM_ (\c -> prName c >> prDesc c) xs
-   where
-      maxLen :: Int
-      maxLen = fromIntegral
-               $ T.length
-               $ commandName
-               $ fromJust
-               $ L.minimumBy (comparing $ (* (-1)) . T.length . commandName) xs
-      prName = putStr . padRight ' ' maxLen . commandName
-      prDesc = putStrLn . (" - " ++) . commandDesc
-
-      padRight c i cs = cs ++ replicate (i - length cs) c
-
-askC :: (MonadIO m, MonadCatch m, Functor m)
-     => Bool -> Asker m a -> [Text] -> Int -> Int -> m a
-askC True f xs _ i = ask f (xs L.!! i)
-askC False f xs j i = maybe (throwM $ TooFewParamsError j (length xs - 1)) (ask f . Just) (xs L.!! i)
-
-
--- |Runs a REPL based on a set of commands.
---  For a line of input, the commands are tried in following order:
---
---  * the "exit" command,
---  * all regular commands, and then
---  * the "unknown" command.
-makeREPL :: (Functor m, MonadIO m, MonadCatch m, Functor f, Foldable f)
-         => [Command m Text a]
-            -- ^The regular commands.
-         -> Command m Text b
-            -- ^The "exit" command which terminates the loop.
-         -> Command m Text c
-            -- ^The command that is called when none of the others match.
-            --  This one's 'commandTest' is replaced with @const True@.
-         -> m Text
-            -- ^The asker to execute before each command (i.e. the prompt).
-         -> f (Handler m ())
-            -- ^Handlers for any exceptions that may arise. Generally, you
-            --  will want to handle at least the exceptions of this module
-            --  ('SomeCommandError', 'MalformedParamsError', 'TooManyParamsError',
-            --   'TooFewParamsError'), and whatever the 'Asker' can throw.
-         -> m ()
-            -- ^Asks the user repeatedly for input, until the input matches
-            --  the command test of the "exit" command.
-makeREPL regular exit unknown prompt handlers = void $ iterateUntil id iter
-   where
-      iter = (prompt >>= runSingleCommand allCommands)
-             `catches` handlers'
-
-      handlers' = fmap (\(Handler f) -> Handler (\e -> f e >> return False)) handlers
-      exit' = fmap (const True) exit
-      regular' = L.map (fmap (const False)) regular
-      unknown' = fmap (const False) $ unknown{commandTest = const True}
-
-      allCommands = oneOf "" "" (exit' : regular' ++ [unknown'])
+{-# LANGUAGE OverloadedStrings #-}++-- |Provides Commands for REPLs. Commands are there to provide high-level+--  handling of user input and to offer functionality in a standard, composable+--  way.+--+--  Whereas an 'Asker' is good for getting a single value, a 'Command' can get+--  multiple inputs and be composed with other commands.+--+--  Use cases:+--+--  1. Getting specific numbers of arguments or optional arguments from the user. E.g.+--+--     @+--     \{\-\# LANGUAGE OverloadedStrings \#\-\}+--     +--     import Data.Text (unpack)+--+--     asker :: Asker' IO String+--     asker = Asker "Enter argument: " (Right . unpack) (return . Right)+--+--     cmd = makeCommand3 "command" ("command"==) "description" True [asker,asker,asker] (\t x y z -> putStrLn "yay!")+--     @+--     +--     This is a command with 3 arguments. The user can enter the arguments+--     in the same line or give them one by one:+--+--     >>> command arg1 arg2 arg3+--     yay!+--+--     >>> command+--     Enter argument:+--     >>> arg1+--     Enter  argument:+--     >>> arg2+--     Enter argument:+--     >>> arg3+--     yay!+--     +--     Had we set the bool above to @False@, only the first form would have been allowed.+--+--     Arguments can contain whitespace if they are surrounded with quotes:+--+--     >>> command "arg1 with spaces" arg2 arg3+--     yay!+--+--     Optional arguments are also possible:+--+--     @+--     cmd = makeCommandN "command" ("command"==) "description" True [asker] [optAsker]+--                        (\t (x:xs) -> do putStrLn ("Required argument: " ++ x)+--                                         if null xs then putStrLn "No optional argument."+--                                         else putStrLn ("Optional argument: " ++ head xs))+--     @+--+--     >>> command arg1+--     Required argument: arg1+--     +--     >>> command arg1 arg2+--     Required argument: arg1+--     Optional argument: arg2+--+--  2. Creating command hierarchies, e.g.+--+--     @+--     commit = makeCommand 1 "commit" ...+--     sendEmail = makeCommand "send-email"+--     sendTweet = makeCommand "send-tweet"+--+--     commit' = subcommand commit [sendEmail, sendTweet]+--+--     main = makeREPLSimple [commit']+--     @+-- +--     >>> myVersionControl commit "my first commit" send-email+--+--     Here, @commit@ is the root command and @sendEmail@, @sendTweet@ its two+--     possible sub-commands. The sub-commands get executed after their root command.+--+--  3. Making a REPL out of some commands.+--+--     As above, one can use 'makeREPL' or 'makeREPLSimple' to create a +--     REPL out of a list of commands and use it as the @main@ function instead+--     of going through the chore of writing a loop it by hand.+module System.REPL.Command (+   -- *Command class+   Command(..),+   oneOf,+   subcommand,+   -- **Running commands+   -- |You can use 'runPartialCommand' to run a command as well, but one generally doesn't want left-over input.+   runCommand,+   runSingleCommand,+   runSingleCommandIf,+   -- **Making REPLs+   makeREPL,+   makeREPLSimple,+   -- *Exceptions+   -- |These are the exceptions that can be thrown during the course of command+   --  invocation (in addition to those that you throw yourself, of course).+   --+   --  SomeCommandError is an abstract exception and all others are its concrete+   --  subclasses. See the example in "Control.Exception" for details.+   SomeREPLError(..),+   SomeCommandError(..),+   MalformedParamsError(..),+   TooFewParamsError(..),+   TooManyParamsError(..),+   -- * Dealing with arguments+   readArgs,+   getName,+   defCommandTest,+   quoteArg,+   -- * Helpers+   summarizeCommands,+   -- * Making commands+   -- |Ignore the "a0"-type parameters in the Askers.+   makeCommand,+   makeCommand1,+   makeCommand2,+   makeCommand3,+   makeCommand4,+   makeCommand5,+   makeCommand6,+   makeCommand7,+   makeCommand8,+   makeCommandN,+   -- * Example commands.+   -- |A few commands for convenience.+   noOpCmd,+   defExitCmd,+   defHelpCmd,+   defErrorHandler,+   ) where++import Prelude hiding (putStrLn, putStr, (++), length, replicate)+import qualified Prelude as P++import Control.Monad+import Control.Monad.Catch+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Loops (unfoldrM, iterateUntil)+import Data.Char (isSpace)+import qualified Data.Functor.Bind as Bi+import Data.Functor.Monadic+import qualified Data.List as LU+import qualified Data.List.Safe as L+import Data.ListLike(ListLike(..))+import Data.ListLike.IO (ListLikeIO(..))+import Data.Maybe (fromJust, isJust, fromMaybe)+import Data.Ord+import qualified Data.Text as T+import System.REPL.Ask+import System.REPL.Types+import qualified System.REPL.Prompt as PR+import qualified Text.Parsec as P+import qualified Text.Parsec.Language as P+import qualified Text.Parsec.Token as P++-- alias for Data.ListLike.append+(++) :: (ListLike full item) => full -> full -> full+(++) = append++-- |Runs the command with the input text as parameter, discarding any left-over+--  input. The command test is disregarded.+-- +--  Can throw:+--  +--  * 'MalformedParamsError'+runCommand :: (MonadThrow m) => Command m T.Text a -> T.Text -> m a+runCommand c = fmap fst . runPartialCommand c <=< readArgs++-- |Runs the command with the input text as parameter.+--  The command test is disregarded.+--+--  Can throw:+--  +--  * 'MalformedParamsError'+--  * 'TooManyParamsError', if any input is left unconsumed.+--+--  __Note:__ 'TooManyParamsError' will only be thrown after the command's execution+--  is attempted. This is because of the subcommand mechanism, which prevents the+--  static determination of the number of required arguments.+runSingleCommand :: (MonadThrow m) => Command m T.Text a -> T.Text -> m a+runSingleCommand c t = fromJust <$> runSingleCommandIf (c{commandTest = const True}) t++-- |Runs the command with the input text as parameter. If the input doesn't+--  pass the command test, @Nothing@ is returned.+--+--  Can throw:+--  +--  * 'MalformedParamsError'+--  * 'TooManyParamsError', if any input is left unconsumed.+runSingleCommandIf :: MonadThrow m => Command m T.Text a -> T.Text -> m (Maybe a)+runSingleCommandIf c t = do+   t' <- readArgs t+   if L.null t' || not (commandTest c $ LU.head t') then return Nothing+   else do+      (res, output) <- runPartialCommand c t'+      let act = length t'+          mx  = act - length output+      when (not . L.null $ output) (throwM $ TooManyParamsError mx act)+      return $ Just res+++-- |Takes a list @xs@ and executes the first command in a list whose+--  'commandTest' matches the input.+--+--  Note that the resultant command @c@'s' 'runPartialCommand' should only be+--  executed with an input @t@ if 'commandTest c t' == True', where @t'@ is either+--  @head (readArgs t)@ or @mempty@ if @t@ is empty.+--  Otherwise, the result is undefined.+oneOf :: Monoid i+      => T.Text+         -- ^Command name.+      -> T.Text+         -- ^Command description.+      -> [Command m i a]+      -> Command m i a+oneOf n d xs = Command n test d cmd+   where+      test t = L.any (($ t) . commandTest) xs+      -- because of @test@, the list is guaranteed to be non-empty+      cmd input = (`runPartialCommand` input)+                  . LU.head+                  . L.dropWhile (not . ($ fromMaybe mempty (L.head input)) . commandTest) $ xs++-- |Adds a list of possible subcommands after a command (that should leave+--  some input unconsumed). Ignoring all the required parameters for a moment,+--+--  > subcommand x xs = x >>- oneOf xs+subcommand :: (Monad m, Monoid i)+           => Command m i a+              -- ^The root command.+           -> [a -> Command m i b]+              -- ^The subcommands that may follow it. This list must be finite.+           -> Command m i b+subcommand x xs = x Bi.>>- \y -> oneOf "" "" (L.map ($ y) xs)++-- |Splits and trims the input of a command. If the input cannot be parsed, a+--  'MalformedParamsError' exception is thrown.+--+--  === Format+--+--  Any non-whitespace sequence of characters is interpreted as+--  one argument, unless double quotes (") are used, in which case+--  they demarcate an argument. Each argument is parsed as a haskell+--  string literal (quote-less arguments have quotes inserted around them).+--+--  Arguments are parsed using parsec's @stringLiteral@ (haskell-style),+--  meaning that escape sequences and unicode characters are handled automatically.+readArgs :: MonadThrow m => T.Text -> m [T.Text]+readArgs = either err return . P.parse parser "" . T.unpack+   where+      err = throwM . MalformedParamsError . T.pack . show+      -- Main parser.+      parser = P.many (stringLiteral P.<|> unquotedLiteral)++      stringLiteral = P.stringLiteral P.haskell >$> T.pack++      -- The parser for string literals without quotes around them.+      --+      -- First we read a bunch of characters and then we pass the result,+      -- wrapped in quotes, to the stringLiteral parser AGAIN.+      -- This might seem strange, but this way, escape sequences are correctly+      -- handled. The alternative would have been to copy the (private) logic+      -- found in Text.Parsec.Token's source.+      unquotedLiteral =+         do raw <- P.many1 $ P.satisfy $ not . isSpace+            P.eof P.<|> (P.many1 P.space >> return ())+            let lit = stringLiteral+                res = P.parse lit "" ("\"" ++ raw ++ "\"")+            case res of (Right r) -> return r+                        (Left l) -> fail (show l)++-- |Gets the first part of a command string. Returns Nothing+--  if the string is empty of if 'readArgs' throws a 'MalformedParamsError'.+getName :: T.Text -> Maybe T.Text+getName = readArgs >=> L.head++-- |The "default" command test for making commands.+--  This function uses 'getName' to extract the first part of the user input,+--  stripping whitespace and also checking whether the entire input is well-formed.+defCommandTest :: [T.Text] -- ^Command names, including permissible aliases.+               -> T.Text -- ^User input.+               -> Bool+defCommandTest xs = maybe False (`L.elem` xs) . getName++-- |Surrounds an argument in quote marks, if necessary.+--  This is useful when arguments were extracted via 'readArgs', which deletes+--  quote marks. Quotes are placed around the input iff it is empty or contains+--  whitespace.+quoteArg :: T.Text -> T.Text+quoteArg x = if T.null x || T.any isSpace x then '\"' `T.cons` x `T.snoc` '\"'+                                            else x++-- |Creates a command without parameters.+makeCommand :: (MonadIO m, MonadCatch m, Monoid i)+            => T.Text -- ^Command name.+            -> (i -> Bool) -- ^Command test.+            -> T.Text -- ^Command description.+            -> (i -> m z)+               -- ^Command function. It will receive the first part of the input+               --  (customarily the command name), or the empty string if the+               --  input only contained whitespace.+            -> Command m i z+makeCommand n t d f = Command n t d f'+   where+      f' args = do res <- f $ fromMaybe mempty $ L.head args+                   return (res, L.drop 1 args)+++-- |Creates a command with one parameter.+makeCommand1 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+                     --  If True, running the command will run the Asker's+                     --  IO action if not enough input is provided. If False+                     --  a 'TooFewParamsError' will be thrown.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> (T.Text -> a -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand1 n t d canAsk p1 f = Command n t d f'+   where+      mx = 1+      f' args = do let x0 = fromMaybe mempty $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   res <- f x0 x1+                   return (res, L.drop (mx+1) args)++-- |Creates a command with two parameters.+makeCommand2 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> Asker m b0 b -- ^'Asker' for the second parameter.+             -> (T.Text -> a -> b -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand2 n t d canAsk p1 p2 f = Command n t d f'+   where+      mx = 2+      f' args = do let x0 = fromMaybe mempty $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   x2 <- askC p2 args 2+                   res <- f x0 x1 x2+                   return (res, L.drop (mx+1) args)++-- |Creates a command with three parameters.+makeCommand3 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> Asker m b0 b -- ^'Asker' for the second parameter.+             -> Asker m c0 c -- ^'Asker' for the third parameter.+             -> (T.Text -> a -> b -> c -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand3 n t d canAsk p1 p2 p3 f = Command n t d f'+   where+      mx = 3+      f' args = do let x0 = fromMaybe "" $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   x2 <- askC p2 args 2+                   x3 <- askC p3 args 3+                   res <- f x0 x1 x2 x3+                   return (res, L.drop (mx+1) args)++-- |Creates a command with four parameters.+makeCommand4 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> Asker m b0 b -- ^'Asker' for the second parameter.+             -> Asker m c0 c -- ^'Asker' for the third parameter.+             -> Asker m d0 d -- ^'Asker' for the fourth parameter.+             -> (T.Text -> a -> b -> c -> d -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand4 n t d canAsk p1 p2 p3 p4 f = Command n t d f'+   where+      mx = 4+      f' args = do let x0 = fromMaybe "" $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   x2 <- askC p2 args 2+                   x3 <- askC p3 args 3+                   x4 <- askC p4 args 4+                   res <- f x0 x1 x2 x3 x4+                   return (res, L.drop (mx+1) args)++-- |Creates a command with five parameters.+makeCommand5 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> Asker m b0 b -- ^'Asker' for the second parameter.+             -> Asker m c0 c -- ^'Asker' for the third parameter.+             -> Asker m d0 d -- ^'Asker' for the fourth parameter.+             -> Asker m e0 e -- ^'Asker' for the fifth parameter.+             -> (T.Text -> a -> b -> c -> d -> e -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand5 n t d canAsk p1 p2 p3 p4 p5 f = Command n t d f'+   where+      mx = 5+      f' args = do let x0 = fromMaybe "" $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   x2 <- askC p2 args 2+                   x3 <- askC p3 args 3+                   x4 <- askC p4 args 4+                   x5 <- askC p5 args 5+                   res <- f x0 x1 x2 x3 x4 x5+                   return (res, L.drop (mx+1) args)++-- |Creates a command with six parameters.+makeCommand6 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> Asker m b0 b -- ^'Asker' for the second parameter.+             -> Asker m c0 c -- ^'Asker' for the third parameter.+             -> Asker m d0 d -- ^'Asker' for the fourth parameter.+             -> Asker m e0 e -- ^'Asker' for the fifth parameter.+             -> Asker m f0 f -- ^'Asker' for the sixth parameter.+             -> (T.Text -> a -> b -> c -> d -> e -> f -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand6 n t d canAsk p1 p2 p3 p4 p5 p6 f = Command n t d f'+   where+      mx = 6+      f' args = do let x0 = fromMaybe mempty $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   x2 <- askC p2 args 2+                   x3 <- askC p3 args 3+                   x4 <- askC p4 args 4+                   x5 <- askC p5 args 5+                   x6 <- askC p6 args 6+                   res <- f x0 x1 x2 x3 x4 x5 x6+                   return (res, L.drop (mx+1) args)++-- |Creates a command with seven parameters.+makeCommand7 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> Asker m b0 b -- ^'Asker' for the second parameter.+             -> Asker m c0 c -- ^'Asker' for the third parameter.+             -> Asker m d0 d -- ^'Asker' for the fourth parameter.+             -> Asker m e0 e -- ^'Asker' for the fifth parameter.+             -> Asker m f0 f -- ^'Asker' for the sixth parameter.+             -> Asker m g0 g -- ^'Asker' for the seventh parameter.+             -> (T.Text -> a -> b -> c -> d -> e -> f -> g -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand7 n t d canAsk p1 p2 p3 p4 p5 p6 p7 f = Command n t d f'+   where+      mx = 7+      f' args = do let x0 = fromMaybe "" $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   x2 <- askC p2 args 2+                   x3 <- askC p3 args 3+                   x4 <- askC p4 args 4+                   x5 <- askC p5 args 5+                   x6 <- askC p6 args 6+                   x7 <- askC p7 args 7+                   res <- f x0 x1 x2 x3 x4 x5 x6 x7+                   return (res, L.drop (mx+1) args)++-- |Creates a command with eight parameters.+makeCommand8 :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input.+             -> Asker m a0 a -- ^'Asker' for the first parameter.+             -> Asker m b0 b -- ^'Asker' for the second parameter.+             -> Asker m c0 c -- ^'Asker' for the third parameter.+             -> Asker m d0 d -- ^'Asker' for the fourth parameter.+             -> Asker m e0 e -- ^'Asker' for the fifth parameter.+             -> Asker m f0 f -- ^'Asker' for the sixth parameter.+             -> Asker m g0 g -- ^'Asker' for the seventh parameter.+             -> Asker m h0 h -- ^'Asker' for the eighth parameter.+             -> (T.Text -> a -> b -> c -> d -> e -> f -> g -> h -> m z) -- ^Command function.+             -> Command m T.Text z+makeCommand8 n t d canAsk p1 p2 p3 p4 p5 p6 p7 p8 f = Command n t d f'+   where+      mx = 8+      f' args = do let x0 = fromMaybe "" $ L.head args+                   when (not canAsk) $ checkParamNum args mx+                   x1 <- askC p1 args 1+                   x2 <- askC p2 args 2+                   x3 <- askC p3 args 3+                   x4 <- askC p4 args 4+                   x5 <- askC p5 args 5+                   x6 <- askC p6 args 6+                   x7 <- askC p7 args 7+                   x8 <- askC p8 args 8+                   res <- f x0 x1 x2 x3 x4 x5 x6 x7 x8+                   return (res, L.drop (mx+1) args)+++-- |Creates a command with a list of parameters.+--  The first list @necc@ of 'Asker's indicates the necessary parameters;+--  the user must at least provide this many. The second list @opt@ contains+--  'Asker's for additional, optional parameters, and may be infinite.+--  If the number of passed parameters exceeds+--  @length necc + length opt@, or if any 'Asker' fails,+--  the command returns an 'AskFailure'.+makeCommandN :: (MonadIO m, MonadCatch m)+             => T.Text -- ^Command name.+             -> (T.Text -> Bool) -- ^Command test.+             -> T.Text -- ^Command description+             -> Bool -- ^Whether the command can ask for input. This only+                     --  affects the necessary parameters.+             -> [Asker m a0 a] -- ^'Asker's for the necessary parameters.+             -> [Asker m b0 a] -- ^'Asker's for the optional parameters.+             -> (T.Text -> [a] -> m z)+             -> Command m T.Text z+makeCommandN n t d canAsk necc opt f = Command n t d f'+   where+      min = P.length necc++      f' args = do when (not canAsk) $ checkParamNum args min+                   neccParams <- unfoldrM (comb args) (necc,1, Nothing)+                   let x0 = maybe "" id (L.head args)+                       from = L.length neccParams + 1+                       to = Just $ L.length args - 1+                   optParams <- unfoldrM (comb args) (opt, from, to)+                   let params = neccParams L.++ optParams+                   res <- f x0 params+                   return (res, L.drop (length params + 1) args)++      -- |Goes through the list of askers until all are done or until the first+      --  AskFailure occurs. The results are of type @Either (AskFailure e) z@,+      --  the state is of type @([Asker m a e], Int)@. The second component @i@+      --  indicates that the @i@th parameter is to be read.+      comb _ ([],_,_) = return Nothing+      comb inp (x:xs, i, j) = if isJust j && fromJust j < i+                              then return Nothing+                              else askC x inp i >$> args xs >$> Just+         where+            args ys y = (y,(ys,i+1,j))++-- |Prints out a list of command names, with their descriptions.+summarizeCommands :: MonadIO m+                  => [Command m2 i z]+                  -> m ()+summarizeCommands [] = return ()+summarizeCommands xs = liftIO $ mapM_ (\c -> prName c >> prDesc c) xs+   where+      maxLen :: Int+      maxLen = fromIntegral+               $ T.length+               $ commandName+               $ fromJust+               $ L.minimumBy (comparing $ (* (-1)) . T.length . commandName) xs+      prName = putStr . padRight ' ' maxLen . commandName+      prDesc = putStrLn . (" - " ++) . commandDesc++      padRight c i cs = cs ++ replicate (i - length cs) c++-- |Throws a 'TooFewParamsError' if the length of the list is smaller than the second argument.+checkParamNum :: MonadThrow m => [a] -> Int -> m ()+checkParamNum xs need = if have < need then throwM $ TooFewParamsError need have else return ()+   where have = length xs - 1 ++-- |Wrapper for 'ask'.+askC :: (MonadIO m, MonadCatch m)+     => Asker m a0 a -> [T.Text] -> Int -> m a+askC f xs i = ask f (xs L.!! i)++--askC False f xs j i = maybe (throwM $ TooFewParamsError j (length xs - 1)) (ask f . Just) (xs L.!! i)++-- |Runs a REPL based on a set of commands.+--  For a line of input, the commands are tried in following order:+--+--  * the "exit" command,+--  * all regular commands, and then+--  * the "unknown" command.+makeREPL :: (MonadIO m, MonadCatch m)+         => [Command m T.Text a]+            -- ^The regular commands.+         -> Command m T.Text b+            -- ^The "exit" command which terminates the loop.+         -> Command m T.Text c+            -- ^The command that is called when none of the others match.+            --  This one's 'commandTest' is replaced with @const True@.+         -> m T.Text+            -- ^The asker to execute before each command (i.e. the prompt).+         -> [Handler m ()]+            -- ^List of Handlers for any exceptions that may arise.+            --  The exception hierchy is rooted in 'SomeREPLError'.+            --  See "System.REPL.Types".+         -> m ()+            -- ^Asks the user repeatedly for input, until the input matches+            --  the command test of the "exit" command.+makeREPL regular exit unknown prompt handlers = void $ iterateUntil id iter+   where+      iter = (prompt >>= runSingleCommand allCommands)+             `catches` handlers'++      handlers' = fmap (\(Handler f) -> Handler (\e -> f e >> return False)) handlers+      exit' = fmap (const True) exit+      regular' = L.map (fmap (const False)) regular+      unknown' = fmap (const False) $ unknown{commandTest = const True}++      allCommands = oneOf "" "" (exit' : regular' ++ [unknown'])++-- |A variant of 'makeREPL' with some default settings:+--+--  * The "exit" command is 'defExitCmd'.+--  * The "unknown" command prints "Unknown command: <user input>".+--  * The prompt is "> ".+--  * The error handler is 'defErrorHandler'.+makeREPLSimple :: (MonadIO m, MonadCatch m)+               => [Command m T.Text a]+               -> m ()+makeREPLSimple regular = makeREPL regular defExitCmd unknownCmd PR.prompt defErrorHandler+   where+      unknownCmd = makeCommandN "" (const True) "" False [] (repeat lineAsker)+                                (\t _ -> liftIO $ PR.putStrLn $ "Unknown command: " ++ t)++-- Example commands+-------------------------------------------------------------------------------++-- |A command that takes no arguments and does nothing.+noOpCmd :: (MonadIO m, MonadCatch m)+        => T.Text+           -- ^Command name.+        -> [T.Text]+           -- ^Alternative names for the command. The user can either+           --  the command name or any of the alternative names.+           --+           --  E.g. "exit" with alternative names ":e", ":quit".+        -> Command m T.Text ()+noOpCmd n ns = makeCommand n ((`L.elem` (n:ns)) . T.strip) "" (const $ return ())++-- |A command with the name ":exit" and the description+--  "Exits the program." Otherwise, it does nothing.+--+--  You can use this as the exit-command for 'makeREPL',+--  if no special clean-up is needed upon quitting.+defExitCmd :: (MonadIO m, MonadCatch m)+           => Command m T.Text ()+defExitCmd = makeCommand n ((n==) . T.strip) "Exits the program." (const $ return ())+   where+      n = ":exit"++-- |A help-command with the name ":help" and the+--  description "Prints this help text."+--+--  It goes through the given list of commands and prints+--  the name and description of each one.+defHelpCmd :: (MonadIO m, MonadCatch m, Foldable f)+           => f (Command m0 a b)+           -> Command m T.Text ()+defHelpCmd cmds = makeCommand n ((n==) . T.strip) "Prints this help text." help+   where+      n = ":help"+      help _ = liftIO $ mapM_ (\x -> putStrLn $ commandName x ++ " - " ++ commandDesc x) cmds++-- |A default error handler that catches 'SomeREPLError' and prints it to stdout.+--+--  Useful in combination with 'makeREPL'.+defErrorHandler :: MonadIO m+                => [Handler m ()]+defErrorHandler = [Handler h]+   where+      h :: MonadIO m => SomeREPLError -> m ()+      h = liftIO . print
System/REPL/Config.hs view
@@ -1,85 +1,83 @@-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-
--- |Contains logic for reading configuration files.
-module System.REPL.Config (
-   readConfigFile,
-   readConfigJSON,
-   readConfigShow,
-   NoParseError(..),
-   ) where
-
-import Prelude hiding ((++), FilePath)
-
-import Control.Monad.Catch
-import Control.Monad.IO.Class
-import Data.Aeson
-import qualified Data.ByteString.Lazy as BL
-import Data.Default
-import Data.Functor.Monadic
-import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
-import qualified Data.Text.Lazy as T
-import Data.Typeable
-import qualified System.FilePath as Fp
-import System.Directory
-import Text.Read (readMaybe)
-
--- |Indicates that some string was not able to be parsed.
-data NoParseError = NoParseError T.Text deriving (Show, Eq, Read, Typeable)
-
-instance Exception NoParseError
-
--- |Creates a NoParseError out of a 'Fp.FilePath'.
-noParseError :: Fp.FilePath -> NoParseError
-noParseError = NoParseError . T.pack
-
--- |Variant of 'readConfigFile' that uses 'Show' and 'Read' for (de)serialization.
---
---  If the file's content's can't be parsed, a 'NoParseError' will be thrown.
-readConfigShow :: forall m a.
-                  (MonadThrow m, Functor m, MonadIO m, Default a, Show a,
-                   Read a)
-               => Fp.FilePath
-               -> m a
-readConfigShow path = readConfigFile path readEither showBL
-   where
-      showBL = encodeUtf8 . T.pack . show
-      readEither = maybe (Left $ noParseError path) Right . readMaybe . T.unpack . decodeUtf8
-
--- |Variant of 'readConfigFile' that uses JSON for (de)serialization.
---
---  If the file's content's can't be parsed, a 'NoParseError' will be thrown.
-readConfigJSON :: forall m a.
-                  (MonadThrow m, Functor m, MonadIO m, Default a, ToJSON a,
-                   FromJSON a)
-               => Fp.FilePath
-               -> m a
-readConfigJSON path = readConfigFile path decodeEither encode
-   where
-      decodeEither = maybe (Left $ noParseError path) Right . decode
-
--- |Tries to read a configuration from file. If the file is missing,
---  a default instance is written to file and returned. The following
---  exceptions may be thrown:
---
---  * @IOException@, if the IO operations associated with reading or creating the
---    configuration file fail, and
---  * An exception of type @e@ if the configuration file is present, but its
---    contents can't be parsed.
-readConfigFile :: forall e m a.
-                  (MonadThrow m, Functor m, MonadIO m, Default a, Exception e)
-               => Fp.FilePath -- ^Path of the configuration file.
-               -> (BL.ByteString -> Either e a)
-                  -- ^Parser for the file's contents.
-               -> (a -> BL.ByteString)
-                  -- ^Encoder for the default value. If the given configuration
-                  --  file does not exist, a default value will be serialized
-                  --  using this function.
-               -> m a
-readConfigFile path parser writer = do
-   liftIO $ createDirectoryIfMissing True $ Fp.takeDirectory path
-   exists <- liftIO $ doesFileExist path
-   content <- if not exists then do liftIO $ BL.writeFile path (writer (def :: a))
-                                    return $ Right def
-              else liftIO (BL.readFile path) >$> parser
-   either throwM return content
+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable #-}++-- |Contains logic for reading configuration files.+module System.REPL.Config (+   readConfigFile,+   readConfigJSON,+   readConfigShow,+   -- *Exceptions+   -- |A NoConfigFileParseError gets thrown whenever a config file can't be parsed.+   NoConfigFileParseError(..),+   ) where++import Prelude hiding ((++), FilePath)++import Control.Monad.Catch+import Control.Monad.IO.Class+import Data.Aeson+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Default+import Data.Functor.Monadic+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import qualified Data.Text as T+import qualified System.FilePath as Fp+import System.Directory+import System.REPL.Types+import Text.Read (readMaybe)++-- |Creates a NoParseError out of a 'Fp.FilePath'.+noParseError :: Fp.FilePath -> NoConfigFileParseError+noParseError = NoConfigFileParseError . T.pack++-- |Variant of 'readConfigFile' that uses 'Show' and 'Read' for (de)serialization.+--+--  If the file's content's can't be parsed, a 'NoParseError' will be thrown.+readConfigShow :: forall m a.+                  (MonadThrow m, Functor m, MonadIO m, Default a, Show a,+                   Read a)+               => Fp.FilePath+               -> m a+readConfigShow path = readConfigFile path readEither showBS+   where+      showBS = encodeUtf8 . T.pack . show+      readEither = maybe (Left $ noParseError path) Right . readMaybe . T.unpack . decodeUtf8++-- |Variant of 'readConfigFile' that uses JSON for (de)serialization.+--+--  If the file's content's can't be parsed, a 'NoParseError' will be thrown.+readConfigJSON :: forall m a.+                  (MonadThrow m, Functor m, MonadIO m, Default a, ToJSON a,+                   FromJSON a)+               => Fp.FilePath+               -> m a+readConfigJSON path = readConfigFile path decodeEither (BL.toStrict . encode)+   where+      decodeEither = maybe (Left $ noParseError path) Right . decode . BL.fromStrict++-- |Tries to read a configuration from file. If the file is missing,+--  a default instance is written to file and returned. The following+--  exceptions may be thrown:+--+--  * @IOException@, if the IO operations associated with reading or creating the+--    configuration file fail, and+--  * An exception of type @e@ if the configuration file is present, but its+--    contents can't be parsed.+readConfigFile :: forall e m a.+                  (MonadThrow m, Functor m, MonadIO m, Default a, Exception e)+               => Fp.FilePath -- ^Path of the configuration file.+               -> (B.ByteString -> Either e a)+                  -- ^Parser for the file's contents.+               -> (a -> B.ByteString)+                  -- ^Encoder for the default value. If the given configuration+                  --  file does not exist, a default value will be serialized+                  --  using this function.+               -> m a+readConfigFile path parser writer = do+   liftIO $ createDirectoryIfMissing True $ Fp.takeDirectory path+   exists <- liftIO $ doesFileExist path+   content <- if not exists then do liftIO $ B.writeFile path (writer (def :: a))+                                    return $ Right def+              else liftIO (B.readFile path) >$> parser+   either throwM return content
+ System/REPL/Prompt.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |Little helper functions for getting and putting lines.+--  +--  This module re-exports part of "Data.ListLike.IO", which contains names that clash with Prelude.+module System.REPL.Prompt (+   -- *String-generic versions of Prelude Functions+   module Data.ListLike.IO,+   putErr,+   putErrLn,+   prompt,+   -- * Prompts+   prompt',+   promptAbort,+   ) where++import Prelude hiding (putStrLn, putStr, getLine, reverse)++import Control.Monad.Catch+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.ListLike(ListLike(empty, cons, reverse))+import Data.ListLike.IO (ListLikeIO(..))+import qualified System.IO as IO+import System.REPL.Types++-- |Prints a string to stderr.+putErr :: ListLikeIO full item => full -> IO ()+putErr = hPutStr IO.stderr++-- |Prints a string, followed by a newline character, to stderr.+putErrLn :: ListLikeIO full item => full -> IO ()+putErrLn = hPutStrLn IO.stderr++-- |Prints @> @ and asks the user to input a line.+prompt :: (MonadIO m, ListLikeIO full item) => m full+prompt = prompt' ("> " :: String)++-- |Prints its first argument and, in the same line, asks the user+--  to input a line.+prompt' :: (MonadIO m, ListLikeIO full item, ListLikeIO full' item')+        => full -> m full'+prompt' s = liftIO (putStr s >> IO.hFlush IO.stdout >> getLine)++-- |The same as prompt, but aborts as soon as the user presses a given key+--  (commonly @'\ESC'@). This function temporarily tries to set the buffering mode+--  to NoBuffering via 'System.IO.hSetBuffering', which may not be supported.+--  See the documentation of 'System.IO.hSetBuffering' for details.+promptAbort :: (MonadIO m, ListLikeIO full item, ListLikeIO full' Char,+                MonadCatch m)+            => Char -> full -> m full'+promptAbort abortChar s = do+   liftIO $ putStr s+   liftIO $ IO.hFlush IO.stdout+   bufMode <- liftIO $ IO.hGetBuffering IO.stdin+   liftIO $ IO.hSetBuffering IO.stdin IO.NoBuffering+   input <- getUntil empty+            `catch` (\(e :: SomeAskerError) ->+                        liftIO (IO.hSetBuffering IO.stdin bufMode) >> throwM e)+   liftIO $ IO.hSetBuffering IO.stdin bufMode+   return $ reverse input+   where+      getUntil acc = do c <- liftIO $ getChar+                        if c == abortChar then throwM AskerInputAbortedError+                        else if c == '\n' then return acc+                        else                   getUntil (cons c acc)
System/REPL/State.hs view
@@ -1,102 +1,102 @@--- |Helper functions relating to State.
-module System.REPL.State (
-   -- *Convenience functions for handling state
-   -- |These can be convenient when one wishes to
-   --  to extract a number of elements from the current state via pattern
-   --  -matching, e.g.
-   --
-   --  @ data State = State{f::a,g::b,h::c}
-   --    ...
-   --    do (x,z) <- get2 f h
-   --       ...do something with x and z... @
-   get1,
-   get2,
-   get3,
-   get4,
-   get5,
-   get6,
-   get7,
-   get8,
-   )where
-
-import Control.Arrow
-import Control.Monad
-import Control.Monad.State
-
--- |Extracts a result from the current state.
---  Defined as @get1 f = liftM f get@.
-get1 :: Monad m
-     => (s -> a)
-     -> StateT s m a
-get1 f1 = liftM f1 get
-
--- |Extracts two results from the current state.
-get2 :: Monad m
-     => (s -> a)
-     -> (s -> b)
-     -> StateT s m (a,b)
-get2 f1 f2 = liftM (f1 &&& f2) get
-
--- |Extracts three results from the current state.
-get3 :: Monad m
-     => (s -> a)
-     -> (s -> b)
-     -> (s -> c)
-     -> StateT s m (a,b,c)
-get3 f1 f2 f3 = liftM (\x -> (f1 x,f2 x, f3 x)) get
-
--- |Extracts four results from the current state.
-get4 :: Monad m
-     => (s -> a)
-     -> (s -> b)
-     -> (s -> c)
-     -> (s -> d)
-     -> StateT s m (a,b,c,d)
-get4 f1 f2 f3 f4 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x)) get
-
--- |Extracts five results from the current state.
-get5 :: Monad m
-     => (s -> a)
-     -> (s -> b)
-     -> (s -> c)
-     -> (s -> d)
-     -> (s -> e)
-     -> StateT s m (a,b,c,d,e)
-get5 f1 f2 f3 f4 f5 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x)) get
-
--- |Extracts six results from the current state.
-get6 :: Monad m
-     => (s -> a)
-     -> (s -> b)
-     -> (s -> c)
-     -> (s -> d)
-     -> (s -> e)
-     -> (s -> f)
-     -> StateT s m (a,b,c,d,e,f)
-get6 f1 f2 f3 f4 f5 f6 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x, f6 x)) get
-
--- |Extracts seven results from the current state.
-get7 :: Monad m
-     => (s -> a)
-     -> (s -> b)
-     -> (s -> c)
-     -> (s -> d)
-     -> (s -> e)
-     -> (s -> f)
-     -> (s -> g)
-     -> StateT s m (a,b,c,d,e,f,g)
-get7 f1 f2 f3 f4 f5 f6 f7 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x, f6 x, f7 x)) get
-
--- |Extracts eight results from the current state.
-get8 :: Monad m
-     => (s -> a)
-     -> (s -> b)
-     -> (s -> c)
-     -> (s -> d)
-     -> (s -> e)
-     -> (s -> f)
-     -> (s -> g)
-     -> (s -> h)
-     -> StateT s m (a,b,c,d,e,f,g,h)
-get8 f1 f2 f3 f4 f5 f6 f7 f8 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x, f6 x, f7 x, f8 x)) get
-
+-- |Helper functions relating to State.+module System.REPL.State (+   -- *Convenience functions for handling state+   -- |These can be convenient when one wishes to+   --  to extract a number of elements from the current state via pattern+   --  -matching, e.g.+   --+   --  @ data State = State{f::a,g::b,h::c}+   --    ...+   --    do (x,z) <- get2 f h+   --       ...do something with x and z... @+   get1,+   get2,+   get3,+   get4,+   get5,+   get6,+   get7,+   get8,+   )where++import Control.Arrow+import Control.Monad+import Control.Monad.State++-- |Extracts a result from the current state.+--  Defined as @get1 f = liftM f get@.+get1 :: Monad m+     => (s -> a)+     -> StateT s m a+get1 f1 = liftM f1 get++-- |Extracts two results from the current state.+get2 :: Monad m+     => (s -> a)+     -> (s -> b)+     -> StateT s m (a,b)+get2 f1 f2 = liftM (f1 &&& f2) get++-- |Extracts three results from the current state.+get3 :: Monad m+     => (s -> a)+     -> (s -> b)+     -> (s -> c)+     -> StateT s m (a,b,c)+get3 f1 f2 f3 = liftM (\x -> (f1 x,f2 x, f3 x)) get++-- |Extracts four results from the current state.+get4 :: Monad m+     => (s -> a)+     -> (s -> b)+     -> (s -> c)+     -> (s -> d)+     -> StateT s m (a,b,c,d)+get4 f1 f2 f3 f4 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x)) get++-- |Extracts five results from the current state.+get5 :: Monad m+     => (s -> a)+     -> (s -> b)+     -> (s -> c)+     -> (s -> d)+     -> (s -> e)+     -> StateT s m (a,b,c,d,e)+get5 f1 f2 f3 f4 f5 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x)) get++-- |Extracts six results from the current state.+get6 :: Monad m+     => (s -> a)+     -> (s -> b)+     -> (s -> c)+     -> (s -> d)+     -> (s -> e)+     -> (s -> f)+     -> StateT s m (a,b,c,d,e,f)+get6 f1 f2 f3 f4 f5 f6 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x, f6 x)) get++-- |Extracts seven results from the current state.+get7 :: Monad m+     => (s -> a)+     -> (s -> b)+     -> (s -> c)+     -> (s -> d)+     -> (s -> e)+     -> (s -> f)+     -> (s -> g)+     -> StateT s m (a,b,c,d,e,f,g)+get7 f1 f2 f3 f4 f5 f6 f7 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x, f6 x, f7 x)) get++-- |Extracts eight results from the current state.+get8 :: Monad m+     => (s -> a)+     -> (s -> b)+     -> (s -> c)+     -> (s -> d)+     -> (s -> e)+     -> (s -> f)+     -> (s -> g)+     -> (s -> h)+     -> StateT s m (a,b,c,d,e,f,g,h)+get8 f1 f2 f3 f4 f5 f6 f7 f8 = liftM (\x -> (f1 x,f2 x, f3 x, f4 x, f5 x, f6 x, f7 x, f8 x)) get+
+ System/REPL/Types.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}++-- |Types used by other modules in the package.+--+--  The module contains the following exception hierarchy:+--+--  * 'SomeREPLError'+--+--      * 'SomeAskerError'+--+--          * 'AskerTypeError'+--          * 'AskerPredicateError'+--          * 'AskerInputAbortedError'+--+--      * 'SomeCommandError'+--+--          * 'MalformedParamsError'+--          * 'TooFewParamsError'+--          * 'TooManyParamsError'+--+--  * 'NoConfigFileParseError'+--+module System.REPL.Types where++import Control.Exception+import qualified Data.Functor.Apply as Ap+import qualified Data.Functor.Bind as Bi+import qualified Data.Text as T+import Data.Typeable++-- Asker types+-------------------------------------------------------------------------------++-- |An error message indicating that a value wasn't able to be parsed.+type TypeError = SomeException+-- |An error message indicating that a value failied a predicate.+type PredicateError = SomeException+-- |A prompt.+type PromptMsg = T.Text++-- |A predicate which a value has to fulfil.+type Predicate m a b = a -> m (Either PredicateError b)++-- |A predicate which does not change the type of its input.+type Predicate' m a = Predicate m a a++-- |A parser which either returns a parsed value or an error message.+type Parser a = T.Text -> Either TypeError a++-- |The description of an \'ask for user input\'-action.+--  The type parameters are the used monad (typically 'IO' or 'ExceptT'),+--  the type of the read value and the type of the error that is thrown+--  in case of failures.+--+--  The components are a prompt, a parser, and a predicate that+--  the parsed value must fulfil. The the predicate+--+--  * is monadic and+--  * can change the returned type (useful for adjoining additional information)+data Asker m a b = Asker{ -- |The prompt to be displayed to the user.+                          askerPrompt::T.Text,+                          -- |The parser for the input value.+                          askerParser::Parser a,+                          -- |The predicate which the input, once read,+                          --  must fulfill. The Left side is an error message.+                          askerPredicate::Predicate m a b}++-- |An Asker which does not convert its argument into different type after parsing.+type Asker' m a = Asker m a a++-- |Root of the exception hierarchy.+data SomeREPLError = forall e.Exception e => SomeREPLError e deriving (Typeable)+instance Show SomeREPLError where show (SomeREPLError e) = show e+instance Exception SomeREPLError++replErrorUpcast :: (Exception a) => a -> SomeException+replErrorUpcast = toException . SomeREPLError+replErrorDowncast :: (Exception a) => SomeException -> Maybe a+replErrorDowncast x = do {SomeREPLError y <- fromException x; cast y}++-- |Generic error related to 'Asker's. Either the input was incorrect+--  in some way, or the process was aborted by the user.+data SomeAskerError = forall e.Exception e => SomeAskerError e deriving (Typeable)+instance Show SomeAskerError where show (SomeAskerError e) = show e+instance Exception SomeAskerError where+   toException = replErrorUpcast+   fromException = replErrorDowncast++askerErrorUpcast :: (Exception a) => a -> SomeException+askerErrorUpcast = toException . SomeAskerError+askerErrorDowncast :: (Exception a) => SomeException -> Maybe a+askerErrorDowncast x = do {SomeAskerError y <- fromException x; cast y}++-- |The input wasn't able to be parsed.+data AskerTypeError = AskerTypeError SomeException deriving (Show, Typeable)+instance Exception AskerTypeError where+   toException = askerErrorUpcast+   fromException = askerErrorDowncast++-- |The parsed value failed a predicate.+data AskerPredicateError = AskerPredicateError SomeException deriving (Show, Typeable)+instance Exception AskerPredicateError where+   toException = askerErrorUpcast+   fromException = askerErrorDowncast++-- |The input for an Asker was aborted by the user.+data AskerInputAbortedError = AskerInputAbortedError deriving (Show, Typeable)+instance Exception AskerInputAbortedError where+   toException = askerErrorUpcast+   fromException = askerErrorDowncast++-- |A generic type failure for use with Askers.+data GenericTypeError = GenericTypeError T.Text deriving (Show, Typeable, Eq)+instance Exception GenericTypeError++-- |Constructor for 'GenericTypeError' which wraps the value into a 'SomeException'.+genericTypeError :: T.Text -> SomeException+genericTypeError = SomeException . GenericTypeError++-- |A generic predicate failure for use with Askers.+data GenericPredicateError = GenericPredicateError T.Text deriving (Show, Typeable, Eq)+instance Exception GenericPredicateError++-- |Constructor for 'GenericTypeError' which wraps the value into a 'SomeException'.+genericPredicateError :: T.Text -> SomeException+genericPredicateError = SomeException . GenericPredicateError++-- |A verbatim Text whose Read instance simply returns the read+--  string, as-is.+--  This is useful for askers which ask for strings without quotes.+newtype Verbatim = Verbatim{fromVerbatim::T.Text}++-- |Read-instance for 'Verbatim'. Wraps the given value into quotes and+--  reads it a a 'T.Text'.+instance Read Verbatim where+   readsPrec _ s = [(Verbatim $ T.pack s,"")]++-- Types for example askers+-------------------------------------------------------------------------------++-- |Indicates whether the target of a path exists and what form it has.+data PathExistenceType = IsDirectory | IsFile | DoesNotExist deriving (Eq, Show, Ord, Read, Enum, Bounded)++-- |Indicates that no part of a path exists.+data PathRootDoesNotExist = PathRootDoesNotExist FilePath deriving (Typeable, Eq, Show)+instance Exception PathRootDoesNotExist++-- |Indicatres that the last existing portion of a path is not writable.+data PathIsNotWritable = PathIsNotWritable FilePath deriving (Typeable, Eq, Show)+instance Exception PathIsNotWritable++-- Command types+-------------------------------------------------------------------------------++-- Exceptions+-------------------------------------------------------------------------------++-- |Generic error related to command execution.+data SomeCommandError = forall e.Exception e => SomeCommandError e deriving (Typeable)+instance Show SomeCommandError where show (SomeCommandError e) = show e+instance Exception SomeCommandError where+   toException = replErrorUpcast+   fromException = replErrorDowncast++commandErrorUpcast :: (Exception a) => a -> SomeException+commandErrorUpcast = toException . SomeCommandError+commandErrorDowncast :: (Exception a) => SomeException -> Maybe a+commandErrorDowncast x = do {SomeCommandError y <- fromException x; cast y}++-- |The input of a command was malformed and could not interpreted. I.e.+--  the input contained inadmissible characters, or quotes were mismatched.+--  The 'Text' argument contains the parser error.+data MalformedParamsError = MalformedParamsError T.Text deriving (Show, Eq, Typeable, Ord)+instance Exception MalformedParamsError where+   toException = commandErrorUpcast+   fromException = commandErrorDowncast++-- |Too many parameters were given to a command. The first value is the maximum,+--  the second the actual number.+data TooManyParamsError = TooManyParamsError Int Int deriving (Show, Eq, Typeable, Ord)+instance Exception TooManyParamsError where+   toException = commandErrorUpcast+   fromException = commandErrorDowncast++-- |Too few parameters were given to a command. The first value is the minium,+--  the second the actual number.+data TooFewParamsError = TooFewParamsError Int Int deriving (Show, Eq, Typeable, Ord)+instance Exception TooFewParamsError where+   toException = commandErrorUpcast+   fromException = commandErrorDowncast++-- Command type+-------------------------------------------------------------------------------++-- |A REPL command, possibly with parameters.+data Command m i a = Command{+                     -- |The short name of the command. Purely informative.+                     commandName :: T.Text,+                     -- |Returns whether the first part of an input+                     --  (the command name) matches+                     --  a the command. 'defCommandTest' is appropriate for most cases.+                     commandTest :: i -> Bool,+                     -- |A description of the command.+                     commandDesc :: T.Text,+                     -- |Runs the command with the input text as parameter,+                     --  returning the unconsumed input.+                     runPartialCommand :: [i] -> m (a, [i])}++instance Functor m => Functor (Command m i) where+   fmap f c@Command{runPartialCommand=run} = c{runPartialCommand=(fmap (\(x,y) -> (f x, y))  . run)}++instance (Monad m) => Ap.Apply (Command m i) where+   -- |Runs the first command, then the second with the left-over input.+   --  The result of the first command is applied to that of the second.+   --+   --  All other fields (name, description,...) of the second command are+   --  ignored.+   f <.> g = f{runPartialCommand = h}+      where+         h input = do (func, output) <- runPartialCommand f input+                      (arg, output') <- runPartialCommand g output+                      return (func arg, output')+++instance (Monad m) => Bi.Bind (Command m i) where+   -- |The same as 'Ap.<.>', but the second argument can read the result of the+   --  first.+   f >>- g = f{runPartialCommand = h}+      where+         h input = do (res, output)   <- runPartialCommand f input+                      (res', output') <- runPartialCommand (g res) output+                      return (res', output')+++-- Config file types+-------------------------------------------------------------------------------++-- |Indicates that some string was not able to be parsed.+data NoConfigFileParseError = NoConfigFileParseError T.Text deriving (Show, Eq, Read, Typeable)++instance Exception NoConfigFileParseError
changelog.txt view
@@ -1,7 +1,9 @@-0.5 Replaced system-filepath with filepath, as system-filepath has become deprecated. This is a minor, but breaking, change.
-
-0.4 Completely overhauled the command system. It is now possible to chain commands together and make subcommands.
-
-0.3.1 Added functionality for reading configuration files.
-
-0.3 Ditched MonadError in favour of MonadThrow. This should make the functions much easier to use.
+1.0 Refactored the package. Switched from lazy to strict text. Changed the types. Added user input as parameter for Asker error messages.++0.5 Replaced system-filepath with filepath, as system-filepath has become deprecated. This is a minor, but breaking, change.++0.4 Completely overhauled the command system. It is now possible to chain commands together and make subcommands.++0.3.1 Added functionality for reading configuration files.++0.3 Ditched MonadError in favour of MonadThrow. This should make the functions much easier to use.
repl-toolkit.cabal view
@@ -1,28 +1,39 @@--- Initial repl-toolkit.cabal generated by cabal init.  For further
--- documentation, see http://haskell.org/cabal/users-guide/
-
-name:                repl-toolkit
-version:             0.5.0.0
-synopsis:            Toolkit for quickly whipping up config files and command-line interfaces.
-description:         A simple toolkit for quickly whipping up REPLs, input validation and sets of commands included.
-homepage:            https://github.com/ombocomp/repl-toolkit
-license:             Apache-2.0
-license-file:        LICENSE.md
-author:              Janos Tapolczai
-maintainer:          janos.tapolczai@gmail.com
-category:            System, REPL
-build-type:          Simple
-cabal-version:       >=1.10
-extra-source-files:  changelog.txt
-
-source-repository head
-  type: git
-  location: git://github.com/ombocomp/repl-toolkit.git
-
-library
-  exposed-modules:     System.REPL, System.REPL.State, System.REPL.Command,
-                       System.REPL.Config
-  other-extensions:    OverloadedStrings, DeriveDataTypeable, FlexibleContexts, LambdaCase, ScopedTypeVariables
-  build-depends:       base >=4.7 && <5, functor-monadic >=0.1, text >=1.1, ListLike >=4.1, exceptions >=0.4, parsec >=3.1, numericpeano >= 0.1, listsafe >= 0.1, monad-loops >= 0.3, mtl >= 2.2, transformers >= 0.3, directory >= 1.2.1, filepath >= 1.3 && <2, bytestring >= 0.10, data-default >= 0.5.3, aeson >=0.8.0.2, semigroupoids >= 4 && <6
-  default-language:    Haskell2010
-
+-- Initial repl-toolkit.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                repl-toolkit+version:             1.0.0.0+synopsis:            Toolkit for quickly whipping up config files and command-line interfaces.+description:         A simple toolkit for quickly whipping up REPLs, input validation and sets of commands included.+homepage:            https://github.com/ombocomp/repl-toolkit+license:             Apache-2.0+license-file:        LICENSE.md+author:              Janos Tapolczai+maintainer:          janos.tapolczai@gmail.com+category:            System, REPL+build-type:          Simple+cabal-version:       >=1.10+extra-source-files:  changelog.txt++source-repository head+  type: git+  location: git://github.com/ombocomp/repl-toolkit.git++library+  exposed-modules:     System.REPL,+                       System.REPL.Ask,+                       System.REPL.Command,+                       System.REPL.Config,+                       System.REPL.Prompt,+                       System.REPL.State,+                       System.REPL.Types+  other-extensions:    OverloadedStrings,+                       DeriveDataTypeable,+                       FlexibleContexts,+                       LambdaCase,+                       ScopedTypeVariables,+                       ExistentialQuantification,+                       TupleSections+  build-depends:       base >=4.8 && <5, functor-monadic >=0.1, text >=1.1, ListLike >=4.1, exceptions >=0.8 && <1, parsec >=3.1 && <4, listsafe >= 0.1, monad-loops >= 0.3 && <0.6, mtl >= 2.2 && <3, transformers >= 0.3 && <0.7, directory >= 1.2.1 && <2, filepath >= 1.3 && <2, bytestring >= 0.10 && <0.20, data-default >= 0.5.3, aeson >=0.8.0.2 && <1, semigroupoids >= 4 && <6+  default-language:    Haskell2010+