WIP

.gitignore

@@ -0,0 +1,10 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
+/.spago/

README.md

@@ -0,0 +1,8 @@
+# spago-search
+
+```
+spago build
+spago docs
+spago bundle-app -m Spago.Search.App --to generated-docs/spago-search-app.js
+spago run -m Spago.Seach.IndexBuilder
+```

packages.dhall

@@ -0,0 +1,22 @@
+let mkPackage =
+	  https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190602/src/mkPackage.dhall sha256:0b197efa1d397ace6eb46b243ff2d73a3da5638d8d0ac8473e8e4a8fc528cf57
+
+let upstream =
+	  https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190602/src/packages.dhall sha256:5da1578dd297709265715a92eda5f42989dce92e121fcc889cff669a3b997c3d
+
+let overrides = {=}
+
+let additions =
+	  { search-trie =
+		  mkPackage
+		  [ "prelude"
+		  , "arrays"
+		  , "ordered-collections"
+		  , "lists"
+		  , "foldable-traversable"
+		  ]
+		  "https://github.com/klntsky/purescript-search-trie.git"
+		  "master"
+	  }
+
+in  upstream ⫽ overrides ⫽ additions

spago.dhall

@@ -0,0 +1,27 @@
+{ name =
+	"my-project"
+, dependencies =
+	[ "effect"
+	, "aff-promise"
+	, "argonaut-codecs"
+	, "argonaut-core"
+	, "arrays"
+	, "console"
+	, "foldable-traversable"
+	, "generics-rep"
+	, "lists"
+	, "maybe"
+	, "newtype"
+	, "node-buffer"
+	, "node-fs"
+	, "node-fs-aff"
+	, "node-process"
+	, "psci-support"
+	, "search-trie"
+	, "strings"
+	, "web-dom"
+	, "web-html"
+	]
+, packages =
+	./packages.dhall
+}

src/Spago/Search/App.js

@@ -0,0 +1,15 @@
+/* global exports */
+
+exports.loadDeclarations_ = function (url) {
+  return function () {
+    return new Promise(function(resolve, reject) {
+      var script = document.createElement('script');
+      script.type = 'text/javascript';
+      script.src = url;
+      script.addEventListener('load', function () {
+        resolve(window.spagoSearchIndex);
+      });
+      script.addEventListener('error', reject);
+    });
+  };
+};

src/Spago/Search/App.purs

@@ -0,0 +1,45 @@
+module Spago.Search.App where
+
+import Prelude
+
+import Spago.Search.Declarations (Declarations)
+import Spago.Search.Index (mkSearchIndex)
+
+import Control.Promise (Promise, toAffE)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (wrap)
+import Effect (Effect)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Web.DOM as DOM
+import Web.DOM.Document as Document
+import Web.DOM.ParentNode as ParentNode
+import Web.DOM.Element as Element
+import Web.HTML as HTML
+import Web.HTML.HTMLDocument as HTMLDocument
+import Web.HTML.Window as Window
+import Web.DOM.Node as Node
+
+main :: Effect Unit
+main = launchAff_ do
+  declarations <- loadDeclarations "../spago-search-index.js"
+  elem <- liftEffect findContainer
+  let index = mkSearchIndex declarations
+  pure unit
+
+findContainer :: Effect (Maybe DOM.Element)
+findContainer = do
+  win <- HTML.window
+  doc <- HTMLDocument.toDocument <$> Window.document win
+  mbBanner <- ParentNode.querySelector (wrap ".top-banner") (Document.toParentNode doc)
+  case mbBanner of
+    Nothing -> pure Nothing
+    Just banner -> do
+      container <- Document.createElement "div" doc
+      void $ Node.appendChild (Element.toNode container) (Element.toNode banner)
+      pure $ Just container
+
+loadDeclarations :: String -> Aff (Array Declarations)
+loadDeclarations = toAffE <<< loadDeclarations_
+
+foreign import loadDeclarations_ :: String -> Effect (Promise (Array Declarations))

src/Spago/Search/Declarations.purs

@@ -0,0 +1,50 @@
+module Spago.Search.Declarations where
+
+import Prelude
+
+import Data.Argonaut.Decode (class DecodeJson, decodeJson)
+import Data.Argonaut.Encode (class EncodeJson, encodeJson)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Newtype (class Newtype, unwrap)
+
+newtype IndexEntry
+  = IndexEntry { title :: String
+               , info :: { declType :: String
+                         }
+               , sourceSpan :: { start :: Array Int
+                               , end :: Array Int
+                               , name :: String
+                               }
+               }
+
+derive instance eqIndexEntry :: Eq IndexEntry
+derive instance genericIndexEntry :: Generic IndexEntry _
+derive instance newtypeIndexEntry :: Newtype IndexEntry _
+
+instance showIndexEntry :: Show IndexEntry where
+  show = genericShow
+
+instance decodeJsonIndexEntry :: DecodeJson IndexEntry where
+  decodeJson json = IndexEntry <$> decodeJson json
+
+instance encodeJsonIndexEntry :: EncodeJson IndexEntry where
+  encodeJson = encodeJson <<< unwrap
+
+newtype Declarations
+  = Declarations { name :: String
+                 , declarations :: Array IndexEntry
+                 }
+
+derive instance eqDeclarations :: Eq Declarations
+derive instance genericDeclarations :: Generic Declarations _
+derive instance newtypeDeclarations :: Newtype Declarations _
+
+instance showDeclarations :: Show Declarations where
+  show = genericShow
+
+instance decodeJsonDeclarations :: DecodeJson Declarations where
+  decodeJson json = Declarations <$> decodeJson json
+
+instance encodeJsonDeclarations :: EncodeJson Declarations where
+  encodeJson = encodeJson <<< unwrap

