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 +201/−201
- Setup.hs +2/−2
- System/REPL.hs +22/−331
- System/REPL/Ask.hs +317/−0
- System/REPL/Command.hs +685/−606
- System/REPL/Config.hs +83/−85
- System/REPL/Prompt.hs +67/−0
- System/REPL/State.hs +102/−102
- System/REPL/Types.hs +242/−0
- changelog.txt +9/−7
- repl-toolkit.cabal +39/−28
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+