Search trie prototype

client/src/services/tSearch.ts

@@ -6,10 +6,6 @@ import {RemoteData, ResolvedData} from 'remote-data-ts'
 import {FunctionRecord} from '../types'
 import {SearchError, fetchError} from './SearchError'
 
-interface ServerSuccess {
-  data: FunctionRecord[]
-}
-
 interface ServerError {
   err: SearchError
 }
@@ -25,9 +21,9 @@ const response = (
 ): Task<SearchResult, Error | UnknownError> => {
   // All good !!! \o/
   if (res.ok) {
-    return (res.json() as Task<ServerSuccess, UnknownError>)
-      .map(({data}) => data)
-      .map(RemoteData.success)
+    return (res.json() as Task<FunctionRecord[], UnknownError>).map(
+      RemoteData.success,
+    )
   }
 
   // Client error, sent by backend
@@ -46,4 +42,6 @@ const response = (
 const base = process.env.REACT_APP_API_URL || 'http://localhost:8000'
 
 export const search = (query: string): SearchTask =>
-  fetch(`${base}/search?${queryString.stringify({query})}`).chain(response)
+  fetch(`${base}/v1/search?${queryString.stringify({q: query})}`).chain(
+    response,
+  )

server/Setup.hs

@@ -1,2 +1,3 @@
 import Distribution.Simple
+
 main = defaultMain

server/apps/cli/Main.hs

@@ -1,4 +1,5 @@
 {-# OPTIONS_GHC -Wall -Werror #-}
+
 module Main where
 
 import qualified Tsearch

server/apps/server/Main.hs

@@ -1,19 +1,81 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wall -Werror #-}
+
 module Main where
 
-import Tsearch.API.Api (Api(Api))
-import qualified Tsearch.API.Api as Api
-import qualified Network.Wai.Handler.Warp as Warp
-import qualified Network.Wai as Wai
-import Tsearch.API.Response.Search (SearchResponse(..))
+import qualified Data.List as List
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes)
 import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
 import qualified Network.HTTP.Types.Status as Wai
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Network.Wai.Middleware.Cors as Cors
+import qualified Tsearch
+import Tsearch.API.Api (Api (Api))
+import qualified Tsearch.API.Api as Api
+import Tsearch.API.Response.Search (SearchResponse (..))
+import qualified Tsearch.API.Schemas.Function as Function
+import qualified Tsearch.API.Schemas.FunctionOrType as FunctionOrType
+import qualified Tsearch.API.Schemas.SearchError as SearchError
+import qualified Tsearch.API.Schemas.SearchResult as SearchResult
+
+corsMiddleware :: Wai.Middleware
+corsMiddleware =
+  Cors.cors $ Just . allowSameOriginPolicy . List.lookup "origin" . Wai.requestHeaders
+
+defaultPolicy :: Cors.CorsResourcePolicy
+defaultPolicy =
+  Cors.CorsResourcePolicy
+    { Cors.corsOrigins = Nothing,
+      Cors.corsMethods = ["OPTIONS", "HEAD", "GET", "PUT", "POST", "DELETE"],
+      Cors.corsRequestHeaders =
+        Cors.simpleHeaders ++ ["Authorization", "Content-Type"],
+      Cors.corsExposedHeaders = Just Cors.simpleResponseHeaders,
+      Cors.corsMaxAge = Just $ 60 * 60, -- hour in seconds
+      Cors.corsVaryOrigin = True,
+      Cors.corsRequireOrigin = True,
+      Cors.corsIgnoreFailures = False
+    }
+
+-- | CORS policy to allow same origin, otherwise fallback to `*`.
+-- For requests sending credentials, CORS doesn't allow
+-- `Access-Control-Allow-Origin` to be set to `*`, it requires an explicit origin.
+allowSameOriginPolicy :: Maybe Cors.Origin -> Cors.CorsResourcePolicy
+allowSameOriginPolicy origin =
+  defaultPolicy
+    { Cors.corsOrigins = fmap (\o -> ([o], True)) origin,
+      Cors.corsRequireOrigin = False
+    }
 
 searchHandler :: Text -> IO SearchResponse
-searchHandler _ = pure $ SearchResponse200 []
+searchHandler query = do
+  Text.putStrLn query
+
+  pure $ case map (Text.unpack . Text.strip) $ Text.splitOn "=>" $ Text.strip query of
+    [] -> SearchResponse422 $ SearchError.SearchErrorMissingQuery
+    [_] -> SearchResponse422 $ SearchError.SearchErrorInavlidQuery
+    signature ->
+      SearchResponse200 $
+        search $
+          Tsearch.TsSignature (init signature) (last signature)
+  where
+    mkFunc :: Tsearch.TsFunc -> SearchResult.SearchResult
+    mkFunc func = SearchResult.SearchResultFunction $ Function.Function (Text.pack func.name) FunctionOrType.FunctionOrTypeFunc
+
+    search q =
+      map mkFunc $
+        catMaybes $
+          map (`Map.lookup` Tsearch.index) $
+            Tsearch.searchBySignature Tsearch.trie $
+              q
 
 api :: Api IO
-api = Api { Api.search = searchHandler }
+api = Api {Api.search = searchHandler}
 
 run :: Wai.Request -> IO a -> IO a
 run _ ma = ma
@@ -22,10 +84,10 @@ notFound :: Wai.Application
 notFound _req respond = respond $ Wai.responseLBS Wai.status404 [] mempty
 
 server :: Wai.Application
-server = Api.application run api notFound
+server = corsMiddleware $ Api.application run api notFound
 
 main :: IO ()
 main = do
-  let port = 8080
+  let port = 8000
   putStrLn $ "Running on port " <> show port
   Warp.run port server

server/server.cabal

@@ -34,10 +34,11 @@ library
   hs-source-dirs:
       src
   build-depends:
-      aeson
-    , base >=4.7 && <5
+      base >=4.7 && <5
+    , aeson
     , bytestring
     , casing
+    , containers
     , data-default-class
     , http-client
     , http-types
@@ -66,10 +67,11 @@ executable tsearch
       TypeApplications
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
   build-depends:
-      aeson
-    , base >=4.7 && <5
+      base >=4.7 && <5
+    , aeson
     , bytestring
     , casing
+    , containers
     , data-default-class
     , filepath
     , http-client
@@ -97,10 +99,11 @@ executable tsearch-server
       apps/server
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
   build-depends:
-      aeson
-    , base >=4.7 && <5
+      base >=4.7 && <5
+    , aeson
     , bytestring
     , casing
+    , containers
     , data-default-class
     , http-client
     , http-types

server/src/Tsearch.hs

@@ -1,4 +1,104 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+
 module Tsearch where
 
-hello :: IO ()
-hello = putStrLn "Hello xD"
+import qualified Data.List as List
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes)
+
+data TsFunc = TsFunc
+  { name :: String,
+    args :: [TsType],
+    return :: TsType
+  }
+  deriving (Show, Eq)
+
+type TsType = String
+
+type ID = String
+
+type Index = Map ID TsFunc
+
+data Arg = Arg
+  { type_ :: TsType,
+    next :: [Arg], -- Next argument
+    returns :: [Return] -- Return type
+  }
+  deriving (Show, Eq)
+
+data Return = Return
+  { type_ :: TsType,
+    ids :: [ID] -- Ref to the function (Map ID Fn)
+  }
+  deriving (Show, Eq)
+
+newtype TsTrie = TsTrie [Arg]
+
+data TsSignature = TsSignature
+  { args :: [TsType],
+    return :: TsType
+  }
+  deriving (Show, Eq)
+
+-- Generated at build time
+
+index :: Index
+index =
+  Map.fromList
+    [ ("123", TsFunc "replace" ["string", "RegExp"] "string"),
+      ("456", TsFunc "length" ["string"] "number"),
+      ("789", TsFunc "len" ["string"] "number"),
+      ("987", TsFunc "volume" ["number", "number", "number"] "number"),
+      ("654", TsFunc "area" ["number", "number"] "number")
+    ]
+
+trie :: TsTrie
+trie =
+  TsTrie
+    [ Arg
+        "string"
+        [Arg "RegExp" [] [Return "string" ["123"]]]
+        [Return "number" ["456", "789"]],
+      Arg
+        "number"
+        [ Arg
+            "number"
+            [Arg "number" [] [Return "number" ["987"]]]
+            [Return "number" ["654"]]
+        ]
+        []
+    ]
+
+-- Search queries
+
+-- (string) => (RegExp) => number
+s1 = TsSignature ["string", "RegExp"] "string"
+
+-- (number) => (number) => (number) => number
+s2 = TsSignature ["number", "number", "number"] "number"
+
+-- (string) => number
+s3 = TsSignature ["string"] "number"
+
+searchBySignature :: TsTrie -> TsSignature -> [ID]
+searchBySignature (TsTrie []) _ = []
+searchBySignature (TsTrie trie) query =
+  walkQuery query trie []
+
+walkQuery :: TsSignature -> [Arg] -> [Return] -> [ID]
+walkQuery (TsSignature [] return) _ returns =
+  maybe [] (\ret -> ret.ids) $
+    List.find (\(Return type_ ids) -> type_ == return) $
+      returns
+walkQuery (TsSignature (arg : next) return) args returns =
+  case mbNextArg of
+    Nothing -> []
+    Just (Arg _ args returns) -> walkQuery (TsSignature next return) args returns
+  where
+    mbNextArg = List.find (\(Arg type_ args returns) -> arg == type_) args
+
+search :: Index -> TsTrie -> TsSignature -> [TsFunc]
+search i t q =
+  catMaybes $ map (`Map.lookup` i) $ Tsearch.searchBySignature t q