Created
January 19, 2015 18:34
-
-
Save ozanmakes/5282f97b1c7a77e0ad31 to your computer and use it in GitHub Desktop.
Thrust Haste example
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module API where | |
import Haste.App | |
-- | Data type to hold all our API calls | |
data API = | |
API {setTitle :: Remote (String -> Server ())} |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Client where | |
import Control.Applicative | |
import API | |
import Haste.App | |
client :: API -> Client () | |
client api = | |
withElems ["title","button"] $ \[titleInput,button] -> | |
button `onEvent` OnClick $ \_ _ -> | |
do title <- getProp titleInput "value" | |
onServer $ setTitle api <.> title | |
-- | Dummy main function to keep haste happy | |
main :: IO () | |
main = runApp def $ | |
do dummyApi <- API <$> remote undefined | |
runClient $ client dummyApi |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
module Server where | |
import Control.Applicative | |
import Control.Concurrent (forkIO) | |
import Control.Monad (void) | |
import qualified Data.String as S | |
import Data.Text (pack) | |
import Graphics.UI.Thrust | |
import qualified Graphics.UI.Thrust.Window as W | |
import Haste.App | |
import Network.Wai.Application.Static (defaultFileServerSettings, | |
staticApp) | |
import Network.Wai.Handler.Warp (defaultSettings, runSettings, | |
setPort) | |
import API (API (API)) | |
import Client (client) | |
setTitle :: Window -> String -> Server () | |
setTitle w hede = liftIO . runUI w . W.setTitle . pack $ hede | |
setup :: Window -> UI () | |
setup w = void $ | |
do W.create | |
W.show | |
W.setFocus True | |
liftIO . forkIO . runApp def $ | |
do api <- API <$> remote (setTitle w) | |
runClient $ client api | |
main :: IO () | |
main = | |
do forkIO . runSettings serverSettings $ staticApp staticSettings | |
startGUI config setup | |
where serverSettings = | |
setPort 8000 defaultSettings | |
staticSettings = | |
defaultFileServerSettings $ | |
S.fromString "examples/thrust-haste/resources" | |
config = | |
defaultConfig {url = "http://localhost:8000"} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment