[0.0.23: site overhaul Jeremy Shaw **20100527011624 Ignore-this: d388507985f538429b4f04494a4969df ] hunk ./HSP/Google/Analytics.hs 1 -{-# OPTIONS_GHC -fglasgow-exts -F -pgmFtrhsx #-} -module HSP.Google.Analytics - ( UACCT(..) - , analytics - ) where - -import Data.Data -import HSP --- import Happstack.Template.HSP - -newtype UACCT = UACCT String -- ^ The UACCT provided to you by Google - deriving (Read, Show, Eq, Ord, Typeable, Data) - --- |create the google analytics script tags --- NOTE: you must put the <% analytics yourUACCT %> immedialy for the tag --- See also: addAnalytics -analytics :: (XMLGenerator m) => UACCT -> GenXMLList m --- analytics :: (Monad m) => UACCT -> HSPT m [XML] -analytics (UACCT uacct) = - do a <- - b <- - return [a,b] -{- --- |automatically add the google analytics scipt tags immediately before the element --- NOTE: this function is not idepotent -addAnalytics :: ( AppendChild m XML - , EmbedAsChild m XML - , EmbedAsAttr m Attribute - , XMLGenerator m) - => UACCT - -> XMLGenT m XML - -> GenXML m --- addAnalytics :: (Monad m) => UACCT -> HSPT m XML -> HSPT m XML -addAnalytics uacct pg = - do page <- pg - a <- analytics uacct - case page of - <[ head, body ]> -> - - <% head %> - <% body <: a %> - - o -> error ("Failed to add analytics." ++ show o) --} --- import Happstack.Template.HSP - -{- Example Analytics Code from Google: - - --} - --- * Test -{- -testXML' :: Web XML -> IO XML -testXML' xml = evalHSP (runWebXML undefined xml) - -testXML :: Web XML -> IO () -testXML xml = evalHSP (runWebXML undefined xml) >>= putStrLn . renderAsHTML - - --- dummy :: (Monad m) => HSPT m HSP.XML --- dummy :: Web HSP.XML -dummy :: (EmbedAsChild m [Char]) => GenXML m -dummy = - - - the title - - -

the body

- - --} - -{- --- * OLD - -pageTemplate :: UACCT -> Web XML -> Web XML -> Web XML -pageTemplate uacct header body = - do a <- analytics uacct - hdr <- header - (Element (Nothing, "body") attrs children) <- body - h <- - <% hdr %> - <% (Element (Nothing, "body") attrs (children ++ a)) %> - - return h - -pageTest = - pageTemplate (UACCT "hi") - - I like Cheese! - - -

bork brok brok

- --} -{- -addAnalytics :: UACCT -> Web XML -> Web XML -addAnalytics uacct page = - case page of - (Element (Nothing, "html") attrs children) -> - return $ (Element (Nothing, "html") attrs - case find (\(Element (Nothing, name) _ _) -> name == "body") children of - (Just (\ (Element (Nothing, name) attrs bodyChildren))) -> - do a <- analytics uacct - return $ (Element (Nothing, name) attrs bodyChildren) --} rmfile ./HSP/Google/Analytics.hs rmdir ./HSP/Google hunk ./HSP/ServerPartT.hs 1 -{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, TypeFamilies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module HSP.ServerPartT where - -import HSP -import Control.Applicative -import qualified HSX.XMLGenerator as HSX -import Happstack.Server - -instance (Monad m) => HSX.XMLGen (ServerPartT m) where - type HSX.XML (ServerPartT m) = XML - newtype HSX.Child (ServerPartT m) = SChild { unSChild :: XML } - newtype HSX.Attribute (ServerPartT m) = SAttr { unSAttr :: Attribute } - genElement n attrs children = - do attribs <- map unSAttr <$> asAttr attrs - childer <- flattenCDATA . map unSChild <$> asChild children - HSX.XMLGenT $ return (Element - (toName n) - attribs - childer - ) - xmlToChild = SChild - -flattenCDATA :: [XML] -> [XML] -flattenCDATA cxml = - case flP cxml [] of - [] -> [] - [CDATA _ ""] -> [] - xs -> xs - where - flP :: [XML] -> [XML] -> [XML] - flP [] bs = reverse bs - flP [x] bs = reverse (x:bs) - flP (x:y:xs) bs = case (x,y) of - (CDATA e1 s1, CDATA e2 s2) | e1 == e2 -> flP (CDATA e1 (s1++s2) : xs) bs - _ -> flP (y:xs) (x:bs) - - -instance (Monad m) => HSX.EmbedAsAttr (ServerPartT m) Attribute where - asAttr = return . (:[]) . SAttr - -instance (Monad m) => HSX.EmbedAsAttr (ServerPartT m) (Attr String Char) where - asAttr (n := c) = asAttr (n := [c]) - -instance (Monad m) => HSX.EmbedAsAttr (ServerPartT m) (Attr String String) where - asAttr (n := str) = asAttr $ MkAttr (toName n, pAttrVal str) - -instance (Monad m) => HSX.EmbedAsAttr (ServerPartT m) (Attr String Bool) where - asAttr (n := True) = asAttr $ MkAttr (toName n, pAttrVal "true") - asAttr (n := False) = asAttr $ MkAttr (toName n, pAttrVal "false") - -instance (Monad m) => HSX.EmbedAsAttr (ServerPartT m) (Attr String Int) where - asAttr (n := i) = asAttr $ MkAttr (toName n, pAttrVal (show i)) - -instance (Monad m) => EmbedAsChild (ServerPartT m) Char where - asChild = XMLGenT . return . (:[]) . SChild . pcdata . (:[]) - -instance (Monad m) => EmbedAsChild (ServerPartT m) String where - asChild = XMLGenT . return . (:[]) . SChild . pcdata - -instance (Monad m) => EmbedAsChild (ServerPartT m) XML where - asChild = XMLGenT . return . (:[]) . SChild - -instance Monad m => EmbedAsChild (ServerPartT m) () where - asChild () = return [] - -instance (Monad m) => AppendChild (ServerPartT m) XML where - appAll xml children = do - chs <- children - case xml of - CDATA _ _ -> return xml - Element n as cs -> return $ Element n as (cs ++ (map unSChild chs)) - -instance (Monad m) => SetAttr (ServerPartT m) XML where - setAll xml hats = do - attrs <- hats - case xml of - CDATA _ _ -> return xml - Element n as cs -> return $ Element n (foldr (:) as (map unSAttr attrs)) cs - -instance (Monad m) => XMLGenerator (ServerPartT m) rmfile ./HSP/ServerPartT.hs rmdir ./HSP hunk ./Main.hs 10 -import Happstack.Server (Conf(port), Method(GET), Response, ServerPartT, dir, fileServe, methodM, nullConf, ok, seeOther, simpleHTTP, toResponse) +import Happstack.Server (Conf(port), Method(GET), Response, ServerPartT, dir, fileServe, methodM, nullConf, ok, nullDir, seeOther, simpleHTTP, toResponse) hunk ./Main.hs 19 -import System.Console.GetOpt (ArgDescr(ReqArg), ArgOrder(Permute), OptDescr(Option), getOpt) +import System.Console.GetOpt (ArgDescr(NoArg, ReqArg), ArgOrder(Permute), OptDescr(Option), getOpt) hunk ./Main.hs 54 - ircTids <- ircLog (ircLogDir appConf) "irc.freenode.net" (PortNumber 6667) (User (ircNick appConf) "happstack.com" "irc.freenode.net" "happstack.com bot") (ircChan appConf) + ircTids <- if (ircBot appConf) + then ircLog (ircLogDir appConf) "irc.freenode.net" (PortNumber 6667) (User (ircNick appConf) "happstack.com" "irc.freenode.net" "happstack.com bot") (ircChan appConf) + else return [] hunk ./Main.hs 67 - , dir "docs" $ fileServe [] docDir hunk ./Main.hs 70 + hunk ./Main.hs 72 - , dir "download.html" $ (ok . toResponse) =<< (unXMLGenT download) - , dir "faq.html" $ (ok . toResponse) =<< (unXMLGenT faq) - , dir "develop.html" $ (ok . toResponse) =<< (unXMLGenT develop) - , dir "tutorials.html" $ (ok . toResponse) =<< (unXMLGenT tutorials) + , dir "download" $ (ok . toResponse) =<< (unXMLGenT download) + , dir "docs" $ msum [ do { nullDir ; (ok . toResponse) =<< (unXMLGenT docs) } + , dir "crashcourse" $ fileServe [] "/home/jeremy/public_html/happstack-crashcourse" + , fileServe [] docDir + ] + , dir "community" $ (ok . toResponse) =<< (unXMLGenT community) + hunk ./Main.hs 89 + , ircBot :: Bool hunk ./Main.hs 102 + , ircBot = False hunk ./Main.hs 138 - , Option [] ["doc-dir"] (ReqArg (\h c -> c { docDir = h}) "PATH") "The directory which contains the haddock documentation files." + , Option [] ["doc-dir"] (ReqArg (\h c -> c { docDir = h}) "PATH") "The directory which contains the haddock documentation files." hunk ./Main.hs 144 + , Option [] ["irc-bot"] (NoArg (\c -> c { ircBot = True})) "Run the irc logging bot." hunk ./Main.hs 147 - hunk ./Main.hs 153 +data PageSection = Home | Download | Docs | Community | Other deriving (Eq, Ord, Show, Read) + hunk ./Main.hs 161 - ) => String -> headers -> body -> XMLGenT m (HSX.XML m) -appTemplate title headers body = + ) => String -> headers -> PageSection -> body -> XMLGenT m (HSX.XML m) +appTemplate title headers pagesection body = hunk ./Main.hs 166 - + hunk ./Main.hs 171 - <% top %> + <% top pagesection %> hunk ./Main.hs 178 -top :: (XMLGenerator m) => XMLGenT m (HSX.XML m) -top = -
- +top :: (XMLGenerator m) => PageSection -> XMLGenT m (HSX.XML m) +top pageSection = +
+ + +footer :: (XMLGenerator m) => XMLGenT m (HSX.XML m) +footer = + hunk ./Main.hs 207 --- TODO: add webgen-menu-item-selected class attribute to the selected menu element hunk ./Main.hs 209 - +homeContent :: (XMLGenerator m) => XMLGenT m (HSX.XML m) +homeContent = +
hunk ./Main.hs 254 -home :: (XMLGenerator m, EmbedAsChild m XML, EmbedAsChild m ()) => XMLGenT m (HSX.XML m) -home = - appTemplate "Happstack - Haskell application server stack" () $ - container

