refactor IndexBuilder + some tests (#3)

src/Docs/Search/IndexBuilder.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Docs.Search.Config (config)
 import Docs.Search.Declarations (Declarations(..), mkDeclarations)
+import Docs.Search.DocsJson (DocsJson)
 import Docs.Search.Extra ((>#>))
 import Docs.Search.Index (getPartId)
 import Docs.Search.SearchResult (SearchResult)
@@ -26,7 +27,6 @@ import Data.Set as Set
 import Data.String.CodePoints (contains) as String
 import Data.String.CodeUnits (singleton) as String
 import Data.String.Common (replace) as String
-import Data.String.Pattern (Pattern(..)) as String
 import Data.String.Pattern (Pattern(..), Replacement(..))
 import Data.Traversable (for, for_)
 import Data.Tuple (Tuple(..), fst, snd)
@@ -38,7 +38,6 @@ import Node.Encoding (Encoding(UTF8))
 import Node.FS.Aff (exists, mkdir, readTextFile, readdir, stat, writeTextFile)
 import Node.FS.Stats (isDirectory, isFile)
 import Node.Process as Process
-import Docs.Search.DocsJson (DocsJson)
 
 main :: Effect Unit
 main = launchAff_ mainAff
@@ -82,7 +81,7 @@ collectDocsJsons :: String -> Aff (Array DocsJson)
 collectDocsJsons outputDir = do
   paths <- readdir outputDir
 
-  mbs <- for paths \moduleName -> do
+  Array.catMaybes <$> for paths \moduleName -> do
     let jsonFile = "output/" <> moduleName <> "/docs.json"
     doesExist <- fileExists jsonFile
     if doesExist then do
@@ -103,8 +102,6 @@ collectDocsJsons outputDir = do
           "Couldn't find docs.json for " <> moduleName
       pure Nothing
 
-  pure $ Array.catMaybes mbs
-
 writeTypeIndex :: TypeIndex -> Aff Unit
 writeTypeIndex typeIndex =
   for_ entries \(Tuple typeShape results) -> do
@@ -117,33 +114,34 @@ writeTypeIndex typeIndex =
     entries :: Array _
     entries = Map.toUnfoldableUnordered (unwrap typeIndex)
 
-writeIndex :: Declarations -> Aff Unit
-writeIndex (Declarations trie) = do
-  let
-    prefixes :: Array (List Char)
-    prefixes =
+-- | Get a mapping from index parts to index contents.
+getIndex :: Declarations -> Map Int (Array (Tuple String (Array SearchResult)))
+getIndex (Declarations trie) =
+  Array.foldr insert mempty parts
+    where
+      prefixes :: Array (List Char)
+      prefixes =
         Set.toUnfoldable $
         List.foldr (\entry -> Set.insert (List.take 2 $ fst entry)) mempty $
         Trie.entriesUnordered trie
 
-    parts
-      :: Array { prefix :: List Char
-               , results :: Array (Tuple String (Array SearchResult))
-               }
-    parts = prefixes <#> \prefix ->
-      let results =
-            Array.fromFoldable $
-            Trie.query prefix trie <#>
-            \(Tuple path value) ->
-            Tuple (path >#> String.singleton) (Array.fromFoldable value)
-      in
-       { prefix, results }
+      parts
+        :: Array { prefix :: List Char
+                 , results :: Array (Tuple String (Array SearchResult))
+                 }
+      parts = prefixes <#> \prefix ->
+        let results =
+              Array.fromFoldable $
+              Trie.query prefix trie <#>
+              \(Tuple path value) ->
+              Tuple (path >#> String.singleton) (Array.fromFoldable value)
+        in
+         { prefix, results }
 
-    resultsMap :: Map Int (Array (Tuple String (Array SearchResult)))
-    resultsMap = Array.foldr insert mempty parts
-
-    insert part = Map.insertWith append (getPartId part.prefix) part.results
+      insert part = Map.insertWith append (getPartId part.prefix) part.results
 
+writeIndex :: Declarations -> Aff Unit
+writeIndex = getIndex >>> \resultsMap -> do
   for_ (Map.toUnfoldableUnordered resultsMap :: Array _)
     \(Tuple indexPartId results) -> do
       let header =
@@ -153,17 +151,24 @@ writeIndex (Declarations trie) = do
       writeTextFile UTF8 (config.mkIndexPartPath indexPartId) $
         header <> stringify (encodeJson results)
 
+patchHTML :: String -> Tuple Boolean String
+patchHTML html =
+  let
+    pattern = Pattern "</body>"
+    patch = "<!-- Docs search index. -->" <>
+            "<script type=\"text/javascript\" src=\"../docs-search-app.js\"></script>" <>
+            "<script type=\"text/javascript\">" <>
+            "window.DocsSearchTypeIndex = {};" <>
+            "window.DocsSearchIndex = {};" <>
+            "</script>" <>
+            "</body>"
+  in if not $ String.contains (Pattern patch) html
+     then Tuple true $ String.replace pattern (Replacement patch) html
+     else Tuple false html
+
 patchDocs :: Aff Unit
 patchDocs = do
   let dirname = "generated-docs/"
-      pattern = Pattern "</body>"
-      patch = "<!-- Docs search index. -->" <>
-              "<script type=\"text/javascript\" src=\"../docs-search-app.js\"></script>" <>
-              "<script type=\"text/javascript\">" <>
-              "window.DocsSearchTypeIndex = {};" <>
-              "window.DocsSearchIndex = {};" <>
-              "</script>" <>
-              "</body>"
 
   files <- readdir (dirname <> "html")
 
@@ -172,9 +177,10 @@ patchDocs = do
 
     whenM (fileExists path) do
       contents <- readTextFile UTF8 path
-      when (not $ String.contains (String.Pattern patch) contents) do
-        writeTextFile UTF8 path $
-          String.replace pattern (Replacement patch) contents
+      case patchHTML contents of
+        Tuple true patchedContents -> do
+          writeTextFile UTF8 path patchedContents
+        _ -> pure unit
 
 createDirectories :: Aff Unit
 createDirectories = do

test/Main.purs

@@ -4,17 +4,18 @@ import Prelude
 
 import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..))
 import Test.TypeQuery as TypeQuery
+import Test.IndexBuilder as IndexBuilder
+
+import Test.Extra (assertRight)
 
 import Data.Argonaut.Decode (decodeJson)
 import Data.Argonaut.Encode (encodeJson)
 import Data.Argonaut.Parser (jsonParser)
-import Data.Either (Either(..), fromRight)
+import Data.Either (fromRight)
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
-import Effect.Aff (Aff)
 import Partial.Unsafe (unsafePartial)
 import Test.Unit (TestSuite, suite, test)
-import Test.Unit.Assert as Assert
 import Test.Unit.Main (runTest)
 
 main :: Effect Unit
@@ -24,6 +25,7 @@ main = do
 mainTest :: TestSuite
 mainTest = do
   TypeQuery.tests
+  IndexBuilder.tests
 
   let mkJson x = unsafePartial $ fromRight $ jsonParser x
   suite "FunDeps decoder" do
@@ -415,11 +417,3 @@ mainTest = do
 
 qualified :: Array String -> String -> QualifiedName
 qualified moduleName name = QualifiedName { moduleName, name }
-
-assertRight :: forall a. Show a => Eq a => Either String a -> a -> Aff Unit
-assertRight eiActual expected =
-  case eiActual of
-    Left string -> do
-      Assert.equal (Right expected) eiActual
-    Right actual -> do
-      Assert.equal (Right expected) eiActual

test/Test/Extra.purs

@@ -0,0 +1,23 @@
+module Test.Extra where
+
+import Prelude
+
+import Data.Either (Either(..))
+import Effect.Aff (Aff)
+import Test.Unit.Assert as Assert
+
+assertRight
+  :: forall a b
+  .  Show a
+  => Show b
+  => Eq a
+  => Eq b
+  => Either b a
+  -> a
+  -> Aff Unit
+assertRight eiActual expected =
+  case eiActual of
+    Left string -> do
+      Assert.equal (Right expected) eiActual
+    Right actual -> do
+      Assert.equal (Right expected) eiActual

test/Test/IndexBuilder.purs

@@ -0,0 +1,30 @@
+module Test.IndexBuilder where
+
+import Prelude
+
+import Test.Extra
+
+import Docs.Search.IndexBuilder
+
+import Data.Either (Either(..))
+import Data.Foldable (class Foldable)
+import Data.List (List(..), (:))
+import Data.List as List
+import Data.List.NonEmpty (NonEmptyList)
+import Data.List.NonEmpty as NonEmptyList
+import Data.Set as Set
+import Data.Tuple (Tuple(..), snd)
+import Effect.Aff (Aff)
+import Test.Unit (TestSuite, suite, test)
+import Test.Unit.Assert as Assert
+
+tests :: TestSuite
+tests = do
+  suite "IndexBuilder" do
+    suite "patchHTML" do
+      test "works" do
+        let input = "</body>"
+        Assert.assertFalse "patchHTML works" (snd (patchHTML input) == input)
+      test "is idempotent" do
+        let input = "</body>"
+        Assert.equal (snd $ patchHTML $ snd $ patchHTML input) (snd $ patchHTML input)

test/Test/TypeQuery.purs

@@ -2,11 +2,12 @@ module Test.TypeQuery where
 
 import Prelude
 
+import Test.Extra (assertRight)
+
 import Docs.Search.TypeQuery (Substitution(..), TypeQuery(..), getFreeVariables, parseTypeQuery, penalty, typeVarPenalty)
 import Docs.Search.TypeShape (ShapeChunk(..), shapeOfTypeQuery)
 import Docs.Search.TypeDecoder (QualifiedName(..), Type(..))
 
-import Data.Either (Either(..))
 import Data.Foldable (class Foldable)
 import Data.List (List(..), (:))
 import Data.List as List
@@ -14,7 +15,6 @@ import Data.List.NonEmpty (NonEmptyList)
 import Data.List.NonEmpty as NonEmptyList
 import Data.Set as Set
 import Data.Tuple (Tuple(..))
-import Effect.Aff (Aff)
 import Test.Unit (TestSuite, suite, test)
 import Test.Unit.Assert as Assert
 
@@ -368,21 +368,5 @@ unitType = TypeConstructor (QualifiedName { moduleName: []
                                           , name: "Unit"
                                           })
 
-assertRight
-  :: forall a b
-  .  Show a
-  => Show b
-  => Eq a
-  => Eq b
-  => Either b a
-  -> a
-  -> Aff Unit
-assertRight eiActual expected =
-  case eiActual of
-    Left string -> do
-      Assert.equal (Right expected) eiActual
-    Right actual -> do
-      Assert.equal (Right expected) eiActual
-
 countFreeVars :: TypeQuery -> Int
 countFreeVars = getFreeVariables >>> Set.size