git.iko.soy/rowtype-yoga/purescript-docs-search
on master help sign in
refactor IndexBuilder + some tests (#3)
6ba28b3Vladimir Kalnitsky
src/Docs/Search/IndexBuilder.purs+44−38
compare with master
unifiedsplit
@@ -4,6 +4,7 @@ import Prelude
4
4
5import Docs.Search.Config (config)
5import Docs.Search.Config (config)
6import Docs.Search.Declarations (Declarations(..), mkDeclarations)
6import Docs.Search.Declarations (Declarations(..), mkDeclarations)
7+import Docs.Search.DocsJson (DocsJson)
7import Docs.Search.Extra ((>#>))
8import Docs.Search.Extra ((>#>))
8import Docs.Search.Index (getPartId)
9import Docs.Search.Index (getPartId)
9import Docs.Search.SearchResult (SearchResult)
10import Docs.Search.SearchResult (SearchResult)
@@ -26,7 +27,6 @@ import Data.Set as Set
26import Data.String.CodePoints (contains) as String
27import Data.String.CodePoints (contains) as String
27import Data.String.CodeUnits (singleton) as String
28import Data.String.CodeUnits (singleton) as String
28import Data.String.Common (replace) as String
29import Data.String.Common (replace) as String
29−import Data.String.Pattern (Pattern(..)) as String
30import Data.String.Pattern (Pattern(..), Replacement(..))
30import Data.String.Pattern (Pattern(..), Replacement(..))
31import Data.Traversable (for, for_)
31import Data.Traversable (for, for_)
32import Data.Tuple (Tuple(..), fst, snd)
32import Data.Tuple (Tuple(..), fst, snd)
@@ -38,7 +38,6 @@ import Node.Encoding (Encoding(UTF8))
38import Node.FS.Aff (exists, mkdir, readTextFile, readdir, stat, writeTextFile)
38import Node.FS.Aff (exists, mkdir, readTextFile, readdir, stat, writeTextFile)
39import Node.FS.Stats (isDirectory, isFile)
39import Node.FS.Stats (isDirectory, isFile)
40import Node.Process as Process
40import Node.Process as Process
41−import Docs.Search.DocsJson (DocsJson)
42
41
43main :: Effect Unit
42main :: Effect Unit
44main = launchAff_ mainAff
43main = launchAff_ mainAff
@@ -82,7 +81,7 @@ collectDocsJsons :: String -> Aff (Array DocsJson)
82collectDocsJsons outputDir = do
81collectDocsJsons outputDir = do
83 paths <- readdir outputDir
82 paths <- readdir outputDir
84
83
85− mbs <- for paths \moduleName -> do
84+ Array.catMaybes <$> for paths \moduleName -> do
86 let jsonFile = "output/" <> moduleName <> "/docs.json"
85 let jsonFile = "output/" <> moduleName <> "/docs.json"
87 doesExist <- fileExists jsonFile
86 doesExist <- fileExists jsonFile
88 if doesExist then do
87 if doesExist then do
@@ -103,8 +102,6 @@ collectDocsJsons outputDir = do
103 "Couldn't find docs.json for " <> moduleName
102 "Couldn't find docs.json for " <> moduleName
104 pure Nothing
103 pure Nothing
105
104
106− pure $ Array.catMaybes mbs
107−
108writeTypeIndex :: TypeIndex -> Aff Unit
105writeTypeIndex :: TypeIndex -> Aff Unit
109writeTypeIndex typeIndex =
106writeTypeIndex typeIndex =
110 for_ entries \(Tuple typeShape results) -> do
107 for_ entries \(Tuple typeShape results) -> do
@@ -117,33 +114,34 @@ writeTypeIndex typeIndex =
117 entries :: Array _
114 entries :: Array _
118 entries = Map.toUnfoldableUnordered (unwrap typeIndex)
115 entries = Map.toUnfoldableUnordered (unwrap typeIndex)
119
116
120−writeIndex :: Declarations -> Aff Unit
117+-- | Get a mapping from index parts to index contents.
118+getIndex :: Declarations -> Map Int (Array (Tuple String (Array SearchResult)))
121−writeIndex (Declarations trie) = do
119+getIndex (Declarations trie) =
122− let
120+ Array.foldr insert mempty parts
121+ where
123− prefixes :: Array (List Char)
122+ prefixes :: Array (List Char)
124− prefixes =
123+ prefixes =
125 Set.toUnfoldable $
124 Set.toUnfoldable $
126 List.foldr (\entry -> Set.insert (List.take 2 $ fst entry)) mempty $
125 List.foldr (\entry -> Set.insert (List.take 2 $ fst entry)) mempty $
127 Trie.entriesUnordered trie
126 Trie.entriesUnordered trie
128
127
129− parts
128+ parts
130− :: Array { prefix :: List Char
129+ :: Array { prefix :: List Char
131− , results :: Array (Tuple String (Array SearchResult))
130+ , results :: Array (Tuple String (Array SearchResult))
132− }
131+ }
133− parts = prefixes <#> \prefix ->
132+ parts = prefixes <#> \prefix ->
134− let results =
133+ let results =
135− Array.fromFoldable $
134+ Array.fromFoldable $
136− Trie.query prefix trie <#>
135+ Trie.query prefix trie <#>
137− \(Tuple path value) ->
136+ \(Tuple path value) ->
138− Tuple (path >#> String.singleton) (Array.fromFoldable value)
137+ Tuple (path >#> String.singleton) (Array.fromFoldable value)
139− in
138+ in
140− { prefix, results }
139+ { prefix, results }
141−
140+
142− resultsMap :: Map Int (Array (Tuple String (Array SearchResult)))
143− resultsMap = Array.foldr insert mempty parts
144−
145− insert part = Map.insertWith append (getPartId part.prefix) part.results
141+ insert part = Map.insertWith append (getPartId part.prefix) part.results
146
142
143+writeIndex :: Declarations -> Aff Unit
144+writeIndex = getIndex >>> \resultsMap -> do
147 for_ (Map.toUnfoldableUnordered resultsMap :: Array _)
145 for_ (Map.toUnfoldableUnordered resultsMap :: Array _)
148 \(Tuple indexPartId results) -> do
146 \(Tuple indexPartId results) -> do
149 let header =
147 let header =
@@ -153,17 +151,24 @@ writeIndex (Declarations trie) = do
153 writeTextFile UTF8 (config.mkIndexPartPath indexPartId) $
151 writeTextFile UTF8 (config.mkIndexPartPath indexPartId) $
154 header <> stringify (encodeJson results)
152 header <> stringify (encodeJson results)
155
153
154+patchHTML :: String -> Tuple Boolean String
155+patchHTML html =
156+ let
157+ pattern = Pattern "</body>"
158+ patch = "<!-- Docs search index. -->" <>
159+ "<script type=\"text/javascript\" src=\"../docs-search-app.js\"></script>" <>
160+ "<script type=\"text/javascript\">" <>
161+ "window.DocsSearchTypeIndex = {};" <>
162+ "window.DocsSearchIndex = {};" <>
163+ "</script>" <>
164+ "</body>"
165+ in if not $ String.contains (Pattern patch) html
166+ then Tuple true $ String.replace pattern (Replacement patch) html
167+ else Tuple false html
168+
156patchDocs :: Aff Unit
169patchDocs :: Aff Unit
157patchDocs = do
170patchDocs = do
158 let dirname = "generated-docs/"
171 let dirname = "generated-docs/"
159− pattern = Pattern "</body>"
160− patch = "<!-- Docs search index. -->" <>
161− "<script type=\"text/javascript\" src=\"../docs-search-app.js\"></script>" <>
162− "<script type=\"text/javascript\">" <>
163− "window.DocsSearchTypeIndex = {};" <>
164− "window.DocsSearchIndex = {};" <>
165− "</script>" <>
166− "</body>"
167
172
168 files <- readdir (dirname <> "html")
173 files <- readdir (dirname <> "html")
169
174
@@ -172,9 +177,10 @@ patchDocs = do
172
177
173 whenM (fileExists path) do
178 whenM (fileExists path) do
174 contents <- readTextFile UTF8 path
179 contents <- readTextFile UTF8 path
175− when (not $ String.contains (String.Pattern patch) contents) do
180+ case patchHTML contents of
181+ Tuple true patchedContents -> do
176− writeTextFile UTF8 path $
182+ writeTextFile UTF8 path patchedContents
177− String.replace pattern (Replacement patch) contents
183+ _ -> pure unit
178
184
179createDirectories :: Aff Unit
185createDirectories :: Aff Unit
180createDirectories = do
186createDirectories = do
test/Main.purs+5−11
@@ -4,17 +4,18 @@ import Prelude
4
4
5import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..))
5import Docs.Search.TypeDecoder (Constraint(..), FunDep(..), FunDeps(..), Kind(..), QualifiedName(..), Type(..))
6import Test.TypeQuery as TypeQuery
6import Test.TypeQuery as TypeQuery
7+import Test.IndexBuilder as IndexBuilder
8+
9+import Test.Extra (assertRight)
7
10
8import Data.Argonaut.Decode (decodeJson)
11import Data.Argonaut.Decode (decodeJson)
9import Data.Argonaut.Encode (encodeJson)
12import Data.Argonaut.Encode (encodeJson)
10import Data.Argonaut.Parser (jsonParser)
13import Data.Argonaut.Parser (jsonParser)
11−import Data.Either (Either(..), fromRight)
14+import Data.Either (fromRight)
12import Data.Maybe (Maybe(..))
15import Data.Maybe (Maybe(..))
13import Effect (Effect)
16import Effect (Effect)
14−import Effect.Aff (Aff)
15import Partial.Unsafe (unsafePartial)
17import Partial.Unsafe (unsafePartial)
16import Test.Unit (TestSuite, suite, test)
18import Test.Unit (TestSuite, suite, test)
17−import Test.Unit.Assert as Assert
18import Test.Unit.Main (runTest)
19import Test.Unit.Main (runTest)
19
20
20main :: Effect Unit
21main :: Effect Unit
@@ -24,6 +25,7 @@ main = do
24mainTest :: TestSuite
25mainTest :: TestSuite
25mainTest = do
26mainTest = do
26 TypeQuery.tests
27 TypeQuery.tests
28+ IndexBuilder.tests
27
29
28 let mkJson x = unsafePartial $ fromRight $ jsonParser x
30 let mkJson x = unsafePartial $ fromRight $ jsonParser x
29 suite "FunDeps decoder" do
31 suite "FunDeps decoder" do
@@ -415,11 +417,3 @@ mainTest = do
415
417
416qualified :: Array String -> String -> QualifiedName
418qualified :: Array String -> String -> QualifiedName
417qualified moduleName name = QualifiedName { moduleName, name }
419qualified moduleName name = QualifiedName { moduleName, name }
418−
419−assertRight :: forall a. Show a => Eq a => Either String a -> a -> Aff Unit
420−assertRight eiActual expected =
421− case eiActual of
422− Left string -> do
423− Assert.equal (Right expected) eiActual
424− Right actual -> do
425− Assert.equal (Right expected) eiActual
test/Test/Extra.pursnew file+23
@@ -0,0 +1,23 @@
1+module Test.Extra where
2+
3+import Prelude
4+
5+import Data.Either (Either(..))
6+import Effect.Aff (Aff)
7+import Test.Unit.Assert as Assert
8+
9+assertRight
10+ :: forall a b
11+ . Show a
12+ => Show b
13+ => Eq a
14+ => Eq b
15+ => Either b a
16+ -> a
17+ -> Aff Unit
18+assertRight eiActual expected =
19+ case eiActual of
20+ Left string -> do
21+ Assert.equal (Right expected) eiActual
22+ Right actual -> do
23+ Assert.equal (Right expected) eiActual
test/Test/IndexBuilder.pursnew file+30
@@ -0,0 +1,30 @@
1+module Test.IndexBuilder where
2+
3+import Prelude
4+
5+import Test.Extra
6+
7+import Docs.Search.IndexBuilder
8+
9+import Data.Either (Either(..))
10+import Data.Foldable (class Foldable)
11+import Data.List (List(..), (:))
12+import Data.List as List
13+import Data.List.NonEmpty (NonEmptyList)
14+import Data.List.NonEmpty as NonEmptyList
15+import Data.Set as Set
16+import Data.Tuple (Tuple(..), snd)
17+import Effect.Aff (Aff)
18+import Test.Unit (TestSuite, suite, test)
19+import Test.Unit.Assert as Assert
20+
21+tests :: TestSuite
22+tests = do
23+ suite "IndexBuilder" do
24+ suite "patchHTML" do
25+ test "works" do
26+ let input = "</body>"
27+ Assert.assertFalse "patchHTML works" (snd (patchHTML input) == input)
28+ test "is idempotent" do
29+ let input = "</body>"
30+ Assert.equal (snd $ patchHTML $ snd $ patchHTML input) (snd $ patchHTML input)
test/Test/TypeQuery.purs+2−18
@@ -2,11 +2,12 @@ module Test.TypeQuery where
2
2
3import Prelude
3import Prelude
4
4
5+import Test.Extra (assertRight)
6+
5import Docs.Search.TypeQuery (Substitution(..), TypeQuery(..), getFreeVariables, parseTypeQuery, penalty, typeVarPenalty)
7import Docs.Search.TypeQuery (Substitution(..), TypeQuery(..), getFreeVariables, parseTypeQuery, penalty, typeVarPenalty)
6import Docs.Search.TypeShape (ShapeChunk(..), shapeOfTypeQuery)
8import Docs.Search.TypeShape (ShapeChunk(..), shapeOfTypeQuery)
7import Docs.Search.TypeDecoder (QualifiedName(..), Type(..))
9import Docs.Search.TypeDecoder (QualifiedName(..), Type(..))
8
10
9−import Data.Either (Either(..))
10import Data.Foldable (class Foldable)
11import Data.Foldable (class Foldable)
11import Data.List (List(..), (:))
12import Data.List (List(..), (:))
12import Data.List as List
13import Data.List as List
@@ -14,7 +15,6 @@ import Data.List.NonEmpty (NonEmptyList)
14import Data.List.NonEmpty as NonEmptyList
15import Data.List.NonEmpty as NonEmptyList
15import Data.Set as Set
16import Data.Set as Set
16import Data.Tuple (Tuple(..))
17import Data.Tuple (Tuple(..))
17−import Effect.Aff (Aff)
18import Test.Unit (TestSuite, suite, test)
18import Test.Unit (TestSuite, suite, test)
19import Test.Unit.Assert as Assert
19import Test.Unit.Assert as Assert
20
20
@@ -368,21 +368,5 @@ unitType = TypeConstructor (QualifiedName { moduleName: []
368 , name: "Unit"
368 , name: "Unit"
369 })
369 })
370
370
371−assertRight
372− :: forall a b
373− . Show a
374− => Show b
375− => Eq a
376− => Eq b
377− => Either b a
378− -> a
379− -> Aff Unit
380−assertRight eiActual expected =
381− case eiActual of
382− Left string -> do
383− Assert.equal (Right expected) eiActual
384− Right actual -> do
385− Assert.equal (Right expected) eiActual
386−
387countFreeVars :: TypeQuery -> Int
371countFreeVars :: TypeQuery -> Int
388countFreeVars = getFreeVariables >>> Set.size
372countFreeVars = getFreeVariables >>> Set.size