Search code examples
haskellhappstack

Haskell web routes example with Happstack and blaze is not showing two different URLs


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.


Solution

  • 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.