happstack

Headline

Web programming in Language:Haskell with Technology:Happstack

The implementation demonstrates web programming in Language:Haskell with the Technology:Happstack framework. The templating engine Technology:Heist for Language:XHTML is used for the composition of dynamic web pages. The system:Company is implemented as a web application using a client-server architecture. The company is stored in a client-side cookie. (The server initializes the cookie with a sample company.) URLs are used to encode requests and ids of involved data. There are these requests, which essentially correspond to user actions: a user can either view a specific part of the company, save an edited part, or cut salaries in the selected scope. The part to be viewed, cut, or saved is specified by making use of a Zipper-inspired focus concept that is also leveraged by Contribution:wxHaskell. Modified data is validated. That is, when processing a save request, sent by an HTML form, the server applies various validators and potentially returns error messages, which will be displayed to the user in the web browser. As a response, the client receives HTML documents, which are composed using Technology:Heist.

Illustration

In the following we will demonstrate how a specific request is processed by the server.

Saving an Employee

Scenario: After requesting to view a manager the user manipulates the input fields and submits a request by clicking a save button. The browser sends an HTTP-request together with a company-cookie to the server. The URL looks like this:

http://localhost:8000/Employee/Save/ManagerFocus%20[0]/?Name=Erik&Address=

Utrecht&Salary=1234.0

Routing filter

We set up a simple HTTP server:

main = simpleHTTP nullConf $ 
  msum [ path $ \v -> path $ \a -> path $ 
           \f -> mainPart a v f
       , serveDirectory EnableBrowsing [] "static"]

We specify two possible server behaviours (values of

ServerPartT

) in a list, which we then apply to the

MonadPlus

-function

msum

. This function tries to run each server until one serverstart succeeds. The first list element uses Happstack's

path

function to extract:

The view (here

Employee

) The action (here

Save

) The focus (here

ManagerFocus [0]

) In case the extraction fails the server falls back to being a file server in line 4. In case extraction succeeds

mainPart

is called passing the action, the view and the focus:

mainPart :: Action -> View -> Focus -> ServerPartT IO Response
mainPart View = viewPart
mainPart Cut  = cutPart
mainPart Save = savePart

In this scenario

mainPart

matches on

Save

and calls

savePart

passing the view and the focus:

Saving

savePart :: View -> Focus -> ServerPartT IO Response
savePart v f = do
  s <- save
  case s of
    (Left errs) -> do
      c <- readCCookie
      displayPart v f c errs
    (Right newc) -> displayPart v f newc []       
    where
      save = case v of
        CompanyV  -> saveCompany f
        DeptV     -> saveDepartment f
        EmployeeV -> saveEmployee f

The function starts by calling a save function, which is chosen based on the given

View

value. The

save

-functions, which are all of type

Focus -> ServerPartT IO (Either [(ENames,String)] Company)

either return a list of error information or the new company. In case of errors

savePart

calls

displayPart

in line 7 passing the old company (read from the cookie) and the errors. In case of success the new company and an empty list of errors is passed to

displayPart

in line 8. In this scenario

saveEmployee

is called by

savePart

saveEmployee :: Focus -> ServerPartT IO (Either [(ENames,String)] Company)
saveEmployee f = do
  c <- readCCookie
  name <- look "Name"
  address <- look "Address"
  salary <- lookRead "Salary"
  let newe = Employee name address salary
  let ev = validateEmployee c f newe
  case ev of
    (Just errs)
        -> return $ Left errs
    Nothing
        -> do
            let newc = writeEM f c newe
            addCookie Session $ 
              (mkCookie "company" (show newc))
            return $ Right newc

saveEmployee

reads the company from a cookie and extracts the request parameters from the URL in lines 3-6. These values are used to compose the new

Employee

value in line 7. In line 8 this employee is then passed to the validation function

validateEmployee

of type

Company -> Focus -> a -> Maybe [(ENames,String)]

. If the validation succeeds,

validateEmployee

returns

Nothing

. In this case the employee is replaced within the company, which is then re-stored in the cookie and returned by the function (lines 14-16). Otherwise

validateEmployee

returns error information, which is then also returned by

saveEmployee

in line 11.

Validation

The validation functionality can be found in the Validators module:

validateEmployee :: Validations Employee
validateEmployee c f (Employee n a s) = if null vs 
                           then Nothing
                           else Just $ concat vs 
                             where 
                               vs = catMaybes 
                                [ validateNA c f (n,a)
                                , validateSalary c f s]

validateEmployee

composes two validations (see this!!Validators.hs for details):

validateNA

checks whether the employee's name/address pair is unique in the company

validateSalary

checks two things regarding the employee's salary:

- It checks whether by changing the salary the employee's department-manager still receives the highest salary within the department.
- It checks whether the salary has a positive value.

In case both validations return

Nothing

validateEmployee

returns

Nothing

. Otherwise it returns the list of all error messages.

Binding and Responding

The user might have tried to assign an invalid salary and an invalid name/address pair to the manager in question. Validation therefore would return error information.

savePart

would call

displayPart

passing the old company and the error messages:

displayPart :: View -> Focus -> Company -> [(ENames,String)] -> ServerPart Response
displayPart v f c errs = do 
      td <- newTemplateDirectory' tDir $ 
              eNamesBinder errs $ binder f c $ 
                emptyTemplateState tDir
      render td (B.pack tname)
          where
            binder = case v of
              CompanyV  -> companyBinder
              DeptV     -> departmentBinder
              EmployeeV -> employeeBinder
                where
            tname = case v of
              CompanyV  -> "company"
              DeptV     -> "department"
              EmployeeV -> "employee"

In lines 8-16

displayPart

decides which template and which binder to apply by making use of a

case

expression on the given view. The binder will bind all template variables to strings or small HTML fragments (splices). After that

eNamesBinder

will bind the error messages to template variables. Both binders can be found in this!!Binder.hs. They return a function of type

Monad m => TemplateState m -> TemplateState m

. That is, binders are state transformers for templates.

displayPart

then renders the HTML document, which is sent to the client as the response in line 6.

Architecture

this!!Main.hs holds the server using various server parts in this!!Serverparts.hs. The actual save action is performed by functionality in this!!Save.hs. this!!Binder.hs contains functions to bind template variables. The validators can be found in this!!Validators.hs using helper functions hosted by this!!Utils.hs. The algebraic datatype for companies can be found in this!!Company.hs, a sample company in this!!SampleCompany.hs. Functionality to total and cut is provided by this!!Total.hs and this!!Cut.hs. this!!Focus.hs provides a focus datatype and functions on top of it. Various types used by the server can be found in this!!Types.hs. The this!!static folder contains the sytlesheet for the application and images, while this!!templates contains the (X)HTML templates.