nbartlomiej · erantapaa · Jun 17, 2016
diff --git a/Application.hs b/Application.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, OverloadedStrings,
-             MultiParamTypeClasses #-}
+             MultiParamTypeClasses, ViewPatterns #-}
 
 module Application where
 
@@ -28,7 +28,7 @@ instance Yesod Tfoo where
       addStylesheet $ StaticR $ StaticRoute ["styles", "tfoo.css"] []
       addScript $ StaticR $ StaticRoute ["scripts","jquery-1.7.1.min.js"] []
       addScript $ StaticR $ StaticRoute ["scripts","jquery.wiggle.js"] []
-    hamletToRepHtml $(hamletFile "templates/layout.hamlet")
+    withUrlRenderer $(hamletFile "templates/layout.hamlet")
 
 instance RenderMessage Tfoo FormMessage where
   renderMessage _ _ = defaultFormMessage

diff --git a/Main.hs b/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE  MultiParamTypeClasses, TemplateHaskell #-}
+{-# LANGUAGE  MultiParamTypeClasses, TemplateHaskell, ViewPatterns, OverloadedStrings #-}
 module Main where
 
 import Tfoo.Foundation
@@ -42,7 +42,7 @@ main = do
   seedP   <- liftIO $ Random.getStdGen >>= (\x -> return $ next x)
   static' <- static "static"
   args    <- getArgs
-  warpDebug (getPort args) (Tfoo (fst seedP) games nextGameId static')
+  warp (getPort args) (Tfoo (fst seedP) games nextGameId static')
 
 getPort :: [String] -> Int
 getPort args = extractPort $ "-p" `elemIndex` args

diff --git a/Setup.hs b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Tfoo/Game.hs b/Tfoo/Game.hs
@@ -2,7 +2,7 @@ module Tfoo.Game where
 
 import Tfoo.Board
 
-import Network.Wai.EventSource (ServerEvent (..), eventSourceApp)
+import Network.Wai.EventSource (ServerEvent (..))
 import Control.Concurrent.Chan
 
 type Player = String

diff --git a/Tfoo/Handlers/Root.hs b/Tfoo/Handlers/Root.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes           #-}
 
 module Tfoo.Handlers.Root where
 
@@ -21,35 +22,38 @@ import Control.Concurrent.MVar
 
 import Yesod
 import Yesod.Default.Util
+import Text.Julius
 
 import Control.Concurrent.Chan
-import Network.Wai.EventSource (ServerEvent (..), eventSourceApp)
+import Network.Wai.EventSource (ServerEvent (..), eventSourceAppChan)
+import Data.Default
+import Network.Wai.Internal (ResponseReceived(..))
 
 
-getHomeR :: Handler RepHtml
+getHomeR :: Handler Html
 getHomeR = do
   tfoo <- getYesod
-  defaultLayout $(widgetFileNoReload "index")
+  defaultLayout $(widgetFileNoReload def "index")
 
-postGamesR :: Handler RepHtml
+postGamesR :: Handler Html
 postGamesR = do
     tfoo <- getYesod
     id   <- liftIO $ newGame tfoo
-    Just single <- runInputPost $ Just <$> iopt hiddenField (T.pack "single")
-    if isJust single
+    single <- runInputPost $ iopt hiddenField (T.pack "single")
+    if single == Just ("true" :: String)
       then newSinglePlayerGame id
       else return ()
     redirect $ GameR id
 
-getGameR :: Int -> Handler RepHtml
+getGameR :: Int -> Handler Html
 getGameR id = let
     columns = [0..19]
     rows    = [0..19]
   in do
     game <- getGame id
     maybePlayers <- lookupSession $ T.pack "players"
     tfoo <- getYesod
-    defaultLayout $(widgetFileNoReload "game")
+    defaultLayout $(widgetFileNoReload def "game")
 
 postMarkR :: Int -> Int -> Int -> Handler ()
 postMarkR id x y = do
@@ -73,7 +77,7 @@ postMarkR id x y = do
           then permissionDenied $ T.pack "Permission Denied"
           else return ()
 
-postPlayerOR :: Int -> Handler RepHtml
+postPlayerOR :: Int -> Handler Html
 postPlayerOR id = do
   game <- getGame id
   if (playerO game) == Nothing
@@ -85,7 +89,7 @@ postPlayerOR id = do
     else return ()
   redirect $ GameR id
 
-postPlayerXR :: Int -> Handler RepHtml
+postPlayerXR :: Int -> Handler Html
 postPlayerXR id = do
   game <- getGame id
   if (playerX game) == Nothing
@@ -101,7 +105,5 @@ getChannelR :: Int -> Handler ()
 getChannelR id = do
   game <- getGame id
   channel <- liftIO $ dupChan $ channel game
-  request  <- waiRequest
-  response  <- lift $ eventSourceApp channel request
+  sendWaiApplication (eventSourceAppChan channel)
   updateGame id game
-  sendWaiResponse response
diff --git a/Tfoo/Helpers/Game.hs b/Tfoo/Helpers/Game.hs
@@ -17,7 +17,7 @@ import Control.Monad
 import Control.Concurrent.MVar
 import Control.Concurrent.Chan
 
-import Network.Wai.EventSource (ServerEvent (..), eventSourceApp)
+import Network.Wai.EventSource (ServerEvent (..) )
 import Blaze.ByteString.Builder.Char.Utf8 (fromString)
 
 getGame :: Int -> Handler Game

diff --git a/stack.yaml b/stack.yaml
@@ -0,0 +1,12 @@
+
+resolver: lts-6.0
+
+packages:
+- '.'
+
+extra-deps: []
+
+flags: {}
+
+extra-package-dbs: []
+
diff --git a/templates/game.julius b/templates/game.julius
@@ -25,7 +25,7 @@ $(document).ready(function() {
     $(element).click(function(){
       var x = $(element).attr('data-x');
       var y = $(element).attr('data-y');
-      post('#{show id}/mark/' + x + '/' + y);
+      post('#{rawJS $ show id}/mark/' + x + '/' + y);
     });
   });
 });
diff --git a/tfoo.cabal b/tfoo.cabal
@@ -0,0 +1,33 @@
+name:                tfoo
+version:             0.1.0.0
+synopsis:            Five in a row
+-- description:         
+homepage:            https://github.com/nbartlomiej/tfoo
+-- license:             
+license-file:        LICENSE
+author:              Bartlomiej Niemtur
+maintainer:          nbartlomiej@gmail.com
+-- copyright:           
+category:            Game
+build-type:          Simple
+extra-source-files:  README.rdoc
+cabal-version:       >=1.10
+
+executable tfoo
+  main-is:          Main.hs
+  other-modules:    Application,
+                    Tfoo.Board,
+                    Tfoo.Foundation,
+                    Tfoo.Game,
+                    Tfoo.Handlers.Root,
+                    Tfoo.Helpers.Application,
+                    Tfoo.Helpers.Game,
+                    Tfoo.Matrix
+
+  other-extensions:    TypeFamilies, QuasiQuotes, TemplateHaskell, OverloadedStrings, MultiParamTypeClasses, ViewPatterns
+  build-depends:       base >=4.8, random, text, 
+    wai-eventsource, yesod, yesod-static, yesod-default, blaze-builder,
+    shakespeare, hamlet, wai-extra, data-default, wai
+
+  -- hs-source-dirs:      
+  default-language:    Haskell2010