... a refreshingly innovative web application - server written in Haskell. Leveraging the MACID state system, - Happstack offers robust and scalable data access without the - headache of managing a traditional RDBMS such as MySQL.

- "The Happstack project needs you!" -
-

Happstackers, coders, bug-hunters, and enthusiasts alike: We need your help. To get involved, please get on the google group or #happs on irc.freenode.net and offer your services there.

- {-

For the latest news, events, and updates on the project be sure to check the project blog frequently.

-} -
+

What is Happstack?

hunk ./Main.hs 256 -download :: (XMLGenerator m, EmbedAsChild m XML, EmbedAsChild m ()) => XMLGenT m (HSX.XML m) -download = - appTemplate "Happstack - Download Happstack" () $ - container

download Happstack tarballs for your computer. If you have cabal-install then this will be even easier.

- "Download Happstack" -
-

ghc 6.10.4 or 6.12.x, and cabal >= 1.6 are required.

-

Cabal Packages on Hackage

-

happstack-util, happstack-data, happstack-state, happstack-ixset, happstack-server, happstack.

-

How to install without cabal-install

-
    -
  1. extract each tarball with a command like: tar -xvzf mypackage.tar.gz
    2. -
  2. cd mypackage
    3. -
  3. runhaskell Setup.hs configure
    4. -
  4. runhaskell Setup.hs build
    5. -
  5. runhaskell Setup.hs install
    6. -
