diff --git a/src/lib/MyLib.hs b/src/lib/MyLib.hs index f9aa6c2..a5da4a7 100644 --- a/src/lib/MyLib.hs +++ b/src/lib/MyLib.hs @@ -15,7 +15,7 @@ module MyLib , runPrintQueryAll , spTreeToPaths , renderComposedFunctions, renderComposedFunctionsStr, parseComposedFunctions - , renderFunction, parseFunction + , renderFunction, parseFunction, renderTypedFunction , Function(..), TypedFunction, UntypedFunction , FullyQualifiedType(..), textToFullyQualifiedType, fullyQualifiedTypeToText , Graph @@ -251,6 +251,18 @@ renderFunction :: Function typeSig -> BS.ByteString renderFunction fn = _function_package fn <> ":" <> _function_module fn <> "." <> _function_name fn +-- | Render a function's name (output of 'renderFunction') and its FROM and TO type. +renderTypedFunction + :: TypedFunction + -> (BS.ByteString, (FullyQualifiedType, FullyQualifiedType)) + -- ^ (output of 'renderFunction', (FROM type, TO type)) +renderTypedFunction fn = + ( renderFunction fn + , (Json.functionType_arg sig, Json.functionType_ret sig) + ) + where + sig = _function_typeSig fn + -- | Parse e.g. "text-2.0.2:Data.Text.Encoding.encodeUtf16BE" to an untyped 'Function' parseFunction :: BS.ByteString -> Maybe UntypedFunction parseFunction bs = diff --git a/src/server/Server/Pages/Search.hs b/src/server/Server/Pages/Search.hs index 712d61f..231ec42 100644 --- a/src/server/Server/Pages/Search.hs +++ b/src/server/Server/Pages/Search.hs @@ -13,14 +13,37 @@ import qualified Data.Text as T import Servant.Server (Handler) import qualified Server.Monad as MyLib import qualified MyLib +import Data.List (intersperse) page :: MyLib.Graph -> T.Text -> T.Text -> Handler (Html ()) page graph src dst = pure $ do p_ $ "Hi there, you entered src=" <> mono (toHtml src) <> ", dst=" <> mono (toHtml dst) - forM_ (map MyLib.renderComposedFunctions results) $ \result -> do - mono (toHtml result) - br_ [] + forM_ results $ \result -> renderResult result >> br_ [] where - mono = span_ [style_ "font-family: monospace, monospace; background-color: rgb(200, 200, 200);"] maxCount = 20 - results = take maxCount $ MyLib.runQueryAll maxCount (MyLib.textToFullyQualifiedType src, MyLib.textToFullyQualifiedType dst) graph + + results = + take maxCount $ MyLib.runQueryAll + maxCount + (MyLib.textToFullyQualifiedType src, MyLib.textToFullyQualifiedType dst) + graph + + renderResult :: [MyLib.TypedFunction] -> Html () + renderResult fns = + let nameWithTypeLst = map MyLib.renderTypedFunction (reverse fns) + renderSingleFn (name, (fromTy, toTy)) = + let typeSig = T.unwords $ + [ "::" + , MyLib.fullyQualifiedTypeToText fromTy + , "->" + , MyLib.fullyQualifiedTypeToText toTy + ] + in mono (toHtml name) `with` [title_ typeSig] + in mconcat $ intersperse (mono " . ") $ map renderSingleFn nameWithTypeLst + + mono = + let style = style_ $ T.intercalate "; " $ + [ "font-family: monospace, monospace" + , "background-color: rgb(200, 200, 200)" + ] + in span_ [style]