Haskell on a Horse
==================

 <style>
	body{ margin-left:40px; margin-right: 15%; text-align: justify; }
	.error{ color: red; }
	h1,h2 { font-family; sans-serif; font-weight: normal; color: #222; }
	h1{ font-size: 22pt; border-bottom: double }
	h2{ font-size: 18pt; border-bottom: 3px dotted }

	.oper{ border: 1px solid; padding: 4px; }

	.sourceCode{ background-color: #eee; border: 1px dotted #666; 
			padding: 8px; width: 100%; }
	.example{ background-color: #eee; width: 100%; 
				border-collapse: collapse; }
	.example td { border: 1px dotted #666; padding: 8px; }
	.example .sourceCode{ border: none; padding: 0; }
 </style>

Haskell on a Horse (HoH) is a combinatorial web framework for the
programming language Haskell.  It is currently at an early, unsettled
stage of development.  It is available under the "BSD3" open-source
license.

Installing and Using HoH
------------------------

    cabal install on-a-horse

> {-#LANGUAGE Arrows, QuasiQuotes, ScopedTypeVariables #-}
> import Web.Horse 
> import Control.Applicative
> import Control.Arrow
> import Control.Monad
> import Control.Monad.Cont
> import Data.Maybe
> import Data.Monoid
> import Data.List.Split (splitOn)
> import Control.Arrow.Transformer.All
> import Text.Pandoc

Atomic Components
-------------------

An HoH application is built up from atomic components.  A component is
a complete HoH application all by itself: it can render itself, and
respond to input.

 <table class="example"><tr><td>

> 
> ex1 = proc url -> do
>     (fo,num::Maybe Integer) <- readForm "enter a number" -< ()
>     returnA -< wrapForm fo
> 

 </td><td>EXAMPLE</td></tr></table>

run this as a web app on port 8080 using

~~~~~~~~{.haskell}
main = runHorse ex1
~~~~~~~~

Side-by-Side Components
--------------------------

Components can be rendered side-by-side within a page.

 <table class=example><tr><td>

> ex2 :: HoH Url (Html ())
> ex2 =  proc url -> do
>               (fo1, oper) <- enumForm "operation" 
>                           [("times", (*)),
>                            ("plus", (+))] -< ()
>               (fo2, x::Maybe Integer) <- readForm "x" -< ()
>               (fo3, y::Maybe Integer) <- readForm "y" -< ()
>               let result = show <$> (oper <*> x <*> y)
>               runHamlet -< [$hamlet|
>                             %form!method=POST!action=""
>                                Calculate a number!
>                                %br
>                                $fo1$ $fo2$ $fo3$
>                                Result:
>                                $maybe result res
>                                       $res$
>                                %br
>                                %input!type=submit  |]

 </td><td>EXAMPLE</td></tr></table>

Replacing one Component With Another
---------------------------------------

Components can be replaced.  A call to the arrow `throwAuto` will
replace the nearest enclosing `catchAuto`.  The new component will be
called immediately, with no form input.

~~~~~~{.haskell}
formSum label fs def = catchAuto $ proc _ -> do
  (fo,f) <- enumForm label fs -< ()
  case f of
    Just f' -> throwAuto -< f'
    Nothing -> returnA -< setFormOut fo def
~~~~~~

Note: `def` is a default value to be used when no form is yet
selected.

 <table class=example><tr><td>

> ex3 :: HoH Url (Html ())
> ex3 = formSum "example to run" [("example 1",ex1),("example 2",ex2)] mempty
>       >>> arr wrapForm

 </td><td>EXAMPLE</td></tr></table>

A More Complex Example
-------------------------

By combining the techniques above, sophisticated pages can be made
with little code.  

 <table class=example><tr><td>

> ex4 = proc url -> do
>      (fo,result) <- term "expression" -< ()
>      runHamlet -< [$hamlet|
>             %form!method=POST!action=""
>                $fo$
>                Result:
>                $maybe result res
>                       $show res$ 
>                %input!type=submit
>                %br |]
>    where
>        term :: String -> HoH () (FormOut, Maybe Integer)
>        term label = catchAuto $ formSum label 
>             [("number", number label),
>              ("add",oper label "add" (+)),
>              ("multiply",oper label "multiply" (*))] (mempty, Nothing)
>
>        number :: String -> WithError (HoH () (FormOut, Maybe Integer)) 
>                                           () (FormOut, Maybe Integer)
>        number termLabel = proc () -> do
>               fo1 <- linkForm "cancel" (term termLabel) -< ()
>               (fo2,x) <- readForm "number" -< ()
>               returnA -< (fo1 `mappend` fo2, x)
>
>        oper termLabel label f = proc () -> do
>             (fo1) <- linkForm "cancel" (term termLabel) -< ()
>             (fo2,x) <- liftError (term "x") -< ()
>             (fo3,y) <- liftError (term "y") -< ()
>             out <- runHamlet -< [$hamlet|
>                 %div.oper
>                        $fo1$
>                        $label$
>                        %br
>                        $fo2$ $fo3$ |]
>             returnA -< (out, f <$> x <*> y)

 </td><td>EXAMPLE</td></tr></table>

Notes: 

* `throwAuto` works by adding an ErrorArrow to its argument.
When it is called recursively, as in the example above, `liftError`
may be required to avoid an infinite type.

* `linkForm` acts much like `throwAuto`, except that it waits to throw
its argument until the link it renders has been clicked.




Building Atomic Components
-------------------------

Atomic components should generally use the 'withInput' function.  This
will add two inputs to an arrow: the first is a unique label for the
component, and the second is the current input to the arrow, or
Nothing if there is no input.  The label should be used as a name in
any form input or query parameters.  Here is the code for `linkForm`.

~~~~~~{.haskell}
linkForm linkName f = withInput $ proc ((),nm,iname) -> do
              case iname of
                Just _ -> throwAuto -< f
                Nothing -> returnA -< (link linkName nm)
~~~~~~

(`link "name" "label"` produces `<a href="?label=1">name</a>`)


Handling urls
-------------

`runHorse` sends the URL as the sole argument to the handler.  A
function, `dispatch`, is available to construct multi-page
applications.


 
 <table class="example"><tr><td>

> ex5 = proc url -> do
>            (dispatch $ staticUrls fourOhFour $
>              [("", urls),
>               ("ex1", ex1),
>               ("ex2", ex2),
>               ("ex3", ex3),
>               ("ex4", ex4)]) -< (url,url)

 </td><td>EXAMPLE</td></tr></table>

> fourOhFour = proc url -> do
>                runHamlet -< [$hamlet| Page not found |]

> urls = proc url -> do
>         runHamlet -< [$hamlet|
>                       %a!href=ex1 example 1
>                       %br
>                       %a!href=ex2 example 2
>                       %br
>                       %a!href=ex3 example 3
>                       %br
>                       %a!href=ex4 example 4
>                       %br
>                       %a!href=ex5 example 5
>                       %br |]
>

Running the Tutorial
--------------------

This tutorial is a sort of self-executing markdown (pandoc) file.
This is the code to run it.

> main = do
>   tut <- readFile "tutorial.lhs"
>   tmpl <- getDefaultTemplate Nothing "html"
>   let pd = readMarkdown defaultParserState{ stateLiterateHaskell=True } tut
>   let tut' = writeHtmlString defaultWriterOptions{
>               writerStandalone=True,
>               writerTemplate= either (error . show) id tmpl
>               } pd
>   let ts = map preEscapedString $ splitOn ("EXA"++"MPLE") tut'
>   runHorse $ proc url -> do
>          fo1 <- ex1 -< url
>          fo2 <- ex2 -< url
>          fo3 <- ex3 -< url
>          fo4 <- ex4 -< url
>          fo5 <- ex5 -< url
>          let vals = interleave ts [fo1,fo2,fo3,fo4,fo5]
>          runHamlet -< [$hamlet|
>                     $forall vals val
>                         $val$ |]

> interleave (x:xs) (y:ys) = (x:y:interleave xs ys)
> interleave [] ys = ys
> interleave xs [] = xs

 <b>

> -- Jason Hart Priestley, July 26, 2010. (jason @ this domain)

 </b>