-

How to install with cabal-install

-
    -
  1. cabal update
    2. -
  2. cabal install happstack
    3. -
-
+

Happstack is a web application framework for Haskell. Happstack is designed so that developers can prototype quickly, deploy painlessly, scale massively, operate reliably, and change easily. It supports GNU/Linux, OS X, FreeBSD, and Windows enironments.

hunk ./Main.hs 258 -faq :: (XMLGenerator m, EmbedAsChild m XML, EmbedAsChild m ()) => XMLGenT m (HSX.XML m) -faq = - appTemplate "Happstack - Frequently Asked Questions" () $ - container

Here you will find answers to frequently asked questions about Happstack and HAppS. It is both exhilarating and informative!

- "Frequently Asked Questions" -
-

How is Happstack related to HAppS?

-

Happstack is a fork of HAppS.

-

Why did you fork HAppS?

-

There are multiple reasons that basically boil down to:

-
    -
  • Alex Jacobson wants someone else to take the project over. (He told me this on the phone)
    • -
  • Only one active developer (Lemmih) has access to the HAppS repository
    • -
  • Lemmih does not have the time to maintain HAppS by himself
    • -
-

Is HAppS really orphaned?

-

Yes, see http://groups.google.com/group/HAppS/msg/d128331e213c1031

-