src/Spago/Search/Index.purs

@@ -0,0 +1,25 @@
+module Spago.Search.Index where
+
+import Prelude
+
+import Spago.Search.Declarations (Declarations(..), IndexEntry(..))
+
+import Data.Foldable (foldr)
+import Data.List as List
+import Data.Newtype (class Newtype)
+import Data.Search.Trie (Trie, insert)
+import Data.String.CodeUnits (toCharArray)
+
+newtype SearchIndex = SearchIndex (Trie Char IndexEntry)
+
+derive instance newtypeEmailAddress :: Newtype SearchIndex _
+
+mkSearchIndex :: Array Declarations -> SearchIndex
+mkSearchIndex = SearchIndex <<< foldr insertDeclarations mempty
+  where
+    insertDeclarations :: (Declarations -> Trie Char IndexEntry -> Trie Char IndexEntry)
+    insertDeclarations (Declarations { name, declarations }) trie
+      = foldr insertIndexEntry trie declarations
+    insertIndexEntry :: (IndexEntry -> Trie Char IndexEntry -> Trie Char IndexEntry)
+    insertIndexEntry entry@(IndexEntry { title })
+      = insert (List.fromFoldable $ toCharArray title) entry

src/Spago/Search/IndexBuilder.purs

@@ -0,0 +1,86 @@
+module Spago.Seach.IndexBuilder where
+
+import Prelude
+
+import Spago.Search.Declarations (Declarations)
+import Spago.Search.Index (mkSearchIndex)
+
+import Data.Argonaut.Core (stringify)
+import Data.Argonaut.Decode (decodeJson)
+import Data.Argonaut.Encode (encodeJson)
+import Data.Argonaut.Parser (jsonParser)
+import Data.Array as Array
+import Data.Either (hush)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (unwrap)
+import Data.Search.Trie as Trie
+import Data.String.CodePoints as String
+import Data.String.Common as String
+import Data.String.Pattern (Pattern(..), Replacement(..))
+import Data.String.Pattern as String
+import Data.Traversable (for, for_)
+import Effect (Effect)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import Node.Encoding (Encoding(UTF8))
+import Node.FS.Aff (exists, readTextFile, readdir, writeTextFile)
+import Node.Process as Process
+
+collectDeclarations :: Array String -> Aff (Array Declarations)
+collectDeclarations paths =
+  Array.catMaybes <$> for paths \path -> do
+    let jsonFile = "output/" <> path <> "/docs.json"
+    doesExist <- exists jsonFile
+    if doesExist then do
+      contents <- readTextFile UTF8 jsonFile
+      pure $ hush $ jsonParser contents >>= decodeJson
+    else
+      pure Nothing
+
+writeDeclarations :: Array Declarations -> Aff Unit
+writeDeclarations decls = do
+  let filename = "generated-docs/spago-search-index.js"
+      dirname  = "generated-docs/"
+
+  whenM (not <$> exists dirname) $
+    liftEffect $ do
+      log "Run `spago docs` first!"
+      Process.exit 1
+
+  let header =
+        "// This file was generated by spago.\n" <>
+        "window.spagoSearchIndex = "
+
+  writeTextFile UTF8 filename (header <> (stringify $ encodeJson decls))
+
+patchDocs :: Aff Unit
+patchDocs = do
+  let dirname = "generated-docs/"
+  let patch = "<!-- Spago search index. -->" <>
+              "<script type=\"text/javascript\" src=\"../spago-search-app.js\"></script>" <>
+              "</body>"
+
+  whenM (not <$> exists dirname) $
+    liftEffect $ do
+      log "Run `spago docs` first!"
+      Process.exit 1
+
+  paths <- readdir (dirname <> "html")
+  for_ paths \file -> do
+    let path = dirname <> "html/" <> file
+    contents <- readTextFile UTF8 path
+    when (not $ String.contains (String.Pattern patch) contents) do
+      let patched = String.replace (Pattern "</body>") (Replacement patch) contents
+      writeTextFile UTF8 path patched
+
+main :: Effect Unit
+main = do
+  launchAff_ do
+    paths <- readdir "output"
+    declarations <- collectDeclarations paths
+    liftEffect $ log $ "Found " <> show (Array.length declarations) <> " modules"
+    writeDeclarations declarations
+    patchDocs
+    let index = mkSearchIndex declarations
+    liftEffect $ log $ "Loaded " <> show (Trie.size $ unwrap index) <> " definitions"

test/Main.purs

@@ -0,0 +1,9 @@
+module Test.Main where
+
+import Prelude
+import Effect (Effect)
+import Effect.Console (log)
+
+main :: Effect Unit
+main = do
+  log "You should add some tests."