srobertson/Effects.elm

## display.html
<!DOCTYPE HTML>
<html>

<head>
  <meta charset="UTF-8">
  <title>Puddy</title>
  <script type="text/javascript" src="elm.js"></script>
</head>

<body>
</body>
<script type="text/javascript" src="/_reactor/debug.js"></script>

<script type="text/javascript">


var effects = Elm.fullscreen(Elm.Effects, {
  asyncResponses: ""
});


effects.ports.responses.subscribe(function (request){
  // replace timeout call with ajax

  console.log(request);
  setTimeout(function(){
    effects.ports.asyncResponses.send("Hi mom");
  }, 1000);
});

</script>

</html>

## Effects.elm
module Effects where
import Html (..)
import Html.Attributes (..)
import Html.Events (..)
import Http

import Signal (..)
import Signal
import String (isEmpty)

-- Model
type alias Model = Int

initialModel = (1, Nothing)

-- Update the Model
type Action
  = NoOp
  | Fetch -- request an update
  | Increment

type Request
  = Ajax String

update : Action -> (Model, Maybe Request) ->  (Model, Maybe Request)
update action (model, _) =
    case action of
        NoOp -> (model, Nothing)
        Fetch -> (model, Just (Ajax (toString model)))
        Increment -> (model + 1, Nothing)


-- These are the Http response strings, but coming from JavaScript through a port
port asyncResponses : Signal String

responseActions : Signal Action
responseActions = responseToAction <~ asyncResponses

responseToAction = always Increment

-- The order of these two parameters of merge may matter. Check which should take precedence.
input : Signal Action
input = Signal.merge responseActions (Signal.subscribe updates)


-- u : (Model, Maybe Request) -> Model
-- u (model, _) = model

updatesWithEffects : Signal (Model, Maybe Request)
updatesWithEffects = Signal.foldp update initialModel input

modelUpdates : Signal Model
modelUpdates =
  let toModel (model,_) = model
  in
    Signal.map toModel updatesWithEffects

-- note the redefinition:
main : Signal Html
main =  Signal.map view modelUpdates

view : Model -> Html
view model = div
  []
  [
    text (toString model)
    ,button
      [onClick (Signal.send updates Increment )]
      [text "Add"]
    ,button
      [onClick (Signal.send updates Fetch )]
      [text "Click me"]
  ]


isSuccess response = case response of
  Http.Success _ -> True
  _ -> False

updates : Signal.Channel Action
updates = Signal.channel NoOp


port responses : Signal  String -- (Http.Request String)
port responses = requests


toRequest: Maybe Request -> String
toRequest request =
  case request of
    Just (Ajax str) -> str
    _ -> ""


requests: Signal String -- (Http.Request String)
requests =
  ( snd >> toRequest ) <~ updatesWithEffects |>
  Signal.dropIf isEmpty ""
	<!DOCTYPE HTML>
	<html>

	<head>
	<meta charset="UTF-8">
	<title>Puddy</title>
	<script type="text/javascript" src="elm.js"></script>
	</head>

	<body>
	</body>
	<script type="text/javascript" src="/_reactor/debug.js"></script>

	<script type="text/javascript">


	var effects = Elm.fullscreen(Elm.Effects, {
	asyncResponses: ""
	});


	effects.ports.responses.subscribe(function (request){
	// replace timeout call with ajax

	console.log(request);
	setTimeout(function(){
	effects.ports.asyncResponses.send("Hi mom");
	}, 1000);
	});

	</script>

	</html>
	module Effects where
	import Html (..)
	import Html.Attributes (..)
	import Html.Events (..)
	import Http

	import Signal (..)
	import Signal
	import String (isEmpty)

	-- Model
	type alias Model = Int

	initialModel = (1, Nothing)

	-- Update the Model
	type Action
	= NoOp
	\| Fetch -- request an update
	\| Increment

	type Request
	= Ajax String

	update : Action -> (Model, Maybe Request) -> (Model, Maybe Request)
	update action (model, _) =
	case action of
	NoOp -> (model, Nothing)
	Fetch -> (model, Just (Ajax (toString model)))
	Increment -> (model + 1, Nothing)


	-- These are the Http response strings, but coming from JavaScript through a port
	port asyncResponses : Signal String

	responseActions : Signal Action
	responseActions = responseToAction <~ asyncResponses

	responseToAction = always Increment

	-- The order of these two parameters of merge may matter. Check which should take precedence.
	input : Signal Action
	input = Signal.merge responseActions (Signal.subscribe updates)


	-- u : (Model, Maybe Request) -> Model
	-- u (model, _) = model

	updatesWithEffects : Signal (Model, Maybe Request)
	updatesWithEffects = Signal.foldp update initialModel input

	modelUpdates : Signal Model
	modelUpdates =
	let toModel (model,_) = model
	in
	Signal.map toModel updatesWithEffects

	-- note the redefinition:
	main : Signal Html
	main = Signal.map view modelUpdates

	view : Model -> Html
	view model = div
	[]
	[
	text (toString model)
	,button
	[onClick (Signal.send updates Increment )]
	[text "Add"]
	,button
	[onClick (Signal.send updates Fetch )]
	[text "Click me"]
	]


	isSuccess response = case response of
	Http.Success _ -> True
	_ -> False

	updates : Signal.Channel Action
	updates = Signal.channel NoOp


	port responses : Signal String -- (Http.Request String)
	port responses = requests



	toRequest: Maybe Request -> String
	toRequest request =
	case request of
	Just (Ajax str) -> str
	_ -> ""


	requests: Signal String -- (Http.Request String)
	requests =
	( snd >> toRequest ) <~ updatesWithEffects \|>
	Signal.dropIf isEmpty ""