Abstract result types in Free Monads - scala

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.

Related

Purescript types for buildQueryString function

I am new to Purescript and I am trying to write a function that
can take any record value and iterate over the fields and values and build
a querystring.
I am thinking something like:
buildQueryString :: forall a. PropertyTraversible r => r -> String
which I want to use like this:
buildQueryString {name: "joe", age: 10} -- returns: "name=joe&age=10"
Is there a way to write something like that in Purescript with existing idioms or do I have to create my own custom Type Class for this?
I'm sure that it can be shorter, but here is my implementation based on purescript-generic-rep (inspired by genericShow). This solution uses typeclasses - it seems to be standard approach with generic-rep:
module Main where
import Prelude
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Data.Foldable (intercalate)
import Data.Generic.Rep (class Generic, Constructor(..), Field(..), Product(..), Rec(..), from)
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
class EncodeValue a where
encodeValue ∷ a → String
instance encodeValueString ∷ EncodeValue String where
encodeValue = id
instance encodeValueInt ∷ EncodeValue Int where
encodeValue = show
class EncodeFields a where
encodeFields :: a -> Array String
instance encodeFieldsProduct
∷ (EncodeFields a, EncodeFields b)
⇒ EncodeFields (Product a b) where
encodeFields (Product a b) = encodeFields a <> encodeFields b
instance encodeFieldsField
∷ (EncodeValue a, IsSymbol name)
⇒ EncodeFields (Field name a) where
encodeFields (Field a) =
[reflectSymbol (SProxy :: SProxy name) <> "=" <> encodeValue a]
buildQueryString
∷ ∀ a l n.
Generic n (Constructor l (Rec a))
⇒ (EncodeFields a)
⇒ n
→ String
buildQueryString n =
build <<< from $ n
where
build (Constructor (Rec fields)) = intercalate "&" <<< encodeFields $ fields
newtype Person =
Person
{ name ∷ String
, age ∷ Int
}
derive instance genericPerson ∷ Generic Person _
joe ∷ Person
joe = Person { name: "joe", age: 10 }
main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
log <<< buildQueryString $ joe
buildQueryString expects value of type with single constructor which contains a record (possibly just newtype) because it is impossible to derive a Generic instance for "unwrapped" Record type.
If you want to handle also Array values etc. then encodeValue should probably return values of type Array String.
This is possible with purescript-generics but it only works on nominal types, not on any record. But it saves you boilerplate, since you can just derive the instance for Generic, so it would work with any data or newtype without further modification.
Downside is, you have to make some assumptions about the type: like it only contains one record and the record does not contain arrays or other records.
Here is a hacky demonstration how it would work:
data Person = Person
{ name :: String
, age :: Int
}
derive instance genericPerson :: Generic Person
joe = Person { name: "joe", age: 10 }
build :: GenericSpine -> String
build (SRecord arr) = intercalate "&" (map (\x -> x.recLabel <> "=" <> build (x.recValue unit)) arr)
build (SProd _ arr) = fromMaybe "TODO" $ map (\f -> build (f unit)) (head arr)
build (SString s) = s
build (SInt i) = show i
build _ = "TODO"
test = build (toSpine joe)
purescript-generics-rep is newer, so possibly there is a better solution, maybe even on any record. I have not tried that (yet).

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

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

Polymorphic instruction in Free Monad in Purescript

I'm trying to get this small piece of code to compile.
module Sodium where
import Prelude
import Control.Monad.Free
import Data.Coyoneda
import Data.Tuple
data ReactiveF more
= RFNewEvent (forall a. (Tuple (Event a) (a -> Reactive Unit) -> more))
type Reactive a = FreeC ReactiveF a
data Event a = Event a
newEvent :: forall a. Reactive (Tuple (Event a) (a -> Reactive Unit))
newEvent = liftFC $ RFNewEvent id
If I instead use "Number" instead of "a" in RFNewEvent, then everything compiles fine. But the moment I go "forall a." and replace "Number" with "a" it no longer compiles.
I get the following error message
Cannot unify type
a1
with type
a0
Does anyone know how to make this work?
I'm using version 0.5.0 of purescript-free.
Edit
If I use the following
data NewEventData = NewEventData forall a. Tuple (Event a) (a -> Reactive Unit)
and substitute it into RFNewEvent, then it will compile. But I end up with an undesired type signature for newEvent.
newEvent :: Reactive NewEventData
newEvent = liftFC $ RFNewEvent id
Which lets me create an event, but lets me shoot different event values to the event stream instead of the same type of value. (missing forall a. now on newEvent)
I might of made a mistake.
The overall goal is to simulate SodiumFRP's interface using a Free Monad. Then plug in an existing JavaScript FRP library that works similar to Sodium via FFI when interpreting the Free Monad.
Is this possible?
The following code now compiles and has the desired type signature for "newEvent"
module FRP.Sodium where
import Prelude
import Control.Monad.Free
import Data.Coyoneda
import Data.Tuple
data ReactiveF more
= RFNewEvent (NewEventData -> more)
type Reactive a = FreeC ReactiveF a
data NewEventData = NewEventData forall a. Tuple (Event a) (a -> Reactive Unit)
data Event a
= ENever
| EMerge (Event a) (Event a)
| EFilterJust (Event (Maybe a))
| ECoalesce (a -> a -> a) (Event a)
| EOnce (Event a)
| ESplit (Event (Array a))
| EVar Int
data Behaviour a = BVar Int
extractNewEventData :: forall a. NewEventData -> (Tuple (Event a) (a -> Reactive Unit))
extractNewEventData (NewEventData x) = x
newEvent :: forall a. Reactive (Tuple (Event a) (a -> Reactive Unit))
newEvent = map extractNewEventData $ liftFC $ RFNewEvent id
Edit
Also trying out purescript-exists. Makes it possible to define "sample"
RFSample gets added to ReactiveF ...
.
.
.
data ReactiveF more
= RFNewEvent (NewEventData -> more)
| RFSample (SampleData more)
.
.
.
data SampleDataF more a = SampleDataF (Behaviour a) (a -> more)
type SampleData more = Exists (SampleDataF more)
sample :: forall a. Behaviour a -> Reactive a
sample beh = liftFC $ RFSample $ mkExists $ SampleDataF beh id
Thank you Phil Freeman for your comment.

Program architecture using the monad reader in Scala

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.