[Add mode=embed support
Neil Mitchell**20110121075136] {
hunk ./CHANGES.txt 3
+    Add mode=embed support
hunk ./src/Web/Response.hs 18
+import System.IO.Unsafe(unsafeInterleaveIO)
hunk ./src/Web/Response.hs 27
-    let response x = responseOk [Header HdrContentType x]
+    let response x ys = responseOk $ [Header HdrContentType x] ++ ys
hunk ./src/Web/Response.hs 29
-    let res ajax = do
-            dbs <- if isRight $ queryParsed q
-                   then fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q)
-                   else return mempty
-            return $ runQuery ajax dbs q
+    dbs <- unsafeInterleaveIO $ case queryParsed q of
+        Left _ -> return mempty
+        Right x -> fmap snd $ loadQueryDatabases (databases q) (fromRight $ queryParsed q)
hunk ./src/Web/Response.hs 34
-        Just "ajax" -> do
-            res <- res True
-            return $ response "text/html" $ unlines res
-        Just "web" -> do
-            res <- res False
-            return $ response "text/html" $ unlines $ header resources (escapeHTML $ queryText q) ++ res ++ footer
-        Just "suggest" -> fmap (response "application/json") $ runSuggest q
-        Just e -> return $ response "text/html" $ "Unknown webmode: " ++ e
+        Just "suggest" -> fmap (response "application/json" []) $ runSuggest q
+        Just "embed" -> return $ response "text/html" [hdr] $ unlines $ runEmbed dbs q
+            where hdr = Header (HdrCustom "Access-Control-Allow-Origin") "*"
+        Just "ajax" -> return $ response "text/html" [] $ unlines $ runQuery True dbs q
+        Just "web" -> return $ response "text/html" [] $ unlines $
+            header resources (escapeHTML $ queryText q) ++
+            runQuery False dbs q ++ footer
+        mode -> return $ response "text/html" [] $ "Unknown webmode: " ++ fromMaybe "none" mode
hunk ./src/Web/Response.hs 63
+
+runEmbed :: Database -> CmdLine -> [String]
+runEmbed dbs Search{queryParsed = Left err} = ["<i>Parse error: " ++& errorMessage err ++ "</i>"]
+runEmbed dbs Search{queryParsed = Right q}
+    | null now = ["<i>No results found</i>"]
+    | otherwise =
+        ["<a href='" ++ url ++ "'>" ++ showTagHTML (transform f $ self $ snd x) ++ "</a>"
+        | x <- now, let url = fromList "" $ map fst $ locations $ snd x] ++
+        ["<i>Press enter for more results...</i>" | not $ null next]
+    where
+        (now,next) = splitAt 10 $ search dbs q
+
+        f (TagEmph x) = TagBold x
+        f (TagBold x) = x
+        f x = x
+
}