prompt (empty) → 0.1.0.0

raw patch · 7 files changed

+925/−0 lines, 7 filesdep +basedep +mtldep +transformerssetup-changed

Dependencies added: base, mtl, transformers, transformers-compat

Files

CHANGELOG.md +5/−0
LICENSE +21/−0
README.md +375/−0
Setup.hs +2/−0
prompt.cabal +56/−0
src/Control/Monad/Prompt.hs +343/−0
src/Control/Monad/Prompt/Class.hs +123/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+0.1.0.0+-------+<https://github.com/mstksg/prompt/releases/tag/v0.1.0.0>++*   Initial release!

+ LICENSE view

@@ -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.

+ README.md view

@@ -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

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ prompt.cabal view

@@ -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 <https://github.com/mstksg/prompt the+                     README>.+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

+ src/Control/Monad/Prompt.hs view

@@ -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+-- <https://github.com/mstksg/prompt the README>.++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+

+ src/Control/Monad/Prompt/Class.hs view

@@ -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