diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +0.1.0.0 +------- + + +* Initial release! diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2015 Justin Le + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,375 @@ +prompt +====== + +Monad (and transformer) for delayed-effect "pure" prompt-and-respose queries. + +Prompt +------ + +`Prompt a b r` represents a "pure" computation producing an `r` that can "ask" or +"prompt" with an `a` and get `b`'s as responses/answers. + +By "pure", I mean that the actual eventual process of *answering* the prompts +might be effectful (it might involve IO, or state, or STM...like database +queries or prompts to a user). When we're writing our actual logic, we never +involve anything with IO, State, etc., so we don't unleash a whole can of +worms by using, for example, a monad transformer over `IO`. + +Don't let your computation/type do arbitrary IO. If you see a `Prompt`, know +that it won't do arbitrary IO --- it'll potentially only do the IO that you, +the caller, explicitly allows --- or even do all of the prompting in a pure +context without any effects! + +~~~haskell +import Control.Monad.Prompt + +data Foo = Foo { fooBar :: String + , fooBaz :: Int + } deriving Show + +promptFoo :: Prompt String String Foo +promptFoo = Foo <$> prompt "bar" <*> fmap length (prompt "baz") +~~~ + +Here we build a `Foo` from a context where we can ask with strings and get +strings in return. + +Let's build a `Foo` from stdin/stdout: + +~~~haskell +ghci> :t runPromptM +runPromptM :: Monad m => Prompt a b r -> (a -> m b) -> m r +ghci> runPromptM promptFoo $ \str -> do putStrLn str; getLine +bar -- stdout prompt +> hello! -- stdin response typed in +baz -- stdout prompt +> i am baz -- stdin response typed in +Foo "hello!" 8 -- result +~~~ + +(by the way, that's also `interactP promptFoo`) + +Now let's build one by asking for environment variables + +~~~haskell +ghci> import System.Environment +ghci> setEnv "bar" "hello!" +ghci> setEnv "baz" "i am baz" +ghci> runPromptM promptFoo getEnv +Foo "hello!" 8 +~~~ + +`promptFoo` is completely "pure", and doesn't ever involve IO or anything, and +doesn't even have IO in the type. We can run `promptFoo` in `IO` if we +wanted, like above...or we can even run "without" IO, too: + +~~~haskell +ghci> import qualified Data.Map as M +ghci> let testMap = M.fromList [("bar", "hello!"), ("baz", "i am baz")] +ghci> :t runPrompt +runPrompt :: Prompt a b r -> (a -> b) -> r +ghci> runPrompt promptFoo (testMap M.!) +Foo "hello!" 8 +~~~ + +Now you can do things like querying databases, prompting the user, etc., +without ever involving `IO` at all in your logic. With a `Prompt`, we can +worry that it will never produce arbitrary IO effects! You can be certain +that a `Prompt` will never call `launchMissiles`, like a `getFoo :: IO Foo` +might! + +You can also do some cute tricks; `Prompt a () r` with a "prompt response +function" like `putStrLn` lets you do streaming logging, and defer *how* the +logging is done --- to IO, to a list? + +~~~haskell +ghci> let logHelloWord = mapM_ prompt ["hello", "world"] +ghci> runPromptM logHelloWorld putStrLn +hello +world +ghci> execWriter $ runPromptM logHelloWorld tell +"helloworld" +~~~ + +As a "pure" underlying effect source +---------------------------------- + +Many libraries managing effects, like *pipes* and *conduit*, or +DSL's/platforms that work with underlying effects, like *auto*, will work over +an effectful monad like IO. But sometimes, you don't need all of the power of +arbitrary IO --- you don't want to manage the effects of arbitrary IO --- you +just need to manage the effects of one thing, like querying a database or +talking to stdio. Instead of working over `IO` the entire time, you can just +decide to work with one prompting aspect. + +With Transformers +----------------- + +`Prompt a b` can be used as monad to transform for any monad transformer to +give an "interactive source" at the bottom of any monad transformer. + +Have you ever wanted to have `State`, with some aspect of IO, like writing to +a database, doing network interactions, or querying a database, but didn't +want to have an ugly terrible `StateT s IO`? Well, wish no more! You can +have `StateT s (Prompt String String) a`, for a `State s` computation that can +occasionally depend on asking the user, or the environment variables, or a +network connection, or a database in IO or whatever. But now you can be sure +it won't ever do arbitrary IO --- it'll only do exactly what IO it needs that +you specify when you "run" it. Your "pure" computation doesn't involve IO at +all! All you added was an extra "promptable source". + +You can also use this to get short-circuiting behavior with `MaybeT`, etc. + +~~~haskell +import Control.Monad.Trans +import Control.Monad.Prompt +import Text.Read + +promptFoo2 :: MaybeT (Prompt String String) Foo +promptFoo2 = do + bar <- lift $ prompt "bar" + x <- lift $ prompt "baz" + case readMaybe x of + Just baz -> return $ Foo bar baz + Nothing -> mzero +~~~ + +~~~haskell +ghci> runPromptM (runMaybeT promptFoo2) getEnv +Nothing +ghci> runPromptM (runMaybeT (promptFoo2 <|> return (Foo "error" 0))) getEnv +Just (Foo "error" 0) +ghci> setEnv "baz" "19" +ghci> runPromptM (runMaybeT (promptFoo2 <|> return (Foo "error" 0))) getEnv +Just (Foo "hello!" 19) +~~~ + +This becomes pretty nice with `ExceptT` or any instance of `MonadError`, where +you can use `throwError`, `catchError`, etc., to have actual data with your +errors. + +You can also play with using for the return type. For example: + +~~~haskell +logEvens :: StateT Int (Prompt String ()) () +logEvens = do + modify (+1) + x <- get + when (even x) . lift $ prompt (show x) +~~~ + +~~~haskell +> runPromptM (runStateT (replicateM 10 logEvens) 0) putStrLn +2 +4 +6 +8 +10 +~~~ + +That gives you streaming logging, or streaming writing-to-a-database, etc. + +There's a bit of a downside to this method, because your "prompt response +function" given can't access the overlying monadic context --- `runPromptM` +and `putStrLn` there can't return a `State Int String`, only a `String`. We +address this in the next section. + +### Typeclass + +There's also the typeclass `MonadPrompt` offered, which allows you to write +code polymorphic over all things that can be "prompted". For example, the +above example can be written as: + +~~~haskell +promptFoo2 :: (MonadPlus m, MonadPrompt String String m) => m Foo +promptFoo2 = do + bar <- prompt "bar" + x <- prompt "baz" + case readMaybe x of + Just baz -> return baz + Nothing -> mzero + +promptFoo :: MonadPrompt String String m => m Foo +promptFoo = Foo <$> prompt "bar" <*> fmap length (prompt "baz") +~~~ + +~~~haskell +ghci> interactP . runMaybeT $ promptFoo2 <|> promptFoo +bar +> hello! +baz +> 19 +Foo "hello!" 19 +ghci> interactP . runMaybeT $ promptFoo2 <|> promptFoo +bar +> hello! +baz +> i am baz +bar -- failure to parse, so retry with `promptFoo` +> hello! +baz +> i am baz +Foo "hello!" 8 +~~~ + +PromptT +------- + +`PromptT a b t r` allows your prompting-and-responding to take place in the +context of `Traversable` `t`, so you can do things like short-circuiting with +`Either e` or `Maybe`, or multiple branches for `[]`, etc --- all "purely", +without worrying about the eventual effects like IO. + +In some ways, this is a bit redundant, because `ParserT a b Maybe` is somewhat +equivalent to `MaybeT (Parser a b)`. However, using `ParserT` can be more +convenient because you can use arbitrary Traversables, and also there are +functions given to make this work "out of the box", instead of manually +unwrapping with `runMaybeT`, `runExceptT`, etc. + +~~~haskell +ghci> interactPT $ promptFoo2 <|> promptFoo +bar +> hello! +baz +> 19 +Foo "hello!" 19 +ghci> interactPT $ promptFoo2 <|> promptFoo +bar +> hello! +baz +> i am baz +bar -- failure to parse, so retry with `promptFoo` +> hello! +baz +> i am baz +Foo "hello!" 8 +~~~ + +Or, like the example above, + +~~~haskell +ghci> runPromptT logHelloWorld tell +"helloworld" +~~~ + +`Alternative`, `MonadPlus`, `MonadError`, `MonadWriter`, etc. are all +supported. And you can specify your logic, etc;, and your prompting can +involve IO. But your logic doesn't ever involve `IO` at all! + +However, the main advantage with this that lets you do things that a Monad +Transformer can't is that your "prompting function" has access to the +underlying `Traversable` `t` as well, so you can communicate with the +underlying prompt using your "prompt response" function. + +Which leads to the big finale --- environment variable loading! + +~~~haskell +import Control.Monad.Error.Class +import Control.Monad.Prompt +import Text.Read +import qualified Data.Map as M + +type Key = String +type Val = String + +data MyError = MENoParse Key Val + | MENotFound Key + deriving Show + +promptRead :: (MonadError MyError m, MonadPrompt Key Val m, Read b) + => Key -> m b +-- promptRead :: Read b => Key -> PromptT Key Val (Either MyError) b +-- promptRead :: Read b => Key -> ExceptT MyError (Prompt Key Val) b +promptRead k = do + resp <- prompt k + case readMaybe resp of + Nothing -> throwError $ MEParse k resp + Just v -> return v + +promptFoo3 :: MonadPrompt Key Val m => m Foo +-- promptFoo3 :: Applicative t => PromptT Key Val t Foo +promptFoo3 = Foo <$> prompt "bar" <*> promptRead "baz" + +-- +-- running! + +-- Lookup environment variables, and "throw" an error if not found +throughEnv :: IO (Either MyError Foo) +throughEnv = runPromptTM parseFoo3 $ \k -> do + env <- lookupEnv k + return $ case env of + Nothing -> Left (MENotFound k) + Just v -> Right v + +-- Fulfill the prompt through user input +throughStdIO :: IO (Either MyError Foo) +throughStdIO = interactPT parseFoo3 + +-- Fulfill the prompt through user input; count blank responses as "not found" +throughStdIOBlankIsError :: IO (Either MyError Foo) +throughStdIOBlankIsError = runPromptTM parseFoo3 $ \k -> do + putStrLn k + resp <- getLine + return $ if null resp + then Left (MENotFound k) + else Right resp + +-- Fulfill the prompt purely through a Map lookup +throughMap :: M.Map Key Val -> Either MyError Foo +throughMap m = runPromptT parseFoo3 $ \k -> + case M.lookup k m of + Nothing -> Left (MENotFound k) + Just v -> Right v +~~~ + +Note that for `throughEnv`, errors can come from both parsing errors and from +the deferred "prompt response" lookup function! + +Comparisons +----------- + +To lay it all on the floor, + +~~~haskell +newtype PromptT a b t r = PromptT { runPromptTM :: forall m. Monad m => (a -> m (t b)) -> m (t r) } +~~~ + +There is admittedly a popular misconception that I've seen going around that +equates this sort of type to `Free` from the *free* package. However, `Free` +doesn't really have anything significant to do with this. Sure, you might be +able to generate this type by using `FreeT` over a specifically chosen +Functor, but...this is the case for literally any Monad ever, so that doesn't +really mean much :) + +It's also unrelated in this same manner to `Prompt` from the *MonadPrompt* +package, and `Program` from *operational* too. + +One close relative to this type is `forall m. ReaderT (a -> m b) m r`, where +`prompt k = ReaderT ($ k)`. This is more or less equivalent to `Prompt`, but +still can't do the things that `PromptT` can do without a special instance of +Monad. + +This type is also similar in structure to `Bazaar`, from the *lens* package. +The biggest difference that makes `Bazaar` unusable is because the RankN +constraint is only `Applicative`, not `Monad`, so a `Monad` instance is +impossible. Ignoring that (or if it's okay for you to only use the +`Applicative` instance), `Bazaar` forces the "prompting effect" to take place +in the same context as the `Traversable` `t`...which really defeats the +purpose of this whole thing in the first place (the idea is to be able to +separate your prompting effect from your application logic). If the +`Traversable` you want to transform has a "monad transformer" version, then +you can somewhat simulate `PromptT` for that specifc `t` with the transformer +version. + +It's also somewhat similar to the `Client` type from *pipes*, but it's also a +bit tricky to use that with a different effect type than the logic +`Traversable`, as well...so it has a lot of the same difference as `Bazaar` +here. + +But this type is common/simple enough that I'm sure someone has it somewhere +in a library that I haven't been able to find. If you find it, let me know! + +Copyright +--------- + +Copyright 2015 Justin Le diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/prompt.cabal b/prompt.cabal new file mode 100644 --- /dev/null +++ b/prompt.cabal @@ -0,0 +1,56 @@ +-- Initial query.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/ + +name: prompt +version: 0.1.0.0 +synopsis: Monad (and transformer) for deferred-effect pure + prompt-response queries +description: Monad (and transformer) for delayed-effect "pure" + prompt-and-response queries. + . + Allows you to specify programs that might query a + database, talk to stdio, etc., without ever involving IO + or opening the door to arbitrary IO. Write a potentially + pure computation describing prompting interactions, etc., + without having your type actually do any IO or involve + itself with IO or any effectful context. + . + Useful as a source of "things from IO", without ever + actually involving IO or arbitrary IO itself; only + executing a specific subset of IO (or State, etc.) that + you yourself, the caller, specifies explicitly. Safer + and more meaningful type. + . + For more information and instructions on usage with + examples, see . +homepage: https://github.com/mstksg/prompt +bug-reports: https://github.com/mstksg/prompt/issues +license: MIT +license-file: LICENSE +author: Justin Le +maintainer: justin@jle.im +copyright: (c) 2015 Justin Le +category: Control +build-type: Simple +extra-source-files: README.md + CHANGELOG.md +cabal-version: >=1.10 + +source-repository head + type: git + location: git://github.com/mstksg/prompt.git + + +library + exposed-modules: Control.Monad.Prompt + Control.Monad.Prompt.Class + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <5 + , mtl + , transformers + , transformers-compat + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 diff --git a/src/Control/Monad/Prompt.hs b/src/Control/Monad/Prompt.hs new file mode 100644 --- /dev/null +++ b/src/Control/Monad/Prompt.hs @@ -0,0 +1,343 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} + +-- | +-- Module : Control.Monad.Prompt +-- Description : Prompt monad and transformer +-- Copyright : (c) Justin Le 2015 +-- License : MIT +-- Maintainer : justin@jle.im +-- Stability : unstable +-- Portability : portable +-- +-- Provides the 'PromptT' type, which allows you to program computations +-- that can "ask" or "prompt" with values to get values in return. The +-- computation doesn't care about the process of prompting, or how it +-- works, and has nothing to do with the effectful monad where the +-- prompting will eventually take place. +-- +-- For example, sometimes you might want a computation to be able to query +-- or database, or talk with stdio, but you don't want your type to involve +-- arbitrary IO or be over IO, opening the door to a mess of IO. 'Prompt' +-- lets you write programs that can query "something", and then at a later +-- point in time, run it, providing the method of fulfilling each prompt. +-- Write your program independent of IO, or databases, or stdio, etc.; only +-- later "fill in" what it means. You can even run the same 'Prompt' with +-- different ways to fulfill the prompts --- pure, effectful, etc. +-- +-- For usage examples and a more detailed explanation, see +-- . + +module Control.Monad.Prompt ( + -- * Prompt + Prompt + , runPromptM + , runPrompt + , interactP + -- * PromptT + , PromptT + , runPromptTM + , runPromptT + , interactPT + -- * Prompting + , MonadPrompt(..) + , prompt' + , prompts' + -- ** Specialized + , promptP + , promptsP + , promptP' + , promptsP' + -- * Low level + , mapPromptT + , hoistP + , liftP + , mkPromptT + , mkPrompt + ) where + +import Control.Applicative +import Control.Monad hiding (sequence, mapM) +import Control.Monad.Error.Class +import Control.Monad.Prompt.Class +import Control.Monad.Reader.Class +import Control.Monad.State.Class +import Control.Monad.Trans +import Control.Monad.Writer.Class +import Data.Functor.Identity + +#if !MIN_VERSION_base(4,8,0) +import Data.Traversable +import Prelude hiding (sequence, mapM) +#endif + + +-- | Like 'Prompt', but can perform its "pure" computations in the context +-- of a 'Traversable' @t@, to absorb short-circuiting behvaior with 'Maybe' +-- or 'Either', logging with 'Writer', etc., but this is in general +-- completely unrelated to the effectful monad where the prompting will +-- eventually take place. Specify short-circuiting and logging logic, +-- without worrying about IO or anything relating to the prompting effect. +-- +-- @ +-- 'prompt' :: a -> (PromptT a b t) b +-- @ +-- +-- Implements several useful typeclasses for working with the underlying +-- 'Traversable' and integrating effects, like 'Alternative', 'MonadError', +-- 'MonadWriter', etc. +-- +-- Constructor is hidden, but a direct constructing function is exported as +-- 'mkPrompT' in the rare case it is needed or wanted. +-- +newtype PromptT a b t r = PromptT (forall m. Monad m => (a -> m (t b)) -> m (t r)) + +-- | Prompt type, providing the ability to "prompt" or "query" by +-- presenting/asking with an @a@ and receiving a @b@ response. +-- +-- @ +-- 'prompt' :: a -> (Prompt a b) b +-- @ +-- +-- "Ask with an @a@, get a @b@." +-- +-- Has a 'Monad', 'Applicative', 'Functor', etc. instance so it can be +-- sequenced monadically or applicatively, so you can sequence and bind +-- from 'prompt'. +-- +-- Note that we defer the process of specifying /how/ 'prompt' delivers its +-- @b@. It can take place in IO, or in any other effectful setting...but +-- 'Prompt' doesn't care, and it never involves IO or any arbitrary IO +-- itself. +-- +-- Can be "constructed directly" using 'mkPrompt', but typically using +-- 'prompt' and the 'Applicative', 'Monad' instances etc. is better. +-- +type Prompt a b = PromptT a b Identity + +instance Functor t => Functor (PromptT a b t) where +#if MIN_VERSION_base(4,8,0) + fmap f (PromptT p) = PromptT $ (fmap . fmap) f . p +#else + fmap f (PromptT p) = PromptT $ (liftM . fmap) f . p +#endif + +instance Applicative t => Applicative (PromptT a b t) where + pure x = PromptT $ const (return (pure x)) +#if MIN_VERSION_base(4,8,0) + PromptT f <*> PromptT x = PromptT $ \g -> liftA2 (<*>) (f g) (x g) +#else + PromptT f <*> PromptT x = PromptT $ \g -> liftM2 (<*>) (f g) (x g) +#endif + +instance Alternative t => Alternative (PromptT a b t) where + empty = PromptT $ const (return empty) +#if MIN_VERSION_base(4,8,0) + PromptT x <|> PromptT y = PromptT $ \g -> liftA2 (<|>) (x g) (y g) +#else + PromptT x <|> PromptT y = PromptT $ \g -> liftM2 (<|>) (x g) (y g) +#endif + +instance (Monad t, Traversable t) => Monad (PromptT a b t) where + return x = PromptT $ const (return (return x)) + PromptT p >>= f = PromptT $ \g -> do +#if MIN_VERSION_base(4,8,0) + PromptT x <- traverse f <$> p g + join <$> x g +#else + PromptT x <- mapM f `liftM` p g + join `liftM` x g +#endif + +instance (MonadPlus t, Traversable t) => MonadPlus (PromptT a b t) where +#if MIN_VERSION_base(4,8,0) + mzero = empty + mplus = (<|>) +#else + mzero = PromptT $ const (return mzero) + mplus (PromptT x) (PromptT y) = PromptT $ \g -> liftM2 mplus (x g) (y g) +#endif + +instance MonadTrans (PromptT a b) where + lift x = PromptT $ const (return x) + +instance (MonadError e t, Traversable t) => MonadError e (PromptT a b t) where + throwError = lift . throwError + catchError (PromptT p) f = PromptT $ \g -> do + x <- p g + let PromptT p' = sequence $ fmap return x `catchError` \e -> return (f e) +#if MIN_VERSION_base(4,8,0) + join <$> p' g +#else + join `liftM` p' g +#endif + +instance (MonadReader r t, Traversable t) => MonadReader r (PromptT a b t) where + ask = lift ask + reader = lift . reader + local = mapPromptT . local + +instance (MonadState s t, Traversable t) => MonadState s (PromptT a b t) where + get = lift get + put = lift . put + state = lift . state + +instance (MonadWriter w t, Traversable t) => MonadWriter w (PromptT a b t) where + writer = lift . writer + tell = lift . tell + listen = mapPromptT listen + pass = mapPromptT pass + +instance Applicative t => MonadPrompt a b (PromptT a b t) where + prompt = promptP + prompts = promptsP + +-- | Directly construct a 'PromptT'. Has to be able to take a @(a - m (t +-- b)) -> m (t r)@ that can work on /any/ 'Monad'. +-- +-- Typically this won't be used, but is provided for completion; using +-- 'prompt' and its 'Applicative', 'Monad' instances, etc., is more clear. +-- +-- @ +-- 'prompt' r = 'mkPromptT' $ \g -> g r +-- @ +mkPromptT :: (forall m. Monad m => (a -> m (t b)) -> m (t r)) -> PromptT a b t r +mkPromptT = PromptT + +-- | Directly construct a 'Prompt'. Has to be able to take a @(a -> m b) +-- -> m r@ that can work on /any/ 'Monad'. +-- +-- Typically this won't be used, but is provided for completion; using +-- 'prompt' and its 'Applicative', 'Monad' instances, etc., is more clear. +mkPrompt :: (forall m. Monad m => (a -> m b) -> m r) -> Prompt a b r +#if MIN_VERSION_base(4,8,0) +mkPrompt f = PromptT $ \g -> Identity <$> f (fmap runIdentity . g) +#else +mkPrompt f = PromptT $ \g -> Identity `liftM` f (liftM runIdentity . g) +#endif + +-- | Maps the underying @t a@ returned by 'PromptT'. Cannot change @t@. +mapPromptT :: (t r -> t s) -> PromptT a b t r -> PromptT a b t s +#if MIN_VERSION_base(4,8,0) +mapPromptT f (PromptT p) = PromptT $ fmap f . p +#else +mapPromptT f (PromptT p) = PromptT $ liftM f . p +#endif + +-- | Swap out the 'Traversable' @t@ with a pair of natural transformations. +-- The first maps the output @t a@, and the second maps the result of the +-- prompting function. +hoistP :: (forall s. t s -> u s) -- ^ forward natural transformation + -> (forall s. u s -> t s) -- ^ backwards natural transformation + -> PromptT a b t r + -> PromptT a b u r +#if MIN_VERSION_base(4,8,0) +hoistP to from (PromptT p) = PromptT $ \g -> to <$> p (fmap from . g) +#else +hoistP to from (PromptT p) = PromptT $ \g -> to `liftM` p (liftM from . g) +#endif + +-- | Like 'lift', but without the 'Monad' constraint. +liftP :: t r -> PromptT a b t r +liftP x = PromptT $ const (return x) + +-- | Like 'prompt', but specialized to 'PromptT' and without +-- the 'Applicative' constraint. +promptP :: a -- ^ prompting value + -> PromptT a b t b +promptP r = PromptT ($ r) + +-- | Like 'prompts', but specialized to 'PromptT' and downgrading the +-- 'Applicative' constraint to a 'Functor' constraint. +promptsP :: Functor t + => (b -> c) -- ^ to be applied to response value + -> a -- ^ prompting value + -> PromptT a b t c +#if MIN_VERSION_base(4,8,0) +promptsP f r = PromptT $ (fmap . fmap) f . ($ r) +#else +promptsP f r = PromptT $ (liftM . fmap) f . ($ r) +#endif + +-- | Like 'prompt'', but specialized to 'PromptT' and without the +-- 'Applicative' constraint. Is a 'promptP' strict on its argument. +promptP' :: a -- ^ prompting value (strict) + -> PromptT a b t b +promptP' x = x `seq` promptP x + +-- | Like 'prompts'', but specialized to 'PromptT' and downgrading the +-- 'Applicative' constraint to a 'Functor' constraint. Is a 'promptsP' +-- strict on its argument. +promptsP' :: Functor t + => (b -> c) -- ^ to be applied to response value + -> a -- ^ prompting value (strict) + -> PromptT a b t c +promptsP' f x = x `seq` promptsP f x + +-- | Run a @'PromptT' a b t r@ with a given effectful @a -> m (t b)@ +-- "prompt response" function, to get the resulting @r@ in @m@ and @t@. +-- The "prompt response" function is able to interact with the underlying +-- 'Traversable' @t@. +-- +-- Note that the 'PromptT' in general has nothing to do with the @m@, and +-- cannot execute arbitrary @m@ other than that given in the prompt +-- response function. +runPromptTM :: Monad m + => PromptT a b t r + -> (a -> m (t b)) -- ^ "Prompt response function", + -- effectfully responding to a given @a@ with a @b@. + -> m (t r) +runPromptTM (PromptT p) = p + +-- | Run a @'Prompt' a b r@ with a given effectful @a -> m b@ "prompt +-- response" function, to get the resulting @r@ in @m@. Note that the +-- 'Prompt' itself in general has nothing to do with @m@, and cannot +-- execute arbitrary @m@ other than that given in the prompt response +-- function. +runPromptM :: Monad m + => Prompt a b r + -> (a -> m b) -- ^ "Prompt response function", effectfully + -- responding to a given @a@ with a @b@. + -> m r +#if MIN_VERSION_base(4,8,0) +runPromptM (PromptT p) f = runIdentity <$> p (fmap Identity . f) +#else +runPromptM (PromptT p) f = runIdentity `liftM` p (liftM Identity . f) +#endif + +-- | Run a @'PromptT' a b t r@ with a given @a -> t b@ function, with +-- 'Traversable' @t@. The effects take place in the same context as the +-- underlying context of the 'PromptT'. +runPromptT :: PromptT a b t r + -> (a -> t b) -- ^ "Prompt response function", "purely" + -- responding to a given @a@ with a @b@ in + -- context of 'Traversable' @t@. + -> t r +runPromptT (PromptT p) f = runIdentity $ p (Identity . f) + +-- | Run a @'Prompt' a b r@ with a pure @a -> b@ prompt response function. +-- More or less reduces @'Prompt' a b@ to a @'Reader' (a -> b)@. +runPrompt :: Prompt a b r + -> (a -> b) -- ^ "Prompt response function", purely responding + -- to a given @a@ with a @b@. + -> r +runPrompt (PromptT p) f = runIdentity . runIdentity $ p (Identity . Identity . f) + +-- | Run a @'PromptT' String String@ in IO by sending the request to stdout +-- and reading the response from stdin. +interactPT :: Applicative t => PromptT String String t r -> IO (t r) +interactPT = flip runPromptTM $ \str -> do + putStrLn str + pure <$> getLine + +-- | Run a @'Prompt' String String@ in IO by sending the request to stdout +-- and reading the response from stdin. +interactP :: Prompt String String r -> IO r +interactP = flip runPromptM $ \str -> do + putStrLn str + getLine + diff --git a/src/Control/Monad/Prompt/Class.hs b/src/Control/Monad/Prompt/Class.hs new file mode 100644 --- /dev/null +++ b/src/Control/Monad/Prompt/Class.hs @@ -0,0 +1,123 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} + +-- | +-- Module : Control.Monad.Prompt.Class +-- Description : Typeclass for contexts with prompting ability. +-- Copyright : (c) Justin Le 2015 +-- License : MIT +-- Maintainer : justin@jle.im +-- Stability : unstable +-- Portability : portable +-- +-- Provides a typeclass for 'Applicative' and 'Monad' types that give you +-- the ability to, at any time, "prompt" with an @a@ and get a @b@ in +-- response. The power of this instance is that each type gets to define +-- its own way to deliver a response. +-- +-- This library provides instances for 'PromptT' from +-- "Control.Monad.Prompt" and the monad transformers in /transformers/ and +-- /mtl/. Feel free to create your own instances too. +-- +-- @ +-- data Interactive a = Interactive ((String -> String) -> a) +-- +-- -- at any time, ask with a string to get a string +-- instance MonadPrompt String String Interactive where +-- prompt str = Interactive $ \f -> f str +-- @ + +module Control.Monad.Prompt.Class ( + MonadPrompt(..) + , prompt' + , prompts' + ) where + +import Control.Monad.Trans.Class +import Control.Monad.Trans.Error +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Control.Monad.Trans.Reader +import qualified Control.Monad.Trans.RWS.Lazy as RWSL +import qualified Control.Monad.Trans.RWS.Strict as RWSS +import qualified Control.Monad.Trans.State.Lazy as SL +import qualified Control.Monad.Trans.State.Strict as SS +import qualified Control.Monad.Trans.Writer.Lazy as WL +import qualified Control.Monad.Trans.Writer.Strict as WS + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +import Data.Monoid +#endif + +-- | An 'Applicative' (and possibly 'Monad') where you can, at any time, +-- "prompt" with an @a@ and receive a @b@ in response. +-- +-- Instances include 'PromptT' and any /transformers/ monad transformer +-- over another 'MonadPrompt'. +class Applicative m => MonadPrompt a b m | m -> a b where + -- | "Prompt" with an @a@ for a @b@ in the context of the type. + prompt :: a -- ^ prompting value + -> m b + prompt = prompts id + -- | "Prompt" with an @a@ for a @b@ in the context of the type, and + -- apply the given function to receive a @c@. + prompts :: (b -> c) -- ^ mapping function + -> a -- ^ prompting value + -> m c + prompts f = fmap f . prompt +#if MIN_VERSION_base(4,7,0) + {-# MINIMAL prompt | prompts #-} +#endif + +-- | A version of 'prompt' strict on its prompting value. +prompt' :: MonadPrompt a b m => a -> m b +prompt' x = x `seq` prompt x + +-- | A version of 'prompts' strict on its prompting value. +prompts' :: MonadPrompt a b m => (b -> c) -> a -> m c +prompts' f x = x `seq` prompts f x + +instance (Monad m, MonadPrompt a b m) => MonadPrompt a b (ReaderT r m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m) => MonadPrompt a b (ExceptT e m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m, Error e) => MonadPrompt a b (ErrorT e m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m) => MonadPrompt a b (SS.StateT s m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m) => MonadPrompt a b (SL.StateT s m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m, Monoid w) => MonadPrompt a b (WS.WriterT w m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m, Monoid w) => MonadPrompt a b (WL.WriterT w m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m, Monoid w) => MonadPrompt a b (RWSS.RWST r w s m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m, Monoid w) => MonadPrompt a b (RWSL.RWST r w s m) where + prompt = lift . prompt + prompts f = lift . prompts f + +instance (Monad m, MonadPrompt a b m) => MonadPrompt a b (MaybeT m) where + prompt = lift . prompt + prompts f = lift . prompts f