implemented search

app/Header.hs

@@ -7,7 +7,16 @@ import Text.Blaze.Html (Html)
 makeLinks :: [(String, String)] -> Html
 makeLinks [] = [hsx||]
 makeLinks [(display,url)] = [hsx|
-    <a href={url}>{display}</a>
+    <a href={url}>{display}</a> | 
+    <input id="search" placeholder="search">
+    <script>
+        var search = document.getElementById("search")
+        search.onkeypress = event => {
+            if(event.keyCode == 13) {
+                window.location.href = "/search/" + search.value
+            }
+        }
+    </script>
 |]
 makeLinks ((display, url):xs) = [hsx|
     <a href={url}>{display}</a> |

app/Main.hs

@@ -7,7 +7,7 @@ import Text.Blaze.Html.Renderer.String (renderHtml)
 import Text.Blaze.Html (Html)
 
 import Data.Text (unpack)
-import Data.List (intercalate)
+import Data.List (intercalate, find)
 
 import System.Directory (doesFileExist)
 
@@ -36,46 +36,14 @@ import Control.Concurrent (forkIO, ThreadId)
 import Helpers.Cli (cli)
 import System.Environment (getArgs)
 import Pages.Admin.Admin (admin)
-
-page404 :: [String] -> Response
-page404 args = responseBuilder status404 [("Content-Type", "text/html")] $ copyByteString (fromString (renderHtml (layout [hsx|
-    <h1>404 - Page not found</h1><br>
-    params: {args}
-|])))
-
-serve :: Html -> Response
-serve content = responseBuilder status200 [("Content-Type", "text/html")] $ copyByteString (fromString (renderHtml content))
-
-serveFile :: String -> IO Response
-serveFile path = do
-    info "Serving file"
-    exists <- doesFileExist path
-    if exists then do
-        info "File exists"
-        return $ responseFile status200 [] path Nothing
-    else do
-        warning "No file found!"
-        return $ responseBuilder status404 [("Content-Type", "text/json")] $ copyByteString "{\"error\":\"Error: file not found!\"}"
-
-
-handleRequest :: [String] -> Request ->  IO Response
-handleRequest ("static":xs) request = serveFile $ intercalate "/" ("static":xs)
-handleRequest ("api":args) request = do
-    (status, value) <- api args request
-    return $ responseBuilder status [("Content-Type", "text/plain")] $ copyByteString (fromString value)
-handleRequest ["contact"] request = return $ serve (layout contact)
-handleRequest ["sources"] request = return $ serve (layout sources)
-handleRequest ["guestbook"] request = serve . layout <$> guestbook
-handleRequest ("projects":project) request = return $ serve (layout (projects project))
-handleRequest ["snake-leaderboard"] request = serve . layout <$> leaderboard
-handleRequest ["favicon.ico"] request = do serveFile "static/favicon.ico"
-handleRequest ("admin":xs) request = serve . layout <$> admin xs
-handleRequest [] request = serve . layout <$> index
-handleRequest x request = return $ page404 x
+import Text.Regex (mkRegex, Regex, matchRegex)
+import Pages.Pages (findPage)
 
 app :: Request -> (Response -> IO b)  -> IO b
 app request respond = do
-    response <- handleRequest (map unpack (pathInfo request)) request
+    let args = "/" ++ intercalate "/" (map unpack $ pathInfo request)
+    let page = findPage args
+    response <- page request
     logger request response
     respond response
 

app/Pages/Pages.hs

@@ -0,0 +1,85 @@
+module Pages.Pages where
+import Network.Wai (Response, Request (pathInfo), responseBuilder, responseFile)
+import IHP.HSX.QQ (hsx)
+import Text.Blaze.Html (Html)
+import Text.Regex (Regex, mkRegex, matchRegex)
+import Network.HTTP.Types (status404, status200)
+import Blaze.ByteString.Builder (copyByteString)
+import Data.ByteString.UTF8 (fromString)
+import Text.Blaze.Html.Renderer.String (renderHtml)
+import Layout (layout)
+import Helpers.Logger (info, warning)
+import System.Directory (doesFileExist)
+import Data.List (intercalate, find)
+import Api.Api (api)
+import Pages.Contact.Contact (contact)
+import Pages.Sources.Sources (sources)
+import Pages.Guestbook.Guestbook (guestbook)
+import Pages.Projects.Projects (projects)
+import Pages.Projects.Snake (leaderboard)
+import Pages.Admin.Admin (admin)
+import Index (index)
+import Data.Text (unpack)
+import Pages.Search.Search (search)
+
+page404 :: [String] -> Response
+page404 args = responseBuilder status404 [("Content-Type", "text/html")] $ copyByteString (fromString (renderHtml (layout [hsx|
+    <h1>404 - Page not found</h1><br>
+    params: {args}
+|])))
+
+serve :: Html -> Response
+serve content = responseBuilder status200 [("Content-Type", "text/html")] $ copyByteString (fromString (renderHtml content))
+
+serveFile :: String -> IO Response
+serveFile path = do
+    info "Serving file"
+    exists <- doesFileExist path
+    if exists then do
+        info "File exists"
+        return $ responseFile status200 [] path Nothing
+    else do
+        warning "No file found!"
+        return $ responseBuilder status404 [("Content-Type", "text/json")] $ copyByteString "{\"error\":\"Error: file not found!\"}"
+
+pages :: [(String, Request -> IO Response)]
+pages = [
+            ("/static", \req -> do
+                let (_:xs) = getArgs req
+                serveFile $ intercalate "/" ("static":xs)
+            ),
+            ("/api", \req -> do
+                let (_:args) = getArgs req
+                (status, value) <- api args req
+                return $ responseBuilder status [("Content-Type", "text/plain")] $ copyByteString (fromString value)
+            ),
+            ("/search", \req -> do
+                let [_, query] = getArgs req
+                return $ serve $ layout $ search pages $ mkRegex query
+            ),
+            ("/contact", \_ -> return $ serve $ layout contact),
+            ("/sources", \_ -> return $ serve $ layout sources),
+            ("/guestbook", \_ -> serve . layout <$> guestbook),
+            ("/projects", \req -> do
+                let (_:project) = getArgs req
+                return $ serve $ layout $ projects project
+            ),
+            ("/snake-leaderboard", \_ -> serve . layout <$> leaderboard),
+            ("/favicon.ico", \_ -> serveFile "static/favicon.ico"),
+            ("/admin", \req -> do
+                let (_:xs) = getArgs req
+                serve . layout <$> admin xs
+            ),
+            ("/", \_ -> serve . layout <$> index)
+        ]
+    where
+        getArgs request = map unpack $ pathInfo request
+
+findPage :: String -> (Request -> IO Response)
+findPage addr = case find (\(regex, _) -> case matchRegex (mkRegex regex) addr of
+    Nothing -> False
+    _ -> True) pages of -- TODO: make regex
+    (Just x) -> snd x
+    Nothing -> \req -> do
+        let x = map unpack $ pathInfo req
+        return $ page404 x

app/Pages/Search/Search.hs

@@ -0,0 +1,29 @@
+module Pages.Search.Search where
+import Text.Blaze.Html (Html)
+import IHP.HSX.QQ (hsx)
+import Text.Regex (Regex, matchRegex)
+import Network.Wai (Request, Response)
+import Helpers.Section (section)
+
+findPage :: [(String, Request -> IO Response)] -> Regex -> [String]
+findPage ((target, _):xs) regex = case matchRegex regex target of
+    Nothing -> findPage xs regex
+    _ -> target : findPage xs regex
+findPage [] _ = []
+
+search :: [(String, Request -> IO Response)] -> Regex -> Html
+search pages query = [hsx|
+    <h1>Search Results:</h1>
+    {section $ makeResults 0 $ findPage pages query}
+|]
+    where
+        makeResults :: Int -> [String] -> Html
+        makeResults index (x:xs) = [hsx|
+            <h2>{index} - {title}</h2>
+            <a href={x}>{x}</a>
+            <br>
+            {makeResults (index+1) xs}
+        |]
+            where
+                (_:title) = x
+        makeResults _ [] = [hsx||]

flake.nix

@@ -25,7 +25,7 @@
                 executableHaskellDepends = with pkgs.haskellPackages; [
                     base blaze-builder blaze-html bytestring http-types ihp-hsx
                     sqlite-simple text time utf8-string uuid wai warp directory
-                    aeson split password cryptonite string-random
+                    aeson split password cryptonite string-random regex-compat
                 ];
                 license = "unknown";
                 mainProgram = "homepage";

homepage.cabal

@@ -19,6 +19,8 @@ executable homepage
         Helpers.Logger,
         Helpers.Cli
         Api.Api,
+        Pages.Pages,
+        Pages.Search.Search,
         Pages.Contact.Contact,
         Pages.Projects.Projects,
         Pages.Projects.Snake,
@@ -45,7 +47,8 @@ executable homepage
         split,
         password,
         cryptonite,
-        string-random
+        string-random,
+        regex-compat
 
     hs-source-dirs:   app
     default-language: Haskell2010