" - ," Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries" - ," by either function name, or by approximate type signature." - ,"
" - ,""
- ," Example searches:
"
- ," " ++ search "map"
- ," " ++ search "(a -> b) -> [a] -> [b]"
- ," " ++ search "Ord a => [a] -> [a]"
- ," " ++ search "Data.Map.insert"
- ,"
Enter your own search at the top of the page."
- ,"
" - ," The Hoogle manual contains more details," - ," including further details on search queries, how to install Hoogle as a command line application" - ," and how to integrate Hoogle with Firefox/Emacs/Vim etc." - ,"
" - ,"" - ," I am very interested in any feedback you may have. Please " - ," email me, or add an entry to my" - ," bug tracker." - ,"
" - ] - where - search x = "" ++& x ++ "\n Hoogle is a Haskell API search engine, which allows you to search many standard Haskell libraries\n by either function name, or by approximate type signature.\n
\n\n Example searches:
\n map\n
\n (a -> b) -> [a] -> [b]\n
\n Ord a => [a] -> [a]\n
\n Data.Map.insert\n
\n\t
Enter your own search at the top of the page.\n
\n The Hoogle manual contains more details,\n including further details on search queries, how to install Hoogle as a command line application\n and how to integrate Hoogle with Firefox/Emacs/Vim etc.\n
\n\n I am very interested in any feedback you may have. Please\n email me, or add an entry to my\n bug tracker.\n
\n" hunk ./src/Web/Response.hs 18 +import qualified Paths_hoogle(version) +import Data.Version(showVersion) hunk ./src/Web/Response.hs 23 +version = showVersion Paths_hoogle.version hunk ./src/Web/Response.hs 40 - Just "web" -> return $ response "text/html" [] $ unlines $ - header resources (escapeHTML $ queryText q) ++ - runQuery False dbs q ++ footer + Just "web" -> return $ response "text/html" [] $ + header version resources (queryText q) ++ + unlines (runQuery False dbs q) ++ footer version hunk ./src/Web/Response.hs 95 -runQuery ajax dbs q | fromRight (queryParsed q) == mempty = welcome +runQuery ajax dbs q | fromRight (queryParsed q) == mempty = [welcome] hunk ./src/Web/Response.hs 170 + +searchLink :: String -> URL +searchLink x = "?hoogle=" ++% x + addfile ./src/Web/Template.hs hunk ./src/Web/Template.hs 1 +{-# LANGUAGE PatternGuards, RecordWildCards #-} + +module Web.Template(main) where + +import General.Base +import General.System +import General.Web + + +main :: IO () +main = do + [from,to,modname] <- getArgs + src <- readFile from + writeFileBinary to $ generate modname $ resolve $ parse src + + +--------------------------------------------------------------------- +-- TYPE + +data Template = Template + {templateName :: String + ,templateArgs :: [String] + ,templateExport :: Bool + ,templateContents :: [Fragment] + } + +data Fragment + = Out String -- ^ Output some text + | Att Esc String -- ^ Output an attribute (and how to escape it) + | Set String String -- ^ Set an attribute to a value + | Call String -- ^ Call another template + +data Esc = EscNone | EscHtml | EscUrl deriving Eq + +escapeAppend e = case e of EscHtml -> "++&"; EscUrl -> "++%"; _ -> "++" +escape e = case e of EscHtml -> escapeHTML; EscUrl -> escapeURL; _ -> id + + +joinOut (Out x:Out y:zs) = joinOut $ Out (x++y) : zs +joinOut (x:xs) = x : joinOut xs +joinOut [] = [] + +--------------------------------------------------------------------- +-- OUTPUT + +generate :: String -> [Template] -> String +generate name xs = unlines $ + ("module " ++ name ++ " where") : + "import General.Web" : + concatMap generateTemplate (filter templateExport xs) + +generateTemplate :: Template -> [String] +generateTemplate Template{..} = "" : + (unwords (templateName : templateArgs) ++ " = \"\"") : + map ((++) " " . f) templateContents + where + f (Out x) = "++ " ++ show x + f (Att e x) = escapeAppend e ++ " " ++ x + + +--------------------------------------------------------------------- +-- RESOLVE + +-- | Eliminate Set and Call, fill in the template arguments +resolve :: [Template] -> [Template] +resolve xs = map (resolveFree . resolveSet . resolveCall xs) xs + +resolveFree t = t{templateArgs=args} + where seen = nub [x | Att _ x <- templateContents t] + args = nub $ filter (`elem` seen) (templateArgs t) ++ seen + +resolveSet t = t{templateContents = joinOut $ f [] $ templateContents t} + where + f seen (Set x y:xs) = f ((x,y):seen) xs + f seen (Att e y:xs) | Just v <- lookup y seen = Out (escape e v) : f seen xs + f seen (x:xs) = x : f seen xs + f seen [] = [] + +resolveCall args t = t{templateContents = concatMap f $ templateContents t} + where + f (Call x) | Just t <- find ((==) x . templateName) args = concatMap f $ templateContents t + f x = [x] + + +--------------------------------------------------------------------- +-- PARSING + +parse :: String -> [Template] +parse = f . dropWhile (not . isPrefixOf "#") . filter (not . all isSpace) . lines + where + f (x:xs) = Template name args exp (parseTemplate $ unlines a) : f b + where (a,b) = break ("#" `isPrefixOf`) xs + ys = words $ dropWhile (== '#') x + exp = ["export"] `isPrefixOf` ys + name:args = if exp then tail ys else ys + f [] = [] + + +parseTemplate :: String -> [Fragment] +parseTemplate = f + where + f [] = [] + f ('$':xs) = g a : f (drop 1 b) + where (a,b) = break (== '$') xs + f xs = Out a : f b + where (a,b) = break (== '$') xs + + g ('!':xs) = Att EscNone xs + g ('&':xs) = Att EscHtml xs + g ('%':xs) = Att EscUrl xs + g ('#':xs) = Call xs + g xs | (a,'=':b) <- break (== '=') xs = Set a b + g x = error $ "Templating error, perhaps you forgot the escape format? $" ++ x ++ "$" }