This seems like a reasonable thing to want, but I'm having type troubles. I'd like to have a Client that can send a list of options to a Server, which will choose one and return the chosen element. So something like this:
module Toy where
import Pipes
asker :: Monad m => () -> Client ([a], a -> String) a m ()
asker () = do
_ <- request ([0.0, 2.0], show)
_ <- request (["3", "4"], show)
return ()
The idea is that the server can call the a -> String function on each element of the list to display them to a user. I'd like to be able to vary a, as long as the list and function match.
Is something like this possible? Maybe the constraints I want can be encoded into a GADT somehow?
You can't do it quite the way you asked, but you can cheat a little bit and get something that's almost as good:
{-# LANGUAGE ExistentialQuantification #-}
module Toy where
import Control.Monad
import Pipes
import Pipes.Prelude (foreverK)
data Request = forall a . Request [a] (a -> String)
asker :: Monad m => () -> Client Request Int m ()
asker () = do
_ <- request (Request [0.0, 2.0] show)
_ <- request (Request ["3", "4"] show)
return ()
server :: Request -> Server Request Int IO r
server = foreverK $ \req -> case req of
Request as f -> do
choice <- lift $ do
let select = do
putStrLn "Select an option"
forM_ (zip [0..] as) $ \(n, a) ->
putStrLn $ show n ++ ": " ++ f a
n <- readLn
if (n >= length as)
then do
putStrLn "Invalid selection"
select
else return n
select
respond choice
Instead of returning back the value selected, you return back an Int corresponding to the index of the selected element. The rest is just using ExistentialQuantification.
Like others recommended, I suggest that you actually just send a list of Strings instead of using the existential quantification trick, but I included it just to show how that would be done just in case you were curious.
Related
In our haskell code base, business logic is interlaved with tracing and logging code. This can obscure the business logic and make it harder to understand and debug. I am looking for ideas how to reduce the code footprint of logging and tracing to make the business logic stick out more.
Our code currently mostly looks roughly like this:
someFunction a b cs =
withTaggedSpan tracer "TRACE_someFunction" [("arg_b", show b)] $ do
logDebug logger $ "someFunction start: " <> show (trimDownC <$> cs)
result <- do ... some business logic ...
if isError result then
logError logger $ "someFunction error: " <> show result
else
logDebug logger $ "someFunction success: " <> show (trimDownResult result)
One observation is that whe mostly trace the entire function body and log at beginning and end. This should allow combining tracing and logging into single helper and automatically extract function name and names of captured values via meta programming. I have used AST transforming compile time macros and runtime introspection in other languges before but not Haskell.
What are good ways to do this using Template Haskell, HasCallStack or other options?
(Cross posted at https://www.reddit.com/r/haskell/comments/gdfu52/extracting_context_for_tracinglogging_via_haskell/)
Let's assume for simplicity that the functions in your business logic are of the form:
_foo :: Int -> String -> ReaderT env IO ()
_bar :: Int -> ExceptT String (ReaderT env IO) Int
That is, they return values in a ReaderT transformer over IO, or perhaps also throw errors using ExceptT. (Actually that ReaderT transformer isn't required right now, but it'll come in handy later).
We could define a traced function like this:
{-# LANGUAGE FlexibleInstances #-}
import Data.Void (absurd)
import Control.Monad.IO.Class
import Control.Monad.Reader -- from "mtl"
import Control.Monad.Trans -- from "transformers"
import Control.Monad.Trans.Except
traced :: Traceable t => Name -> t -> t
traced name = _traced name []
type Name = String
type Arg = String
class Traceable t where
_traced :: Name -> [Arg] -> t -> t
instance Show r => Traceable (ReaderT env IO r) where
_traced msg args t = either absurd id <$> runExceptT (_traced msg args (lift t))
instance (Show e, Show r) => Traceable (ExceptT e (ReaderT env IO) r) where
_traced msg args t =
do
liftIO $ putStrLn $ msg ++ " invoked with args " ++ show args
let mapExits m = do
e <- m
case e of
Left err -> do
liftIO $ putStrLn $ msg ++ " failed with error " ++ show err
return $ Left err
Right r -> do
liftIO $ putStrLn $ msg ++ " exited with value " ++ show r
return $ Right r
mapExceptT (mapReaderT mapExits) t
instance (Show arg, Traceable t) => Traceable (arg -> t) where
_traced msg args f = \arg -> _traced msg (args ++ [show arg]) (f arg)
This solution is still a bit unsatisfactory because, for functions that call other functions, we must decide at the outset if we want the traced version of the called functions or not.
One thing we could try—although more invasive to the code—is to put our functions in a record, and make the environment of the ReaderT equal to that same record. Something like this:
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
-- from "red-black-record"
import Data.RBR (FromRecord (..), IsRecordType, ToRecord (..))
data MyAPI = MyAPI
{ foo :: Int -> String -> ReaderT MyAPI IO (),
bar :: Int -> ExceptT String (ReaderT MyAPI IO) Int,
baz :: Bool -> ExceptT String (ReaderT MyAPI IO) ()
}
deriving (Generic, FromRecord, ToRecord)
An then use some generics utility library (here red-black-record) to write a function that says: "if every function in your record is Traceable, I will give you another record where all the functions are traced":
import Data.Kind
import Data.Proxy
import Data.Monoid (Endo(..))
import GHC.TypeLits
import Data.RBR
( I (..),
KeyValueConstraints,
KeysValuesAll,
Maplike,
cpure'_Record,
liftA2_Record,
)
traceAPI ::
( IsRecordType r t,
Maplike t,
KeysValuesAll (KeyValueConstraints KnownSymbol Traceable) t
) =>
r ->
r
traceAPI =
let transforms =
cpure'_Record (Proxy #Traceable) $
\fieldName -> Endo (traced fieldName)
applyTraced (Endo endo) (I v) = I (endo v)
in fromRecord . liftA2_Record applyTraced transforms . toRecord
-- small helper function to help invoke the functions in the record
call :: MonadReader env m => (env -> f) -> (f -> m r) -> m r
call getter execute = do
f <- asks getter
execute f
Alternatively, in order to avoid magic, such function could we written by hand for each particular API record.
Putting it to work:
main :: IO ()
main = do
let api =
traceAPI $
MyAPI
{ foo = \_ _ ->
do liftIO $ putStrLn "this is foo",
bar = \_ ->
do
liftIO $ putStrLn "this is bar"
return 5,
baz = \_ ->
do
call foo $ \f -> lift $ f 0 "fooarg"
call bar $ \f -> f 23
throwE "oops"
}
flip runReaderT api $ runExceptT $ baz api False
pure ()
-- baz invoked with args ["False"]
-- foo invoked with args ["0","\"fooarg\""]
-- this is foo
-- foo exited with value ()
-- bar invoked with args ["23"]
-- this is bar
-- bar exited with value 5
-- baz failed with error "oops"
Pure functions are deterministic. If you know what went into them, you can always reproduce the result. Thus, you shouldn't need a lot of logging inside the main parts of a functional code base.
Log the impure actions only, and architect your code into a pure core with a small imperative shell. Log only the impure actions that take place in the shell. I've described the technique in a blog post here.
I have a concern regarding how far the introduction of IO trickles through a program. Say a function deep within my program is altered to include some IO; how do I isolate this change to not have to also change every function in the path to IO as well?
For instance, in a simplified example:
a :: String -> String
a s = (b s) ++ "!"
b :: String -> String
b s = '!':(fetch s)
fetch :: String -> String
fetch s = reverse s
main = putStrLn $ a "hello"
(fetch here could more realistically be reading a value from a static Map to give as its result)
But say if due to some business logic change, I needed to lookup the value returned by fetch in some database (which I can exemplify here with a call to getLine):
fetch :: String -> IO String
fetch s = do
x <- getLine
return $ s ++ x
So my question is, how to prevent having to rewrite every function call in this chain?
a :: String -> IO String
a s = fmap (\x -> x ++ "!") (b s)
b :: String -> IO String
b s = fmap (\x -> '!':x) (fetch s)
fetch :: String -> IO String
fetch s = do
x <- getLine
return $ s ++ x
main = a "hello" >>= putStrLn
I can see that refactoring this would be much simpler if the functions themselves did not depend on each other. That is fine for a simple example:
a :: String -> String
a s = s ++ "!"
b :: String -> String
b s = '!':s
fetch :: String -> IO String
fetch s = do
x <- getLine
return $ s ++ x
doit :: String -> IO String
doit s = fmap (a . b) (fetch s)
main = doit "hello" >>= putStrLn
but I don't know if that is necessarily practical in more complicated programs.
The only way I've found thus far to really isolate an IO addition like this is to use unsafePerformIO, but, by its very name, I don't want to do that if I can help it. Is there some other way to isolate this change? If the refactoring is substantial, I would start to feel inclined to avoid having to do it (especially under deadlines, etc).
Thanks for any advice!
Here are a few methods I use.
Reduce dependencies on effects by inverting control. (One of the methods you described in your question.) That is, execute the effects outside and pass the results (or functions with those results partially applied) into pure code. Instead of having main → a → b → fetch, have main → fetch and then main → a → b:
a :: String -> String
a f = b f ++ "!"
b :: String -> String
b f = '!' : f
fetch :: String -> IO String
fetch s = do
x <- getLine
return $ s ++ x
main = do
f <- fetch "hello"
putStrLn $ a f
For more complex cases of this, where you need to thread an argument to do this sort of “dependency injection” through many levels, Reader/ReaderT lets you abstract over the boilerplate.
Write pure code that you expect might need effects in monadic style from the start. (Polymorphic over the choice of monad.) Then if you do eventually need effects in that code, you don’t need to change the implementation, only the signature.
a :: (Monad m) => String -> m String
a s = (++ "!") <$> b s
b :: (Monad m) => String -> m String
b s = ('!' :) <$> fetch s
fetch :: (Monad m) => String -> m String
fetch s = pure (reverse s)
Since this code works for any m with a Monad instance (or in fact just Applicative), you can run it directly in IO, or purely with the “dummy” monad Identity:
main = putStrLn =<< a "hello"
main = putStrLn $ runIdentity $ a "hello"
Then as you need more effects, you can use “mtl style” (as #dfeuer’s answer describes) to enable effects on an as-needed basis, or if you’re using the same monad stack everywhere, just replace m with that concrete type, e.g.:
newtype Fetch a = Fetch { unFetch :: IO a }
deriving (Applicative, Functor, Monad, MonadIO)
a :: String -> Fetch String
a s = pure (b s ++ "!")
b :: String -> Fetch String
b s = ('!' :) <$> fetch s
fetch :: String -> Fetch String
fetch s = do
x <- liftIO getLine
return $ s ++ x
main = putStrLn =<< unFetch (a "hello")
The advantage of mtl style is that you can have multiple different implementations of your effects. That makes things like testing & mocking easy, since you can reuse the logic but run it with different “handlers” for production & testing. In fact, you can get even more flexibility (at the cost of some runtime performance) using an algebraic effects library such as freer-effects, which not only lets the caller change how each effect is handled, but also the order in which they’re handled.
Roll up your sleeves and do the refactoring. The compiler will tell you everywhere that needs to be updated anyway. After enough times doing this, you’ll naturally end up recognising when you’re writing code that will require this refactoring later, so you’ll consider effects from the beginning and not run into the problem.
You’re quite right to doubt unsafePerformIO! It’s not just unsafe because it breaks referential transparency, it’s unsafe because it can break type, memory, and concurrency safety as well—you can use it to coerce any type to any other, cause a segfault, or cause deadlocks and concurrency errors that would ordinarily be impossible. You’re telling the compiler that some code is pure, so it’s going to assume it can do all the transformations it does with pure code—such as duplicating, reordering, or even dropping it, which may completely change the correctness and performance of your code.
The main legitimate use cases for unsafePerformIO are things like using the FFI to wrap foreign code (that you know is pure), or doing GHC-specific performance hacks; stay away from it otherwise, since it’s not meant as an “escape hatch” for ordinary code.
First off, the refactoring doesn't tend to be as bad as you might imagine. Once you make the first change, the type checker will point you to the next few, and so on. But suppose you have a reason to suspect from the start that you might need some extra capability to make a function go. A common way to do this (called mtl-style, after the monad transformer library) is to express your needs in a constraint.
class Monad m => MonadFetch m where
fetch :: String -> m String
a :: MonadFetch m => String -> m String
a s = fmap (\x -> x ++ "!") (b s)
b :: MonadFetch m => String -> m String
b s = fmap (\x -> '!':x) (fetch s)
instance MonadFetch IO where
-- fetch :: String -> IO String
fetch s = do
x <- getLine
return $ s ++ x
instance MonadFetch Identity where
-- fetch :: String -> Identity String
fetch = Identity . reverse
You're no longer tied to a particular monad: you just need one that can fetch. Code operating on an arbitrary MonadFetch instance is pure, except that it can fetch.
I have the following code which grabs two pages of data from a paginated API endpoint. I'd like to modify query function to keep getting pages until it finds no more data (so replace take 2 in the code below with something which looks at the API response).
My question is wether it is possible to achieve this without changing query function to an IO function. And if so, how would I go about it. If not, is there a way of doing this without writing recursive function?
Here is the code:
#!/usr/bin/env stack
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
import Servant.Client
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Data.Proxy
import Servant.API
import Data.Aeson
import GHC.Generics
-- data type
data BlogPost = BlogPost
{ id :: Integer
, title :: String
} deriving (Show, Generic)
instance FromJSON BlogPost
-- api client
type API = "posts" :> QueryParam "_page" Integer :> Get '[JSON] [BlogPost]
api :: Proxy API
api = Proxy
posts :: Maybe Integer -> ClientM [BlogPost]
posts = client api
-- query by page
query :: ClientM [[BlogPost]]
query = sequence $ take 2 $ map posts pages
where
pages = [Just p | p <- [1..]]
-- main
main :: IO ()
main = do
manager' <- newManager defaultManagerSettings
let url = ClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
posts' <- runClientM query url
print posts'
I've tried to use takeWhileM to do this and ended up making query an IO function and passing url into it. It was starting to look pretty horrible and I couldn't get the types to match up (I felt like I needed something more like (a -> m Bool) -> m [a] -> m [a] rather than (a -> m Bool) -> [a] -> m [a] which is what takeWhileM is - still find this strange because I see this function as a filter, yet the input list and output list are different (one has monad around it and the other doesn't)).
For these cases of monadic iteration I usually turn to the streaming library. Its interface is reminiscent to that of pure lists, while still allowing effects:
import Streaming
import qualified Streaming.Prelude as S
repeatAndCollect :: Monad m => m (Either a r) -> m [a]
repeatAndCollect = S.toList_ . Control.Monad.void . S.untilRight
repeatAndCollectLimited :: Monad m => Int -> m (Either a r) -> m [a]
repeatAndCollectLimited len = S.toList_ . S.take len . S.untilRight
Using the untilRight, take and toList_ functions.
When only the first successful result is needed, we can use the Alternative instance of the ExceptT transformer in combination with asum from Data.Foldable to execute a list of fallible actions until one of them succeeds.
IO itself has an Alternative instance that returns the first "success", where "failure" means throwing a IOException.
Have you tried unfoldM?
unfoldM :: Monad m => m (Maybe a) -> m [a]
Let's update posts this way
posts :: Maybe Integer -> ClientM (Maybe [BlogPost])
posts = fmap notNil . client api where
notNil [] = Nothing
notNil bs = Just bs
The idea is to update query so that you can just use unfoldM query and get back an ClientM [[BlogPost]]. To do that, the type of query has to be
query :: ClientM (Maybe [BlogPost])
meaning, the page number must be coming from the environment:
query = forever $ page >>= posts
Clearly, there is some form of state going on here, as we need a way to keep track of the current page number. We can wrap the client action in a StateT:
type ClientSM = StateT Integer ClientM
page :: ClientSM Integer
page = get <* modify (+1)
This action demands a few additional changes to both query and posts. Edit: see below for a stroke of insight I got in the bus. First we need to lift the client action in the state monad:
posts :: Integer -> ClientSM (Maybe [BlogPost])
posts = fmap notNil . lift . client api . Just where
notNil [] = Nothing
notNil xs = Just xs
Only the type of query needs changing
query :: ClientSM (Maybe [BlogPost])
Finally, the main action just needs to peel the monad stack and unfold the query:
main = do
manager' <- newManager defaultManagerSettings
let url = mkClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
result <- flip runClientM url $ flip runStateT 1 $ unfoldM query
case result of
Left error -> print error
Right (posts, _) -> print posts
I haven't tested this, but it compiles 😅🤗
posts is oblivious to the state, and should remain so. So, without changing my original version above, you just need to lift in query:
query :: ClientSM (Maybe [BlogPost])
query = forever $ page >>= lift . posts . Just
If you need to keep the ClientM objects separate (either to run them each in a clean state, or anything similar), the best way is to chain your operations together.
In this particular case, the runClientM query ... IO action returns a Either String [BlogPost]. This means that the stop condition is receiving a Left String from one of the computations.
Using a hand-crafted eitherM helper, which runs one of two actions depending on the Either contructor, here is a relatively simple example of that:
Using the good old either makes this relatively simple :
queryAll :: ClientEnv -> [Int] -> IO [[BlogPost]]
queryAll _ [] = return []
queryAll url (x:xs) = runClientM (posts x) url >>= either ((const.pure) []) (\b -> (b:) <$> queryAll url xs)
main :: IO ()
main = do
manager' <- newManager defaultManagerSettings
let url = ClientEnv manager' (BaseUrl Http "jsonplaceholder.typicode.com" 80 "")
posts' <- queryAll url [1..]
print posts'
Hope it can help! :)
I find the following function missing from the Data.Conduit.List module, and I couldn't find an easy way to compose this using functions in that module.
takeWhile :: Monad m => (a -> Bool) -> Consumer a m [a]
takeWhile p = await >>= \case
Nothing -> return []
Just b -> if p b
then (b :) <$> takeWhile p
else (leftover b) >> return []
This function is very useful in my application where I sometimes need to group the next few items together, and I am not sure how many are there.
The missing of this function is kind of strange to me as there are take :: Monad m => Int -> Consumer a m [a], and groupBy :: Monad m => (a -> a -> Bool) -> Conduit a m [a], but no takeWhile.
Am I missing something?
Edit: Per #ErikR's request, here is two simple examples that can perhaps clarify why I think this function could be useful.
Case 1: the protocol specifies there be a header section in the stream. For simplicity let's assume it's a String stream and the header items are marked by a leading #.
Stream content:
#language=English
#encoding=Unicode
Apple
Orange
Blue
Red
Sheep
Dog
...
Code using takeWhile:
myConduit :: Conduit String IO String ()
myConduit = do
headers <- takeWhile ((== '#') . head)
awaitForever $ \ item -> do
case getLanguage headers of
English -> ...
French -> ...
Case 2: the protocol specifies that items with prefix # has several continuations prefixed by +.
Stream content:
Apple
Orange
Blue
#Has
+kell
#A
+Really
+Long
+Word
Dog
...
Code using takeWhile:
myConduit :: Conduit String IO String ()
myConduit = runMaybeC . forever $ do
a <- maybe (lift mzero) return =<< await
aConts <- if head item == '#' then takeWhile ((== '+') . head)
else return []
liftIO . putStrLn . concat $ a : aConts
However, aside from being useful, it is also for completeness. I see that Data.Conduit.List's goal is to provide a set of "list-like" operations in the Conduit context. I think bread-and-butter functions like takeWhile should be provided, along with its siblings like dropWhile, so that people don't have to change their style of coding when thinking about conduits as lists.
I want to write a function that read some data using getLine and return i.e. a tuple (Integer, Integer) but using do-notation. Something like this (of course it doesn't work):
fun :: (Integer, Integer)
fun = do
a <- read (getLine::Integer)
b <- read (getLine::Integer)
return (a, b)
Do I have to write my own monad for this? Is there any solution to not writing a new monad?
EDIT
So I can write main function that use fun, I think it's the only solution:
main :: IO ()
main = do
tuple <- fun
putStrLn (show tuple)
fun :: IO (Integer, Integer)
fun = do
a1 <- getLine
b1 <- getLine
let a = read (a1)
b = read (b1)
return (a, b)
And above code works.
You type of function should be
fun :: IO (Integer, Integer)
as mentioned by #kaan you should not try to get a mondic value (with side effects) out of the monad as that will break referential transparency. Running fun should always return same value no matter how many times it is run and if we use your type this will not happen. However if the type is IO (Integer, Integer) then it returns the same action every time you use that function and running this action actually perform the side effect of reading the values from the console.
Coming back to using you function. You can do that inside another IO monad like
main = do
(a,b) <- fun
print a
print b
Although there are ways of getting things out of IO using unsafe functions but that is not recommended until you know exactly what you are doing.
As mentioned, you will need to give fun the type IO (Integer, Integer) instead of (Integer, Integer). However, once you have resigned yourself to this fate, there are many ways to skin this cat. Here are a handful of ways to get your imagination going.
fun = do
a <- getLine
b <- getLine
return (read a, read b)
-- import Control.Applicative for (<$>)
-- can also spell (<$>) as fmap, liftA, liftM, and others
fun = do
a <- read <$> getLine
b <- read <$> getLine
return (a, b)
fun = do
a <- readLn
b <- readLn
return (a, b)
fun = liftM2 (,) readLn readLn
-- different type!
-- use in main like this:
-- main = do
-- [a, b] <- fun
-- foo
-- import Control.Monad for replicateM
fun :: IO [Integer]
fun = replicateM 2 readLn