git.iko.soy/rowtype-yoga/purescript-docs-search
on master help sign in
improvements
c2c729cklntsky
src/Spago/Search/App.purs+31−27
compare with master
unifiedsplit
@@ -1,33 +1,27 @@
1module Spago.Search.App where
1module Spago.Search.App where
2
2
3−import Effect.Console
4import Prelude
3import Prelude
5
4
6−import Control.Promise (Promise, toAffE)
5+import Spago.Search.App.SearchField as SearchField
6+import Spago.Search.App.SearchResults as SearchResults
7+import Spago.Search.Extra (whenJust)
8+
9+import Control.Coroutine as Coroutine
7import Data.Maybe (Maybe(..))
10import Data.Maybe (Maybe(..))
8import Data.Newtype (wrap)
11import Data.Newtype (wrap)
9import Effect (Effect)
12import Effect (Effect)
10−import Effect.Aff (Aff, launchAff_)
13+import Halogen as H
11−import Effect.Class (liftEffect)
12import Halogen.Aff as HA
14import Halogen.Aff as HA
13import Halogen.VDom.Driver (runUI)
15import Halogen.VDom.Driver (runUI)
14−import Spago.Search.App.SearchField as SearchField
15−import Spago.Search.App.SearchResults as SearchResults
16−import Spago.Search.Declarations (Declarations)
17−import Spago.Search.Index (mkSearchIndex)
18−import Spago.Search.Extra
19−import Web.DOM as DOM
20import Web.DOM.Document as Document
16import Web.DOM.Document as Document
21import Web.DOM.Element as Element
17import Web.DOM.Element as Element
22−import Web.DOM.Text as Text
23import Web.DOM.Node as Node
18import Web.DOM.Node as Node
24import Web.DOM.ParentNode as ParentNode
19import Web.DOM.ParentNode as ParentNode
20+import Web.DOM.Text as Text
25import Web.HTML as HTML
21import Web.HTML as HTML
26import Web.HTML.HTMLDocument as HTMLDocument
22import Web.HTML.HTMLDocument as HTMLDocument
27−import Web.HTML.HTMLElement as HTMLElement
23+import Web.HTML.HTMLElement (fromElement)
28import Web.HTML.Window as Window
24import Web.HTML.Window as Window
29−import Control.Coroutine as Coroutine
30−import Halogen as H
31
25
32main :: Effect Unit
26main :: Effect Unit
33main = do
27main = do
@@ -35,12 +29,12 @@ main = do
35 doc <- HTMLDocument.toDocument <$> Window.document win
29 doc <- HTMLDocument.toDocument <$> Window.document win
36
30
37 insertStyle doc
31 insertStyle doc
38− mbContainer <- findContainer doc
32+ mbContainers <- getContainers doc
39
33
40− whenJust mbContainer \container -> do
34+ whenJust mbContainers \ { searchField, searchResults, pageContents } -> do
41 HA.runHalogenAff do
35 HA.runHalogenAff do
42− sfio <- runUI SearchField.component unit container
36+ sfio <- runUI SearchField.component unit searchField
43− srio <- runUI SearchResults.component unit container
37+ srio <- runUI (SearchResults.mkComponent pageContents) unit searchResults
44 sfio.subscribe $
38 sfio.subscribe $
45 Coroutine.consumer \message ->
39 Coroutine.consumer \message ->
46 srio.query $ H.tell $ SearchResults.SearchFieldMessage message
40 srio.query $ H.tell $ SearchResults.SearchFieldMessage message
@@ -62,13 +56,23 @@ insertStyle doc = do
62 void $ Node.appendChild (Text.toNode contents) (Element.toNode style)
56 void $ Node.appendChild (Text.toNode contents) (Element.toNode style)
63 void $ Node.appendChild (Element.toNode style) (Element.toNode head)
57 void $ Node.appendChild (Element.toNode style) (Element.toNode head)
64
58
65−findContainer :: Document.Document -> Effect (Maybe HTML.HTMLElement)
59+getContainers :: Document.Document -> Effect (Maybe { searchField :: HTML.HTMLElement
66−findContainer doc = do
60+ , searchResults :: HTML.HTMLElement
61+ , pageContents :: Element.Element })
62+getContainers doc = do
63+ let docPN = Document.toParentNode doc
67 mbBanner <-
64 mbBanner <-
68− ParentNode.querySelector (wrap ".top-banner > .container") (Document.toParentNode doc)
65+ ParentNode.querySelector (wrap ".top-banner > .container") docPN
66+ mbEverything <-
67+ ParentNode.querySelector (wrap ".everything-except-footer") docPN
68+ mbContainer <-
69+ ParentNode.querySelector (wrap ".everything-except-footer > .container") docPN
69− case mbBanner of
70+ case mbBanner, mbEverything, mbContainer of
70− Nothing -> pure Nothing
71+ Just banner, Just everything, Just pageContents -> do
71− Just banner -> do
72− container <- Document.createElement "div" doc
72+ search <- Document.createElement "div" doc
73− void $ Node.appendChild (Element.toNode container) (Element.toNode banner)
73+ void $ Node.appendChild (Element.toNode search) (Element.toNode banner)
74− pure $ HTMLElement.fromElement container
74+ pure $ fromElement search >>= \searchField ->
75+ fromElement everything >>= \searchResults ->
76+ pure { searchField, searchResults, pageContents }
77+ _, _, _ ->
78+ pure Nothing
src/Spago/Search/App/SearchResults.purs+107−44
@@ -2,66 +2,71 @@ module Spago.Search.App.SearchResults where
2
2
3import Prelude
3import Prelude
4
4
5−import Spago.Search.App.SearchField (Message(..))
5+import Spago.Search.Declarations (loadDeclarations)
6−import Spago.Search.Declarations
6+import Spago.Search.Extra (whenJust)
7−import Spago.Search.Index
7+import Spago.Search.Index (SearchIndex, SearchResult, mkSearchIndex)
8−import Spago.Search.Extra
9
8
10−import CSS hiding (render,map)
11import Data.Array as Array
9import Data.Array as Array
10+import Data.Either (Either(..))
12import Data.List as List
11import Data.List as List
13−import Data.Maybe
12+import Data.Maybe (Maybe(..), isNothing)
14−import Data.Newtype
13+import Data.Newtype (unwrap, wrap)
15import Data.Search.Trie as Trie
14import Data.Search.Trie as Trie
16−import Data.String (null) as String
15+import Data.String (length) as String
17import Data.String.CodeUnits (toCharArray) as String
16import Data.String.CodeUnits (toCharArray) as String
18import Data.String.Common (toLower) as String
17import Data.String.Common (toLower) as String
19−import Effect.Aff
18+import Effect.Aff (Aff)
20−import Effect.Console
19+import Effect.Console (error)
21import Halogen as H
20import Halogen as H
22import Halogen.HTML as HH
21import Halogen.HTML as HH
23−import Halogen.HTML.CSS as HS
24−import Halogen.HTML.Events as HE
25import Halogen.HTML.Properties as HP
22import Halogen.HTML.Properties as HP
23+import Spago.Search.App.SearchField (Message(..))
24+import Web.DOM.Element (Element)
25+import Web.DOM.Element as Element
26
26
27−type State = { shown :: Boolean
28− , mbIndex :: Maybe SearchIndex
27+type State = { mbIndex :: Maybe SearchIndex
29 , results :: Array SearchResult
28 , results :: Array SearchResult
30 , input :: String
29 , input :: String
30+ , contents :: Element
31 }
31 }
32
32
33data Query a
33data Query a
34 = SearchFieldMessage Message a
34 = SearchFieldMessage Message a
35
35
36−component :: forall i o. H.Component HH.HTML Query i o Aff
36+mkComponent :: forall i o. Element -> H.Component HH.HTML Query i o Aff
37−component =
37+mkComponent contents =
38 H.mkComponent
38 H.mkComponent
39 { initialState:
39 { initialState:
40− const { mbIndex: Nothing, results: [], shown: false, input: "" }
40+ const { mbIndex: Nothing, results: [], input: "", contents }
41 , render
41 , render
42 , eval: H.mkEval $ H.defaultEval { handleQuery = handleQuery }
42 , eval: H.mkEval $ H.defaultEval { handleQuery = handleQuery }
43 }
43 }
44
44
45handleQuery :: forall o a. Query a -> H.HalogenM State Unit () o Aff (Maybe a)
45handleQuery :: forall o a. Query a -> H.HalogenM State Unit () o Aff (Maybe a)
46handleQuery (SearchFieldMessage Focused next) = do
46handleQuery (SearchFieldMessage Focused next) = do
47− H.modify_ (_ { shown = true })
48 state <- H.get
47 state <- H.get
49 when (isNothing state.mbIndex) do
48 when (isNothing state.mbIndex) do
50− declarations <- H.liftAff $ loadDeclarations "../spago-search-index.js"
49+ eiDeclarations <- H.liftAff $ loadDeclarations "../spago-search-index.js"
50+ case eiDeclarations of
51+ Left err -> do
52+ H.liftEffect do
53+ error $ "spago-search: couldn't load search index: " <> err
54+ Right declarations -> do
51− H.modify_ (_ { mbIndex = Just $ mkSearchIndex declarations })
55+ H.modify_ (_ { mbIndex = Just $ mkSearchIndex declarations })
52 pure Nothing
56 pure Nothing
53handleQuery (SearchFieldMessage LostFocus next) = do
57handleQuery (SearchFieldMessage LostFocus next) = do
54 state <- H.get
58 state <- H.get
55 when (Array.null state.results) do
59 when (Array.null state.results) do
56− H.modify_ (_ { shown = false })
60+ showPageContents
57 pure Nothing
61 pure Nothing
58handleQuery (SearchFieldMessage (InputUpdated input) next) = do
62handleQuery (SearchFieldMessage (InputUpdated input) next) = do
59 H.modify_ (_ { input = input })
63 H.modify_ (_ { input = input })
60−
61− if String.null input
64+ if String.length input < 2
62 then do
65 then do
66+ showPageContents
63 H.modify_ (_ { results = [] })
67 H.modify_ (_ { results = [] })
64 else do
68 else do
69+ hidePageContents
65 state <- H.get
70 state <- H.get
66 whenJust (unwrap <$> state.mbIndex) \index -> do
71 whenJust (unwrap <$> state.mbIndex) \index -> do
67 let path = List.fromFoldable $
72 let path = List.fromFoldable $
@@ -76,33 +81,91 @@ handleQuery (SearchFieldMessage (InputUpdated input) next) = do
76
81
77 pure Nothing
82 pure Nothing
78
83
84+showPageContents :: forall o. H.HalogenM State Unit () o Aff Unit
85+showPageContents = do
86+ state <- H.get
87+ H.liftEffect do
88+ Element.removeAttribute "style" state.contents
89+
90+hidePageContents :: forall o. H.HalogenM State Unit () o Aff Unit
91+hidePageContents = do
92+ state <- H.get
93+ H.liftEffect do
94+ Element.setAttribute "style" "display: none" state.contents
95+
79render :: forall m. State -> H.ComponentHTML Unit () m
96render :: forall m. State -> H.ComponentHTML Unit () m
80−render { mbIndex: Nothing, shown: true } =
97+render { mbIndex: Nothing } =
81− renderSummary "Loading index..."
98+ HH.div_ []
82−render { mbIndex: Nothing, shown: false } =
99+render { input: "" } =
83 HH.div_ []
100 HH.div_ []
84−render state
101+render state =
85− | not state.shown || String.null state.input = HH.div_ []
102+ HH.div [ HP.classes [ wrap "container"
86− | otherwise =
103+ , wrap "clearfix"
87− HH.div
104+ ]
88− [ HS.style do
105+ ]
89− float floatLeft
106+ if Array.null state.results
107+ then
108+ [ renderSummary "No search results" ]
109+ else
110+ [ renderSummary $
111+ "Found " <>
112+ show (Array.length state.results) <>
113+ " definitions" ] <>
114+
115+ [ HH.div [ HP.id_ "spage-search-results-container" ] $
116+ Array.concat $
117+ state.results <#> renderResult
90 ]
118 ]
91− if Array.null state.results
92− then
93− [ renderSummary "No search results" ]
94− else
95− [ renderSummary $
96− "Found " <>
97− show (Array.length state.results) <>
98− " definitions" ] <>
99−
100− [ HH.div_ $ state.results <#> \result ->
101− HH.div_ [ HH.text (unwrap result).name ]
102− ]
103
119
104renderSummary :: forall a b. String -> HH.HTML b a
120renderSummary :: forall a b. String -> HH.HTML b a
105renderSummary text =
121renderSummary text =
106 HH.div [ HP.id_ "spago-search-summary" ]
122 HH.div [ HP.id_ "spago-search-summary" ]
107 [ HH.text text
123 [ HH.text text
108 ]
124 ]
125+
126+renderResult :: forall a b. SearchResult -> Array (HH.HTML a b)
127+renderResult = unwrap >>> \result ->
128+ [ HH.div [ HP.class_ (wrap "result") ]
129+ [ HH.h3 [ HP.class_ (wrap "result__title") ]
130+ [ HH.a [ HP.class_ (wrap "result__link") ]
131+ [ HH.text result.name ]
132+ ]
133+ ]
134+
135+ , HH.div [ HP.class_ (wrap "result__body") ] $
136+ [ HH.pre [ HP.class_ (wrap "result__signature") ]
137+ [ HH.code_ []
138+ ]
139+ ] <>
140+
141+ case result.comments of
142+ Just comments -> [ HH.pre_
143+ [ HH.text comments
144+ ]
145+ ]
146+ Nothing -> [ ]
147+
148+ , HH.div [ HP.class_ (wrap "result__actions") ]
149+ [ HH.span [ HP.class_ (wrap "result__actions__item") ]
150+ [ HH.span [ HP.classes [ wrap "badge"
151+ , wrap "badge--package"
152+ ]
153+ , HP.title "Package"
154+ ]
155+ [ HH.text "P"
156+ ]
157+ , HH.text result.packageName
158+ ]
159+
160+ , HH.span [ HP.class_ (wrap "result__actions__item") ]
161+ [ HH.span [ HP.classes [ wrap "badge"
162+ , wrap "badge--module"
163+ ]
164+ , HP.title "Module"
165+ ]
166+ [ HH.text "M"
167+ ]
168+ , HH.text result.moduleName
169+ ]
170+ ]
171+ ]
src/Spago/Search/Declarations.purs+18−8
@@ -2,17 +2,21 @@ module Spago.Search.Declarations where
2
2
3import Prelude
3import Prelude
4
4
5−import Effect
6−import Effect.Aff
7−import Control.Promise
5+import Control.Promise (Promise, toAffE)
6+import Data.Argonaut.Core (Json)
8−import Data.Argonaut.Decode (class DecodeJson, decodeJson)
7+import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:), (.:?))
9import Data.Argonaut.Encode (class EncodeJson, encodeJson)
8import Data.Argonaut.Encode (class EncodeJson, encodeJson)
9+import Data.Either (Either(..))
10import Data.Generic.Rep (class Generic)
10import Data.Generic.Rep (class Generic)
11import Data.Generic.Rep.Show (genericShow)
11import Data.Generic.Rep.Show (genericShow)
12+import Data.Maybe (Maybe)
12import Data.Newtype (class Newtype, unwrap)
13import Data.Newtype (class Newtype, unwrap)
14+import Effect (Effect)
15+import Effect.Aff (Aff)
13
16
14newtype IndexEntry
17newtype IndexEntry
15 = IndexEntry { title :: String
18 = IndexEntry { title :: String
19+ , comments :: Maybe String
16 , info :: { declType :: String
20 , info :: { declType :: String
17 }
21 }
18 , sourceSpan :: { start :: Array Int
22 , sourceSpan :: { start :: Array Int
@@ -29,7 +33,13 @@ instance showIndexEntry :: Show IndexEntry where
29 show = genericShow
33 show = genericShow
30
34
31instance decodeJsonIndexEntry :: DecodeJson IndexEntry where
35instance decodeJsonIndexEntry :: DecodeJson IndexEntry where
32− decodeJson json = IndexEntry <$> decodeJson json
36+ decodeJson json = IndexEntry <$> do
37+ handle <- decodeJson json
38+ title <- handle .: "title"
39+ comments <- handle .:? "comments"
40+ info <- handle .: "info"
41+ sourceSpan <- handle .: "sourceSpan"
42+ pure { title, comments, info, sourceSpan }
33
43
34instance encodeJsonIndexEntry :: EncodeJson IndexEntry where
44instance encodeJsonIndexEntry :: EncodeJson IndexEntry where
35 encodeJson = encodeJson <<< unwrap
45 encodeJson = encodeJson <<< unwrap
@@ -52,7 +62,7 @@ instance decodeJsonDeclarations :: DecodeJson Declarations where
52instance encodeJsonDeclarations :: EncodeJson Declarations where
62instance encodeJsonDeclarations :: EncodeJson Declarations where
53 encodeJson = encodeJson <<< unwrap
63 encodeJson = encodeJson <<< unwrap
54
64
55−loadDeclarations :: String -> Aff (Array Declarations)
65+loadDeclarations :: String -> Aff (Either String (Array Declarations))
56−loadDeclarations = toAffE <<< loadDeclarations_
66+loadDeclarations string = decodeJson <$> toAffE (loadDeclarations_ string)
57
67
58−foreign import loadDeclarations_ :: String -> Effect (Promise (Array Declarations))
68+foreign import loadDeclarations_ :: String -> Effect (Promise Json)
src/Spago/Search/Index.purs+44−9
@@ -5,9 +5,12 @@ import Prelude
5import Spago.Search.Declarations (Declarations(..), IndexEntry(..))
5import Spago.Search.Declarations (Declarations(..), IndexEntry(..))
6
6
7import Data.Foldable (foldr)
7import Data.Foldable (foldr)
8+import Data.Array ((!!))
8import Data.List (List)
9import Data.List (List)
9import Data.List as List
10import Data.List as List
10−import Data.Maybe (Maybe(..))
11+import Data.Maybe (Maybe(..), fromMaybe)
12+import Data.String.Common as String
13+import Data.String.Pattern (Pattern(..))
11import Data.Newtype (class Newtype)
14import Data.Newtype (class Newtype)
12import Data.Search.Trie (Trie, alter)
15import Data.Search.Trie (Trie, alter)
13import Data.String.CodeUnits (toCharArray)
16import Data.String.CodeUnits (toCharArray)
@@ -19,6 +22,14 @@ derive instance newtypeSearchIndex :: Newtype SearchIndex _
19
22
20newtype SearchResult
23newtype SearchResult
21 = SearchResult { name :: String
24 = SearchResult { name :: String
25+ , comments :: Maybe String
26+ , declType :: String
27+ , moduleName :: String
28+ , packageName :: String
29+ , sourceSpan :: { start :: Array Int
30+ , end :: Array Int
31+ , name :: String
32+ }
22 }
33 }
23
34
24derive instance newtypeSearchResult :: Newtype SearchResult _
35derive instance newtypeSearchResult :: Newtype SearchResult _
@@ -27,10 +38,11 @@ mkSearchIndex :: Array Declarations -> SearchIndex
27mkSearchIndex = SearchIndex <<< foldr insertDeclarations mempty
38mkSearchIndex = SearchIndex <<< foldr insertDeclarations mempty
28 where
39 where
29 insertDeclarations (Declarations { name, declarations }) trie
40 insertDeclarations (Declarations { name, declarations }) trie
30− = foldr insertIndexEntry trie declarations
41+ = foldr (insertIndexEntry name) trie declarations
31
42
32− insertIndexEntry entry@(IndexEntry { title }) trie
43+ insertIndexEntry moduleName entry@(IndexEntry { title }) trie
33− = foldr insertSearchResult trie (resultsForEntry entry)
44+ = foldr insertSearchResult trie
45+ (resultsForEntry moduleName entry)
34
46
35 insertSearchResult :: { path :: String
47 insertSearchResult :: { path :: String
36 , result :: SearchResult
48 , result :: SearchResult
@@ -46,12 +58,35 @@ mkSearchIndex = SearchIndex <<< foldr insertDeclarations mempty
46 Nothing ->
58 Nothing ->
47 Just $ List.singleton result
59 Just $ List.singleton result
48
60
49− resultsForEntry :: IndexEntry -> List { path :: String
61+ resultsForEntry
62+ :: String
63+ -> IndexEntry
64+ -> List { path :: String
50− , result :: SearchResult
65+ , result :: SearchResult
51− }
66+ }
52− resultsForEntry (IndexEntry { title })
67+ resultsForEntry moduleName (IndexEntry { title
68+ , comments
69+ , info
70+ , sourceSpan })
53 = List.fromFoldable
71 = List.fromFoldable
54 [ { path: title
72 [ { path: title
55− , result : SearchResult { name: title }
73+ , result: SearchResult { name: title
74+ , comments
75+ , declType: info.declType
76+ , moduleName
77+ , sourceSpan
78+ , packageName:
79+ extractPackageName sourceSpan
80+ }
56 }
81 }
57 ]
82 ]
83+
84+ extractPackageName { name } =
85+ let chunks = String.split (Pattern "/") name in
86+ fromMaybe "<unknown>" $
87+ chunks !! 0 >>= \dir ->
88+ -- TODO: is is safe to assume that directory name is ".spago"?
89+ if dir == ".spago" then
90+ chunks !! 1
91+ else
92+ Just "<local package>"
src/Spago/Search/IndexBuilder.purs+22−9
@@ -10,14 +10,14 @@ import Data.Argonaut.Decode (decodeJson)
10import Data.Argonaut.Encode (encodeJson)
10import Data.Argonaut.Encode (encodeJson)
11import Data.Argonaut.Parser (jsonParser)
11import Data.Argonaut.Parser (jsonParser)
12import Data.Array as Array
12import Data.Array as Array
13−import Data.Either (hush)
13+import Data.Either (hush, isLeft)
14import Data.Maybe (Maybe(..))
14import Data.Maybe (Maybe(..))
15import Data.Newtype (unwrap)
15import Data.Newtype (unwrap)
16import Data.Search.Trie as Trie
16import Data.Search.Trie as Trie
17−import Data.String.CodePoints as String
17+import Data.String.CodePoints (contains) as String
18−import Data.String.Common as String
18+import Data.String.Common (replace) as String
19import Data.String.Pattern (Pattern(..), Replacement(..))
19import Data.String.Pattern (Pattern(..), Replacement(..))
20−import Data.String.Pattern as String
20+import Data.String.Pattern (Pattern(..)) as String
21import Data.Traversable (for, for_)
21import Data.Traversable (for, for_)
22import Effect (Effect)
22import Effect (Effect)
23import Effect.Aff (Aff, launchAff_)
23import Effect.Aff (Aff, launchAff_)
@@ -28,15 +28,28 @@ import Node.FS.Aff (exists, readTextFile, readdir, writeTextFile)
28import Node.Process as Process
28import Node.Process as Process
29
29
30collectDeclarations :: Array String -> Aff (Array Declarations)
30collectDeclarations :: Array String -> Aff (Array Declarations)
31−collectDeclarations paths =
31+collectDeclarations paths = do
32− Array.catMaybes <$> for paths \path -> do
32+ mbs <- for paths \moduleName -> do
33− let jsonFile = "output/" <> path <> "/docs.json"
33+ let jsonFile = "output/" <> moduleName <> "/docs.json"
34 doesExist <- exists jsonFile
34 doesExist <- exists jsonFile
35+
35 if doesExist then do
36 if doesExist then do
36 contents <- readTextFile UTF8 jsonFile
37 contents <- readTextFile UTF8 jsonFile
37− pure $ hush $ jsonParser contents >>= decodeJson
38+ let mbResult = jsonParser contents >>= decodeJson
39+
40+ when (isLeft mbResult) do
41+ liftEffect $ log $
42+ "Index build failed for module " <>
43+ moduleName <>
44+ ": " <> show mbResult
45+
46+ pure $ hush mbResult
38− else
47+ else do
48+ liftEffect $ do
49+ log $
50+ "Couldn't find docs.json for " <> moduleName
39 pure Nothing
51 pure Nothing
52+ pure $ Array.catMaybes mbs
40
53
41writeDeclarations :: Array Declarations -> Aff Unit
54writeDeclarations :: Array Declarations -> Aff Unit
42writeDeclarations decls = do
55writeDeclarations decls = do