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.
Related
Here's a small toy DSL in typed tagless final style (see Typed Tagless Final Interpreters by O. Kiselyov).
class Monad m => RPCToy m where
mkdir :: FilePath -> m ()
ls :: FilePath -> m [FilePath]
The different instatiations of this little DSL would be, for example, the implementation of mkdir and ls on different platforms, either local and remote. Type m is a monad in all implementations, it could be IO, or one provided by some networking library, or some other homebrew monad.
Here's an implementation in IO:
import System.Directory (listDirectory)
import Control.Monad (void)
instance RPCToy IO where
mkdir = void . putStrLn . ("better not create "++)
ls = listDirectory
and a little application
import Control.Monad (unless)
demo :: RPCToy m => m ()
demo = do
files <- ls "."
unless ("test" `elem` files) $
mkdir "test"
that can be run in the IO monad
main :: IO ()
main = do
demo
So far so good.
Now suppose that different implementations rely on the same monad m, e.g. from the same networking library. For the typed tagless final style to work distinct monads are needed, here, that are nonetheless essentially the same. The ambiguity can be removed by wrapping things:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
newtype Local a = Local {runLocal :: IO a} deriving (Functor, Applicative, Monad)
and then implement RPCToy Local,
instance RPCToy Local where
mkdir = Local . putStrLn . ("BETTER NOT CREATE "++)
ls = Local . listDirectory
that can be run nicely
main :: IO ()
main = do
runLocal demo
What bugs me is this: The implementers have to put a lot of Locals in their code, or, rather repetitively, wrap the library functions like so
localListDirectory = Local . listDirectory
...
One idea is to create an 'indexed monad' im i a, im i being the monad, that carries around an index type i for the sole purpose of letting the compiler distinguish the different implementations. The RebindableSyntax extension makes this possible without having to give up the do syntax. But each monad needs to be 'lifted' into this indexed monad. The improvement is this: Each monad m and the functions therein need to be lifted only once. Otherwise it's still quite convoluted.
I'm wondering whether there's a nicer way to get rid of the monad wrapping.
Here's one approach: Introduce a monad transformer that just wraps another monad with the twist of adding a phantom type i,
import Control.Monad.Trans.Class (MonadTrans, lift)
newtype IndexedWrapT i m a = IndexedWrapT {runIndexedWrapT :: m a}
deriving (Functor, Applicative, Monad)
instance MonadTrans (IndexedWrapT i) where
lift = IndexedWrapT
The phantom type i has the sole purpose of letting different implementations have distinct type.
Then wrap (lift) the relevant functions once, e.g.:
putStrLn' :: MonadTrans t => String -> t IO ()
putStrLn' = lift . putStrLn
On the implementation side
data MyImpl'
type MyImpl = IndexedWrapT MyImpl' IO
runMyImpl :: MyImpl a -> IO a
runMyImpl = runIndexedWrapT
instance RPCToy MyImpl where
mkdir = putStrLn' . ("BETTER NOT CREATE "++)
....
Having formulated the wrapping operation as a monad transformer it becomes clear that other approaches to composing effects may be used, here, as pointed out in the comments, e.g. freer-simple or polysemy.
I'm designing a small game which basically uses StateT and just updating the state. Below is the simplified version:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State
import Control.Monad.State.Class
import System.Random
data PlayerState = PlayerState {
_psName :: String,
_psScore :: Int
} deriving (Show)
makeClassy ''PlayerState
data Game = Game {
_turns :: Int,
_players :: [PlayerState]
} deriving (Show)
makeClassy ''Game
randomGameInit :: IO Game
randomGameInit = do
players <- replicateM 5 $ PlayerState <$> (replicateM 4 $ randomRIO ('a', 'z')) <*> randomRIO (1,10)
return $ Game 0 players
update :: (MonadState s m, HasGame s) => m ()
update = do
players . ix 0 . psName %= (\_ -> "mordor")
turns %= (+1)
exitCondition <- fmap (>10) (turns <%= id)
unless exitCondition update
main :: IO ()
main = do
init <- randomGameInit
runStateT update init >> print "Game Over"
I've recently learned about the ReaderT Design Pattern vs mtl StateT, which encourages replacing StateT with a mutable reference inside a ReaderT over IO.
I wonder how I should adapt the code using ReaderT. Most specifically, many Lens functions have types: (MonadState s m) which apparently need to be inside a State. Does this mean that Lens library functions are designed for StateT and not ReaderT? How to use Lens with ReaderT design pattern?
From what I've seen, ReaderT pattern users typically don't use the MonadState lens operators. Instead, use view to access the desired MVar (or whatever kind of mutable var you're dealing with) and update that as usual (e.g. with modifyMVar).
The RIO monad offers an appropriate MonadState instance, though. A better answer than mine could probably adapt your code to the RIO monad fairly easily.
I'm learning Servant and write a simple service. Here's source code:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
module BigMama where
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Control.Monad.Reader
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Char
import qualified Data.Map as M
import Debug.Trace
import GHC.Generics
import Prelude hiding (id)
import Servant
data MicroService = MicroService
{ name :: String
, port :: Int
, id :: Maybe String
} deriving (Generic)
instance ToJSON MicroService
instance FromJSON MicroService
instance Show MicroService where
show = C.unpack . encode
type ServiceSet = STM (TVar (M.Map String MicroService))
type LocalHandler = ReaderT ServiceSet IO
defaultServices :: ServiceSet
defaultServices = newTVar $ M.fromList []
type Api =
"bigmama" :> Get '[JSON] (Maybe MicroService)
:<|> "bigmama" :> ReqBody '[JSON] MicroService :> Post '[JSON] MicroService
api :: Proxy Api
api = Proxy
serverT :: ServerT Api LocalHandler
serverT = getService
:<|> registerService
getService :: LocalHandler (Maybe MicroService)
getService = do
stm <- ask
liftIO . atomically $ do
tvar <- stm
mss <- readTVar tvar
return $ M.lookup "file" mss
registerService :: MicroService -> LocalHandler MicroService
registerService ms = do
stm <- ask
liftIO . atomically $ do
tvar <- stm
mss <- readTVar tvar
let mss' = M.insert (name ms) ms mss
writeTVar tvar mss'
return ms
readerToHandler' :: forall a. ServiceSet -> LocalHandler a -> Handler a
readerToHandler' ss r = liftIO $ runReaderT r ss
readerToHandler :: ServiceSet -> (:~>) LocalHandler Handler
readerToHandler ss = Nat (readerToHandler' ss)
server :: Server Api
server = enter (readerToHandler defaultServices) serverT
It seems like servant providing a new defaultServices for every request. I send POST to create service (name = "file") and can't get the service back on GET request. How to share data among requests on servant?
It seems like servant providing a new defaultServices for every request.
It is, because your code as written is an STM action to do so. Following the logic—
defaultServices :: ServiceSet
defaultServices = newTVar ...
This (fragmentary) definition crucially does not run the STM action to produce a new TVar. Instead it defines a value (defaultServices) which is an STM action which can produce TVars. Following where defaultServices gets passed to, you use it in your handlers like—
getService = do
stm <- ask
liftIO . atomically $ do
tvar <- stm
...
The action stored in your Reader is unchanged from the defaultServices value itself, so this code is equivalent to—
getService = do
liftIO . atomically $ do
tvar <- defaultServices
...
And by substituting in the definition of defaultServices—
getService = do
liftIO . atomically $ do
tvar <- newTVar ...
...
This now looks obviously wrong. Instead of defaultServices being an action to produce a new TVar, it should be that TVar itself, right? So on the type level without aliases—
type ServiceSet = STM (TVar (M.Map String MicroService)) -- From this
type Services = TVar (M.Map String MicroService) -- To this
defaultServices :: Services
Now defaultServices represents an actual TVar, instead of a method of creating TVars. Writing this may seem tricky if it's your first time because you somehow have to run an STM action, but atomically just turns that into an IO action, and you probably “know” that there is no way to escape IO. This actually is incredibly common though, and a quick look at the actual stm documentation for the functions in play will point you right to the answer.
It turns out that this is one of those exciting times in your life as a Haskell developer that you get to use unsafePerformIO. The definition of atomically spells out pretty much exactly what you have to do.
Perform a series of STM actions atomically.
You cannot use atomically inside an unsafePerformIO or
unsafeInterleaveIO. Any attempt to do so will result in a runtime
error. (Reason: allowing this would effectively allow a transaction
inside a transaction, depending on exactly when the thunk is
evaluated.)
However, see newTVarIO, which can be called inside unsafePerformIO,
and which allows top-level TVars to be allocated.
Now there's one final piece of this puzzle that isn't in the documentation, which is that unless you tell GHC not to inline your top-level value produced using unsafePerformIO, you might still end up with sites where you use defaultServices having their own unique set of services. E.g., without forbidding inlining this would happen—
getService = do
liftIO . atomically $ do
mss <- readTVar defaultServices
getService = do
liftIO . atomically $ do
mss <- readTVar (unsafePerformIO $ newTVarIO ...)
...
This is a simple fix though, just add a NOINLINE pragma to your definition of defaultServices.
defaultServices :: Services
defaultServices = unsafePerformIO $ newTVar M.empty
{-# NOINLINE defaultServices #-}
Now this is a fine solution, and I've happily used it in production code, but there are some objections to it. Since you're already fine with using a ReaderT in your handler monad stack (and the above solution is mostly for people who for some reason are avoiding threading a reference around), you could just create a new TVar at program initialization and then pass that in. The briefest sketch of how that would work is below.
main :: IO ()
main = do
services <- atomically (newTVar M.empty)
run 8080 $ serve Proxy (server services)
server :: TVar Services -> Server Api
server services = enter (readerToHandler services) serverT
getService :: LocalHandler (Maybe MicroService)
getService = do
services <- ask
liftIO . atomically $ do
mss <- readTVar services
...
In the code below I manage a game, which owns a list of links.
At each step of the game, I change the game state updating the list of links modified.
As I am learning the State monad, I was trying to apply the State monad technique to this use case.
Nonetheless, at each turn, I need to get a piece of info from IO, using getLine
this gives such a code
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
import Control.Monad
import Control.Monad.State.Strict
import qualified Data.List as List
import qualified Control.Monad.IO.Class as IOClass
type Node = Int
type Link = (Node,Node)
type Links = [Link]
type Gateway = Node
type Gateways = [Gateway]
data Game = Game { nbNodes :: Int, links :: Links, gateways :: Gateways }
computeNextTurn :: State Game Link
computeNextTurn = do
g <- get
inputLine <- IOClass.liftIO getLine -- this line causes problem
let node = read inputLine :: Int
let game#(Game _ ls gs) = g
let linkToSever = computeLinkToSever game node
let ls' = List.delete linkToSever ls
let game' = game{links = ls'}
put game'
return linkToSever
computeAllTurns :: State Game Links
computeAllTurns = do
linkToSever <- computeNextTurn
nextGames <- computeAllTurns
return (linkToSever : nextGames)
computeLinkToSever :: Game -> Node -> Link
computeLinkToSever _ _ = (0,1) -- just a dummy value
-- this function doesnt compute really anything for the moment
-- but it will depend on the value of node i got from IO
However I get an error at compilation:
No instance for (MonadIO Data.Functor.Identity.Identity)
arising from a use of liftIO
and I get the same style of error, if I try to use liftM and lift.
I have read some questions that are suggesting StateT and ST, which I don't grasp yet.
I am wondering if my current techique with a simple State is doomed to fail, and that indeed I can not use State, but StateT / ST ?
Or is there a possible operation to simply get the value from getLine, inside the State monad ?
As #bheklilr said in his comment, you can't use IO from State. The reason for that, basically, is that State (which is just shorthand for StateT over Identity) is no magic, so it's not going to be able to use anything more than
What you can already do in its base monad, Identity
The new operations provided by State itself
However, that first point also hints at the solution: if you change the base monad from Identity to some other monad m, then you get the capability to use the effects provided by m. In your case, by setting m to IO, you're good to go.
Note that if you have parts of your computation that don't need to do IO, but require access to your state, you can still express this fact by making their type something like
foo :: (Monad m) => Bar -> StateT Game m Baz
You can then compose foo with computations in StateT Game IO, but its type also makes it apparent that it can't possibly do any IO (or anything else base monad-specific).
You also mentioned ST in your question as possible solution. ST is not a monad transformer and thus doesn't allow you to import effects from some base monad.
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.