packages feed

Hayoo 1.2.0 → 1.2.3

raw patch · 7 files changed

+650/−436 lines, 7 filesdep +data-lensdep +data-lens-templatedep +heistdep −hackdep −hack-contribdep −hack-handler-simpleserverdep ~Holumbus-Searchenginedep ~containersdep ~deepseq

Dependencies added: data-lens, data-lens-template, heist

Dependencies removed: hack, hack-contrib, hack-handler-simpleserver, hslogger

Dependency ranges changed: Holumbus-Searchengine, containers, deepseq, filepath, hxt, snap, snap-core, snap-server, text, xhtml-combinators

Files

Hayoo.cabal view
@@ -1,10 +1,10 @@ name:          Hayoo-version:       1.2.0+version:       1.2.3 license:       MIT license-file:  LICENSE-author:        Sebastian M. Schlatt, Timo B. Huebel, Uwe Schmidt-copyright:     Copyright (c) 2007 - 2012 Uwe Schmidt, Sebastian M. Schlatt and Timo B. Kranz-maintainer:    Timo B. Huebel <tbh@holumbus.org>+author:        Sebastian M. Gauck, Timo B. Kranz, Uwe Schmidt+copyright:     Copyright (c) 2007 - 2012 Uwe Schmidt, Sebastian M. Gauck and Timo B. Kranz+maintainer:    Timo B. Kranz <tbh@holumbus.org>, Uwe Schmidt <uwe@fh-wedel.de> stability:     experimental category:      Text, Data synopsis:      The Hayoo! search engine for Haskell API search on hackage@@ -12,9 +12,11 @@ description:   The Hayoo! search engine based no the Holumbus framework provides a document indexer                and a crawler to build indexes over Haddock generated API documentation and packages                as well as a query interface for these indexes.+               .+               Changes from 1.2.2: Optional use of new HashedIndex with DocIds generated by a hash function cabal-version: >=1.6 build-type:    Simple--- tested-with:  ghc-7.0.3+-- tested-with:  ghc-7.0.3 and ghc-7.4  extra-source-files:     README@@ -35,6 +37,32 @@  -- ------------------------------------------------------------ +source-repository head+  type:     git+  location: https://github.com/fortytools/holumbus++-- ------------------------------------------------------------++Flag hayooSnap4+  Description: Build Hayoo! search with Snap server version 4 or version 7+  Default: True++Flag hashedIndex+  Description:  Build with hashed index instead of compact index.+                The main difference between CompactIndex (default) and+                HashedIndex is the generation of document ids.+                With CompactIndex the document ids are generated sequentially+                by using a counter. So the ids are only valid per index.+                With HashedIndex the ids are generated by computing a hash value (64 bit)+                from the document URL. So these ids are valid across different indexes.+                This enables easy and efficient merging of separatly generated indexes.+                Updating indexes becomes mutch easier with this strategy.+                The drawback is a larger inverted index. The small numbers in the CompactIndex+                can be compressed much better than the large numbers generated by the hash function.+  Default:      False++-- ------------------------------------------------------------+ executable hayooIndexer   main-is:      HayooIndexer.hs @@ -46,48 +74,63 @@                 , Hayoo.HackagePackage                 , Hayoo.IndexConfig -  build-depends:  base                   >= 4   && < 5-                , Holumbus-Searchengine  >= 1.2 && < 2-                , binary                 >= 0.5 && < 1-                , bytestring             >= 0.9 && < 1-                , bzlib                  >= 0.4 && < 1-                , containers             >= 0.2 && < 1-                , deepseq                >= 1.1 && < 2-                , enummapset             >= 0   && < 1-                , filepath               >= 1   && < 2-                , hxt                    >= 9.1 && < 10-                , hxt-cache              >= 9   && < 10-                , hxt-charproperties     >= 9   && < 10-                , hxt-curl               >= 9   && < 10-                , hxt-http               >= 9   && < 10-                , hxt-regex-xmlschema    >= 9   && < 10-                , hxt-xpath              >= 9.1 && < 10-                , network                >= 2.1 && < 3-                , old-time               >= 1   && < 2-                , parsec                 >= 2.1 && < 4-                , process                >= 1   && < 2-                , tar                    >= 0.3 && < 1-                , zlib                   >= 0.5 && < 1 +  build-depends:  base                   >= 4     && < 5+                , binary                 >= 0.5   && < 1+                , bytestring             >= 0.9   && < 1+                , bzlib                  >= 0.4   && < 1+                , enummapset             >= 0     && < 1+                , filepath               >= 1     && < 2+                , Holumbus-Searchengine  >= 1.2.3 && < 2+                , hxt                    >= 9.1   && < 10+                , hxt-cache              >= 9     && < 10+                , hxt-charproperties     >= 9     && < 10+                , hxt-curl               >= 9     && < 10+                , hxt-http               >= 9     && < 10+                , hxt-regex-xmlschema    >= 9     && < 10+                , hxt-xpath              >= 9.1   && < 10+                , network                >= 2.1   && < 3+                , old-time               >= 1     && < 2+                , parsec                 >= 2.1   && < 4+                , process                >= 1     && < 2+                , tar                    >= 0.3   && < 1+                , zlib                   >= 0.5   && < 1  +  -- instance NFData (Map k v) has moved from deepseq into containers (dependency hell)+  if impl( ghc < 7.4 )+    build-depends: containers             >= 0.2   && < 0.4.2+                 , deepseq                >= 1.1   && < 1.2+  else+    build-depends: containers             >= 0.4.2+                 , deepseq                >= 1.2+   hs-source-dirs: src +  ghc-options:   -threaded+                 -Wall+                 -funbox-strict-fields+   if impl( ghc >= 7 )-    ghc-options: -threaded -Wall -funbox-strict-fields -fwarn-tabs -rtsopts-  else-    ghc-options: -threaded -Wall -funbox-strict-fields+    ghc-options: -rtsopts+                 -fwarn-tabs -  extensions:+  extensions:    CPP +  if flag(hashedIndex)+    cpp-options: -DhashedIndex=1+  else+    cpp-options: -DhashedIndex=0+ -- ------------------------------------------------------------ -executable hayooSearch-  main-is:      HayooSearch.hs+Executable hayooSnap+  hs-source-dirs: src +  main-is:        HayooSnap.hs+     other-modules:  Hayoo.FunctionInfo                 , Hayoo.IndexTypes                 , Hayoo.PackageInfo                 , Hayoo.PackageRank-                , Hayoo.Search.Application                 , Hayoo.Search.Common                 , Hayoo.Search.EvalSearch                 , Hayoo.Search.HTML@@ -97,85 +140,60 @@                 , Hayoo.Search.Parser                 , Hayoo.Signature -  build-depends:  base                      >= 4   && < 5-                , Holumbus-Searchengine     >= 1   && < 2-                , hack                      >= 2009.10.30-                , hack-contrib              >= 2010.9.28-                , hslogger                  >= 1   && < 2-                , hxt-unicode               >= 9   && < 10-                , json                      >= 0.4 && < 1-                , text                      >= 0.7 && < 1-                , xhtml-combinators         >= 0.2 && < 1--  if impl( ghc >= 7.0.3 )-    build-depends: hack-handler-simpleserver >= 0.2.0.2 && < 1-  else-    build-depends: hack-handler-simpleserver >= 0.2.0.1+  if flag(hayooSnap4)+    other-modules: Hayoo.Snap.Application+                 , Hayoo.Snap.Extension.HayooState+                 , Hayoo.Snap.Site -  hs-source-dirs: src+  build-depends:   base                      >= 4     && < 5+                 , bytestring                >= 0.9.1 && < 0.10+                 , Holumbus-Searchengine     >= 1.2.3 && < 2+                 , hxt                       >= 9     && < 10+                 , hxt-unicode               >= 9     && < 10+                 , json                      >= 0.4   && < 1+                 , MonadCatchIO-transformers >= 0.2.1 && < 0.3+                 , mtl                       >= 2     && < 3+                 , text                      >= 0.11  && < 1+                 , transformers              >= 0.2.2 && < 0.3+                 , xhtml-combinators         >= 0.2.2 && < 0.3 -  if impl( ghc >= 7 )-    ghc-options: -threaded -Wall -funbox-strict-fields -fwarn-tabs -rtsopts+  if flag(hayooSnap4)+    build-depends: base                      >= 4     && < 5+                 , snap                      >= 0.4   && < 0.6+                 , snap-core                 >= 0.4   && < 0.6+                 , snap-server               >= 0.4   && < 0.6   else-    ghc-options: -threaded -Wall -funbox-strict-fields--  extensions:---- --------------------------------------------------------------Flag hayooSnap-  Description: Build Hayoo! search with Snap server-  Default: True+    build-depends: containers+                 , data-lens                 >= 2+                 , data-lens-template        >= 2.1   && < 2.2+                 , filepath+                 , heist                     >= 0.7   && < 0.9+                 , snap                      >= 0.7   && <0.8+                 , snap-core                 >= 0.7   && <0.8+                 , snap-server               >= 0.7   && <0.8 -executable hayooSnap- -- if flag(hayooSnap)-  main-is:      HayooSnap.hs+  extensions:    TypeSynonymInstances MultiParamTypeClasses -  other-modules:  Hayoo.FunctionInfo-                , Hayoo.IndexTypes-                , Hayoo.PackageInfo-                , Hayoo.PackageRank-                , Hayoo.Search.Common-                , Hayoo.Search.EvalSearch-                , Hayoo.Search.HTML-                , Hayoo.Search.JSON-                , Hayoo.Search.Pages.Static-                , Hayoo.Search.Pages.Template-                , Hayoo.Search.Parser-                , Hayoo.Signature-                , Hayoo.Snap.Application-                , Hayoo.Snap.Extension.HayooState-                , Hayoo.Snap.Site+  ghc-options:   -threaded+                 -Wall+                 -funbox-strict-fields+                 -fno-warn-orphans -  build-depends:  base                      >= 4     && < 5-                , bytestring                >= 0.9.1 && < 0.10-                , Holumbus-Searchengine     >= 1.2   && < 2-                , hslogger                  >= 1     && < 2-                , hxt-unicode               >= 9     && < 10-                , json                      >= 0.4   && < 1-                , MonadCatchIO-transformers >= 0.2.1 && < 0.3-                , mtl                       >= 2     && < 3-                , snap                      == 0.4.*-                , snap-core                 == 0.4.*-                , snap-server               == 0.4.*-                , text                      >= 0.11  && < 1-                , transformers              >= 0.2.2 && < 0.3-                , xhtml-combinators         >= 0.2   && < 1- -- else-  -- hayooSnap is currently only tested with ghc-7.0.3, with ghc-6.12 you will run into cabal package hell-  -- with ghc-6.12 there is a mess with hack-handler-simpleserver, which wants old versions of network, web-encodings and text-  -- so this is a dummy-  -- main-is:      Dummy.hs+  if impl( ghc >= 7 )+    ghc-options: -rtsopts+                 -fwarn-tabs+                 -fno-warn-unused-do-bind - hs-source-dirs: src+  extensions:    CPP - if impl( ghc >= 7 )-  ghc-options: -threaded -Wall -funbox-strict-fields -fwarn-tabs -rtsopts-               -fno-warn-orphans -fno-warn-unused-do-bind- else-  ghc-options: -threaded -Wall -funbox-strict-fields -fwarn-tabs-               -fno-warn-orphans -fno-warn-unused-do-bind+  if flag(hashedIndex)+    cpp-options: -DhashedIndex=1+  else+    cpp-options: -DhashedIndex=0 - extensions: TypeSynonymInstances MultiParamTypeClasses+  if flag(hayooSnap4)+    cpp-options: -DhayooSnap4=1+  else+    cpp-options: -DhayooSnap4=0  -- ------------------------------------------------------------
src/Hayoo/IndexTypes.hs view
@@ -4,7 +4,11 @@  module Hayoo.IndexTypes     ( module Hayoo.IndexTypes+#if hashedIndex+    , module Holumbus.Index.HashedIndex+#else     , module Holumbus.Index.CompactIndex+#endif     , FunctionInfo(..)     , PackageInfo(..)     , Score@@ -39,7 +43,12 @@                                                 , toMap                                                 , updateDocuments                                                 )+#if hashedIndex+import           Holumbus.Index.HashedIndex+#else import           Holumbus.Index.CompactIndex+#endif+ import           Holumbus.Query.Result          ( Score )  -- ------------------------------------------------------------
− src/Hayoo/Search/Application.hs
@@ -1,172 +0,0 @@--- ------------------------------------------------------------------------------{- |-  Module     : Hayoo.SearchApplication-  Copyright  : Copyright (C) 2010 Timo B. Huebel-  License    : MIT--  Maintainer : Timo B. Huebel (tbh@holumbus.org)-  Stability  : experimental-  Portability: portable-  Version    : 0.1--  The search web-service for the Hayoo Haskell API search engine.---}---- ------------------------------------------------------------------------------module Hayoo.Search.Application-    ( hayooApplication-    , hayooInit-    , Core (..)-    )-where--import Control.Concurrent               -- For the global MVar--import Data.ByteString.Lazy.Char8       ( fromChunks )--import qualified Data.List              as L-import qualified Data.Text.Encoding     as T--import Hayoo.IndexTypes-import Hayoo.Search.EvalSearch-import Hayoo.Search.Pages.Template-import Hayoo.Search.Pages.Static--import Holumbus.Index.Common--import Hack-import Hack.Contrib.Middleware.File-import Hack.Contrib.Middleware.URLMap-import Hack.Contrib.Request             ( params, path, host )-import Hack.Contrib.Utils               ( empty_app )--import System.IO                        ( stdout )-import System.Time--import System.Log.Logger-import System.Log.Handler.Simple--import qualified-       Text.XHtmlCombinators            as X---- ---------------------------------------------------------------- | Init Hayoo!-hayooInit :: FilePath -> IO Application-hayooInit ixBase = do-    fdl  <- fileHandler "hayoo.log" INFO-    sdl  <- streamHandler stdout INFO--    updateGlobalLogger rootLoggerName (setHandlers [fdl, sdl])-    updateGlobalLogger rootLoggerName (setLevel INFO)--    idx  <- loadIndex     hayooIndex-    infoM "Hayoo.Main" ("Hayoo index   loaded from file " ++ show hayooIndex)--    doc  <- loadDocuments hayooDocs-    infoM "Hayoo.Main" ("Hayoo docs    loaded from file " ++ show hayooDocs )-    infoM "Hayoo.Main" ("Hayoo docs contains " ++ show (sizeDocs doc) ++ " functions and types")--    pidx <- loadIndex     hackageIndex-    infoM "Hayoo.Main" ("Hackage index loaded from file " ++ show hackageIndex)--    pdoc <- loadPkgDocs   hackageDocs-    infoM "Hayoo.Main" ("Hackage docs  loaded from file " ++ show hackageDocs)-    infoM "Hayoo.Main" ("Hackage docs contains " ++ show (sizeDocs pdoc) ++ " packages")--    prnk <- return $ buildRankTable pdoc-    infoM "Hayoo.Main" ("Hackage package rank table computed")--    tpl  <- return $ makeTemplate (sizeDocs pdoc) (sizeDocs doc)--    midct <- newMVar $-             Core-             { index      = idx-             , documents  = doc-             , pkgIndex   = pidx-             , pkgDocs    = pdoc-             , template   = tpl-             , packRank   = prnk-             }--    return $-           url_map [ ("/hayoo.html", hayooApplication midct)-                   , ("/hayoo.json", hayooApplication midct)-                   , ("/help.html", serveStatic $ tpl help)-                   , ("/about.html", serveStatic $ tpl about)-                   , ("/api.html", serveStatic $ tpl api)-                   ] (file Nothing empty_app)-  where-  hayooIndex      = ixBase ++ "/ix.bin.idx"-  hayooDocs       = ixBase ++ "/ix.bin.doc"-  hackageIndex    = ixBase ++ "/pkg.bin.idx"-  hackageDocs     = ixBase ++ "/pkg.bin.doc"-  serveStatic c _ = return $ Response -                    { status = 200-                    , headers = [ ("Content-Type", "text/html") ]-                    , body = fromChunks [T.encodeUtf8 $ X.render c]-                    }---- | Generate the actual response-hayooApplication :: MVar Core -> Env -> IO Response-hayooApplication midct env      = let p = params env in do-          request <- return $               getValDef p "query"  ""-          start   <- return $ readDef 0    (getValDef p "start"  "")-          static  <- return $ readDef True (getValDef p "static" "")-          json    <- return $ isJson (path env)--          -- Output some information about the request.-          logRequest env--          -- Because index access is read only, the MVar's are just read -          -- to make them avaliable again.-          idct    <- readMVar midct--          -- Put all information relevant for rendering into a container-          state   <- return $ (request, start, static, (template idct))--          -- If the query is empty, just render an empty page-          resp    <- return $-                     if L.null request-                     then renderEmpty json idct-                     else renderResult state json idct--          -- Determine the mime type of the response-          mime    <- return $ -                     if json -                     then "application/json" -                     else "text/html"--          -- Return the actual response-          return $ Response { status = 200, headers = [ ("Content-Type", mime) ], body = resp }----- | Log a request to stdout.-logRequest :: Env -> IO ()-logRequest env = do-  -- Extract remote host and the search string from the incoming transaction.-  remHost    <- return $ host env-  rawRequest <- return $ getValDef (params env) "query" ""-  start      <- return $ getValDef (params env) "start" "0"-  userAgent  <- return $ getValDef (http env) "User-Agent" "No user agent"--  -- Decode URI encoded entities in the search string.-  decodedRequest <- return $ decode rawRequest--  -- Get the current date and time.-  unixTime <- getClockTime-  currTime <- return $ calendarTimeToString $ toUTCTime unixTime--  -- Output all the collected information from above to stdout.-  infoM "Hayoo.Request" (currTime ++ "\t" ++-                         remHost ++ "\t "++-                         userAgent ++ "\t" ++-                         rawRequest ++ "\t" ++-                         decodedRequest ++ "\t" ++-                         start-                        )---- ------------------------------------------------------------
src/Hayoo/Search/Pages/Static.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- ----------------------------------------------------------------------------  {- |@@ -15,8 +17,6 @@  -- ---------------------------------------------------------------------------- -{-# LANGUAGE OverloadedStrings #-}- module Hayoo.Search.Pages.Static (help, about, api, examples) where  import Data.Text (Text)@@ -33,27 +33,47 @@     a' [A.href "http://hackage.haskell.org"] $ text "Hackage"     text ", including all function and type definitions. Here are some example queries:"     div' [A.class_ "example"] $ p $ do-      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map&apos;); return false;", A.href "hayoo.html?query=map&amp;start=0"] $ text "map"-      text " searches for everything that contains a word starting with \"map\" (case insensitive) in the function name, module name or description."+      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map&apos;); return false;"+         ,A.href "hayoo.html?query=map&amp;start=0"+         ] $ text "map"+      text " searches for everything that contains a word starting with \"map\""+      text " (case insensitive) in the function name, module name or description."     div' [A.class_ "example"] $ p $ do-      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;name:map&apos;); return false;", A.href "hayoo.html?query=name%3Amap&amp;start=0"] $ text "name:map"+      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;name:map&apos;); return false;"+         ,A.href "hayoo.html?query=name%3Amap&amp;start=0"+         ] $ text "name:map"       text " searches for everything where the function name starts with \"map\" (case insensitive)."     div' [A.class_ "example"] $ p $ do-      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map OR fold&apos;); return false;", A.href "hayoo.html?query=map%20OR%20fold&amp;start=0"] $ text "map OR fold"-      text " searches for everything that contains a word starting with \"map\" or \"fold\" (case insensitive) in the function name, module name or description."+      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map OR fold&apos;); return false;"+         ,A.href "hayoo.html?query=map%20OR%20fold&amp;start=0"+         ] $ text "map OR fold"+      text " searches for everything that contains a word starting with \"map\" or \"fold\""+      text " (case insensitive) in the function name, module name or description."     div' [A.class_ "example"] $ p $ do-      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map package:containers&apos;); return false;", A.href "hayoo.html?query=map%20package%3Acontainers&amp;start=0"] $ text "map package:containers"-      text " searches for everything from package \"containers\" that contains a word starting with \"map\" (case insensitive) in the function name, module name or description."+      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map package:containers&apos;); return false;"+         ,A.href "hayoo.html?query=map%20package%3Acontainers&amp;start=0"+         ] $ text "map package:containers"+      text " searches for everything from package \"containers\" that contains a word"+      text " starting with \"map\" (case insensitive) in the function name, module name or description."     div' [A.class_ "example"] $ p $ do-      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map hierarchy:Lazy&apos;); return false;", A.href "hayoo.html?query=map%20hierarchy%3ALazy&amp;start=0"] $ text "map hierarchy:Lazy"-      text " searches for everything where \"Lazy\" appears somewhere in the full qualified module name \-        \and that contains a word starting with \"map\" (case insensitive) in the function name, module name or description."+      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;map hierarchy:Lazy&apos;); return false;"+         ,A.href "hayoo.html?query=map%20hierarchy%3ALazy&amp;start=0"+         ] $ text "map hierarchy:Lazy"+      text " searches for everything where \"Lazy\" appears somewhere in the full qualified module"+      text " name and that contains a word starting with \"map\" (case insensitive)"+      text " in the function name, module name or description."     div' [A.class_ "example"] $ p $ do-      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;(map OR fold) module:Data.Map&apos;); return false;", A.href "hayoo.html?query=(map%20OR%20fold)%20module%3AData.Map&amp;start=0"] $ text "(map OR fold) module:Data.Map"-      text " searches for everything from module \"Data.Map\" that contains a word starting with \"map\" or \"fold\" (case insensitive) in the function name, module name or description."+      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;(map OR fold) module:Data.Map&apos;); return false;"+         ,A.href "hayoo.html?query=(map%20OR%20fold)%20module%3AData.Map&amp;start=0"+         ] $ text "(map OR fold) module:Data.Map"+      text " searches for everything from module \"Data.Map\" that contains a word"+      text " starting with \"map\" or \"fold\" (case insensitive) in the function name, module name or description."     div' [A.class_ "example"] $ p $ do-      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;name:attr module:Text.XML&apos;); return false;", A.href "hayoo.html?query=name%3Aattr%20module%3AText.XML&amp;start=0"] $ text "name:attr module:Text.XML"-      text " searches for everything from the whole module hierarchy \"Text.XML\" where the function name starts with \"attr\" (case insensitive)."+      a' [A.attr "onclick" "replaceInQuery(&apos;&apos;,&apos;name:attr module:Text.XML&apos;); return false;"+         ,A.href "hayoo.html?query=name%3Aattr%20module%3AText.XML&amp;start=0"+         ] $ text "name:attr module:Text.XML"+      text " searches for everything from the whole module hierarchy \"Text.XML\""+      text " where the function name starts with \"attr\" (case insensitive)."  help :: XHtml FlowContent help = div' [A.id_ "result"] $ do@@ -62,27 +82,28 @@   div' [A.id_ "helptext", A.class_ "text"] $ do     h2 $ text "Basic Usage"     p $ do-      text "By default, Hayoo! searches for function names, module names, signatures and function \-        \descriptions. With every letter typed, Hayoo! will show the results it thinks are best matching \-        \the query as well as some suggestions on how the words from the query could be completed. \-        \Clicking one of these suggestions will replace the according word in the query."+      text "By default, Hayoo! searches for function names, module names, signatures and function descriptions."+      text " With every letter typed, Hayoo! will show the results it thinks are best matching the query as well"+      text " as some suggestions on how the words from the query could be completed."+      text " Clicking one of these suggestions will replace the according word in the query."     p $ do-      text "Hayoo! displays results as a list of functions, including full qualified module name and the \-        \function signature. Clicking the function name will lead directly to the corresponding documentation \-        \while clicking the module name will lead to the documentation of the module. Additionally, Hayoo! \-        \shows the function description (if available) and provides a link leading directly to the source \-        \of the function (if available). The description of the function can be expanded by clicking on \-        \the small '+' sign."+      text "Hayoo! displays results as a list of functions, including full qualified module name"+      text " and the function signature. Clicking the function name will lead directly to the"+      text " corresponding documentation while clicking the module name will lead to the documentation"+      text " of the module. Additionally, Hayoo! shows the function description (if available) and"+      text " provides a link leading directly to the source of the function (if available)."+      text " The description of the function can be expanded by clicking on the small '+' sign."     p $ do-      text "Along with the results, Hayoo! shows two lists on the right, containing the top fifteen \-        \root-modules and packages. These are aggregated from the actual results. Clicking on each of \-        \these will further restrict the current query to the respective module hierarchy or package. \-        \On the left side, package search results are shown if the query matches the package information."+      text "Along with the results, Hayoo! shows two lists on the right, containing the top"+      text " fifteen root-modules and packages. These are aggregated from the actual results."+      text " Clicking on each of these will further restrict the current query to the"+      text " respective module hierarchy or package. On the left side, package search"+      text " results are shown if the query matches the package information."      h2 $ text "Advanced Queries"     p $ do-      text "If words are seperated by whitespace, Hayoo! will search for results containing both words. \-        \Instead of using whitespace, the explicit "+      text "If words are seperated by whitespace, Hayoo! will search for results containing both words."+      text " Instead of using whitespace, the explicit "       span' [A.class_ "query"] $ text "AND"       text " operator can be used. Hayoo! also supports "       span' [A.class_ "query"] $ text "OR"@@ -96,14 +117,14 @@       span' [A.class_ "query"] $ text "map NOT fold"       text " or "       span' [A.class_ "query"] $ text "map AND NOT fold"-      text ". Operator precedence can be influenced using round parentheses. Phrases can be searched \-        \using double quotes, e.g. "+      text ". Operator precedence can be influenced using round parentheses."+      text " Phrases can be searched using double quotes, e.g. "       span' [A.class_ "query"] $ text "\"this is a phrase\""       text "."       p $ do-      text "It is possible to restrict a search to certain packages or modules. The most simple way would \-        \be to just include the package name in the search, e.g. "+      text "It is possible to restrict a search to certain packages or modules."+      text " The most simple way would be to just include the package name in the search, e.g. "       span' [A.class_ "query"] $ text "map base"       text " will prefer hits from the base package. But the restriction can also be more explicit, like "       span' [A.class_ "query"] $ text "map package:base"@@ -113,18 +134,20 @@       span' [A.class_ "query"] $ text "fold module:(data.list OR data.map)"       text ". This will return all hits for fold in the module hierarchies below Data.List and Data.Map."     p $ do-      text "Hayoo! always performs fuzzy queries. This means, it tries to find something even if the \-        \query contains spelling errors. For example, Hayoo! will still find \"fold\" if \"fodl\" is \-        \being searched. If Hayoo! detects \">\" in the query string, it will only search for signatures. \-        \A signature query may consist of explicit type names as well as type variables. For example, \-        \searching for \"a > b\" will find signatures like \"Int > Bool\"."+      text "Hayoo! always performs fuzzy queries. This means, it tries to find something"+      text " even if the query contains spelling errors. For example, Hayoo! will still"+      text " find \"fold\" if \"fodl\" is being searched. If Hayoo! detects \">\" in the"+      text " query string, it will only search for signatures. A signature query may consist"+      text " of explicit type names as well as type variables. For example,"+      text " searching for \"a > b\" will find signatures like \"Int > Bool\"."      h2 $ text "Scope"     p $ do       text "Currently, Hayoo! searches all packages available on "       a' [A.href "http://hackage.haskell.org"] $ text "Hackage"-      text ". Additionally, any Haskell documentation generated by Haddock can be included in Hayoo!. \-        \Just send a message including an URI where the documentation can be found to "+      text ". Additionally, any Haskell documentation generated by Haddock can be"+      text " included in Hayoo!. Just send a message including"+      text " an URI where the documentation can be found to "       a' [A.href "mailto:hayoo@holumbus.org"] $ text "hayoo@holumbus.org"       text "." @@ -137,10 +160,12 @@     p $ do       text "Hayoo! is a search engine specialized on "        a' [A.href "http://www.haskell.org"] $ text "Haskell"-      text " API documentation. The goal of Hayoo! is to provide an interactive, easy-to-use search interface to \-        \the documenation of various Haskell packages and libraries. Although the Hayoo! data is regularly updated, \-        \we might miss a package or library. If you think there is some documentation for Haskell modules available \-        \on the Internet which should be added to Hayoo!, just drop us a note at "+      text " API documentation. The goal of Hayoo! is to provide an interactive,"+      text " easy-to-use search interface to the documenation of various Haskell"+      text " packages and libraries. Although the Hayoo! data is regularly updated,"+      text " we might miss a package or library. If you think there is some"+      text " documentation for Haskell modules available on the Internet which"+      text " should be added to Hayoo!, just drop us a note at "       a' [A.href "mailto:hayoo@holumbus.org"] $ text "hayoo@holumbus.org"       text " and tell us the location where we can find the documentation." @@ -150,16 +175,18 @@       a' [A.href "http://holumbus.fh-wedel.de"] $ text "Holumbus"       text " framework and was heavily inspired by "       a' [A.href "http://www.haskell.org/hoogle"] $ text "Hoogle"-      text ". The Holumbus library provides the search and indexing backend for Hayoo!. Holumbus and Hayoo! \-        \have been developed by Sebastian M. Gauck and Timo B. Hübel at "+      text ". The Holumbus library provides the search and indexing backend for Hayoo!."+      text " Holumbus and Hayoo! have been developed by"+      text " Sebastian M. Gauck and Timo B. Kranz (formerly H\252bel) at "       a' [A.href "http://www.fh-wedel.de"] $ text "FH Wedel University of Applied Sciences"-      text ". The Holumbus framework provides the basic building blocks for creating highly customizable search \-        \engines. To demonstrate the flexibility of the framework by a very special use case, the Hayoo! Haskell \-        \API search was implemented using Holumbus."+      text ". The Holumbus framework provides the basic building blocks"+      text " for creating highly customizable search engines. To demonstrate the"+      text " flexibility of the framework by a very special use case, the Hayoo!"+      text " Haskell API search was implemented using Holumbus."     p $ do-      text "Currently, Hayoo! is still in beta stage. This means, it can become unavailable unexpectedly, as \-        \we do some maintenance or add new features. Therefore you should not yet rely on Hayoo! as primary \-        \ search engine for Haskell documentation."+      text "Currently, Hayoo! is still in beta stage. This means, it can become"+      text " unavailable unexpectedly, as we do some maintenance or add new features."+      text " Therefore you should not yet rely on Hayoo! as primary search engine for Haskell documentation."     p $ do       text "Hardware infrastructure for daily index updates is generously sponsored by "       a' [A.href "http://www.fortytools.com"] $ text "fortytools gmbh"@@ -167,9 +194,10 @@      h2 $ text "Technical Information"     p $ do-      text "Hayoo! is written entirely in Haskell and consists of two main parts: The indexer, which regularly \-        \checks Hackage for package updates and builds the search index and the web frontend, which relies on \-        \Apache, FastCGI and Hack for presenting search results to the user."+      text "Hayoo! is written entirely in Haskell and consists of two main parts:"+      text " The indexer, which regularly checks Hackage for package updates and"+      text " builds the search index and the web frontend. The web frontend formerly worked with apache and FastCGI"+      text " today it's implemented with the use of the Snap system."      h2 $ text "Feedback"     p $ do@@ -177,12 +205,15 @@       a' [A.href "mailto:hayoo@holumbus.org"] $ text "hayoo@holumbus.org"       text " and tell us about bugs, suggestions or anything else related to Hayoo!."     div' [A.id_ "sponsors"] $ do-      div' [A.id_ "hol"] $ do-        a' [A.href "http://holumbus.fh-wedel.de"] $ img' "" "" [A.src "hayoo/hol.png", A.alt "Holumbus logo", A.class_ "logo"] -- Change here when img bug in xhtml-combinators is fixed-      div' [A.id_ "ft"] $ do-        a' [A.href "http://www.fortytools.com"] $ img' "" "" [A.src "hayoo/ft.png", A.alt "fortytools logo", A.class_ "logo"]-      div' [A.id_ "fhw"] $ do-        a' [A.href "http://www.fh-wedel.de"] $ img' "" "" [A.src "hayoo/fhw.gif", A.alt "FH-Wedel logo", A.class_ "logo"]+      div' [A.id_ "hol"] $+        a' [A.href "http://holumbus.fh-wedel.de"] $+           img' "" "" [A.src "hayoo/hol.png", A.alt "Holumbus logo", A.class_ "logo"] -- Change here when img bug in xhtml-combinators is fixed+      div' [A.id_ "ft"] $+        a' [A.href "http://www.fortytools.com"] $+           img' "" "" [A.src "hayoo/ft.png", A.alt "fortytools logo", A.class_ "logo"]+      div' [A.id_ "fhw"] $+        a' [A.href "http://www.fh-wedel.de"] $+           img' "" "" [A.src "hayoo/fhw.gif", A.alt "FH-Wedel logo", A.class_ "logo"]        api :: XHtml FlowContent api = div' [A.id_ "result"] $ do@@ -191,14 +222,16 @@   div' [A.id_ "helptext", A.class_ "text"] $ do     h2 $ text "Hayoo! API"     p $ do-      text "Hayoo! provides a JSON-based webservice API, which can be used to retrieve search results in a structured \-           \format. This allows one to include Hayoo! search functionality in other applications. Arbitrary queries \-           \can be submitted the same way as they would be entered them into the search box and results are returned \-           \encoded in JSON format."+      text "Hayoo! provides a JSON-based webservice API, which can be used"+      text " to retrieve search results in a structured format. This allows"+      text " one to include Hayoo! search functionality in other applications."+      text " Arbitrary queries can be submitted the same way as they would be"+      text " entered them into the search box and results are returned encoded in JSON format."      p $ do-      text "You may use this service for whatever you like and without any limitations, although we would be \-           \very happy to know about any application that uses the Hayoo! webservice API. Just drop us a line at"+      text "You may use this service for whatever you like and without any limitations,"+      text " although we would be very happy to know about any application that uses"+      text " the Hayoo! webservice API. Just drop us a line at"       a' [A.href "mailto:hayoo@holumbus.org"] $ text "hayoo@holumbus.org"       text "."       @@ -208,9 +241,9 @@     p $ do       text "Provide your query as argument to the "       code $ text "query"-      text " URI parameter. Please note that you need to ensure proper URI encoding for the query argument. The syntax \-           \for the query is the same as if it would be entered into the search box. A detailed explanation of the \-           \syntax can be found " +      text " URI parameter. Please note that you need to ensure proper URI encoding"+      text " for the query argument. The syntax for the query is the same as if it"+      text " would be entered into the search box. A detailed explanation of the syntax can be found "        a' [A.href "help.html"] $ text "here"       text "." @@ -219,49 +252,74 @@       text "The response to a search request will be encoded in "       a' [A.href "http://www.json.org"] $ text "JSON"       text " format and is structured as follows:"-    pre $ do-      code $ text "{\n\-                 \  \"message\":\"Found 12 results and 17 completions.\",\n\-                 \  \"hits\":12,\n\-                 \  \"functions\":[ {\n\-                 \    \"name\":\"map\",\n\-                 \    \"uri\":\"http://hackage.haskell.org/...\",\n\-                 \    \"module\":\"Data.Map\",\n\-                 \    \"signature\":\"(a->b)->[a]->[b]\",\n\-                 \    \"package\":\"containers\"\n\-                 \  }, ... ],\n\-                 \  \"completions\":[ {\n\-                 \    \"word\":\"MapM\",\n\-                 \    \"count\":11\n\-                 \  }, ... ],\n\-                 \  \"modules\":[ {\n\-                 \    \"name\":\"Data\",\n\-                 \    \"count\":19\n\-                 \  }  }, ... ],\n\-                 \  \"packages\":[ {\n\-                 \    \"name\":\"containers\",\n\-                 \    \"count\":13\n\-                 \  }, ... ]\n\-                 \}"+    pre $ code $ sequence_ $ map text $+        [ "{\n"+        , "  \"message\":\"Found 12 results and 17 completions.\",\n"+        , "  \"hits\":12,\n"+        , "  \"functions\":[ {\n"+        , "    \"name\":\"map\",\n"+        , "    \"uri\":\"http://hackage.haskell.org/...\",\n"+        , "    \"module\":\"Data.Map\",\n"+        , "    \"signature\":\"(a->b)->[a]->[b]\",\n"+        , "    \"package\":\"containers\"\n"+        , "  }, ... ],\n"+        , "  \"completions\":[ {\n"+        , "    \"word\":\"MapM\",\n"+        , "    \"count\":11\n"+        , "  }, ... ],\n"+        , "  \"modules\":[ {\n"+        , "    \"name\":\"Data\",\n"+        , "    \"count\":19\n"+        , "  }  }, ... ],\n"+        , "  \"packages\":[ {\n"+        , "    \"name\":\"containers\",\n"+        , "    \"count\":13\n"+        , "  }, ... ]\n"+        , "}"+        ]     p $ do-      (text "The ") >> (ct "message") >> (text " field will contain a descriptive status message about the result \-        \or any errors encountered. The ") >> (ct "hits") >> (text " field will contain the total number of \-        \functions found. In the ") >> (ct "functions") >> (text " field, an array containing all functions found \-        \will be returned. For every function, a JSON object is included in the array.")+      text "The "+      ct "message"+      text " field will contain a descriptive status message about the result or any errors encountered. The "+      ct "hits"+      text " field will contain the total number of functions found. In the "+      ct "functions"+      text " field, an array containing all functions found will be returned."+      text " For every function, a JSON object is included in the array."     p $ do-      (text "Each of these objects contains the function name, the URI pointing to the Haddock documentation, the module, \-        \the signature and the package name in the ") >> (ct "name") >> (text ", ") >> (ct "uri") >> (text ", ")-        >> (ct "module") >> (text ", ") >> (ct "signature") >> (text" and ") >> (ct "package") >> (text " fields, respectively.")+      text "Each of these objects contains the function name, the URI pointing"+      text " to the Haddock documentation, the module, the signature and the package name in the "+      ct "name"+      text ", "+      ct "uri"+      text ", "+      ct "module"+      text ", "+      ct "signature"+      text" and "+      ct "package"+      text " fields, respectively."     p $ do-      (text "The ") >> (ct "completions") >> (text " contains all word completions (suggestions) resulting from the query \-        \For every completion, a JSON object is included in the array, containing the suggested word and the total number \-        \of occurrences of this word in the search result in the ") >> (ct "word") >> (text " and ") >> (ct "count")-        >> (text " fields.")+      text "The "+      ct "completions"+      text " contains all word completions (suggestions) resulting from the query For every completion,"+      text " a JSON object is included in the array, containing the suggested word and"+      text " the total number of occurrences of this word in the search result in the "+      ct "word"+      text " and "+      ct "count"+      text " fields."     p $ do-      (text "The ") >> (ct "modules") >> (text " and ") >> (ct "packages") >> (text " fields contain arrays with JSON objects \-        \denoting the occurrences of root modules and packages in the search result. For each element, the module/package \-        \name is included in the ") >> (ct "name") >> (text " field and the number of occurrences in the ") >> (ct "count")-        >> (text " field.")+      text "The "+      ct "modules"+      text " and "+      ct "packages"+      text " fields contain arrays with JSON objects denoting the occurrences of root"+      text " modules and packages in the search result. For each element, the module/package name is included in the "+      ct "name"+      text " field and the number of occurrences in the "+      ct "count"+      text " field."  ct :: (Functor t, Monad t, Inline c) => Text -> XHtmlT t c ct = code . text
src/Hayoo/Search/Pages/Template.hs view
@@ -51,15 +51,19 @@   script' "text/javascript" [A.src "hayoo/hayoo.js"] "&nbsp;"    -- Piwik tracking stuff-  script "text/javascript" -    "var pkBaseURL = (('https:' == document.location.protocol) ? 'https://piwik.hayoo.info/' : 'http://piwik.hayoo.info/'); \-    \document.write(unescape(\"%3Cscript src='\" + pkBaseURL + \"piwik.js' type='text/javascript'%3E%3C/script%3E\"));"-  script "text/javascript"-    "try {\-      \var piwikTracker = Piwik.getTracker(pkBaseURL + \"piwik.php\", 3);\-      \piwikTracker.trackPageView();\-      \piwikTracker.enableLinkTracking();\-    \} catch( err ) {}"+  script "text/javascript" $ T.pack $+    unwords+    [ "var pkBaseURL = (('https:' == document.location.protocol) ? 'https://piwik.hayoo.info/' : 'http://piwik.hayoo.info/');"+    , "document.write(unescape(\"%3Cscript src='\" + pkBaseURL + \"piwik.js' type='text/javascript'%3E%3C/script%3E\"));"+    ]+  script "text/javascript" $ T.pack $+    unwords+    [ "try {"+    , "var piwikTracker = Piwik.getTracker(pkBaseURL + \"piwik.php\", 3);"+    , "piwikTracker.trackPageView();"+    , "piwikTracker.enableLinkTracking();"+    , "} catch( err ) {}"+    ]  makeInfo :: XHtml FlowContent makeInfo = div' [A.id_ "info"] $ do@@ -102,7 +106,7 @@       a' [A.href "mailto:hayoo@holumbus.org"] $ text "hayoo@holumbus.org"     div' [A.id_ "copyright"] $ do       text "Hayoo! beta 2.2 © 2010 "-      span' [A.class_ "author"] $ a' [A.href "http://tbh.github.com"] $ text "Timo B. Hübel"+      span' [A.class_ "author"] $ a' [A.href "http://tbh.github.com"] $ text "Timo B. Kranz"       text ", "       span' [A.class_ "author"] $ text "Sebastian M. Gauck"       text " & "
− src/HayooSearch.hs
@@ -1,37 +0,0 @@-  -- ------------------------------------------------------------------------------{- |-  Module     : Main-  Copyright  : Copyright (C) 2011 Timo B. Huebel-  License    : MIT--  Maintainer : Timo B. Huebel (tbh@holumbus.org)-  Stability  : experimental-  Portability: portable-  Version    : 0.1--  Main program to use as standalone webserver for serving Hayoo!---}---- ------------------------------------------------------------------------------module Main where--import Hayoo.Search.Application--import Hack.Handler.SimpleServer---- -------------------------------------------------------------------------------- | Maybe read these from the command line ... somewhen-ixBase :: FilePath-ixBase          = "./lib"---- | The main application, fire up the server here!-main :: IO ()-main = do-       apl <- hayooInit ixBase-       run 4242 $ apl---- ----------------------------------------------------------------------------
src/HayooSnap.hs view
@@ -1,6 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} +#if hayooSnap4+------------------------------------------------------------------------------+-- Snap version 4 implementation+------------------------------------------------------------------------------+ {-|  This is the entry point for this web server application.  It supports@@ -62,4 +70,330 @@     quickHttpServe snap #else main = quickHttpServe applicationInitializer site+#endif++------------------------------------------------------------------------------+-- end Snap version 4+------------------------------------------------------------------------------+#else+------------------------------------------------------------------------------+-- Snap version 7+------------------------------------------------------------------------------++module Main where++import           Control.Applicative+import           Control.Exception              ( SomeException )+import           Control.Monad+import           Control.Monad.CatchIO          ( catch )+import           Control.Monad.State++import qualified Data.ByteString.Char8          as B++import           Data.Lens.Common+import           Data.Lens.Template+import           Data.Map                       ( toList )+import           Data.Maybe++import           Data.Text (Text)+import qualified Data.Text                      as T+import qualified Data.Text.Encoding             as T++import           Hayoo.IndexTypes               ( buildRankTable+                                                )+import           Hayoo.Search.EvalSearch        ( Core(..)+                                                , emptyRes+                                                , examples+                                                , filterStatusResult+                                                , genResult+                                                , getValDef+                                                , loadDocuments+                                                , loadIndex+                                                , loadPkgDocs+                                                , parseQuery+                                                , readDef+                                                , renderEmptyJson+                                                , renderJson+                                                , template+                                                )+import           Hayoo.Search.HTML              ( RenderState(..)+                                                , result+                                                )+import           Hayoo.Search.Pages.Template    ( makeTemplate+                                                )+import qualified Hayoo.Search.Pages.Static      as P++import           Holumbus.Index.Common          ( sizeDocs )+{-+import           Data.Time.Clock.POSIX+import           Foreign.C.Types+-- -}+import           Prelude                        hiding (catch)++import           Snap.Http.Server+import           Snap.Core+import           Snap.Snaplet+import           Snap.Snaplet.Heist+import           Snap.Util.FileServe+{-+import           Snap.Util.GZip+-- -}+import           System.FilePath                ( (</>) )+import           System.IO                      ( stderr+                                                , hPutStrLn+                                                )+import           Text.Templating.Heist++import qualified Text.XHtmlCombinators          as X++------------------------------------------------------------------------------++type HayooState = Core++data App+    = App+      { _heist      :: Snaplet (Heist App)+      , _hayooState :: HayooState+      }++makeLenses [''App]++instance HasHeist App where+    heistLens = subSnaplet heist++------------------------------------------------------------------------------++{- snap website example stuff++epochTime :: IO CTime+epochTime = do+    t <- getPOSIXTime+    return $ fromInteger $ truncate t+-- -}++description :: Text+description = "The snapframework.com website"+++appInit :: SnapletInit App App+appInit = makeSnaplet "snap-website" description Nothing $ do+    hs <- nestSnaplet "" heist $ heistInit "templates"+    hy <- liftIO $ getHayooInitialState++    addRoutes [ ("/",             ifTop hayooHtml)       -- map to /hayoo.html+              , ("/hayoo.html",   hayooHtml)+              , ("/hayoo.json",   hayooJson)+              , ("/help.html",    serveStatic P.help)+              , ("/about.html",   serveStatic P.about)+              , ("/api.html",     serveStatic P.api)+              , ("/hayoo/:stuff", serveHayooStatic)+              ]+    addSplices [ ("snap-version", serverVersion)+               , ("feed-autodiscovery-link", liftHeist $ textSplice "")+               ]+    wrapHandlers catch500++    {- snap website example stuff: compress html and set headers for caching static pages++    wrapHandlers (\h -> catch500 $ withCompression $+                        h <|> setCache (serveDirectory "static"))+    -- -}+    return $ App hs hy++------------------------------------------------------------------------------+-- | Deliver Hayoo files++serveHayooStatic :: Handler App App ()+serveHayooStatic = do+    relPath <- decodedParam "stuff"+    serveFile $ "hayoo" </> B.unpack relPath+  where+    decodedParam p = fromMaybe "" <$> getParam p++------------------------------------------------------------------------------+-- | Deliver static Hayoo pages++serveStatic :: X.XHtml X.FlowContent -> Handler App App ()+serveStatic pg+  = do+    core <- hayooCore+    modifyResponse htmlResponse+    writeText (X.render $ (template core) pg) ++------------------------------------------------------------------------------+-- | Render JSON page++hayooJson :: Handler App App ()+hayooJson+    = do pars <- getParams+         core <- hayooCore+         modifyResponse jsonResponse+         writeText (T.pack $ evalJsonQuery (toStringMap pars) core)+    where+      toStringMap   = map (uncurry tos) . toList+          where+            tos k a   = (            T.unpack . T.decodeUtf8  $ k+                        , concatMap (T.unpack . T.decodeUtf8) $ a+                        )++evalJsonQuery :: [(String, String)] -> Core -> String+evalJsonQuery p idct+    | null request      = renderEmptyJson+    | otherwise         = renderResult+    where+    request =               getValDef p "query"  ""++    {- not used for json output++    start   = readDef 0    (getValDef p "start"  "")+    static  = readDef True (getValDef p "static" "")+    tmpl    = template idct+    -- -}++    renderResult        = renderJson+                          . either emptyRes (genResult idct)+                          . parseQuery+                          $ request++------------------------------------------------------------------------------+-- | Render HTML page++hayooHtml :: Handler App App ()+hayooHtml+    = do pars <- getParams+         core <- hayooCore+         modifyResponse htmlResponse+         writeText $ evalHtmlQuery (toStringMap pars) core+    where+      toStringMap   = map (uncurry tos) . toList+          where+            tos k a = (            T.unpack . T.decodeUtf8  $ k+                      , concatMap (T.unpack . T.decodeUtf8) $ a+                      )++evalHtmlQuery :: [(String, String)] -> Core -> T.Text+evalHtmlQuery p idct+    | null request      = renderEmptyHtml+    | otherwise         = renderResult+    where+      request =               getValDef p "query"  ""+      start   = readDef 0    (getValDef p "start"  "")+      static  = readDef True (getValDef p "static" "")+      tmpl    = template idct++      renderEmptyHtml     = X.render $ tmpl examples++      renderResult        = applyTemplate (RenderState request start static)+                            . filterStatusResult request+                            . either emptyRes (genResult idct)+                            . parseQuery+                            $ request+          where+            applyTemplate rs sr+                | rsStatic rs   = X.render $ tmpl rr+                | otherwise     = X.render $      rr+                where+                  rr            = result rs sr++------------------------------------------------------------------------------++htmlResponse :: Response -> Response+htmlResponse+    = setContentType "text/html; charset=utf-8"+      . setResponseCode 200++jsonResponse :: Response -> Response+jsonResponse+    = setContentType "application/json; charset=utf-8"+      . setResponseCode 200++hayooCore :: Handler App App HayooState+hayooCore+    = gets $ getL hayooState++------------------------------------------------------------------------------++{- snap website example stuff++setCache :: MonadSnap m => m a -> m ()+setCache act = do+    pinfo <- liftM rqPathInfo getRequest+    act+    when ("media" `B.isPrefixOf` pinfo) $ do+       expTime <- liftM (+604800) $ liftIO epochTime+       s       <- liftIO $ formatHttpTime expTime+       modifyResponse $+          setHeader "Cache-Control" "public, max-age=604800" .+          setHeader "Expires" s+-- -}++catch500 :: MonadSnap m => m a -> m ()+catch500 m = (m >> return ()) `catch` \(e::SomeException) -> do+--    let t = T.pack $ show e+    putResponse r+    writeBS "<html><head><title>Internal Server Error</title></head>"+    writeBS "<body><h1>Internal Server Error</h1>"+    writeBS "<p>A web handler threw an exception. Details:</p>"+    writeBS "<pre>\n"+--    writeText $ X.escape t+    writeBS "\n</pre></body></html>"++    logError $ B.concat [ "caught exception: ", B.pack $ show e ]+  where+    r = setContentType "text/html" $+        setResponseStatus 500 "Internal Server Error" emptyResponse+++serverVersion :: SnapletSplice b v+serverVersion = liftHeist $ textSplice $ T.decodeUtf8 snapServerVersion++main :: IO ()+main = serveSnaplet defaultConfig appInit++------------------------------------------------------------------------------++ixBase          :: FilePath+ixBase          = "./lib"++getHayooInitialState    :: MonadIO m => m Core+getHayooInitialState+    = liftIO $+      do idx  <- loadIndex     hayooIndex+         infoM "Hayoo.Main" ("Hayoo index   loaded from file " ++ show hayooIndex)+               +         doc  <- loadDocuments hayooDocs+         infoM "Hayoo.Main" ("Hayoo docs    loaded from file " ++ show hayooDocs )+         infoM "Hayoo.Main" ("Hayoo docs contains " ++ show (sizeDocs doc) ++ " functions and types")++         pidx <- loadIndex     hackageIndex+         infoM "Hayoo.Main" ("Hackage index loaded from file " ++ show hackageIndex)++         pdoc <- loadPkgDocs   hackageDocs+         infoM "Hayoo.Main" ("Hackage docs  loaded from file " ++ show hackageDocs)+         infoM "Hayoo.Main" ("Hackage docs contains " ++ show (sizeDocs pdoc) ++ " packages")++         prnk <- return $ buildRankTable pdoc+         infoM "Hayoo.Main" ("Hackage package rank table computed")++         tpl  <- return $ makeTemplate (sizeDocs pdoc) (sizeDocs doc)++         return $ Core+                    { index      = idx+                    , documents  = doc+                    , pkgIndex   = pidx+                    , pkgDocs    = pdoc+                    , template   = tpl+                    , packRank   = prnk+                    }+    where+      hayooIndex      = ixBase ++ "/ix.bin.idx"+      hayooDocs       = ixBase ++ "/ix.bin.doc"+      hackageIndex    = ixBase ++ "/pkg.bin.idx"+      hackageDocs     = ixBase ++ "/pkg.bin.doc"++      infoM m msg     = hPutStrLn stderr $ m ++ ": " ++ msg++------------------------------------------------------------------------------+-- end Snap version 7+------------------------------------------------------------------------------ #endif