I'm just starting out with haskell and I'm having issues with a basic "echo" REST server.
Spock looked like a nice starting place for a REST server, and I though I got the basics of the State monad, but I'm having issues understanding how to put a runState around the spock code.
Here's the code I've got so far.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Monoid
import Web.Spock.Safe
import qualified Control.Monad.State as S
storeData :: String -> S.State String String
storeData val = do S.put val
return val
getData :: S.State String String
getData = do val <- S.get
return val
main :: IO ()
main =
runSpock 11350 $ spockT id $
do get "store" $
text "Would be a call to getData"
OK so here's a version of the restartableStateT hack for your example:
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
module Main where
import Data.Monoid
import Data.String (fromString)
import Web.Spock.Safe
import qualified Control.Monad.State as S
import Data.IORef
storeData :: (Monad m) => String -> S.StateT String m String
storeData val = do S.put val
return val
getData :: (Monad m) => S.StateT String m String
getData = do val <- S.get
return val
newtype RunStateT s m = RunStateT{ runStateT :: forall a. S.StateT s m a -> m a }
restartableStateT :: s -> IO (RunStateT s IO)
restartableStateT s0 = do
r <- newIORef s0
return $ RunStateT $ \act -> do
s <- readIORef r
(x, s') <- S.runStateT act s
atomicModifyIORef' r $ const (s', x)
main :: IO ()
main = do
runner <- restartableStateT "initial state"
runSpock 11350 $ spockT (runStateT runner) $ do
get "store" $ do
cmd <- param "value"
case cmd of
Nothing -> do
old <- S.lift getData
text $ fromString old
Just new -> do
S.lift $ storeData new
text "Stored."
Like the other answer, this one creates a single global IORef to store "the state". The runner passed to spockT is then able to run any StateT String IO computation by getting the state from this IORef, running the computation, and putting the resulting state back into the IORef.
I would like to reiterate from the other answer that this is not necessarily a good idea, because it has no story for concurrency. I guess that could be papered over by using STM for example, but... I think you should just use a database for this kind of thing.
Related
I am back again trying to learn Haskell and, oh boy it is difficult!
I am a trying to do a simple mongoDB insertion inside a Scotty endpoint. Problem is the type return by the insert function is not accepted in the Scotty do statement. The program is quite simple:
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Data.Monoid (mconcat)
import Control.Monad.Trans(liftIO,lift,MonadIO)
import System.IO
import Data.Text.Lazy.Encoding (decodeUtf8)
import Data.Text.Lazy (pack,unpack)
import Data.Maybe
import Data.Time.Clock.POSIX
import Database.MongoDB (Action, Document, Document, Value, access,
allCollections,insert, close, connect, delete, exclude, find,
host,findOne, insertMany, master, project, rest,
select, liftDB, sort, Val, at, (=:))
main :: IO ()
main = scotty 3000 $ do
post "/logs" $ do
id <- liftIO $ getTimeInMillis
b <- body
let decodedBody = unpack(decodeUtf8 b)
i <- liftIO $ insertLog id decodedBody
text $ "Ok"
--setup database connection
run::MonadIO m => Action m a -> m a
run action = do
pipe <- liftIO(connect $ host "127.0.0.1")
access pipe master "data" action
getTimeInMillis ::Integral b => IO b
getTimeInMillis = round `fmap` getPOSIXTime
insertLog::MonadIO m => Int -> String -> Action m Value
insertLog id body = run $ insert "logs" ["id" =: id, "content" =: body]
the problem comes in the line
i <- liftIO $ insertLog id decodedBody
And the type error is
Expected type: Web.Scotty.Internal.Types.ActionT
Data.Text.Internal.Lazy.Text IO Value
Actual type: Action m0 Value
Any help or tip will be welcome!
I see a different error message with that code. Maybe you made some changes (like adding liftIO).
• Couldn't match type ‘Control.Monad.Trans.Reader.ReaderT
Database.MongoDB.Query.MongoContext m0 Value’
with ‘IO a0’
Expected type: IO a0
Actual type: Action m0 Value
In the line:
i <- liftIO $ insertLog id decodedBody
the liftIO function expects a genuine IO action, of type IO a for some a. However, the expression insertLog id decodedBody doesn't represent an IO action. It is Mongo action of type Action m Value for some m that has a MonadIO constraint. You need to use some function run Mongo Action values in IO. It looks like you've already written such a function, named run. It's written for a general MonadIO m but can be specialized to:
run :: Action IO a -> IO a
so if you first run your Mongo action (to turn it into IO) and then lift that action (to run it in the Scotty action under post), the following should type check:
i <- liftIO $ run $ insertLog id decodedBody
Update: Whoops! I missed the run in the insertLog function. You either want to write:
-- use "run" here
main = do
...
i <- liftIO $ run $ insertLog id decodedBody
-- but no "run" here
insertLog::MonadIO m => Int -> String -> Action m Value
insertLog id body = insert "logs" ["id" =: id, "content" =: body]
OR you want to write:
-- no "run" here
main = do
...
i <- liftIO $ insertLog id decodedBody
-- change the type signature and use "run" here
insertLog :: Int -> String -> IO Value
insertLog id body = run $ insert "logs" ["id" =: id, "content" =: body]
That will avoid the double-run problem.
The reason run didn't work as intended in your original code is a little complicated...
The problem is that run has flexibility to convert its Mongo action to many possible monads by returning m a for any m that supports MonadIO m. Because you gave insertLog a type signature with return type MonadIO m' => Action m' Value (where I changed the variable to keep m and m' distinct), the type checker matched the return type of run to the return type of insertLog:
m a ~ Action m' Value
by setting a ~ Value and m ~ Action m'. So, your run in insertLog was actually used with the following bizarre type:
run :: Action (Action m') Value -> Action m' Value
Normally, this would have caused a type error, but the type of insert is also flexible. Instead of returning an action of type Action IO Value, which would be the "usual" type, it happily adapted itself to return an action of type Action (Action IO) Value to match what run was expecting.
I having a problem with my code I'm trying to compile it but it throws me Could Not Match Maybe Element with Element
Why? how does Maybe Work?, how do I convert it to a Value? why is so hard to understand monads and functors,
and why isn't an easy library to get some newbie getting started wit purescript?
:P
(for those who didn't understand I was just asking the first 3)
module Main where
import Prelude --(Unit, bind, pure, ($), (<$>))
import Effect (Effect)
import Data.Maybe --(Just,Maybe,fromJust, fromMaybe)
import Data.Foldable (traverse_)
import Effect.Console (log)
import Web.HTML (window)
import Web.HTML.Window (document)
import Web.HTML.HTMLDocument (toNonElementParentNode)
import Web.Event.Event (Event, target)
import Web.HTML.HTMLInputElement (value, fromEventTarget)
import Web.DOM.NonElementParentNode (NonElementParentNode,getElementById)
import Web.DOM.Node (setTextContent)
import Web.DOM.Element (Element,toNode)
import Web.Event.EventTarget (addEventListener)
pname = "#inputName" :: String
bname = "#badgeName" :: String
main :: Effect Unit
main = do
nod1 <- returnNonElementParentNode
--querySelector :: QuerySelector -> ParentNode -> Effect (Maybe Element)
elementTarget <- getElementById pname nod1
--addEventListener :: EventType -> EventListener -> Boolean -> EventTarget
addEventListener "input" updateBadge false elementTarget
updateBadge :: Event -> Unit
updateBadge event = do
nod2 <- returnNonElementParentNode
elementTarget <- getElementById bname nod2
tget <- target event
inml <- fromEventTarget tget
input <- value inml
badge <- toNode (pure elementTarget)
if not(badge == Nothing)
then setTextContent input (toNode badge)
else Nothing
returnNonElementParentNode :: Effect NonElementParentNode
returnNonElementParentNode = do
win <- window
doc <- document win
--let nd = toNonElementParentNode doc
let
nod = toNonElementParentNode doc
pure nod
I just want to understand how to get the input value from an htmlInputElement and pass it to the textContent of Another HTMLElement
pretty much how to convert a Maybe to a Value to pass to toNode function
pattern matching ... https://github.com/purescript/documentation/blob/master/language/Pattern-Matching.md
Data.Maybe#v:maybe ... https://pursuit.purescript.org/packages/purescript-maybe/4.0.1/docs/Data.Maybe#v:maybe
Data.Maybe#v:fromMaybe ... https://pursuit.purescript.org/packages/purescript-maybe/4.0.1/docs/Data.Maybe#v:fromMaybe
Partial.Unsafe#v:unsafePartial + Data.Maybe#v:fromJust https://pursuit.purescript.org/packages/purescript-partial/2.0.1/docs/Partial.Unsafe#v:unsafePartial https://pursuit.purescript.org/packages/purescript-maybe/4.0.1/docs/Data.Maybe#v:fromJust
I'm trying to fetch some JSON data from a Haskell server, but I'm having trouble with the Respondeable instance, as well as just Affjax in general. I've defined EncodeJson + DecodeJson with Data.Argonaut.Generic.Aeson (GA), but I can't figure out how to fit that in with the Respondeable instance and it's fromResponse function.
It gives me the error "Could not match type Foreign with type Json" but is it possible to reuse my decodeJson instance without having to create anything else by hand? Maybe by creating an IsForeign instance, but using GA.decodeJson in that? I'm just not sure how to go about doing it. I've seen how it's done in https://github.com/purescript/purescript-foreign/blob/master/examples/Complex.purs by hand, but I have complex types that need to match up with my Haskell JSON output, and it's going to be a huge pain to do it manually.
I'm using purescript 10.7, Affjax 3.02, and argonaut 2.0.0, and argonaut-generic-codecs 5.1.0. Thanks!
testAffjax :: forall eff. Aff (ajax :: AJAX | eff) (Answer)
testAffjax = launchAff do
res <- affjax $ defaultRequest { url = "/", method = Left GET }
pure res.response
data Answer = Answer {
_answer :: String
, _isCorrect :: Boolean
, _hint :: String
}
{- PROBLEM -}
instance respondableAnswer :: Respondable Answer where
responseType = Tuple Nothing JSONResponse
fromResponse = GA.decodeJson {- Error here -}
derive instance genericAnswer :: Generic Answer
instance showAnswer :: Show Answer where
show = gShow
instance encodeAnswer :: EncodeJson Answer where
encodeJson = GA.encodeJson
instance decodeAnswer :: DecodeJson Answer where
decodeJson = GA.decodeJson
What you're looking for is a function that adapts a JSON decoder:
decodeJson :: forall a. Json -> Either String a
To return using F rather than Either. F is a synonym defined in Data.Foreign for Except MultipleErrors a. To do that we need to:
Translate our String error into a MultipleErrors
Convert from Either to Except
MultipleErrors is another synonym defined in Data.Foreign, this time for NonEmptyList ForeignError. Looking at ForeignError there's a constructor also called ForeignError that lets us provide some string message. That leaves us with the need to create a NonEmptyList, which is pretty easy:
remapError = pure <<< ForeignError
NonEmptyList is Applicative, so we can create a one-element list with pure.
To go from Either to Except is also straightforward. Again looking at the definitions in Pursuit we can see:
newtype ExceptT m e a = ExceptT (m (Either e a))
type Except = ExceptT Identity
So ExceptT is just a fancy Either already, giving us:
eitherToExcept = ExceptT <<< pure
The pure here is to lift Either e a into m (Either e a), which for Except m ~ Identity.
So now we can take this stuff, and make a general "decode JSON for Affjax responses" function:
decodeJsonResponse :: forall a. DecodeJson a => Json -> F a
decodeJsonResponse =
ExceptT <<< pure <<< lmap (pure <<< ForeignError) <<< decodeJson
The only other thing that happened in here is we used lmap to map over the left part of the Either, to do the error-message-type-conversion bit.
We can now use Kleisli composition ((<=<)) to chain this decodeJsonResponse together with the original fromResponse that will do the initial ResponseContent -> F Json:
instance respondableAnswer :: Respondable Answer where
responseType = Tuple (Just applicationJSON) JSONResponse
fromResponse = decodeJsonResponse <=< fromResponse
Here's the full example using your Answer type:
module Main where
import Prelude
import Control.Monad.Aff (Aff)
import Control.Monad.Except (ExceptT(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson)
import Data.Argonaut.Generic.Argonaut as GA
import Data.Bifunctor (lmap)
import Data.Foreign (F, ForeignError(..))
import Data.Generic (class Generic, gShow)
import Data.Maybe (Maybe(..))
import Data.MediaType.Common as MediaType
import Data.Tuple (Tuple(..))
import Network.HTTP.Affjax as AX
import Network.HTTP.Affjax.Response as AXR
testAffjax :: forall eff. Aff (ajax :: AX.AJAX | eff) Answer
testAffjax = _.response <$> AX.get "/"
newtype Answer = Answer
{ _answer :: String
, _isCorrect :: Boolean
, _hint :: String
}
derive instance genericAnswer :: Generic Answer
instance showAnswer :: Show Answer where
show = gShow
instance encodeAnswer :: EncodeJson Answer where
encodeJson = GA.encodeJson
instance decodeAnswer :: DecodeJson Answer where
decodeJson = GA.decodeJson
instance respondableAnswer :: AXR.Respondable Answer where
responseType = Tuple (Just MediaType.applicationJSON) AXR.JSONResponse
fromResponse = decodeJsonResponse <=< AXR.fromResponse
decodeJsonResponse :: forall a. DecodeJson a => Json -> F a
decodeJsonResponse =
ExceptT <<< pure <<< lmap (pure <<< ForeignError) <<< decodeJson
The following code produces this error:
module Broken1 where
import Control.Monad.Aff.Class (MonadAff)
import Control.Monad.Aff (Aff())
import DOM.HTML.Types
import Halogen
import DOM
import Control.Monad.Eff.Exception
import Control.Monad.Aff.AVar
import Prelude
import qualified Halogen.HTML.Indexed as H
data State = State
data Query a = Query a
ui :: forall eff g. (MonadAff (HalogenEffects eff) g) => Component State Query g
ui = component (\_ -> H.div_ []) (\(Query next) -> pure next)
main' :: forall eff a. (HTMLElement -> Aff (HalogenEffects eff) a)
-> Aff (HalogenEffects eff) Unit
main' addToDOM = do
{ node: node, driver: driver } <- runUI ui State
let driver' :: Natural Query (Aff (HalogenEffects eff))
driver' = driver
return unit
the error:
at Broken1.purs line 34, column 19 - line 36, column 5
Could not match type
a2
with type
a1
while trying to match type a2
with type a1
while checking that expression driver
has type Query a1 -> Aff ( avar :: AVAR
, err :: EXCEPTION
, dom :: DOM
| eff1
)
a1
in value declaration main'
If I omit the type signature for driver', there is no compiler error, as I was hoping. If I ask psc for a signature (by replacing the type with _), this is the suggestion:
Wildcard type definition has the inferred type
forall a. Query a -> Aff ( dom :: DOM
, err :: EXCEPTION
, avar :: AVAR
| eff4
)
a
When I cut&paste this into the code instead of my original type, the error is the same as above.
In the second case this actually makes sense, since the quantifier opens a new scope for a which should be captured in the signature of main'. But even if I remove the forall a, the type error sticks around.
garyb earlier today on #purescript said it may be a bug in the type checker. I am posting this here anyway until that is established fact.
thanks! (:
I'm trying to wrap my head around dependency injection in Scala using monad readers. I started learning Scala recently, so the code I give here, does not compile, but I hope my problem becomes clear. To start, lets assume our application allows a user to changes it password. First, I create a simple case class User and add a changePassword method on the companion object:
case class User (id:Int, username:String, password:String)
object User {
def changePassword (oldPassword:String, newPassword:String, user:User) = {
if (!user.password.equals(oldPassword)) {
-\/("Old password incorrect")
} else {
\/-(user.copy(password = newPassword))
}
}
}
Note that the changePassword method is still a bit to specific in its return type. In Haskell I would write:
data User = User {
id :: Int
, username :: String
, password :: String
} deriving (Show)
changePassword :: (MonadError String m) => String -> String -> User -> m User
changePassword old new user =
if password user == old
then return $ user { password = new }
else throwError "Old password incorrect"
This would allow the changePassword function to be used in any monad transformer stack which contains the Error monad.
Now, to create the application we need two more additional components. One component is a repository which knows how to retrieve and store User objects. Multiple implementations may exists. For example we may have a database repository in production and a in memory repository for testing purposes.
trait UserRepository {
def getById(id:Int):M[User]
def save (user:User):M[Unit]
}
object DatabaseUserRepository extends UserRepository {
def getById(id:Int):MonadReader[Connection,User]
def save (user:User):MonadReader[Connection,Unit]
}
object InMemoryUserRepository extends UserRepository {
def getById(id:Int):MonadState[UserMap,User]
def save (user:User):MonadState[UserMap,Unit]
}
Both implementations are monadic, but the monadic behavior they need may differ. I.e. the database repository depends on a connection which its may access using the reader monad while the in memory repository depends on the state monad.
The other component is a service component which acts as entry point to our logic from the UI.
object UserService {
def doChangePassword (id:Int, oldPassword:String, newPassword:String):MonadReader[UserRepository, Unit]
}
This component uses the user repository to retrieve the user by the given id and then calls the changePassword function and saves the updated user object back using the repository.
I hope this illustrates what I try to achieve. However, I'm still a bit puzzled how to connect the different parts together...
To answer my own question, at least partially. I searched google for this topic and found out about the concept of a free monad:
http://www.haskellforall.com/2012/06/you-could-have-invented-free-monads.html
After reading this, I came up with:
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Control.Monad.Free
import Control.Monad.Error
import Control.Monad.Identity
import Control.Monad.State hiding (get)
import qualified Control.Monad.State as MS
import Data.IntMap
import Prelude hiding (lookup)
data User = User {
ident :: Int
, username :: String
, password :: String
} deriving (Show, Eq, Ord)
changePassword' :: (MonadError String m) => String -> String -> User -> m User
changePassword' old new user =
if password user == old
then return $ user { password = new }
else throwError "Old password incorrect"
type UserMap = IntMap User
data Interaction next = Save User next
| Get Int (User -> next)
| ChangePassword String String User (User -> next)
instance Functor Interaction where
fmap f (Save user next) = Save user (f next)
fmap f (Get id g) = Get id (f . g)
fmap f (ChangePassword old new user g) = ChangePassword old new user (f . g)
type Program = Free Interaction
save :: User -> Program ()
save user = liftF (Save user ())
get :: Int -> Program User
get ident = liftF (Get ident id)
changePassword :: String -> String -> User -> Program User
changePassword old new user = liftF (ChangePassword old new user id)
doChangePassword :: String -> String -> Int -> Program ()
doChangePassword old new ident = get ident
>>= changePassword old new
>>= save
newtype ST a = ST { run :: StateT UserMap (ErrorT String Identity) a } deriving (Monad, MonadState UserMap, MonadError String)
runST :: ST a -> UserMap -> UserMap
runST (ST x) s = case runIdentity (runErrorT (execStateT x s)) of
Left message -> error message
Right state -> state
interpreter :: Program r -> ST r
interpreter (Pure r) = return r
interpreter (Free (Save user next)) = do
modify (\map -> insert (ident user) user map)
interpreter next
interpreter (Free (Get id g)) = do
userMap <- MS.get
case lookup id userMap of
Nothing -> throwError "Unknown identifier"
Just user -> interpreter (g user)
interpreter (Free (ChangePassword old new user g)) = do
user' <- changePassword' old new user
interpreter (g user')
main = (putStrLn . show) $ runST (interpreter p) (fromList [(1, User 1 "username" "secret")])
where
p = doChangePassword "secret" "new" 1
Here we define a small language consisting of three operations: Get, Save and ChangePassword. Then we define our function in terms of these 3 operations:
doChangePassword :: String -> String -> Int -> Program ()
doChangePassword old new ident = get ident
>>= changePassword old new
>>= save
The result of this function is simply a structure describing a small program which we need to execute. For this, we write a small interpreter. Changing from a database repository to an in memory repository is achieved by providing a different interpreter.
Composing multiple languages is possible by defining coproducts as described in data types a la carte (http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.101.4131&rep=rep1&type=pdf). But until now, I didn't have time yet to try this out.