I'm struggling to compile the following program:
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
import Reflex.Dom
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
-- let t = (T.pack "this program works if you replace the line below with this")
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
text t
however this similar version works with vanilla ghc
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.URLEncoded
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
body
body = do
t <- fmap (T.pack . fromMaybe "" . Data.URLEncoded.lookup "parm2") (importString (T.unpack url))
T.putStrLn t
The compiler says something is ambiguous and I'm not really sure how to implement these to work.
The type variable ‘e0’ is ambiguous
Relevant bindings include body :: m () (bound at reflex.hs:14:1)
These potential instances exist:
instance [safe] Control.Monad.Error.Class.MonadError e (Either e)
-- Defined in ‘Control.Monad.Error.Class’
...plus 13 instances involving out-of-scope types
instance [safe] Control.Monad.Error.Class.MonadError
GHC.IO.Exception.IOException IO
-- Defined in ‘Control.Monad.Error.Class’
instance [safe] (Monad m, Control.Monad.Trans.Error.Error e) =>
Control.Monad.Error.Class.MonadError
e (Control.Monad.Trans.Error.ErrorT e m)
-- Defined in ‘Control.Monad.Error.Class’
FYI: I haven't fully grasped Monads yet and easily get scared with these errors. Help!
In the ghc version, importString is operating in the context of an IO monad do statement . importString is capable of returning a value in the IO monad so the compiler is happy
In the ghcjs version, importString is operating in the context of an m monad do statement (m is specified in the declaration of body ). importString has no way to return a value in the m monad so the compiler complains.
You can get around this by using liftIO to change an IO monad value to a m monad value. Here's your code with this change and a few other changes that I made to help myself understand the code.
import Data.Maybe
import qualified Data.Text as T
import Data.URLEncoded as DU
import Reflex.Dom
import Control.Monad.Trans as CMT
url :: T.Text
url = T.pack "parm1=one&parm2=two"
main = do
mainWidget body
body :: MonadWidget t m => m ()
body = el (T.pack "div") $ do
let istr = CMT.liftIO $ DU.importString (T.unpack url)
t <- fmap (T.pack . fromMaybe "" . DU.lookup "parm2") istr
text t
Related
I'm trying to figure out how to use a custom monad in the ConduitT definition of the WebSocketConduit endpoint provided by the servant-websocket library.
Say that I have this API:
type MyAPI = "ws" :> WebSocketConduit Value Value
if I try to define a handler for that endpoint that just copies input but I specify a Monad different from the parametric m:
ws :: ConduitT Value Value (Reader String) ()
ws _ = CL.map id
I get this error:
• Couldn't match type: transformers-0.5.6.2:Control.Monad.Trans.Reader.ReaderT
String Data.Functor.Identity.Identity
with: resourcet-1.2.5:Control.Monad.Trans.Resource.Internal.ResourceT
IO
I faced this problem because the monad I want to use is one created with Polysemy with lots of effects, but I wanted to keep the example simple using the Reader monad.
So the general question is, how do you use a custom monad in a Conduit Websocket endpoint?
Solution
Thanks to the tips from fghibellini this is the full solution to a toy example:
#!/usr/bin/env stack
{-
stack --resolver lts-19.07 script --package servant --package servant-server
--package servant-websockets --package polysemy --package aeson --package mtl
--package wai --package warp --package conduit
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module Main where
import Conduit
import qualified Data.Conduit.List as CL
import Control.Monad.Except (ExceptT(ExceptT))
import Data.Aeson (ToJSON, FromJSON)
import Data.Char (toUpper)
import Data.Function ((&))
import GHC.Generics ( Generic )
import Network.Wai (Application)
import Network.Wai.Handler.Warp (run)
import Polysemy ( runM, Sem, Members, Embed )
import Polysemy.Error ( runError, Error )
import Polysemy.Trace ( trace, traceToStdout, Trace )
import Servant
import Servant.API.WebSocketConduit (WebSocketConduit)
import Servant.Server
-- Dummy message
newtype Message = Message { content :: String } deriving (Show, Generic)
instance ToJSON Message
instance FromJSON Message
type MyApi = "toupper" :> ReqBody '[JSON] Message :> Post '[JSON] Message
:<|> "ws-toupper" :> WebSocketConduit Message Message
:<|> "ws-toupper-sem" :> WebSocketConduit Message Message
server :: Members '[Trace, Embed IO] r => ServerT MyApi (Sem r)
server = toupper :<|> wstoupper :<|> wstoupperWithSem
toupper :: Members '[Trace, Embed IO] r => Message -> Sem r Message
toupper (Message msg) = do
trace $ "Received msg in the REST endpoint: " ++ msg
return (Message . map toUpper $ msg)
wstoupper :: Monad m => ConduitT Message Message m ()
wstoupper = CL.map (\(Message msg) -> Message . map toUpper $ msg)
wstoupperWithSem :: ConduitT Message Message (ResourceT IO) ()
wstoupperWithSem = transPipe (liftIO . interpreter) semConduit
where
interpreter :: Sem '[Trace , Embed IO] a -> IO a
interpreter sem = sem
& traceToStdout
& runM
semConduit :: Members '[Trace, Embed IO] r => ConduitT Message Message (Sem r) ()
semConduit = mapMC effect
effect :: Members '[Trace] r => Message -> Sem r Message
effect (Message msg) = do
trace $ "Received msg through the WS: " ++ msg
return (Message . map toUpper $ msg)
liftServer :: ServerT MyApi Handler
liftServer = hoistServer api interpreter server
where
interpreter :: Sem '[Trace, Error ServerError , Embed IO] a -> Handler a
interpreter sem = sem
& traceToStdout
& runError
& runM
& liftHandler
liftHandler = Handler . ExceptT
api :: Proxy MyApi
api = Proxy
app :: Application
app = serve api liftServer
main :: IO ()
main = do
putStrLn "Starting server on http://localhost:8080"
run 8080 app
The HasServer instance of WebSocketConduit starts with:
instance (FromJSON i, ToJSON o) => HasServer (WebSocketConduit i o) ctx where
type ServerT (WebSocketConduit i o) m = Conduit i (ResourceT IO) o
link to source code
as you can see the monad is fixed to ResourceT IO. That's why your example won't compile.
You can ignore the ResourceT part as you can trivially lift an IO into it. So your task boils down to evaluating your monad stack until you get a simple IO operation.
To evaluate the ReaderT String layer in your example we would use
runReaderC :: Monad m => r -> ConduitT i o (ReaderT r m) res -> ConduitT i o m res. But generally you'd use whatever "runs/evaluates" your Monad into IO.
The following code compiles fine:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
import Servant
import Data.Conduit
import Data.Aeson (Value)
import qualified Data.Conduit.List as CL
import Servant.API.WebSocketConduit
import Control.Monad.Reader
import Data.Conduit.Lift (runReaderC)
type WebSocketApi = "echo" :> WebSocketConduit Value Value
server :: Server WebSocketApi
server = transPipe lift $ runReaderC "your-reader-state" echo
where
echo :: Conduit Value (ReaderT String IO) Value
echo = CL.map id
there's a warning about using monad transformeres with conduit under transPipe, which you probably better read.
Correction
I just realized you used Reader String and not ReaderT String IO. I'm gonna leave the answer as it is as it illustrates a more common scenario, but for Reader String you'd just replace lift with (pure . runIdentity) to rewrap from Identity to IO.
I would like to catch an exception inside runResourceT without releasing the resource, but the function catch runs the computation inside IO. Is there a way to catch an exception inside runResourceT, or what is the recommended way to refactor the code ?
Thank you for your help.
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Control.Exception as EX
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
type Resource = String
allocResource :: IO Resource
allocResource = let r = "Resource"
in putStrLn (r ++ " opened.") >> return r
closeResource :: Resource -> IO ()
closeResource r = putStrLn $ r ++ " closed."
withResource :: ( MonadIO m
, MonadBaseControl IO m
, MonadThrow m
, MonadUnsafeIO m
) => (Resource -> ResourceT m a) -> m a
withResource f = runResourceT $ do
(_, r) <- allocate allocResource closeResource
f r
useResource :: ( MonadIO m
, MonadBaseControl IO m
, MonadThrow m
, MonadUnsafeIO m
) => Resource -> ResourceT m Int
useResource r = liftIO $ putStrLn ("Using " ++ r) >> return 1
main :: IO ()
main = do
putStrLn "Start..."
withResource $ \r -> do
x <- useResource r
{-- This does not compile as the catch computation runs inside IO
y <- liftIO $ EX.catch (useResource r)
(\e -> do putStrLn $ show (e::SomeException)
return 0)
--}
return ()
putStrLn "Done."
ResourceT is an instance of MonadBaseControl from the monad-control package, which is designed for lifting control structures like forkIO and catch into transformed monads.
The lifted-base package, which is built on top of monad-control, contains modules with versions of standard control structures that work in any MonadBaseControl. For exception handling, you can use the functions in the Control.Exception.Lifted module. So, just import qualified Control.Exception.Lifted as EX1 instead, and your code should work fine.
1 Note the qualified here; quite confusingly, import A as B actually imports all of the definitions in A into scope, and simply defines B as an alias for the module! You need to use qualified to ensure that the definitions are not brought into scope, and are instead accessed exclusively through the B alias.
As an alternative approach, you can use the MonadCatch instance of ResourceT, found in the exceptions package. You simply need to substitute the generalized version of catch from Control.Monad.Catch:
import Control.Monad.Catch
…
main = do
…
withResource $ \r -> do
…
y <- Control.Monad.Catch.catch (useResource r) (\e -> …)
I'm adapting this example, in particular, the client. I'll tel you what I think the trouble is, following the code and the error it generates.
> {-# LANGUAGE OverloadedStrings #-}
> import Network.HTTP.Conduit
> ( http, parseUrl, newManager,def, withManager, RequestBody (RequestBodyLBS)
> , requestBody, method, Response (..)
> )
> import Data.Aeson (Value (Object, String))
> import Data.Aeson.Parser (json)
> import Data.Conduit
> import Data.Conduit.Attoparsec (sinkParser)
> import Control.Monad.IO.Class (liftIO)
> import Control.Monad.Trans.Class (lift)
> import Data.Aeson (encode, (.=), object)
> main :: IO ()
> main = withManager $ \manager -> do
> value <- makeValue
> -- We need to know the size of the request body, so we convert to a
> -- ByteString
> let valueBS = encode value
> req' <- parseUrl "http://10.64.16.6:3000/"
> let req = req' { method = "POST", requestBody = RequestBodyLBS valueBS }
> Response status version headers body <- http req manager
> resValue <- body $$ sinkParser json
> handleResponse resValue
> -- Application-specific function to make the request value
> makeValue :: ResourceT IO Value
> makeValue = return $ object
> [ ("foo" .= ("bar" :: String))
> ]
> -- Application-specific function to handle the response from the server
> handleResponse :: Value -> ResourceT IO ()
> handleResponse foo = do
> _ <- lift (print foo)
> return ()
No instance for (Control.Monad.Trans.Class.MonadTrans ResourceT)
arising from a use of `lift'
Possible fix:
add an instance declaration for
(Control.Monad.Trans.Class.MonadTrans ResourceT)
In a stmt of a 'do' block: _ <- lift (print foo)
In the expression:
do { _ <- lift (print foo);
return () }
In an equation for `handleResponse':
handleResponse foo
= do { _ <- lift (print foo);
return () }
Here's the problem, the error says there is no instance for Control.Monad.Trans.Class.MonadTrans ResourceT
But I think there is, due to this documentation. So where have things gone wrong?
As mentioned below there is something janke going on with Control.Monad.Trans.Resource
Here's the results of the ResourceT introspection.
*Main Control.Monad.Trans.Resource> :i ResourceT
newtype ResourceT m a
= Control.Monad.Trans.Resource.ResourceT (GHC.IORef.IORef
Control.Monad.Trans.Resource.ReleaseMap
-> m a)
-- Defined in `Control.Monad.Trans.Resource'
instance Monad m => Monad (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
instance Functor m => Functor (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
instance MonadBaseControl b m => MonadBaseControl b (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
instance MonadThrow m => MonadThrow (ResourceT m)
-- Defined in `Control.Monad.Trans.Resource'
version of resourcet is
[mlitchard#Boris Boris]$ ghc-pkg list resourcet
WARNING: there are broken packages. Run 'ghc-pkg check' for more details.
/usr/lib/ghc-7.4.1/package.conf.d
/home/mlitchard/.ghc/x86_64-linux-7.4.1/package.conf.d
resourcet-0.3.2.1
Any ideas on how to proceed?
Where's the instance for MonadTrans ResourceT?
If I were a betting man, I would say you have multiple versions of some library installed. For example, say you have version 0.2 and 0.3 of transformers, and resourcet is built against version 0.2. When you write the code import Control.Monad.Trans.Class (lift) you're importing version 0.3 of lift, but there are no instances for it involved.
Easiest way to test this is to cabalize your code. Cabal will make sure you have the right versions of the libraries involved.
EDIT: This answer does not solve the problem, the import does still not resolve the instances, even though it should. This seems to be a bug in either GHC or some other system.
The Data.Conduit module only re-exports ResourceT as a convenience; the resource monad transformer is defined in a separate package resourcet. conduit does for that reason not re-export class instances (apparently?). You need to manually import Control.Monad.Trans.Resource to gain access to the associated class instances. This can of course be done with the following syntax:
import Control.Monad.Trans.Resource () -- Only import instances
Problem:
I need to compose writer monads of different types in the same Haskell monad transformer stack. Besides using tell to write debug messages I'd also like to use it to write some other data type, e.g. data packets to be transmitted in some other context.
I've checked Hackage for a channelized writer monad. What I was hoping to find was a writer-like monad that supports multiple data types, each representing a distinct "logical" channel in the runWriter result. My searches didn't turn up anything.
Solution Attempt 1:
My first approach at solving the problem was to stack WriterT twice along these lines:
type Packet = B.ByteString
newtype MStack a = MStack { unMStack :: WriterT [Packet] (WriterT [String] Identity) a }
deriving (Monad)
However, I ran into problems when declaring MStack as an instance of both MonadWriter [Packet] and MonadWriter [String]:
instance MonadWriter [String] MStack where
tell = Control.Monad.Writer.tell
listen = Control.Monad.Writer.listen
pass = Control.Monad.Writer.pass
instance MonadWriter [Packet] MStack where
tell = lift . Control.Monad.Writer.tell
listen = lift . Control.Monad.Writer.listen
pass = lift . Control.Monad.Writer.pass
Subsequent complaints from ghci:
/Users/djoyner/working/channelized-writer/Try1.hs:12:10:
Functional dependencies conflict between instance declarations:
instance MonadWriter [String] MStack
-- Defined at /Users/djoyner/working/channelized-writer/Try1.hs:12:10-36
instance MonadWriter [Packet] MStack
-- Defined at /Users/djoyner/working/channelized-writer/Try1.hs:17:10-36
Failed, modules loaded: none.
I understand why this approach is not valid as shown here but I couldn't figure out a way around the fundamental issues so I abandoned it altogether.
Solution Attempt 2:
Since it appears there can only be a single WriterT in the stack, I'm using a wrapper type over Packet and String and hiding the fact in the utility functions (runMStack, tellPacket, and tellDebug below). Here's the complete solution that does work:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Monad.Identity
import Control.Monad.Writer
import qualified Data.ByteString as B
type Packet = B.ByteString
data MStackWriterWrapper = MSWPacket Packet
| MSWDebug String
newtype MStack a = MStack { unMStack :: WriterT [MStackWriterWrapper] Identity a }
deriving (Monad, MonadWriter [MStackWriterWrapper])
runMStack :: MStack a -> (a, [Packet], [String])
runMStack act = (a, concatMap unwrapPacket ws, concatMap unwrapDebug ws)
where (a, ws) = runIdentity $ runWriterT $ unMStack act
unwrapPacket w = case w of
MSWPacket p -> [p]
_ -> []
unwrapDebug w = case w of
MSWDebug d -> [d]
_ -> []
tellPacket = tell . map MSWPacket
tellDebug = tell . map MSWDebug
myFunc = do
tellDebug ["Entered myFunc"]
tellPacket [B.pack [0..255]]
tellDebug ["Exited myFunc"]
main = do
let (_, ps, ds) = runMStack myFunc
putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
putStrLn "Debug log:"
mapM_ putStrLn ds
Yay, compiles and works!
Solution Non-Attempt 3:
It also occurred to me that this might be a time when I'd roll my own, also including error, reader, and state monad functionality that needs be present in my actual application's transformer stack type. I didn't attempt this.
Question:
Although solution 2 works, is there a better way?
Also, could a channelized writer monad with a variable number of channels be generically implemented as a package? It would seem like that would be a useful thing and I'm wondering why it doesn't already exist.
The output of the Writer monad needs to be a Monoid, but luckily tuples of monoids are monoids too! So this works:
import Control.Monad.Writer
import qualified Data.ByteString as B
import Data.Monoid
type Packet = B.ByteString
tellPacket xs = tell (xs, mempty)
tellDebug xs = tell (mempty, xs)
myFunc :: Writer ([Packet], [String]) ()
myFunc = do
tellDebug ["Entered myFunc"]
tellPacket [B.pack [0..255]]
tellDebug ["Exited myFunc"]
main = do
let (_, (ps, ds)) = runWriter myFunc
putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
putStrLn "Debug log:"
mapM_ putStrLn ds
For the record, it is possible to stack two WriterT's on top of each other:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Monad.Writer
import Control.Monad.Identity
import qualified Data.ByteString as B
type Packet = B.ByteString
newtype MStack a = MStack { unMStack :: WriterT [Packet] (WriterT [String] Identity) a }
deriving (Functor, Applicative, Monad)
tellDebug = MStack . lift . Control.Monad.Writer.tell
tellPacket = MStack . Control.Monad.Writer.tell
runMStack m =
let ((a, ps), ds) = (runIdentity . runWriterT . runWriterT . unMStack) m
in (a, ps, ds)
myFunc = do
tellDebug ["Entered myFunc"]
tellPacket [B.pack [0..255]]
tellDebug ["Exited myFunc"]
main = do
let (_, ps, ds) = runMStack myFunc
putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
putStrLn "Debug log:"
mapM_ putStrLn ds
I'm trying to figure out how enumerators work, and therefore testing the enumerator library. I have a snippet which compiles on my desktop computer, but complains about No instance for MonadIO. Am I way off on how to use the enumerator library or is something amiss with my laptop?
iterateetests.hs:29:17:
No instance for (MonadIO (Iteratee Int IO))
arising from a use of `enumeratorFile' at iterateetests.hs:29:17-32
Possible fix:
add an instance declaration for (MonadIO (Iteratee Int IO))
In the first argument of `(==<<)', namely `enumeratorFile h'
In the first argument of `run_', namely
`(enumeratorFile h ==<< summer)'
In the expression: run_ (enumeratorFile h ==<< summer)
And the code
import Data.Enumerator
import qualified Data.Enumerator.List as EL
import System.IO
import Control.Exception.Base
import Control.Monad.Trans
summer :: (Monad m) => Iteratee Int m Int
summer = do
m <- EL.head
case m of
Nothing -> return 0
Just i -> do
rest <- summer
return (i+rest)
enumeratorFile h (Continue k) = do
e <- liftIO (hIsEOF h)
if e
then k EOF
else do
l <- liftIO $ hGetLine h
k (Chunks [read l]) >>== enumeratorFile h
enumeratorFile _ step = returnI step
main = do
bracket
(openFile "numberlist" ReadMode)
(hClose)
(\h -> run_ (enumeratorFile h ==<< summer))
Try changing the import of:
import Control.Monad.Trans
to
import Control.Monad.IO.Class
It may be that you have an older version of mtl installed, and therefore have different MonadIO typeclasses between Control.Monad.Trans and Data.Enumerator.