catchException doesn't remove the effect - purescript

In the module below, function g compiles without no comment but function f gives the message "Could not match type", with the explanation that (err :: Exception | e) does not match ().
However, both throwException and toISOString return a value in Eff with the EXCEPTION effect (and possibly others).
It looks as if catchException does not remove the EXCEPTION effect in f, but does remove the effect in g. Indeed, the inferred type for f is:
f :: forall e. DateTime -> Eff (err :: EXCEPTION | e) String
Why is this?
module Problem.With.Exception where
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Exception (catchException, throwException, error)
import Data.DateTime (DateTime(..))
import Data.JSDate (fromDateTime, toISOString)
import Prelude (pure, ($), (<>), show, discard, bind)
g :: DateTime -> Eff () String
g d = catchException
(\_ -> pure "Some message")
(throwException $ error "Bla")
-- This is the inferred type for f:
-- f :: forall e. DateTime -> Eff (err :: EXCEPTION | e) String
-- But this is the type I hope for:
f :: DateTime -> Eff () String
f d = catchException
(\_ -> pure "Some message")
(toISOString (fromDateTime d))

I tried it in a clean environment, and the module compiled as is (with the expected type, no EXCEPTION effect).
I think you may have some library/code version problems.
Maybe you want to do
rm -rf node_modules
rm -rf bower_components
npm install
bower install
pulp build
I have the following library versions in package.json:
"devDependencies": {
"bower": "^1.8.2",
"pulp": "^12.0.1",
"purescript": "^0.11.7"
}
And these in bower.json:
"dependencies": {
"purescript-prelude": "^3.1.1",
"purescript-console": "^3.0.0",
"purescript-exceptions": "^3.1.0",
"purescript-js-date": "^5.1.0",
"purescript-datetime": "^3.4.1"
},
"devDependencies": {
"purescript-psci-support": "^3.0.0"
}

Related

Purescript Halogen manually trigger input validation outside of a form