Why hasn't Alex Jacobson made a statement regarding the project being orphaned?

-

I don't know. If you want to ask him yourself contact me in private and I will give you his phone number.

+

Self-contained

+

Happstack provides you with all the components you need to build and deploy your application. No need to configure Apache, MySQL, memcached, etc. Simply build your self-contained app and run it on the server.

hunk ./Main.hs 261 -

Where is the new repository?

-

http://patch-tag.com/repo/mae/happstack/home

+

Distributed Persistent State

+

Happstack's unique MACID distributed persistent data storage layer is based on the lessons learned and shared by high traffic sites such as Amazon, eBay, Facebook, and reddit. It provides a simple, yet powerful and scalable alternative to SQL. It uses native Haskell datatypes and functions, which means you get the power of Haskell in your query language, and freedom from SQL-injection attacks, database normalization, and data marshalling. Use graphs, trees, and your other favorite Haskell types in your persistent database with ease.

hunk ./Main.hs 264 -

How is the new repository structured?

-

The old HAppS project had each module split into a separate darcs-1 repository. The new repository combines all these packages into one darcs-2 repository.

+

Flexible Templating Options

+

Happstack integrates support for a variety of templating libraries including HSP, HStringTemplate, hamlet, and more!

hunk ./Main.hs 267 -

Why did you put all the packages in one repository?

-

There are multiple reasons. To name a few:

-
    -
  • One repository is more convenient for developers
    • -
  • We are going to reorganize code amongst the packages and perhaps even deprecate some. Having one repository will drastically reduce the administrative overhead of this process.
    • -
+

Type-Safety

+

Happstack also includes support for type-safe URL routing via web-routes and type-safe form processing via formlets.

hunk ./Main.hs 270 -

Where is all the repository history?

-

The history for HAppS is in the old darcs1 repositories, I retained the patch context when I created the new repository, so we can always go back if we really need to.

+

Getting Started

+

The fastest way to get started is to install happstack from hackage using cabal.

+
+ + $ export PATH=~/.cabal/bin:$PATH
+ $ cabal update
+ $ cabal install happstack + +
hunk ./Main.hs 280 -

Can I have commit access?

-

Yes and no. Yes you may pull the repository and create your own spontaneous branch. Yes you may submit your changes to the mailing list. Yes we will accept quality work. No we will probably not give most people access to the root repository - but rest assured, there will be several people to share the keys should one of us get hit by a bus.

+

Simple App

+

Here is a simple app to test out your installation. The application will run on port 8000 by default. If you are reading this website on the same machine you are running the app on, just click here to see it.

hunk ./Main.hs 283 -

What are the project goals of happstack?

-

To improve the existing codebase of HAppS without drastically changing its original function. Namely we want to prune dead code, improve test coverage, and increase the existing documentation.

+
hunk ./Main.hs 285 -

How do you pronounce Happstack? What does it stand for?

-

Happstack is pronounced HAPP-STACK. It is short for "Haskell Application Server Stack".

- -

When installing I get an error about QC2 dependencies

-

Currently the haskell world is halfway in a process of migrating from QC1 to QC2. Cabal however wants to find a consistent version of QuickCheck to use when installing packages; which is thus impossible. A better solution is being worked on, but for now your best option is to install the package you are trying to install manually (as described on haskell wiki)

-
+

module Main where

hunk ./Main.hs 287 +

import Happstack.Server

+

main = simpleHTTP nullConf $ ok "Hello, World!"

hunk ./Main.hs 290 -develop :: (XMLGenerator m, EmbedAsChild m XML, EmbedAsChild m ()) => XMLGenT m (HSX.XML m) -develop = - appTemplate "Happstack - Help develop Happstack" () $ - container

