[Add Web.Page, for basic generation of the pages Neil Mitchell**20080804214020] { hunk ./src/Web/Action.hs 9 +import Web.Page hunk ./src/Web/Action.hs 39 +-- TODO: Should escape the query text hunk ./src/Web/Action.hs 41 -runQuery _ _ = "hello" +runQuery q _ = header (queryText q) ++ footer addfile ./src/Web/Page.hs hunk ./src/Web/Page.hs 1 + +module Web.Page(header, footer) where + + +header query = unlines $ + ["" + ,"" + ," " + ," " + ," " ++ query ++ " - Hoogle" + ," " + ," " + ," " + ," " + ] ++ rightBox ++ search + + +rightBox = + ["
" + ," " + ," Firefox plugin |" + ," " + ," Manual |" + ," haskell.org" + ,"
" + ] + +search = ["[search]"] + + +footer = unlines + [" " + ," " + ,"" + ] + +{- + + + map - Hoogle
Searched for mapResults 1 - 25 of 129

Lambdabot says: http://www.haskell.org/hawiki/HaskellUserLocations

+ + + + + + + + + + + + + + + + + + + + + + + + +
Prelude.map:: (a -> b) -> [a] -> [b]
Data.List.map:: (a -> b) -> [a] -> [b]
Data.ByteString.map:: (Word8 -> Word8) -> ByteString -> ByteString
Data.Set.map:: (Ord a, Ord b) => (a -> b) -> Set a -> Set b
Data.Map.map:: (a -> b) -> Map k a -> Map k b
Data.IntSet.map:: (Int -> Int) -> IntSet -> IntSet
Data.IntMap.map:: (a -> b) -> IntMap a -> IntMap b
Data.ByteString.Ch...map:: (Char -> Char) -> ByteString -> ByteString
Data.ByteString.Lazy.map:: (Word8 -> Word8) -> ByteString -> ByteString
Data.ByteString.La...map:: (Char -> Char) -> ByteString -> ByteString
Data.Map:: module
Data.Map.Map:: data Map k a
Prelude.mapM:: Monad m => (a -> m b) -> [a] -> m [b]
Prelude.mapM_:: Monad m => (a -> m b) -> [a] -> m ()
Data.Maybe.mapMaybe:: (a -> Maybe b) -> [a] -> [b]
Control.Monad.mapM:: Monad m => (a -> m b) -> [a] -> m [b]
Control.Monad.mapM_:: Monad m => (a -> m b) -> [a] -> m ()
Control.Monad.mapAndUnzipM:: Monad m => (a -> m (b, c)) -> [a] -> m ([b], [c])
Data.List.mapAccumL:: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
Data.List.mapAccumR:: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])
Data.Monoid.mappend:: Monoid a => a -> a -> a
Control.Exception.mapException:: (Exception -> Exception) -> a -> a
Data.Foldable.mapM_:: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
Data.Traversable.mapM:: (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b)
Distribution.Confi...mapTreeData:: (a -> b) -> CondTree v c a -> CondTree v c b
1 2 3 4 5 6
+ +-} }