I have input fields which I have marked with a required attribute, but can't figure out a way to trigger a validation check (I am not working inside of a form, so using a default submit button action won't work for me).
A quick pursuit search shows many validity functions for core html element types, but I'm not sure how to apply these to Halogen.
Is there some way to trigger a DOM effect to check all required inputs on the page and get a result back?
Here is an example component showing what I'm trying to achieve
import Prelude
import Data.Maybe (Maybe(..))
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
data Message = Void
type State =
{ textValue :: String
, verified :: Boolean
}
data Query a = ContinueClicked a | InputEntered String a
inputHtml :: State -> H.ComponentHTML Query
inputHtml state =
HH.div [ HP.class_ $ H.ClassName "input-div" ]
[ HH.label_ [ HH.text "This is a required field" ]
, HH.input [ HP.type_ HP.InputText
, HE.onValueInput $ HE.input InputEntered
, HP.value state.textValue
, HP.required true
]
, HH.button [ HE.onClick $ HE.input_ ContinueClicked ]
[ HH.text "Continue"]
]
verifiedHtml :: H.ComponentHTML Query
verifiedHtml =
HH.div_ [ HH.h3_ [ HH.text "Verified!" ] ]
render :: State -> H.ComponentHTML Query
render state = if state.verified then verifiedHtml else inputHtml state
eval :: forall m. Query ~> H.ComponentDSL State Query Message m
eval = case _ of
InputEntered v next -> do
H.modify $ (_ { textValue = v })
pure next
ContinueClicked next -> do
let inputValid = false -- somehow use the required prop to determine if valid
when inputValid $ H.modify $ (_ { verified = true })
pure next
initialState :: State
initialState =
{ textValue : ""
, verified : false
}
component :: forall m. H.Component HH.HTML Query Unit Message m
component =
H.component
{ initialState: const initialState
, render
, eval
, receiver: const Nothing
}
I don't think relying on HTML form validation is the most effective way of checking inputs within a Halogen application. But I'll assume you have your reasons and present an answer anyway.
First things first, if we want to deal with DOM elements we need a way to retrieve them. Here's a purescript version of document.getElementById
getElementById
:: forall a eff
. (Foreign -> F a)
-> String
-> Eff (dom :: DOM | eff) (Maybe a)
getElementById reader elementId =
DOM.window
>>= DOM.document
<#> DOM.htmlDocumentToNonElementParentNode
>>= DOM.getElementById (wrap elementId)
<#> (_ >>= runReader reader)
runReader :: forall a b. (Foreign -> F b) -> a -> Maybe b
runReader r =
hush <<< runExcept <<< r <<< toForeign
(Don't worry about the new imports for now, there's a complete module at the end)
This getElementById function takes a read* function (probably from DOM.HTML.Types) to determine the type of element you get back, and an element id as a string.
In order to use this, we need to add an extra property to your HH.input:
HH.input [ HP.type_ HP.InputText
, HE.onValueInput $ HE.input InputEntered
, HP.value state.textValue
, HP.required true
, HP.id_ "myInput" <-- edit
]
Aside: a sum type with a Show instance would be safer than hard-coding stringy ids everywhere. I'll leave that one to you.
Cool. Now we need to call this from the ContinueClicked branch of your eval function:
ContinueClicked next ->
do maybeInput <- H.liftEff $
getElementById DOM.readHTMLInputElement "myInput"
...
This gives us a Maybe HTMLInputElement to play with. And that HTMLInputElement should have a validity property of type ValidityState, which has the information we're after.
DOM.HTML.HTMLInputElement has a validity function that will give us access to that property. Then we'll need to do some foreign value manipulation to try and get the data out that we want. For simplicity, let's just try and pull out the valid field:
isValid :: DOM.ValidityState -> Maybe Boolean
isValid =
runReader (readProp "valid" >=> readBoolean)
And with that little helper, we can finish the ContinueClicked branch:
ContinueClicked next ->
do maybeInput <- H.liftEff $
getElementById DOM.readHTMLInputElement "myInput"
pure next <*
case maybeInput of
Just input ->
do validityState <- H.liftEff $ DOM.validity input
when (fromMaybe false $ isValid validityState) $
H.modify (_ { verified = true })
Nothing ->
H.liftEff $ log "myInput not found"
And then putting it all together we have...
module Main where
import Prelude
import Control.Monad.Aff (Aff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Except (runExcept)
import Data.Either (hush)
import Data.Foreign (Foreign, F, toForeign, readBoolean)
import Data.Foreign.Index (readProp)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (wrap)
import DOM (DOM)
import DOM.HTML (window) as DOM
import DOM.HTML.HTMLInputElement (validity) as DOM
import DOM.HTML.Types
(ValidityState, htmlDocumentToNonElementParentNode, readHTMLInputElement) as DOM
import DOM.HTML.Window (document) as DOM
import DOM.Node.NonElementParentNode (getElementById) as DOM
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP
import Halogen.VDom.Driver (runUI)
main :: Eff (HA.HalogenEffects (console :: CONSOLE)) Unit
main = HA.runHalogenAff do
body <- HA.awaitBody
runUI component unit body
type Message
= Void
type Input
= Unit
type State
= { textValue :: String
, verified :: Boolean
}
data Query a
= ContinueClicked a
| InputEntered String a
component
:: forall eff
. H.Component HH.HTML Query Unit Message (Aff (console :: CONSOLE, dom :: DOM | eff))
component =
H.component
{ initialState: const initialState
, render
, eval
, receiver: const Nothing
}
initialState :: State
initialState =
{ textValue : ""
, verified : false
}
render :: State -> H.ComponentHTML Query
render state =
if state.verified then verifiedHtml else inputHtml
where
verifiedHtml =
HH.div_ [ HH.h3_ [ HH.text "Verified!" ] ]
inputHtml =
HH.div
[ HP.class_ $ H.ClassName "input-div" ]
[ HH.label_ [ HH.text "This is a required field" ]
, HH.input
[ HP.type_ HP.InputText
, HE.onValueInput $ HE.input InputEntered
, HP.value state.textValue
, HP.id_ "myInput"
, HP.required true
]
, HH.button
[ HE.onClick $ HE.input_ ContinueClicked ]
[ HH.text "Continue" ]
]
eval
:: forall eff
. Query
~> H.ComponentDSL State Query Message (Aff (console :: CONSOLE, dom :: DOM | eff))
eval = case _ of
InputEntered v next ->
do H.modify (_{ textValue = v })
pure next
ContinueClicked next ->
do maybeInput <- H.liftEff $
getElementById DOM.readHTMLInputElement "myInput"
pure next <*
case maybeInput of
Just input ->
do validityState <- H.liftEff $ DOM.validity input
when (fromMaybe false $ isValid validityState) $
H.modify (_ { verified = true })
Nothing ->
H.liftEff $ log "myInput not found"
getElementById
:: forall a eff
. (Foreign -> F a)
-> String
-> Eff (dom :: DOM | eff) (Maybe a)
getElementById reader elementId =
DOM.window
>>= DOM.document
<#> DOM.htmlDocumentToNonElementParentNode
>>= DOM.getElementById (wrap elementId)
<#> (_ >>= runReader reader)
isValid :: DOM.ValidityState -> Maybe Boolean
isValid =
runReader (readProp "valid" >=> readBoolean)
runReader :: forall a b. (Foreign -> F b) -> a -> Maybe b
runReader r =
hush <<< runExcept <<< r <<< toForeign

Purescript Reuse Argonaut JSON Decoding for Affjax Respondeable

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

Abstract result types in Free Monads

Suppose we want to define a simple DSL for defining UI interactions where we can create objects and then select them:
object TestCommand {
sealed trait EntityType
case object Project extends EntityType
case object Site extends EntityType
sealed trait TestCommand[A, E]
case class Create[A, E](entityType: EntityType, withEntity: E => A) extends TestCommand[A, E]
case class Select[A, E](entity: E, next: A) extends TestCommand[A, E]
}
The problem I have is that I wouldn't want to specify what the return type of the creation command should be (E above). I would like to let this decision up to the interpreter. For instance, E could be a string, or a Future if we are creating objects with asynchronous REST calls.
If I try to define the DSL in the usual way using liftF as shown below:
object TestDSL {
def create[E](entityType: EntityType): Free[TestCommand[?, E], E] =
Free.liftF(Create(entityType, identity: E => E): TestCommand[E, E])
def select[E](entity: E): Free[TestCommand[?, E], Unit] =
Free.liftF(Select[Unit, E](entity, ()))
}
I get the following error:
Error:(10, 10) no type parameters for method liftF: (value: S[A])scalaz.Free[S,A] exist so that it can be applied to arguments (dsl.TestCommand.TestCommand[E,E])
--- because ---
argument expression's type is not compatible with formal parameter type;
found : dsl.TestCommand.TestCommand[E,E]
required: ?S[?A]
Free.liftF(Create(entityType, identity: E => E): TestCommand[E, E])
I cannot understand what is going wrong in the code above, but a more important question is whether this is the right way to abstract over the types appearing in free monads. If not, what is the right (functional) approach?
EDIT:
In Haskell the approach described above works without a problem:
{-# LANGUAGE DeriveFunctor #-}
-- |
module TestDSL where
import Control.Monad.Free
data EntityType = Project | Site
data TestCommand e a = Create EntityType (e -> a) | Select e a
deriving Functor
-- | The DSL
create :: EntityType -> Free (TestCommand e) e
create et = liftF $ Create et id
select :: e -> Free (TestCommand e) ()
select e = liftF $ Select e ()
-- | A sample program:
test :: Free (TestCommand e) ()
test = do
p <- create Project
select p
_ <- create Site
return ()
-- | A trivial interpreter.
interpTestCommand :: TestCommand String a -> IO a
interpTestCommand (Create Project withEntity) = do
putStrLn $ "Creating a project"
return (withEntity "Project X")
interpTestCommand (Create Site withEntity) = do
putStrLn $ "Creating a site"
return (withEntity "Site 51")
interpTestCommand (Select e next) = do
putStrLn $ "Selecting " ++ e
return next
-- | Running the interpreter
runTest :: IO ()
runTest = foldFree interpTestCommand test
Running the test will result in the following output:
λ> runTest
Creating a project
Selecting Project X
Creating a site
Right now you have test :: Free (TestCommand e) (). This means that the type of the entity e can be anything the caller wants, but it's fixed throughout the computation.
But that's not right! In the real world, the type of the entity that's created in response to a Create command depends on the command itself: if you created a Project then e should be Project; if you created a Site then e should be Site. So e shouldn't be fixed over the whole computation (because I might want to create Projects and Sites), and it shouldn't be up to the caller to pick an e.
Here's a solution in which the type of the entity depends on the value of the command.
data Site = Site { {- ... -} }
data Project = Project { {- ... -} }
data EntityType e where
SiteTy :: EntityType Site
ProjectTy :: EntityType Project
The idea here is that pattern-matching on an EntityType e tells you what its e is. In the Create command we'll existentially package up an entity e along with a bit of GADT evidence of the form EntityType e which you can pattern-match on to learn what e was.
data CommandF r where
Create :: EntityType e -> (e -> r) -> CommandF r
Select :: EntityType e -> e -> r -> CommandF r
instance Functor CommandF where
fmap f (Create t next) = Create t (f . next)
fmap f (Select t e next) = Select t e (f next)
type Command = Free CommandF
create :: EntityType e -> Command e
create t = Free (Create t Pure)
select :: EntityType e -> e -> Command ()
select t e = Free (Select t e (Pure ()))
myComputation :: Command ()
myComputation = do
p <- create ProjectTy -- p :: Project
select ProjectTy p
s <- create SiteTy -- s :: Site
return ()
When the interpreter reaches a Create instruction, its job is to return an entity of the type that matches the wrapped EntityType. It has to inspect the EntityType in order to know what e is and behave appropriately.
-- assuming createSite :: IO Site and createProject :: IO Project
interp :: CommandF a -> IO a
interp (Create SiteTy next) = do
site <- createSite
putStrLn "created a site"
return (next site)
interp (Create ProjectTy next) = do
project <- createProject
putStrLn "created a project"
return (next project)
-- plus clauses for Select
I don't know how this would translate into Scala exactly, but that's the gist of it in Haskell.

purescript type signature fails to compile, code works fine without; suggested signature not working

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! (:

How do I use a persistent State monad with Spock?

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.