Think you're ready to dive in and start developing Happstack? You'll need darcs2 installed to get our development branch. Grab your caffeine and let's get started!

- "Help develop Happstack" -
-

Get involved

-

If you are interested in helping the project out, please offer your services on the google group or #happs on irc.freenode.net.

-

How to get the code

-

You will need darcs2 to get the development code.

-

Development Branch

-

darcs get --lazy http://patch-tag.com/r/mae/happstack

- {- -

Stable Branch

-

darcs get --lazy http://patch-tag.com/r/mae/happstack-stable/pullrepo happstack

- -} -

Build Bot

-

Automated builds are available via our buildbot.

-

Patches

-

Patches can be sent to happs@googlegroups.com or attached to the relevant issue.

+
hunk ./Main.hs 292 -
+
hunk ./Main.hs 294 -tutorials :: (XMLGenerator m, EmbedAsChild m XML, EmbedAsChild m ()) => XMLGenT m (HSX.XML m) -tutorials = - appTemplate "Happstack - Tutorials" () $ - container

Happstack tutorials from around the land. Here you will find a semi-definitive list. Happy hacking!

- "Tutorials" -
- -
+download :: (XMLGenerator m, EmbedAsChild m ()) => XMLGenT m (HSX.XML m) +download = + appTemplate "Happstack - Download" () Download $ + mainContent $ +
+

How to get Happstack

+

cabal install happstack

+

The easiest way to get happstack is to just install it from hackage using the cabal command.

+
+ + $ export PATH=~/.cabal/bin:$PATH
+ $ cabal update
+ $ cabal install happstack + +
+

Getting the development version of the source code

+

You can get and install the latest development source using darcs.

+
+ + $ darcs get http://patch-tag.com/r/mae/happstack
+ $ cd happstack
+ $ chmod +x bin/build-install-test-all.sh
+ $ ./bin/build-install-test-all.sh
+ +
+ +

After you have checked out the code, you can get further updates by running:

+
+ + $ darcs pull + +
hunk ./Main.hs 332 -ircLogs :: (XMLGenerator m, EmbedAsChild m XML, EmbedAsChild m (), MonadIO m) => FilePath -> XMLGenT m (HSX.XML m) -ircLogs ircLogDir = - do logFiles <- liftIO $ (reverse . sort . filter ((\ext -> (ext == ".html") || (ext == ".txt")) . takeExtension)) <$> getDirectoryContents ircLogDir - appTemplate "Happstack - IRC Logs" () $ - container

Logs from #happs on irc.freenode.net

- "#happs IRC Logs" - - +

To submit a patch run:

+
+ + $ darcs record
+ $ darcs send + +
+ +

Note that darcs send assumes you have a working sendmail installed. Another option is to write the patches to a file and then manually attach the patches to an email message. You should send the patches to our mailing list.

+
+ + $ darcs record
+ $ darcs send -o descriptive_name.dpatch + +
+

Browse the source code online

+

You can browse the source code online by visiting our project on patch-tag.com.

+
hunk ./Main.hs 351 -container :: - ( XMLGenerator m - , EmbedAsChild m intro - , EmbedAsChild m content - , EmbedAsChild m XML - ) => intro -> String -> content -> XMLGenT m (HSX.XML m) -container intro heading content = -
-
+docs :: (XMLGenerator m, EmbedAsChild m ()) => XMLGenT m (HSX.XML m) +docs = + appTemplate "Happstack - Documentation" () Docs $ + mainContent $ +
+

Documentation

+

Tutorials

+

Happstack Crash Course

+

The Happstack Crash Course is the new friendly introduction to Happstack. Unfortunately, it is so new that it isn't done yet. But it is still a great place to get started. It is updated frequency so check back often.

+

Classic Happstack Tutorial

+

The classic happstack tutorial is also still available. This is currently the best resource to learn about using the MACID state system and HStringTemplate. Soon to be replaced by the Happstack Crash Course.

+ +

Guestbook Demo

+

The guestbook demo, included with happstack, is a complete, cabalized web application which demonstrates the Happstack MACID database, HSP templating, and HStringTemplate. There is currently no separate tutorial, but the code is heavily commented for instructive purposes.

hunk ./Main.hs 366 -