I want to write a simple webserver in haskell which provides the current time. The time should be returned in json format.
Here is what I have so far:
{-# LANGUAGE DeriveDataTypeable #-}
import Happstack.Server
import Text.JSON.Generic
import Data.Time
import System.IO.Unsafe
data TimeStr = TimeStr {time :: String} deriving (Data, Typeable)
main = simpleHTTP nullConf $ ok $ toResponse $ encodeJSON (TimeStr $ show (unsafePerformIO getCurrentTime))
I am aware that unsafePerformIO should be avoided, yet I could not find a better solution yet. Maybe this is where the problem lies? I have a very basic understanding of monads.
The result is the following:
{"time":"2014-10-16 16:11:38.834251 UTC"}
The problem is that when I refresh localhost:8000 the time doesn't change. Is there some sort of memoization going on?
unsafePerformIO :: IO a -> a
This is the "back door" into the IO monad, allowing IO computation to be performed at any time. For this to be safe, the IO computation should be free of side effects and independent of its environment.
getCurrentTime is dependent on its environment, so unsafePerformIO is not the way to go. However, given a MonadIO, we can use liftIO in order to lift the action into the appropriate monad. Lets have a look at the types to find out where we can plug it in:
-- http://hackage.haskell.org/package/happstack-server-7.3.9/docs/Happstack-Server-SimpleHTTP.html
simpleHTTP :: ToMessage a => Conf -> ServerPartT IO a -> IO ()
ServerPartT is an instance of MonadIO, so we could definitely plug it in here. Lets check ok:
ok :: FilterMonad Response m => a -> m a
-- nope: ^^^
So we really need to get the current time before we prepare the response. After all, this makes sense: when you create the response, all heavy work has been done, you know what response code you can use and you don't need to check whether the file or entry in the database exists. After all, you were going to sent an 200 OK, right?
This leaves us with the following solution:
{-# LANGUAGE DeriveDataTypeable #-}
import Happstack.Server
import Text.JSON.Generic
import Data.Time
import System.IO.Unsafe
import Control.Monad.IO.Class (liftIO)
data TimeStr = TimeStr {time :: String} deriving (Data, Typeable)
main = simpleHTTP nullConf $ do
currentTime <- liftIO getCurrentTime
ok $ toResponse $ encodeJSON (TimeStr $ show currentTime)
Lessons learned
Don't use unsafePerformIO.
Don't use unsafePerformIO, unless you're really sure what you're actually doing.
Use liftIO if you want to use an IO action in an instance of MonadIO.
Related
I have a Lift instance that works with template-haskell 2.14, but won't compile with later versions. Can someone explain what changes are needed?
{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}
module LiftBS where
import Data.ByteString as B (ByteString, length, unpack)
import Data.ByteString.Unsafe (unsafePackAddressLen)
import Language.Haskell.TH (runIO, litE, stringPrimL)
import Language.Haskell.TH.Lift (Lift(lift))
instance Lift (IO B.ByteString) where
lift bsio = do
bs <- runIO bsio
[|unsafePackAddressLen $(lift (B.length bs)) $(litE (stringPrimL (B.unpack bs))) :: IO ByteString|]
That's a sketchy instance of Lift. It's really not what Lift is for. It isn't an accident that the new type of lift rules out compile-time side effects. Lift is for serializing data structures, which this isn't even doing conceptually. If this were serializing the data structure passed to it, it would be splicing in a representation of the IO action. This is executing an action and serializing the result of that action. That's just not what someone unfamiliar with this code is going to expect to happen.
Also, all the work you're putting in to serialize the ByteString as its components hasn't been necessary since bytestring-0.11.2.0, when it got its own Lift instance.
But the real thing to do here is just write a function that does what you want:
atCompileTime :: Lift a => IO a -> Q Exp
atCompileTime act = do
x <- runIO act
[| pure x |]
It's not a Lift instance, so it can have a type that allows it to do what you want. It's not a Lift instance, so it can have a name that explains what it's actually doing. And as a bonus, it will work across a wide range of versions of template haskell.
I'm trying to thread configuration through my Scotty based application using ReaderT monad transformer approach, and having trouble doing so. I have to use configuration both when defining routes (as some of them depend on the config) and when handling actual requests.
The latter works just fine in the ActionT, but no matter what I try I just can't get the types right in ScottyT.
Here's the minimal example I compiled from the ReaderT sample from Scotty GitHub repository:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks, lift, runReaderT)
import Data.Default.Class (def)
import Data.Text.Lazy (Text, pack)
import Prelude
import Web.Scotty.Trans (ScottyT, get, scottyOptsT, text, capture)
data Config = Config
{ environment :: String
} deriving (Eq, Read, Show)
newtype ConfigM a = ConfigM
{ runConfigM :: ReaderT Config IO a
} deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config)
application :: ScottyT Text ConfigM ()
application = do
get "/" $ do
e <- lift $ asks environment
text $ pack $ show e
path <- lift $ asks environment
get (capture path) $ do
text $ pack $ "Hello, custom path"
main :: IO ()
main = scottyOptsT def runIO application where
runIO :: ConfigM a -> IO a
runIO m = runReaderT (runConfigM m) config
config :: Config
config = Config
{ environment = "Development"
}
The error I'm getting is:
• No instance for (Control.Monad.Trans.Class.MonadTrans
(ScottyT Text))
arising from a use of ‘lift’
• In a stmt of a 'do' block: path <- lift $ asks environment
I've looked through the code where ScottyT type is outlined, and indeed there doesn't seem to be an instance of MonadTrans defined for it.
However, I don't feel I have enough both mana and Haskell experience to find a way out of it and would appreciate any help!
Thank you!
With a collective mind we all came to a currently viable solution to the problem.
ScottyT type cased to be a monad transformer with after https://github.com/scotty-web/scotty/pull/167 got merged, therefore there's currently no way of using it this way. There was a PR https://github.com/scotty-web/scotty/pull/181 aimed at bringing that feature back, but as far as I understood it has never got merged.
Since it's not a monad transformer we can only wrap it again:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative
import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks, lift, runReaderT)
import Data.Default.Class (def)
import Data.Text.Lazy (Text, pack)
import Prelude
import Web.Scotty.Trans (ScottyT, get, scottyOptsT, text, capture)
data Config = Config
{ environment :: String
} deriving (Eq, Read, Show)
newtype ConfigM a = ConfigM
{ runConfigM :: ReaderT Config IO a
} deriving (Applicative, Functor, Monad, MonadIO, MonadReader Config)
application :: ConfigM (ScottyT Text ConfigM ())
application = do
path <- asks environment
return $
get "/" $ do
e <- lift $ asks environment
text $ pack $ show e
get (capture path) $
text $ pack $ "Hello, custom path"
runIO :: Config -> ConfigM a -> IO a
runIO c m = runReaderT (runConfigM m) c
main :: IO ()
main = do
let config = Config { environment = "/path" }
app <- runIO config application
scottyOptsT def (runIO config) app
Thanks everyone for helping me out, and hopefully this helps another wandering Scotty like me :).
I'm getting to grips with writing an API in Haskell using Scotty. My files are provided below. My questions are:
In the routes definition, I'm extracting from liftIO whatsTheTime in a do block. This works, but it seems verbose. Is there a nicer syntax?
In the whatsTheTime definition, I'm needing to do fromString. I'd have thought OverloadedString would take care of that, but that's not the case. I'd really appreciate it if somebody pointed out why it doesn't work without fromString.
In a stack project, if I need a directive like OverloadedStrings, do I need to include it every file that needs it, or just at the top of the main entrypoint?
Api.hs:
{-# LANGUAGE OverloadedStrings #-}
module Api
( whatsTheTime
) where
import Data.Time (getCurrentTime)
import Web.Scotty
import Data.String
whatsTheTime :: IO (ActionM ())
whatsTheTime = do
time <- getCurrentTime
return $ text $ fromString ("The time is now " ++ show time)
Main.hs:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where
import Api
import Web.Scotty
import Control.Monad.IO.Class
routes = do
get "/" $ do
res <- liftIO whatsTheTime
res
main :: IO ()
main = do
putStrLn "Starting server..."
scotty 3000 routes
(1) This:
do
res <- liftIO whatsTheTime
res
Desugars to this:
liftIO whatsTheTime >>= \ res -> res
If you look at the type of \ m -> m >>= id:
(Monad m) => m (m a) -> m a
That’s exactly the type of join (Hoogle), so you can use:
get "/" $ join $ liftIO whatsTheTime
join is a common idiom for “execute this action which returns an action, and also execute the returned action”.
(2) OverloadedStrings is for overloading of string literals. You have an overloaded literal "The time is now ", but you constrain it to be of type String by using it as an operand of (++) with a String (the result of show time). You can pack the result of show time as a Text instead using fromString or Data.Text.pack:
import Data.Monoid ((<>))
import qualified Data.Text as Text
-- ...
return $ text $ "The time is now " <> Text.pack (show time)
(3) LANGUAGE pragmas operate per file; as #mgsloan notes, you can add OverloadedStrings to the default-extensions: field of your library or executable in your .cabal file.
The following code tries to combine two examples that work separately:
day 19 of 24 (2012) and e.g. ws example but I took almost everything websocket related away to get a small example.
Please, find the code below. The msgHandler is called by helloDb, which will get the the snaplet containing the db-connection and pass it to the msgHandler. The snaplet-posgresql-simple docs (at the end) give convenience instances and an example how to use one of them in the Initializer monad.
When I take the two commented lines away, ghc say that there are two instances involving out-of-scope types and that instances do overlapp: HasPostgres (ReaderT r m) and HasPostgres (ReaderT (Snaplet Postgres) m).
So the question is, how to get the program to compile so that I could pass db-connection from the snaplet to the websocket-part.
My goal is to make the websocket listen for messages, query db, and send messages pack. Other things that I already tried:
aFun :: (MonadIO m, HasPostgres m) => ... m (..) having both db-queries and websocket-things (both liftIO'd) compiles until WS.runWebSocketsSnap calls directly or indirectly aFun.
Tried to tell msgHandler :: (MonadIO m, HasPostgres m) but then ghc says that there is no instance for HasPosgres IO. My feeling is that this should be doable without IO-instance. Or is it?
The code below is trying to use snaplet in non-snaplet context but I'm not sure if this is the correct way.
Is there a better approach to combining websockets and (db-) snaplets in snapframework? After trying several approaches I'm in serious mental lock state obviously needing help. Any help (even small hints about what kind of things I should start learning/refreshing), will be highly appreciated!
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Maybe
import Data.Monoid ((<>))
import Control.Lens
import Control.Monad.Trans
import Control.Monad.Reader
import Snap.Snaplet
import Snap.Snaplet.PostgresqlSimple
import Snap.Http.Server
import Snap.Core as SC
import Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Network.WebSockets as WS
import qualified Network.WebSockets.Snap as WS
newtype App = App { _db :: Snaplet Postgres }
makeLenses ''App
msgHandler :: (MonadIO m) => App -> BS.ByteString -> WS.PendingConnection -> m ()
msgHandler appSt mUId pending = do
conn <- liftIO $ WS.acceptRequest pending
-- res <- liftIO $ runReaderT (query "SELECT name FROM users WHERE id = ?" (Only mUId)) dbSnaplet
-- liftIO $ print (res :: [Name])
liftIO $ T.putStrLn "msgHandler ended"
where dbSnaplet = view db appSt
initApp :: SnapletInit App App
initApp = makeSnaplet "myapp" "My application" Nothing $
App <$> nestSnaplet "db" db pgsInit
<* addRoutes [("/hello/:id", helloDb)]
newtype Name = Name { _nm :: Text } deriving (Show, Eq)
instance FromRow Name where fromRow = Name <$> field
helloDb :: Handler App App ()
helloDb = do
Just mUId <- getParam "id"
userName <- with db $ listToMaybe <$> query "SELECT name FROM users WHERE id = ?" (Only mUId)
writeText $ maybe "User not found" (\h -> "Hello, " <> (T.pack . show) h) (userName :: Maybe Name)
sStApp <- getSnapletState
WS.runWebSocketsSnap $ msgHandler (view snapletValue sStApp) mUId
main :: IO ()
main = serveSnaplet defaultConfig initApp
The overlapping instance issue you ran into is a bug in the snaplet-postgresql-simple library that has been fixed but the fix has not yet been released. You might want to ask the maintainer about this.
In the meantime you can either pull the latest version of the library from Github, or redefine a type different but isomorphic to ReaderT (Snaplet Postgres), copying the HasPostgres instance.
In the question Web, Scotty: connection pool as monad reader it is shown how to use ScottyT to embed a Reader monad in the stack to access a static configuration (in that case, a connection pool).
I have a similar question, but simpler – or at least I thought so…
I want to add a Reader to a single handler (i.e. a ActionT), not the whole app.
I started modifying the program from the question above, but I cannot figure out how to turn an ActionT Text (ReaderT String IO) into the ActionT Text IO the handler needs to be. After fumbling around and trying to use typed holes hoping to see how to construct this I have to give up for now and ask for help. I really feel this should be simple, but cannot figure out how to do this.
Here's the program, with the lines where I'm stuck highlighted:
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text.Lazy as T
import Data.Text.Lazy (Text)
import Control.Monad.Reader
import Web.Scotty.Trans
type ActionD = ActionT Text (ReaderT String IO)
main :: IO ()
main = do
scottyT 3000 id id app
-- Application
app :: ScottyT Text IO ()
app = do
get "/foo" $ do
h <- handler -- ?
runReaderT h "foo" -- ?
--get "/bar" $ do
-- h <- handler
-- runReaderT h "bar"
-- Route action handler
handler :: ActionD ()
handler = do
config <- lift ask
html $ T.pack $ show config
If you want to run each action in a separate reader, you don't need the more complex Scotty.Trans interface at all. You can just build you monad stack the other way around, with ReaderT on top.
import qualified Data.Text.Lazy as T
import Control.Monad.Reader
import Web.Scotty
type ActionD = ReaderT String ActionM
main :: IO ()
main = do
scotty 3000 app
-- Application
app :: ScottyM ()
app = do
get "/foo" $ do
runReaderT handler "foo"
-- Route action handler
handler :: ActionD ()
handler = do
config <- ask
lift $ html $ T.pack $ show config