I've already done the the Happstack crash course and had working reform and web routes examples. I'm trying to combine the two like so, but showURL Home and showURL Login show the same URL for my example application.
Here is the example application
, GeneralizedNewtypeDeriving
, TemplateHaskell
, TypeOperators
, GADTs
, OverloadedStrings
, TypeFamilies
#-}
module Main where
import Data.Data
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Text.Blaze
import Text.Blaze.Html
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Text.Reform
import Text.Reform.Happstack
import Text.Reform.Blaze.Text
import Happstack.Server
import Web.Routes
import Web.Routes.TH
import Web.Routes.Happstack
import Web.Routes.Boomerang
import Text.Boomerang.TH
import Text.Boomerang.HStack
import Text.Boomerang.Texts ()
import Data.Text
data Sitemap
= Login
| Home
deriving (Eq, Ord, Read, Show, Data, Typeable)
-- $(derivePathInfo ''Sitemap)
$(makeBoomerangs ''Sitemap)
sitemap :: Router () (Sitemap :- ())
sitemap = rLogin
<> rHome
site :: Site Sitemap (ServerPartT IO Response)
site =
setDefault Login $ boomerangSiteRouteT route sitemap
route :: Sitemap -> RouteT Sitemap (ServerPartT IO) Response
route Login = loginPage
route Home = homePage
appTemplate :: String
-> [H.Html]
-> H.Html
-> H.Html
appTemplate title headers body =
H.html $ do
H.head $ do
H.title $ toHtml title
sequence_ headers
H.body $ do
body
data LoginData = LoginData
{ username :: Text
, password :: Text
}
renderLoginData :: LoginData -> H.Html
renderLoginData loginData = H.dl $ do H.dt $ "name: "
H.dd $ (text . username) loginData
H.dt $ "password: "
H.dd $ (text . password) loginData
data AppError
= AppCFE (CommonFormError [Input])
deriving Show
instance FormError AppError where
type ErrorInputType AppError = [Input]
commonFormError = AppCFE
loginForm :: Form (ServerPartT IO) [Input] AppError Html () LoginData
loginForm = LoginData
<$> label (Data.Text.pack "username:") ++> inputText (Data.Text.pack "") <++ br
<*> label (Data.Text.pack "password: ") ++> inputPassword <++ br
<* inputSubmit "post"
homePage :: RouteT Sitemap (ServerPartT IO) Response
homePage = ok $ toResponse $
H.html $ do
H.body $ do
H.p "You have logged in successfully"
loginPage :: RouteT Sitemap (ServerPartT IO) Response
loginPage =
do homeURL <- showURL Home
loginURL <- showURL Login
-- formHTML <- lift $ reform (form homeURL) "loginPage" displayMessage Nothing loginForm
ok $ toResponse $
H.html $ do
H.head $ do
H.title "Hello Form"
H.body $ do
-- formHTML
H.span $ toHtml homeURL
H.br
H.span $ toHtml loginURL
where
displayMessage :: LoginData -> ServerPartT IO H.Html
displayMessage loginData = return $ appTemplate "Form validation result" [] $ renderLoginData loginData
main :: IO ()
main = simpleHTTP nullConf $
msum [ implSite "http://localhost:8000" "" site
]
The homeURL and loginURL in the loginPage are equal, when they should have their own paths. When I did the Happstack crash course and when I refer to it, Sitemap's Home and UserOverview constructors receive their own URLs, so I'm not sure why my example script's Sitemap's constructors Login and Home are not receiving different URLs.
I found that it was a subtle issue in the imports. I needed to include these imports/
import Prelude hiding (head, id, (.)) import Control.Category (id, (.))
I will need to identify the difference between Prelude's composition (.) operator and Control.Category's composition (.) operator.
After adding the imports, I was able to change sitemap to
sitemap :: Router () (Sitemap :- ())
sitemap = rLogin
<> lit (Data.Text.pack "home") .rHome
where before it complained when using Prelude's composition operator.