├── .gitignore ├── README.md ├── src ├── scripts │ ├── Blacklist.elm │ ├── Utils │ │ ├── Markdown.elm │ │ └── Code.elm │ ├── Docs │ │ ├── Package │ │ │ └── Cache.elm │ │ ├── Name.elm │ │ ├── Package.elm │ │ └── Type.elm │ ├── index.js │ ├── Search │ │ ├── Update.elm │ │ ├── Chunk.elm │ │ ├── Model.elm │ │ ├── Distance.elm │ │ └── View.elm │ ├── Generate.elm │ ├── Setup.elm │ ├── Logo.elm │ └── Web.elm ├── html │ └── index.html └── styles │ └── search.css ├── package.json ├── elm.json ├── .github └── workflows │ └── ci.yml └── Makefile /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | /bin/* 3 | node_modules/ 4 | npm-debug.log 5 | dist/ 6 | cache/ 7 | .DS_Store 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Elm-search 2 | 3 | Elm-search is a search engine for all exposed values in the latest versions of all published packages at . One can either search by name or by approximate type annotation. 4 | 5 | **Proper installation instructions, documentation and plans for contributions are coming soon.** 6 | -------------------------------------------------------------------------------- /src/scripts/Blacklist.elm: -------------------------------------------------------------------------------- 1 | module Blacklist exposing (contains, length) 2 | 3 | 4 | length : Int 5 | length = 6 | 2 7 | 8 | 9 | contains : { a | user : String, name : String } -> Bool 10 | contains { user, name } = 11 | (user == "turboMack" && name == "tea-component") 12 | || (user == "christophp" && name == "elm-i18next") 13 | -------------------------------------------------------------------------------- /src/scripts/Utils/Markdown.elm: -------------------------------------------------------------------------------- 1 | module Utils.Markdown exposing (block) 2 | 3 | -- where 4 | 5 | import Html 6 | import Markdown 7 | 8 | 9 | block : String -> Html.Html msg 10 | block raw = 11 | Markdown.toHtmlWith myOptions [] raw 12 | 13 | 14 | myOptions : Markdown.Options 15 | myOptions = 16 | let 17 | options = 18 | Markdown.defaultOptions 19 | in 20 | { options | defaultHighlighting = Just "elm" } 21 | -------------------------------------------------------------------------------- /src/scripts/Docs/Package/Cache.elm: -------------------------------------------------------------------------------- 1 | port module Docs.Package.Cache exposing (check, onMissing, put) 2 | 3 | import Docs.Package as Package 4 | 5 | 6 | check : String -> Package.Metadata -> Cmd msg 7 | check moduleName package = 8 | lookup { moduleName = moduleName, metadata = package } 9 | 10 | 11 | port lookup : { moduleName : String, metadata : Package.Metadata } -> Cmd msg 12 | 13 | 14 | port put : { moduleName : String, code : String } -> Cmd msg 15 | 16 | 17 | port onMissing : (Package.Metadata -> msg) -> Sub msg 18 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "elm-search", 3 | "version": "1.0.0", 4 | "description": "an API search engine for all published Elm packages", 5 | "repository": { 6 | "type": "git", 7 | "url": "git+https://github.com/klaftertief/elm-search.git" 8 | }, 9 | "author": "", 10 | "license": "BSD-3-Clause", 11 | "bugs": { 12 | "url": "https://github.com/klaftertief/elm-search/issues" 13 | }, 14 | "homepage": "https://github.com/klaftertief/elm-search#readme", 15 | "devDependencies": { 16 | "elm": "^0.19.1-6", 17 | "elm-format": "^0.8.7", 18 | "xhr2": "^0.2.1" 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /src/scripts/Utils/Code.elm: -------------------------------------------------------------------------------- 1 | module Utils.Code exposing (addParens, arrow, colon, equals, keyword, padded, space) 2 | 3 | -- where 4 | 5 | import Html exposing (..) 6 | import Html.Attributes exposing (..) 7 | 8 | 9 | keyword : String -> Html msg 10 | keyword kw = 11 | span [ class "hljs-keyword" ] [ text kw ] 12 | 13 | 14 | addParens : List (Html msg) -> List (Html msg) 15 | addParens list = 16 | text "(" :: list ++ [ text ")" ] 17 | 18 | 19 | space : Html msg 20 | space = 21 | text " " 22 | 23 | 24 | padded : Html msg -> List (Html msg) 25 | padded html = 26 | [ space, html, space ] 27 | 28 | 29 | arrow : Html msg 30 | arrow = 31 | span [] [ text "->" ] 32 | 33 | 34 | colon : Html msg 35 | colon = 36 | span [] [ text ":" ] 37 | 38 | 39 | equals : Html msg 40 | equals = 41 | span [] [ text "=" ] 42 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src/scripts", 5 | "cache", 6 | "elm-stuff/generated-code/klaftertief/elm-search" 7 | ], 8 | "elm-version": "0.19.1", 9 | "dependencies": { 10 | "direct": { 11 | "elm/browser": "1.0.1", 12 | "elm/core": "1.0.0", 13 | "elm/html": "1.0.0", 14 | "elm/http": "1.0.0", 15 | "elm/json": "1.0.0", 16 | "elm/project-metadata-utils": "1.0.0", 17 | "elm/svg": "1.0.1", 18 | "elm/url": "1.0.0", 19 | "elm-community/list-extra": "8.1.0", 20 | "elm-explorations/markdown": "1.0.0" 21 | }, 22 | "indirect": { 23 | "elm/parser": "1.1.0", 24 | "elm/time": "1.0.0", 25 | "elm/virtual-dom": "1.0.2" 26 | } 27 | }, 28 | "test-dependencies": { 29 | "direct": {}, 30 | "indirect": {} 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /src/scripts/index.js: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env node 2 | 3 | if (process.argv.length !== 5) 4 | throw new Error("USAGE: ./index.js COMPILED_SETUP_APP CACHE_DIR OUTPUT_APP"); 5 | 6 | const [, , compiledSetupApp, cacheDirectory, outputApp] = process.argv; 7 | 8 | XMLHttpRequest = require("xhr2"); 9 | const fs = require("fs"); 10 | const path = require("path"); 11 | const compiledElm = path.relative(__dirname, compiledSetupApp); 12 | const app = require(compiledElm).Elm.Setup.init(); 13 | 14 | function pathInCache(moduleName) { 15 | return path.join(cacheDirectory, moduleName + ".elm"); 16 | } 17 | 18 | function createFile(filePath, data) { 19 | fs.writeFile(filePath, data, "utf8", err => { 20 | if (err) throw new Error(err); 21 | else console.log(`>> created ${filePath}`); 22 | }); 23 | } 24 | 25 | app.ports.lookup.subscribe(msg => { 26 | fs.access(pathInCache(msg.moduleName), err => { 27 | if (err) app.ports.onMissing.send(msg.metadata); 28 | }); 29 | }); 30 | 31 | app.ports.put.subscribe(msg => { 32 | createFile(pathInCache(msg.moduleName), msg.code); 33 | }); 34 | 35 | app.ports.writeOutput.subscribe(code => createFile(outputApp, code)); 36 | -------------------------------------------------------------------------------- /src/scripts/Docs/Name.elm: -------------------------------------------------------------------------------- 1 | module Docs.Name exposing (Name, decoder, fromString, pathTo) 2 | 3 | import Json.Decode as Decode 4 | 5 | 6 | type alias Name = 7 | { name : String 8 | , home : String 9 | } 10 | 11 | 12 | decoder : Decode.Decoder Name 13 | decoder = 14 | Decode.string 15 | |> Decode.andThen (fromString >> parseToDecoder) 16 | 17 | 18 | fromString : String -> Maybe Name 19 | fromString str = 20 | case List.reverse (String.split "." str) of 21 | name :: homeSegements -> 22 | List.reverse homeSegements 23 | |> String.join "." 24 | |> Name name 25 | |> Just 26 | 27 | _ -> 28 | Nothing 29 | 30 | 31 | parseToDecoder : Maybe Name -> Decode.Decoder Name 32 | parseToDecoder = 33 | let 34 | errorMessage = 35 | "names look like `maybe_nested.module.name`" 36 | in 37 | Maybe.map Decode.succeed 38 | >> Maybe.withDefault (Decode.fail errorMessage) 39 | 40 | 41 | pathTo : Name -> String 42 | pathTo { home, name } = 43 | String.map dotToDash home ++ "#" ++ name 44 | 45 | 46 | dotToDash : Char -> Char 47 | dotToDash char = 48 | if char == '.' then 49 | '-' 50 | 51 | else 52 | char 53 | -------------------------------------------------------------------------------- /src/html/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Elm Search - 0.19.1 6 | 7 | 8 | 10 | 11 | 12 | 13 | 14 |
15 | 19 | 20 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | schedule: 5 | - cron: "0 0 * * *" 6 | push: 7 | branches: 8 | - "develop" 9 | workflow_dispatch: 10 | 11 | concurrency: 12 | group: "pages" 13 | cancel-in-progress: false 14 | 15 | jobs: 16 | build: 17 | runs-on: ubuntu-latest 18 | steps: 19 | - uses: actions/checkout@v4 20 | - uses: actions/setup-node@v4 21 | with: 22 | node-version: 18 23 | cache: "npm" 24 | - name: Cache generated Elm modules 25 | uses: actions/cache@v3 26 | with: 27 | path: cache 28 | key: ${{ runner.os }}-elm-modules 29 | - run: make install 30 | - run: make clean setup build 31 | - name: Setup Pages 32 | uses: actions/configure-pages@v3 33 | - name: Upload artifact 34 | uses: actions/upload-pages-artifact@v2 35 | with: 36 | path: "dist" 37 | name: "github-pages" 38 | deploy: 39 | needs: build 40 | permissions: 41 | contents: read 42 | pages: write 43 | id-token: write 44 | environment: 45 | name: github-pages 46 | url: ${{ steps.deployment.outputs.page_url }} 47 | runs-on: ubuntu-latest 48 | steps: 49 | - name: Deploy to GitHub Pages 50 | id: deployment 51 | uses: actions/deploy-pages@v2 52 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | SHELL := /bin/bash 2 | 3 | .PHONY: install server watch clean help setup build publish 4 | 5 | ELM_TMP_DIR := elm-stuff/generated-code/klaftertief/elm-search 6 | ELM_SETUP := src/scripts/Setup.elm 7 | ELM_SETUP_COMPILED := $(ELM_TMP_DIR)/setup.js 8 | ELM_MAIN := $(ELM_TMP_DIR)/Main.elm 9 | ELM_FILES = $(shell find src -type f -name '*.elm') 10 | 11 | BUILD_DIR := dist 12 | CACHE_DIR := cache 13 | COMPILE_TARGETS := scripts styles html 14 | 15 | help: ## Prints a help guide 16 | @echo "Available tasks:" 17 | @grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' 18 | 19 | setup: ## Downloads docs files 20 | mkdir -p $(ELM_TMP_DIR) 21 | mkdir -p $(CACHE_DIR) 22 | node_modules/.bin/elm make $(ELM_SETUP) --output $(ELM_SETUP_COMPILED) 23 | src/scripts/index.js $(ELM_SETUP_COMPILED) $(CACHE_DIR) $(ELM_MAIN) 24 | 25 | build: $(COMPILE_TARGETS) ## Compiles project files 26 | 27 | install: ## Installs dependencies 28 | npm install 29 | 30 | clean: ## Removes compiled files 31 | rm -rf $(BUILD_DIR)/* 32 | 33 | styles: 34 | mkdir -p $(BUILD_DIR)/styles 35 | cp src/styles/search.css $(BUILD_DIR)/styles 36 | 37 | scripts: $(ELM_FILES) 38 | node_modules/.bin/elm make $(ELM_MAIN) --optimize --output $(BUILD_DIR)/scripts/search.js 39 | 40 | html: 41 | mkdir -p $(BUILD_DIR) 42 | cp -r src/html/* $(BUILD_DIR) 43 | -------------------------------------------------------------------------------- /src/scripts/Search/Update.elm: -------------------------------------------------------------------------------- 1 | module Search.Update exposing (init, update) 2 | 3 | import Docs.Package as Package exposing (Package) 4 | import Search.Model as Model exposing (..) 5 | 6 | 7 | init : Filter -> List Package -> Model 8 | init filter packages = 9 | let 10 | model = 11 | update (BuildIndex packages) { initialModel | filter = filter } 12 | 13 | _ = 14 | List.length model.index.chunks 15 | in 16 | case filter.query of 17 | [ query ] -> 18 | update RunFilter model 19 | 20 | _ -> 21 | model 22 | 23 | 24 | update : Msg -> Model -> Model 25 | update msg model = 26 | case msg of 27 | BuildIndex packages -> 28 | { model | index = buildIndex packages } 29 | 30 | SetFilter filter -> 31 | { model | filter = filter } 32 | 33 | SetFilterQueryString queryString -> 34 | let 35 | filterFacts = 36 | model.filter 37 | 38 | filter = 39 | { filterFacts 40 | | queryString = queryString 41 | , query = queryListFromString queryString 42 | } 43 | in 44 | { model 45 | | filter = filter 46 | } 47 | 48 | SetFilterQueryStringAndRunFilter queryString -> 49 | update (SetFilterQueryString queryString) model 50 | |> update RunFilter 51 | 52 | RunFilter -> 53 | let 54 | newFilter filter = 55 | { filter | lastQuery = model.filter.queryString } 56 | in 57 | { model 58 | | result = runFilter model.filter model.index 59 | , filter = newFilter model.filter 60 | } 61 | -------------------------------------------------------------------------------- /src/scripts/Docs/Package.elm: -------------------------------------------------------------------------------- 1 | module Docs.Package exposing 2 | ( Entry 3 | , Metadata 4 | , Module 5 | , Package 6 | , decode 7 | , identifier 8 | , metadataToString 9 | , remoteMetadataDecoder 10 | ) 11 | 12 | import Docs.Type exposing (Type) 13 | import Elm.Docs as ElmDocs 14 | import Json.Decode as Decode exposing (Decoder) 15 | 16 | 17 | type alias Package = 18 | { metadata : Metadata 19 | , modules : List Module 20 | } 21 | 22 | 23 | type alias Metadata = 24 | { user : String 25 | , name : String 26 | , version : String 27 | } 28 | 29 | 30 | metadataToString : Metadata -> String 31 | metadataToString metadata = 32 | "{ user = \"" 33 | ++ metadata.user 34 | ++ "\", name = \"" 35 | ++ metadata.name 36 | ++ "\", version = \"" 37 | ++ metadata.version 38 | ++ "\"}" 39 | 40 | 41 | type alias Module = 42 | { name : String 43 | , entries : List Entry 44 | , elmVersion : Maybe String 45 | } 46 | 47 | 48 | type alias Entry = 49 | { name : String 50 | , docs : String 51 | , tipe : Type 52 | } 53 | 54 | 55 | identifier : Metadata -> String 56 | identifier { user, name, version } = 57 | user ++ "/" ++ name ++ "/" ++ version 58 | 59 | 60 | decode : String -> Metadata -> Decode.Decoder Package 61 | decode elmVersion metadata = 62 | ElmDocs.decoder 63 | |> Decode.map (elmDocsToModule elmVersion) 64 | |> Decode.list 65 | |> Decode.map (Package metadata) 66 | 67 | 68 | remoteMetadataDecoder : Decode.Decoder Metadata 69 | remoteMetadataDecoder = 70 | Decode.map2 (\a b -> ( a, b )) 71 | (Decode.field "name" Decode.string) 72 | (Decode.field "version" Decode.string) 73 | |> Decode.andThen remoteMetadataHelp 74 | 75 | 76 | remoteMetadataHelp : ( String, String ) -> Decode.Decoder Metadata 77 | remoteMetadataHelp ( fullName, version ) = 78 | case String.split "/" fullName of 79 | [ user, name ] -> 80 | Decode.succeed <| Metadata user name version 81 | 82 | _ -> 83 | Decode.fail "package names must look like `user/project`" 84 | 85 | 86 | elmDocsToModule : String -> ElmDocs.Module -> Module 87 | elmDocsToModule elmVersion { name, values } = 88 | Module name (List.map elmValueToEntry values) (Just elmVersion) 89 | 90 | 91 | elmValueToEntry : ElmDocs.Value -> Entry 92 | elmValueToEntry { name, tipe, comment } = 93 | Entry name comment (Docs.Type.toInternal tipe) 94 | -------------------------------------------------------------------------------- /src/scripts/Search/Chunk.elm: -------------------------------------------------------------------------------- 1 | module Search.Chunk exposing (Chunk, Context, dotToDash, identifierHome, packageChunks, pathToModule, pathToPackage, pathToValue, rootUrl, toChunk) 2 | 3 | import Docs.Package exposing (Entry, Package) 4 | import Docs.Type as Type exposing (Type) 5 | import String 6 | 7 | 8 | type alias Chunk = 9 | { context : Context 10 | , tipe : Type 11 | , tipeNormalized : Type 12 | , docs : Maybe String 13 | , elmVersion : Maybe String 14 | } 15 | 16 | 17 | type alias Context = 18 | { userName : String 19 | , packageName : String 20 | , packageVersion : String 21 | , moduleName : String 22 | , name : String 23 | } 24 | 25 | 26 | packageChunks : Package -> List Chunk 27 | packageChunks package = 28 | package.modules 29 | |> List.concatMap 30 | (\{ name, elmVersion, entries } -> 31 | List.map (\c -> ( name, elmVersion, c )) entries 32 | ) 33 | |> List.map 34 | (\( name, maybeVersion, entry ) -> 35 | toChunk package name maybeVersion entry 36 | ) 37 | 38 | 39 | toChunk : Package -> String -> Maybe String -> Entry -> Chunk 40 | toChunk package moduleName elmVersion { name, docs, tipe } = 41 | { context = Context package.metadata.user package.metadata.name package.metadata.version moduleName name 42 | , tipe = tipe 43 | , tipeNormalized = Type.normalize tipe 44 | , docs = List.head (docs |> String.trim |> String.split "\n\n" |> List.filter (not << String.isEmpty)) 45 | , elmVersion = elmVersion 46 | } 47 | 48 | 49 | identifierHome : Context -> String 50 | identifierHome { userName, packageName, packageVersion } = 51 | [ userName, packageName, packageVersion ] 52 | |> String.join "/" 53 | 54 | 55 | rootUrl : String 56 | rootUrl = 57 | "http://package.elm-lang.org" 58 | 59 | 60 | pathToPackage : Context -> String 61 | pathToPackage { userName, packageName, packageVersion } = 62 | [ rootUrl, "packages", userName, packageName, packageVersion ] 63 | |> String.join "/" 64 | 65 | 66 | pathToModule : Context -> String 67 | pathToModule ({ moduleName } as context) = 68 | [ pathToPackage context 69 | , String.map dotToDash moduleName 70 | ] 71 | |> String.join "/" 72 | 73 | 74 | pathToValue : Context -> String 75 | pathToValue ({ name } as context) = 76 | [ pathToModule context, name ] 77 | |> String.join "#" 78 | 79 | 80 | dotToDash : Char -> Char 81 | dotToDash char = 82 | if char == '.' then 83 | '-' 84 | 85 | else 86 | char 87 | -------------------------------------------------------------------------------- /src/scripts/Generate.elm: -------------------------------------------------------------------------------- 1 | module Generate exposing (lowerName, main_, package) 2 | 3 | import Docs.Package as Package 4 | 5 | 6 | main_ : List String -> String 7 | main_ moduleNames = 8 | String.join "\n" <| 9 | "module Main exposing (..)" 10 | :: List.map (\name -> "import " ++ name) moduleNames 11 | ++ [ "import Web" 12 | , "main = Web.program " 13 | ++ list (\name -> name ++ ".package") moduleNames 14 | ] 15 | 16 | 17 | package : String -> Package.Package -> String 18 | package moduleName { metadata, modules } = 19 | let 20 | { defs, inline } = 21 | fromPackage metadata modules 22 | in 23 | String.join "\n" <| 24 | [ "module " ++ moduleName ++ " exposing(package)" 25 | , "import Docs.Type exposing(..)" 26 | , "package = " ++ inline 27 | ] 28 | ++ List.map assignment defs 29 | 30 | 31 | fromPackage : 32 | Package.Metadata 33 | -> List Package.Module 34 | -> { defs : List ( String, String ), inline : String } 35 | fromPackage metadata modules = 36 | let 37 | moduleDefs = 38 | List.map fromModule modules 39 | in 40 | { defs = 41 | List.map .def moduleDefs 42 | , inline = 43 | record 44 | [ ( "metadata", Package.metadataToString metadata ) 45 | , ( "modules", list .inline moduleDefs ) 46 | ] 47 | } 48 | 49 | 50 | fromModule : Package.Module -> { def : ( String, String ), inline : String } 51 | fromModule { name, elmVersion, entries } = 52 | let 53 | entryListDefName = 54 | "v_" ++ lowerName name 55 | 56 | entriesWithFirstDocParagraph = 57 | List.map 58 | (\entry -> 59 | { entry 60 | | docs = 61 | entry.docs 62 | |> String.split "\n\n" 63 | |> List.head 64 | |> Maybe.withDefault "" 65 | } 66 | ) 67 | entries 68 | in 69 | { def = 70 | ( entryListDefName, list Debug.toString entriesWithFirstDocParagraph ) 71 | , inline = 72 | record 73 | [ ( "name", "\"" ++ name ++ "\"" ) 74 | , ( "elmVersion", Debug.toString elmVersion ) 75 | , ( "entries", entryListDefName ) 76 | ] 77 | } 78 | 79 | 80 | list : (a -> String) -> List a -> String 81 | list f values = 82 | "[" ++ String.join "\n , " (List.map f values) ++ "\n ]" 83 | 84 | 85 | record : List ( String, String ) -> String 86 | record fields = 87 | "{ " 88 | ++ String.join "\n , " (List.map assignment fields) 89 | ++ "\n }" 90 | 91 | 92 | assignment : ( String, String ) -> String 93 | assignment ( left, right ) = 94 | left ++ " = " ++ right 95 | 96 | 97 | lowerName : String -> String 98 | lowerName = 99 | String.map replaceUnsafe >> String.toLower 100 | 101 | 102 | replaceUnsafe : Char -> Char 103 | replaceUnsafe char = 104 | if char == '-' || char == '.' then 105 | '_' 106 | 107 | else 108 | char 109 | -------------------------------------------------------------------------------- /src/scripts/Setup.elm: -------------------------------------------------------------------------------- 1 | port module Setup exposing (main) 2 | 3 | import Blacklist 4 | import Docs.Package as Package 5 | import Docs.Package.Cache as Cache 6 | import Generate 7 | import Http 8 | import Json.Decode as Decode 9 | import Process 10 | import Set 11 | import Task 12 | 13 | 14 | type alias Model = 15 | { elmVersion : String 16 | } 17 | 18 | 19 | type Msg 20 | = All (List Package.Metadata) 21 | | CacheCheck String Package.Metadata 22 | | CacheMiss Package.Metadata 23 | | Response Package.Package 24 | 25 | 26 | main : Program () Model Msg 27 | main = 28 | Platform.worker 29 | { init = init 30 | , update = update 31 | , subscriptions = subscriptions 32 | } 33 | 34 | 35 | init : () -> ( Model, Cmd Msg ) 36 | init _ = 37 | let 38 | elmVersion = 39 | "0.19.1" 40 | 41 | getAllPackages = 42 | Http.get "https://package.elm-lang.org/search.json" 43 | (Decode.list Package.remoteMetadataDecoder) 44 | in 45 | ( Model elmVersion 46 | , getAllPackages 47 | |> Http.send (ensureOk All) 48 | ) 49 | 50 | 51 | update : Msg -> Model -> ( Model, Cmd Msg ) 52 | update msg model = 53 | case msg of 54 | All partials -> 55 | ( model, planFileWrites partials ) 56 | 57 | CacheCheck moduleName metadata -> 58 | ( model, Cache.check moduleName metadata ) 59 | 60 | CacheMiss metadata -> 61 | ( model, fetchDocs model.elmVersion metadata ) 62 | 63 | Response package -> 64 | ( model, cacheModule package ) 65 | 66 | 67 | 68 | -- COMMANDS 69 | 70 | 71 | planFileWrites : List Package.Metadata -> Cmd Msg 72 | planFileWrites partials = 73 | let 74 | moduleNames = 75 | List.map safeModuleName partials 76 | 77 | cacheChecks = 78 | List.map2 CacheCheck moduleNames partials 79 | |> List.indexedMap (\i msg -> delay (toFloat i * 10) msg) 80 | in 81 | writeOutput (Generate.main_ moduleNames) 82 | :: cacheChecks 83 | |> Cmd.batch 84 | 85 | 86 | delay : Float -> msg -> Cmd msg 87 | delay time msg = 88 | Task.perform (always msg) (Process.sleep time) 89 | 90 | 91 | fetchDocs : String -> Package.Metadata -> Cmd Msg 92 | fetchDocs elmVersion metadata = 93 | if Blacklist.contains metadata then 94 | Cmd.none 95 | 96 | else 97 | let 98 | url = 99 | String.join "/" 100 | [ "https://package.elm-lang.org/packages" 101 | , Package.identifier metadata 102 | , "docs.json" 103 | ] 104 | 105 | decoder = 106 | Package.decode elmVersion metadata 107 | in 108 | Http.get url decoder 109 | |> Http.send (ensureOk Response) 110 | 111 | 112 | cacheModule : Package.Package -> Cmd msg 113 | cacheModule package = 114 | let 115 | name = 116 | safeModuleName package.metadata 117 | in 118 | Cache.put 119 | { moduleName = name 120 | , code = Generate.package name package 121 | } 122 | 123 | 124 | safeModuleName : Package.Metadata -> String 125 | safeModuleName { user, name, version } = 126 | "M_" ++ Generate.lowerName (user ++ "__" ++ name ++ "__" ++ version) 127 | 128 | 129 | replaceUnsafe : Char -> Char 130 | replaceUnsafe char = 131 | if char == '-' || char == '.' then 132 | '_' 133 | 134 | else 135 | char 136 | 137 | 138 | ensureOk : (a -> b) -> Result x a -> b 139 | ensureOk func result = 140 | case result of 141 | Ok value -> 142 | func value 143 | 144 | Err e -> 145 | Debug.todo (Debug.toString e) 146 | 147 | 148 | subscriptions : Model -> Sub Msg 149 | subscriptions model = 150 | Cache.onMissing CacheMiss 151 | 152 | 153 | 154 | -- PORT 155 | 156 | 157 | port writeOutput : String -> Cmd msg 158 | -------------------------------------------------------------------------------- /src/scripts/Logo.elm: -------------------------------------------------------------------------------- 1 | module Logo exposing (view, viewWithSize) 2 | 3 | -- where 4 | 5 | import Svg exposing (..) 6 | import Svg.Attributes exposing (..) 7 | 8 | 9 | view : Svg msg 10 | view = 11 | viewWithSize 128 12 | 13 | 14 | viewWithSize : Int -> Svg msg 15 | viewWithSize s = 16 | let 17 | size = 18 | String.fromInt s 19 | in 20 | svg 21 | [ width size 22 | , height size 23 | , viewBox "2 2 132 132" 24 | , Svg.Attributes.style "overflow: visible;" 25 | ] 26 | [ g 27 | [ stroke "#fff" 28 | , strokeWidth "2" 29 | , strokeLinejoin "round" 30 | 31 | --, transform "rotate(90 64 64)" 32 | ] 33 | parts 34 | ] 35 | 36 | 37 | parts : List (Svg msg) 38 | parts = 39 | [ largeBlueTriangle (Transformation (3 * quarterHypothenuse - 128) (3 * quarterHypothenuse) -90) 40 | , largeGreyTriangle (Transformation 0 0 0) 41 | , mediumBlueTriangle (Transformation quarterHypothenuse quarterHypothenuse -135) 42 | , smallOrangeTriangle (Transformation halfHypothenuse quarterHypothenuse -45) 43 | , smallOrangeTriangle (Transformation halfHypothenuse 0 45) 44 | , greenSquare (Transformation halfHypothenuse quarterHypothenuse -45) 45 | , greenDiamond (Transformation halfHypothenuse quarterHypothenuse 45) False 46 | ] 47 | 48 | 49 | halfHypothenuse : Float 50 | halfHypothenuse = 51 | 128 / sqrt 2 52 | 53 | 54 | quarterHypothenuse : Float 55 | quarterHypothenuse = 56 | 128 / 2 / sqrt 2 57 | 58 | 59 | orange : String 60 | orange = 61 | "#F0AD00" 62 | 63 | 64 | blue : String 65 | blue = 66 | "#60B5CC" 67 | 68 | 69 | green : String 70 | green = 71 | "#7FD13B" 72 | 73 | 74 | grey : String 75 | grey = 76 | "#5A6378" 77 | 78 | 79 | type alias Transformation = 80 | { movementX : Float 81 | , movementY : Float 82 | , rotation : Float 83 | } 84 | 85 | 86 | toTransform : Transformation -> String 87 | toTransform { movementX, movementY, rotation } = 88 | "translate(" 89 | ++ String.fromFloat movementX 90 | ++ " " 91 | ++ String.fromFloat movementY 92 | ++ ") rotate(" 93 | ++ String.fromFloat rotation 94 | ++ ")" 95 | 96 | 97 | largeBlueTriangle : Transformation -> Svg msg 98 | largeBlueTriangle transformation = 99 | polygon 100 | [ points "0,0 0,128 64,64" 101 | , fill blue 102 | , transform (toTransform transformation) 103 | ] 104 | [] 105 | 106 | 107 | largeGreyTriangle : Transformation -> Svg msg 108 | largeGreyTriangle transformation = 109 | polygon 110 | [ points "0,0 0,128 64,64" 111 | , fill grey 112 | , transform (toTransform transformation) 113 | ] 114 | [] 115 | 116 | 117 | mediumBlueTriangle : Transformation -> Svg msg 118 | mediumBlueTriangle transformation = 119 | polygon 120 | [ points "0,0 0,64 64,0" 121 | , fill blue 122 | , transform (toTransform transformation) 123 | ] 124 | [] 125 | 126 | 127 | smallOrangeTriangle : Transformation -> Svg msg 128 | smallOrangeTriangle transformation = 129 | polygon 130 | [ points "0,0 0,64 32,32" 131 | , fill orange 132 | , transform (toTransform transformation) 133 | ] 134 | [] 135 | 136 | 137 | greenSquare : Transformation -> Svg msg 138 | greenSquare transformation = 139 | polygon 140 | [ points "0,0 32,-32 64,0 32,32" 141 | , fill green 142 | , transform (toTransform transformation) 143 | ] 144 | [] 145 | 146 | 147 | greenDiamond : Transformation -> Bool -> Svg msg 148 | greenDiamond transformation flip = 149 | polygon 150 | [ points "0,0 64,0 96,32 32,32" 151 | , fill green 152 | , transform <| 153 | toTransform transformation 154 | ++ (if flip then 155 | " scale(1 -1)" 156 | 157 | else 158 | "" 159 | ) 160 | ] 161 | [] 162 | -------------------------------------------------------------------------------- /src/scripts/Web.elm: -------------------------------------------------------------------------------- 1 | port module Web exposing (program) 2 | 3 | import Browser 4 | import Dict 5 | import Docs.Package exposing (Package) 6 | import Html exposing (..) 7 | import Html.Attributes exposing (class) 8 | import Http 9 | import Search.Model as Search 10 | import Search.Update as Search 11 | import Search.View as Search 12 | import Url 13 | 14 | 15 | program : List Package -> Program Flags Model Msg 16 | program packages = 17 | Browser.element 18 | { init = init packages 19 | , view = view 20 | , update = update 21 | , subscriptions = subscriptions 22 | } 23 | 24 | 25 | type Model 26 | = Ready Search.Model 27 | 28 | 29 | type Msg 30 | = SearchMsg Search.Msg 31 | | LocationSearchChange String 32 | 33 | 34 | type alias Flags = 35 | { search : String 36 | } 37 | 38 | 39 | toQueryString : Search.Filter -> String 40 | toQueryString { queryString } = 41 | if String.isEmpty queryString then 42 | "" 43 | 44 | else 45 | "?q=" ++ Url.percentEncode queryString 46 | 47 | 48 | decodeQuery : String -> String 49 | decodeQuery query_ = 50 | String.join "%20" (String.split "+" query_) 51 | 52 | 53 | parseSearchString : String -> Search.Filter 54 | parseSearchString searchString = 55 | case String.uncons (decodeQuery searchString) of 56 | Just ( '?', rest ) -> 57 | let 58 | parts = 59 | String.split "&" rest 60 | |> List.map (String.split "=") 61 | |> List.filterMap decodePair 62 | |> Dict.fromList 63 | 64 | queryString = 65 | Dict.get "q" parts 66 | |> Maybe.withDefault "" 67 | 68 | query_ = 69 | Search.queryListFromString queryString 70 | in 71 | { queryString = queryString 72 | , query = query_ 73 | , lastQuery = "" 74 | } 75 | 76 | _ -> 77 | Search.initialFilter 78 | 79 | 80 | decodePair : List String -> Maybe ( String, String ) 81 | decodePair pair = 82 | case pair of 83 | [ k, v ] -> 84 | Maybe.map2 (\a b -> ( a, b )) (Url.percentDecode k) (Url.percentDecode v) 85 | 86 | _ -> 87 | Nothing 88 | 89 | 90 | init : List Package -> Flags -> ( Model, Cmd Msg ) 91 | init packages { search } = 92 | let 93 | searchModel = 94 | Search.init (parseSearchString search) packages 95 | in 96 | ( Ready searchModel, Cmd.none ) 97 | 98 | 99 | update : Msg -> Model -> ( Model, Cmd Msg ) 100 | update msg (Ready search) = 101 | case msg of 102 | SearchMsg Search.RunFilter -> 103 | let 104 | newSearch = 105 | Search.update Search.RunFilter search 106 | in 107 | ( Ready newSearch, toQueryString search.filter |> pushQuery ) 108 | 109 | SearchMsg searchMsg -> 110 | let 111 | newSearch = 112 | Search.update searchMsg search 113 | in 114 | ( Ready newSearch, Cmd.none ) 115 | 116 | LocationSearchChange queryString -> 117 | let 118 | filter = 119 | parseSearchString queryString 120 | 121 | newSearch = 122 | if filter /= search.filter then 123 | search 124 | |> Search.update (Search.SetFilter filter) 125 | |> Search.update Search.RunFilter 126 | 127 | else 128 | search 129 | in 130 | ( Ready newSearch, Cmd.none ) 131 | 132 | 133 | view : Model -> Html Msg 134 | view (Ready search) = 135 | Html.map SearchMsg <| 136 | div [ class "searchReady" ] 137 | [ Search.viewSearchHeader search 138 | , Search.viewSearchBody search 139 | ] 140 | 141 | 142 | subscriptions : Model -> Sub Msg 143 | subscriptions _ = 144 | query LocationSearchChange 145 | 146 | 147 | port query : (String -> msg) -> Sub msg 148 | 149 | 150 | port pushQuery : String -> Cmd msg 151 | -------------------------------------------------------------------------------- /src/styles/search.css: -------------------------------------------------------------------------------- 1 | * { 2 | box-sizing: border-box; 3 | } 4 | 5 | html { 6 | font-size: 16px; 7 | } 8 | 9 | body { 10 | font-size: 1rem; 11 | line-height: 1.5; 12 | font-family: Source Sans Pro, sans-serif; 13 | background-color: #eee; 14 | color: #293c4b; 15 | margin: 0; 16 | display: flex; 17 | flex-direction: column; 18 | min-height: 100vh; 19 | } 20 | 21 | a { 22 | color: #60b5cc; 23 | } 24 | 25 | code { 26 | font-family: Source Code Pro, consolas, inconsolata, monospace; 27 | } 28 | 29 | .searchApp { 30 | flex: 1; 31 | } 32 | 33 | .searchHeader { 34 | padding: 1.5rem 0; 35 | background-color: #ddd; 36 | border-bottom: 1px solid #ccc; 37 | } 38 | 39 | .searchBranding { 40 | text-align: center; 41 | margin-bottom: 1.5rem; 42 | } 43 | .searchLogo { 44 | vertical-align: middle; 45 | display: inline-block; 46 | } 47 | .searchTitle { 48 | display: block; 49 | font-size: 1.25rem; 50 | margin: 0.5rem 0; 51 | } 52 | 53 | .searchForm { 54 | display: flex; 55 | width: 100%; 56 | max-width: 800px; 57 | margin: 0 auto; 58 | padding: 0 1rem; 59 | } 60 | 61 | .searchForm input { 62 | display: block; 63 | flex: 1; 64 | -webkit-appearance: none; 65 | font-size: 16px; 66 | font-family: Source Code Pro, consolas, inconsolata, monospace; 67 | margin: 0 0.5rem 0 0; 68 | padding: 0.5rem 1rem; 69 | background-color: #fff; 70 | border: 1px solid #bbb; 71 | border-radius: 3px; 72 | } 73 | .searchForm button { 74 | display: block; 75 | width: 6rem; 76 | margin: 0; 77 | -webkit-appearance: none; 78 | font-size: 16px; 79 | font-family: Source Sans Pro, sans-serif; 80 | padding: 0.5rem 1rem; 81 | border: 1px solid #60b5cc; 82 | border-radius: 3px; 83 | background-color: #60b5cc; 84 | color: #fff; 85 | } 86 | .searchForm input:disabled, 87 | .searchForm button:disabled { 88 | background-color: #eee; 89 | border-color: #bbb; 90 | color: #666; 91 | } 92 | .searchFormDisabled label::after { 93 | color: #666; 94 | } 95 | 96 | .searchStatus { 97 | margin: 3rem auto; 98 | padding: 0 1rem; 99 | max-width: 800px; 100 | font-size: 1.5rem; 101 | } 102 | 103 | .searchBody { 104 | margin: 3rem auto; 105 | padding: 0 1rem; 106 | max-width: 800px; 107 | } 108 | 109 | .searchIntro h1 { 110 | margin: 0 0 1.5rem 0; 111 | font-size: 1.5rem; 112 | font-weight: normal; 113 | } 114 | .searchIntro h2 { 115 | margin: 0 0 1.5rem 0; 116 | font-size: 1.25rem; 117 | font-weight: normal; 118 | } 119 | 120 | .searchQuery { 121 | padding-left: 1rem; 122 | padding-right: 1rem; 123 | padding-bottom: 1rem; 124 | } 125 | 126 | .searchChunk { 127 | width: 100%; 128 | margin: 0 auto 1.5rem auto; 129 | background-color: #fff; 130 | border: 1px solid #ddd; 131 | border-radius: 3px; 132 | overflow: hidden; 133 | box-shadow: 0 1px 2px rgba(0,0,0,0.1); 134 | } 135 | 136 | .chunkAnnotation { 137 | background-color: #293c4b; 138 | padding: 1rem 0 0 0; 139 | color: #ddd; 140 | } 141 | .chunkAnnotation pre { 142 | margin: 0; 143 | padding: 0 1rem 1rem 1rem; 144 | overflow-y: hidden; 145 | overflow-x: auto; 146 | -webkit-overflow-scrolling: touch; 147 | } 148 | .chunkAnnotation a { 149 | color: #60b5cc; 150 | text-decoration: none; 151 | } 152 | 153 | .chunkDocumentation { 154 | padding: 1rem; 155 | } 156 | .chunkDocumentation p { 157 | margin: 0; 158 | } 159 | .chunkDocumentation code { 160 | background-color: #eee; 161 | color: #293c4b; 162 | font-size: 0.85em; 163 | padding: 0.125em 0.5em; 164 | border-radius: 2px; 165 | } 166 | 167 | .chunkMeta { 168 | border-top: 1px solid #eee; 169 | padding: 1rem; 170 | display: flex; 171 | justify-content: space-between; 172 | } 173 | 174 | .chunkPath, 175 | .chunkPath a { 176 | color: #99cc99; 177 | text-decoration: none; 178 | } 179 | 180 | .chunkModule, 181 | .chunkModule a { 182 | color: #ea157a; 183 | text-decoration: none; 184 | } 185 | 186 | 187 | .searchFooter { 188 | width: 100%; 189 | max-width: 800px; 190 | margin: 0 auto; 191 | padding: 1rem; 192 | text-align: center; 193 | color: #bbb; 194 | } 195 | .searchFooter p { 196 | margin: 0; 197 | } 198 | .searchFooter a { 199 | color: inherit; 200 | } 201 | .searchFooter a:hover { 202 | color: #60b5cc; 203 | } 204 | .searchNav h4 { 205 | margin: 0; 206 | font-weight: normal; 207 | display: inline-block; 208 | } 209 | .searchNav span, 210 | .searchNav a { 211 | display: inline-block; 212 | margin-left: 0.5rem; 213 | } 214 | -------------------------------------------------------------------------------- /src/scripts/Docs/Type.elm: -------------------------------------------------------------------------------- 1 | module Docs.Type exposing 2 | ( Type(..) 3 | , decoder 4 | , normalize 5 | , parse 6 | , reserverdVars 7 | , toInternal 8 | ) 9 | 10 | import Char 11 | import Dict exposing (Dict) 12 | import Docs.Name as Name exposing (Name) 13 | import Elm.Type as Type 14 | import Json.Decode as Decode exposing (Decoder) 15 | import Json.Encode as Encode 16 | 17 | 18 | type Type 19 | = Function (List Type) Type 20 | | Var String 21 | | Apply Name (List Type) 22 | | Tuple (List Type) 23 | | Record (List ( String, Type )) (Maybe String) 24 | 25 | 26 | parse : String -> Result Decode.Error Type 27 | parse = 28 | Decode.decodeValue decoder << Encode.string 29 | 30 | 31 | decoder : Decoder Type 32 | decoder = 33 | Decode.andThen (Decode.succeed << toInternal) Type.decoder 34 | 35 | 36 | toInternal : Type.Type -> Type 37 | toInternal = 38 | toInternalHelp [] 39 | 40 | 41 | toInternalHelp : List Type -> Type.Type -> Type 42 | toInternalHelp functionArgs elmType = 43 | case elmType of 44 | Type.Var name -> 45 | Var name 46 | 47 | Type.Lambda first ((Type.Lambda _ _) as next) -> 48 | toInternalHelp (toInternalHelp [] first :: functionArgs) next 49 | 50 | Type.Lambda almostLast last -> 51 | Function 52 | (List.reverse (toInternalHelp [] almostLast :: functionArgs)) 53 | (toInternalHelp [] last) 54 | 55 | Type.Tuple args -> 56 | Tuple (List.map (toInternalHelp []) args) 57 | 58 | Type.Type name args -> 59 | Apply (toName name) (List.map (toInternalHelp []) args) 60 | 61 | Type.Record args extensible -> 62 | Record (List.map (Tuple.mapSecond (toInternalHelp [])) args) extensible 63 | 64 | 65 | toName : String -> Name.Name 66 | toName str = 67 | Name.fromString str 68 | |> Maybe.withDefault { name = str, home = "" } 69 | 70 | 71 | 72 | -- NORMALIZE 73 | 74 | 75 | reserverdVars : Dict String (List String) 76 | reserverdVars = 77 | Dict.empty 78 | |> Dict.insert "number" [ "Float", "Int" ] 79 | |> Dict.insert "comparable" [ "Float", "Int", "Char", "String" ] 80 | |> Dict.insert "appendable" [ "String", "List" ] 81 | 82 | 83 | type alias Mapping = 84 | Dict String String 85 | 86 | 87 | defaultMapping : Mapping 88 | defaultMapping = 89 | Dict.keys reserverdVars 90 | |> List.map (\v -> ( v, v )) 91 | |> Dict.fromList 92 | 93 | 94 | nextMappingValue : Mapping -> String 95 | nextMappingValue mapping = 96 | let 97 | base = 98 | Dict.size mapping - Dict.size defaultMapping 99 | 100 | code = 101 | modBy 26 base + Char.toCode 'a' 102 | 103 | string = 104 | String.fromChar (Char.fromCode code) 105 | 106 | times = 107 | (base // 26) + 1 108 | in 109 | String.repeat times string 110 | 111 | 112 | updateMapping : Type -> Mapping -> Mapping 113 | updateMapping tipe mapping = 114 | let 115 | updateMappingFor name = 116 | if Dict.member name mapping then 117 | mapping 118 | 119 | else 120 | Dict.insert name 121 | (nextMappingValue mapping) 122 | mapping 123 | in 124 | case tipe of 125 | Function args result -> 126 | List.foldl updateMapping mapping (List.append args [ result ]) 127 | 128 | Var name -> 129 | updateMappingFor name 130 | 131 | Apply name args -> 132 | List.foldl updateMapping mapping args 133 | 134 | Tuple args -> 135 | List.foldl updateMapping mapping args 136 | 137 | Record fields ext -> 138 | List.foldl updateMapping mapping (List.map (\( _, t ) -> t) fields) 139 | 140 | 141 | normalize : Type -> Type 142 | normalize tipe = 143 | normalizeWithMapping (updateMapping tipe defaultMapping) tipe 144 | 145 | 146 | normalizeWithMapping : Mapping -> Type -> Type 147 | normalizeWithMapping mapping tipe = 148 | let 149 | normalize_ = 150 | normalizeWithMapping mapping 151 | in 152 | case tipe of 153 | Function args result -> 154 | Function (List.map normalize_ args) 155 | (normalize_ result) 156 | 157 | Var name -> 158 | let 159 | name_ = 160 | case Dict.get name mapping of 161 | Just n -> 162 | n 163 | 164 | Nothing -> 165 | name 166 | in 167 | Var name_ 168 | 169 | Apply name args -> 170 | Apply name (List.map normalize_ args) 171 | 172 | Tuple args -> 173 | Tuple (List.map normalize_ args) 174 | 175 | Record fields ext -> 176 | Record (List.map (\( k, v ) -> ( k, normalize_ v )) fields) ext 177 | -------------------------------------------------------------------------------- /src/scripts/Search/Model.elm: -------------------------------------------------------------------------------- 1 | module Search.Model exposing (Filter, Index, Model, Msg(..), Query(..), Result, buildIndex, distanceByQuery, filterByDistance, indexedPair, initialFilter, initialIndex, initialModel, initialResult, prioritizeChunk, prioritizeChunks, queryListFromString, runFilter) 2 | 3 | import Docs.Package as Package exposing (Package) 4 | import Docs.Type as Type 5 | import Search.Chunk as Chunk exposing (Chunk) 6 | import Search.Distance as Distance 7 | import String 8 | 9 | 10 | type alias Model = 11 | { index : Index 12 | , filter : Filter 13 | , result : Result 14 | } 15 | 16 | 17 | type alias Index = 18 | { chunks : List Chunk 19 | } 20 | 21 | 22 | type alias Filter = 23 | { queryString : String 24 | , query : List Query 25 | , lastQuery : String 26 | } 27 | 28 | 29 | type Query 30 | = Name String 31 | | Type Type.Type 32 | | User String 33 | | Package String 34 | | Module String 35 | 36 | 37 | type alias Result = 38 | { chunks : List Chunk } 39 | 40 | 41 | initialModel : Model 42 | initialModel = 43 | { index = initialIndex 44 | , filter = initialFilter 45 | , result = initialResult 46 | } 47 | 48 | 49 | initialIndex : Index 50 | initialIndex = 51 | { chunks = [] 52 | } 53 | 54 | 55 | initialFilter : Filter 56 | initialFilter = 57 | { queryString = "" 58 | , query = [] 59 | , lastQuery = "" 60 | } 61 | 62 | 63 | initialResult : Result 64 | initialResult = 65 | { chunks = [] } 66 | 67 | 68 | type Msg 69 | = BuildIndex (List Package) 70 | | SetFilter Filter 71 | | SetFilterQueryString String 72 | | SetFilterQueryStringAndRunFilter String 73 | | RunFilter 74 | 75 | 76 | queryListFromString : String -> List Query 77 | queryListFromString string = 78 | if String.isEmpty string then 79 | [] 80 | 81 | else 82 | [ if String.startsWith "user:" string then 83 | User (String.dropLeft 5 string) 84 | 85 | else if String.startsWith "package:" string then 86 | Package (String.dropLeft 8 string) 87 | 88 | else if String.startsWith "module:" string then 89 | Module (String.dropLeft 7 string) 90 | 91 | else 92 | case Type.parse string of 93 | Ok tipe -> 94 | case tipe of 95 | Type.Var _ -> 96 | Name string 97 | 98 | _ -> 99 | Type tipe 100 | 101 | Err _ -> 102 | Name string 103 | ] 104 | 105 | 106 | buildIndex : List Package -> Index 107 | buildIndex packages = 108 | { chunks = List.concatMap Chunk.packageChunks packages } 109 | 110 | 111 | runFilter : Filter -> Index -> Result 112 | runFilter { query } { chunks } = 113 | let 114 | resultChunks = 115 | case query of 116 | [] -> 117 | [] 118 | 119 | _ -> 120 | List.foldl distanceByQuery (List.map (\c -> ( 0, c )) chunks) query 121 | |> List.map (\( d, c ) -> ( d / toFloat (List.length query), c )) 122 | |> filterByDistance (Distance.lowPenalty / 2) 123 | |> prioritizeChunks 124 | |> List.sortBy (\( d, c ) -> ( d, ( c.context.name, c.context.moduleName, c.context.packageName ) )) 125 | |> List.map Tuple.second 126 | in 127 | { chunks = resultChunks } 128 | 129 | 130 | distanceByQuery : Query -> List ( Float, Chunk ) -> List ( Float, Chunk ) 131 | distanceByQuery query chunks = 132 | let 133 | distance = 134 | case query of 135 | Name name -> 136 | Distance.simple (.context >> .name) name 137 | 138 | Type tipe -> 139 | Distance.tipe tipe 140 | 141 | User name -> 142 | Distance.simple (.context >> .userName) name 143 | 144 | Package name -> 145 | Distance.simple (.context >> .packageName) name 146 | 147 | Module name -> 148 | Distance.simple (.context >> .moduleName) name 149 | in 150 | List.map (\( d, c ) -> ( d + distance c, c )) chunks 151 | 152 | 153 | filterByDistance : Float -> List ( Float, Chunk ) -> List ( Float, Chunk ) 154 | filterByDistance distance weightedChunks = 155 | List.filter (Tuple.first >> (>=) distance) weightedChunks 156 | 157 | 158 | prioritizeChunks : List ( Float, Chunk ) -> List ( Float, Chunk ) 159 | prioritizeChunks weightedChunks = 160 | List.map prioritizeChunk weightedChunks 161 | 162 | 163 | prioritizeChunk : ( Float, Chunk ) -> ( Float, Chunk ) 164 | prioritizeChunk ( distance, chunk ) = 165 | let 166 | ( userName, packageName ) = 167 | ( chunk.context.userName, chunk.context.packageName ) 168 | 169 | priority = 170 | Distance.lowPenalty 171 | in 172 | if userName == "elm" && packageName == "core" then 173 | ( distance - priority / 2, chunk ) 174 | 175 | else if userName == "elm" then 176 | ( distance - priority / 3, chunk ) 177 | 178 | else if userName == "elm-community" then 179 | ( distance - priority / 4, chunk ) 180 | 181 | else 182 | ( distance, chunk ) 183 | 184 | 185 | indexedPair : (a -> b) -> a -> ( b, a ) 186 | indexedPair f x = 187 | ( f x, x ) 188 | -------------------------------------------------------------------------------- /src/scripts/Search/Distance.elm: -------------------------------------------------------------------------------- 1 | module Search.Distance exposing (distance, distanceApply, distanceCanonical, distanceList, distanceName, distanceVarApply, highPenalty, lowPenalty, maxPenalty, mediumPenalty, noPenalty, simple, tipe) 2 | 3 | import Dict exposing (Dict) 4 | import Docs.Name as Name exposing (Name) 5 | import Docs.Type as Type exposing (..) 6 | import List.Extra 7 | import Search.Chunk as Chunk exposing (Chunk) 8 | import String 9 | 10 | 11 | simple : (Chunk -> String) -> String -> Chunk -> Float 12 | simple extract query chunk = 13 | if query == extract chunk then 14 | noPenalty 15 | 16 | else if String.contains (String.toLower query) (String.toLower <| extract chunk) then 17 | mediumPenalty * (1 - (toFloat (String.length query) / toFloat (String.length (extract chunk)))) 18 | 19 | else 20 | maxPenalty 21 | 22 | 23 | tipe : Type -> Chunk -> Float 24 | tipe query chunk = 25 | distance (normalize query) chunk.tipeNormalized 26 | 27 | 28 | distance : Type -> Type -> Float 29 | distance needle hay = 30 | case ( needle, hay ) of 31 | {- Compare two functions `Function (List Type) Type` 32 | Functions get parsed like `a -> b` ~> `Function ([Var "a"]) (Var "b")` 33 | TODO: support three different comparisons 34 | - strict: length of arguments have to match 35 | - from beginning: concat args and result and compare the list 36 | - from end: concat args and result and compare the reversed list 37 | TODO: add some kind of mapping for vars in fuzzy calculations 38 | -} 39 | ( Function argsN resultN, Function argsH resultH ) -> 40 | let 41 | -- Handle special cases with singleton `Var` Type args 42 | argsDistance = 43 | case ( argsN, argsH ) of 44 | -- Compare `a -> r` and `b -> s` 45 | ( [ Var n ], [ Var h ] ) -> 46 | distanceName n h 47 | 48 | -- Compare `a -> r` and `b -> c -> s` 49 | -- This is the important special case. 50 | ( [ Var n ], _ ) -> 51 | mediumPenalty 52 | 53 | -- The default case 54 | _ -> 55 | distanceList argsN argsH 56 | 57 | resultDistance = 58 | distance resultN resultH 59 | in 60 | (argsDistance + resultDistance) / 2 61 | 62 | -- `Var String` 63 | -- `a` ~> `Var "a"` 64 | ( Var nameN, Var nameH ) -> 65 | distanceName nameN nameH 66 | 67 | -- Special cases for comparisons like `number` - `Float` 68 | ( Var nameN, Apply canonicalH [] ) -> 69 | distanceVarApply nameN canonicalH 70 | 71 | ( Apply canonicalN [], Var nameH ) -> 72 | distanceVarApply nameH canonicalN 73 | 74 | -- Hack for special cases like `a` - `Maybe a` 75 | -- TODO: make proper comparison 76 | ( Var nameN, Apply canonicalH argsH ) -> 77 | distanceApply ( { name = "", home = "" }, [ Var nameN ] ) ( canonicalH, argsH ) 78 | 79 | ( Apply canonicalN argsN, Var nameH ) -> 80 | distanceApply ( { name = "", home = "" }, [ Var nameH ] ) ( canonicalN, argsN ) 81 | 82 | -- `Apply Name (List Type)` 83 | -- `Foo.Bar a b` ~> `Apply { home = "Foo", name = "Bar" } ([Var "a", Var "b"])` 84 | ( Apply canonicalN argsN, Apply canonicalH argsH ) -> 85 | distanceApply ( canonicalN, argsN ) ( canonicalH, argsH ) 86 | 87 | -- Tuple (List Type) 88 | -- `(a,b)` ~> `Tuple ([Var "a",Var "b"])` 89 | ( Tuple argsN, Tuple argsH ) -> 90 | distanceList argsN argsH 91 | 92 | -- TODO: Record (List ( String, Type )) (Maybe String) 93 | {- The incomparable case 94 | TODO: Find and add special cases 95 | -} 96 | _ -> 97 | maxPenalty 98 | 99 | 100 | distanceList : List Type -> List Type -> Float 101 | distanceList needle hay = 102 | let 103 | needleLength = 104 | List.length needle 105 | 106 | hayLength = 107 | List.length hay 108 | 109 | sharedLength = 110 | min needleLength hayLength 111 | 112 | maxLength = 113 | max needleLength hayLength 114 | 115 | diffLength = 116 | maxLength - sharedLength 117 | in 118 | if diffLength > 1 then 119 | maxPenalty 120 | 121 | else 122 | -- TODO: optimize, maybe add penalty for permutations 123 | List.Extra.permutations needle 124 | |> List.map 125 | (\curr -> 126 | List.map2 distance curr hay 127 | |> List.sum 128 | |> (+) (toFloat diffLength * maxPenalty) 129 | |> (\a -> (/) a (toFloat maxLength)) 130 | ) 131 | |> List.minimum 132 | |> Maybe.withDefault maxPenalty 133 | 134 | 135 | distanceName : String -> String -> Float 136 | distanceName needle hay = 137 | if needle == hay then 138 | noPenalty 139 | 140 | else 141 | maxPenalty 142 | 143 | 144 | distanceCanonical : Name -> Name -> Float 145 | distanceCanonical needle hay = 146 | -- TODO: Also take `.home` into account. 147 | --distanceName needle.name hay.name 148 | if needle.name == hay.name then 149 | noPenalty 150 | 151 | else if String.contains needle.name hay.name then 152 | mediumPenalty 153 | 154 | else 155 | maxPenalty 156 | 157 | 158 | distanceVarApply : String -> Name -> Float 159 | distanceVarApply varName applyName = 160 | let 161 | maybeReservedVarTypeList = 162 | Dict.get varName reserverdVars 163 | in 164 | case maybeReservedVarTypeList of 165 | Just typeList -> 166 | if List.any ((==) applyName.name) typeList then 167 | lowPenalty 168 | 169 | else 170 | maxPenalty 171 | 172 | Nothing -> 173 | mediumPenalty 174 | 175 | 176 | distanceApply : ( Name, List Type ) -> ( Name, List Type ) -> Float 177 | distanceApply ( canonicalN, argsN ) ( canonicalH, argsH ) = 178 | case ( argsN, argsH ) of 179 | ( [], [] ) -> 180 | distanceCanonical canonicalN canonicalH 181 | 182 | ( [], hd :: tl ) -> 183 | --distanceCanonical canonicalN canonicalH 184 | -- TODO: should we do this only for some specific types like `Maybe` and `Result`? 185 | -- TODO: check if this is a nice implementation (with regard to `min` and `+ lowPenalty`) 186 | min maxPenalty <| 187 | distance (Apply canonicalN argsN) 188 | (Maybe.withDefault hd (List.head (List.reverse tl))) 189 | + lowPenalty 190 | 191 | _ -> 192 | (distanceCanonical canonicalN canonicalH + distanceList argsN argsH) / 2 193 | 194 | 195 | noPenalty : Float 196 | noPenalty = 197 | 0 198 | 199 | 200 | lowPenalty : Float 201 | lowPenalty = 202 | 0.25 203 | 204 | 205 | mediumPenalty : Float 206 | mediumPenalty = 207 | 0.5 208 | 209 | 210 | highPenalty : Float 211 | highPenalty = 212 | 0.75 213 | 214 | 215 | maxPenalty : Float 216 | maxPenalty = 217 | 1 218 | -------------------------------------------------------------------------------- /src/scripts/Search/View.elm: -------------------------------------------------------------------------------- 1 | module Search.View exposing (Context(..), annotation, annotationBlock, annotationName, longFunctionAnnotation, typeLength, viewChunk, viewField, viewLogo, viewSearchBody, viewSearchBranding, viewSearchForm, viewSearchHeader, viewSearchIntro, viewSearchResults, viewType) 2 | 3 | import Docs.Type as Type exposing (Type) 4 | import Html exposing (..) 5 | import Html.Attributes exposing (..) 6 | import Html.Events exposing (..) 7 | import Logo 8 | import Search.Chunk as Chunk exposing (Chunk) 9 | import Search.Model as Model exposing (..) 10 | import String 11 | import Utils.Code as Code 12 | import Utils.Markdown as Markdown 13 | 14 | 15 | viewSearchHeader : Model -> Html Msg 16 | viewSearchHeader search = 17 | div [ class "searchHeader" ] 18 | [ viewSearchBranding 19 | , viewSearchForm search 20 | ] 21 | 22 | 23 | viewSearchBranding : Html Msg 24 | viewSearchBranding = 25 | div [ class "searchBranding" ] 26 | [ viewLogo 27 | , span [ class "searchTitle" ] [ text "Elm Search" ] 28 | ] 29 | 30 | 31 | viewLogo : Html msg 32 | viewLogo = 33 | span [ class "searchLogo" ] 34 | [ Logo.viewWithSize 64 ] 35 | 36 | 37 | viewSearchForm : Model -> Html Msg 38 | viewSearchForm { filter, index, result } = 39 | let 40 | isDisabled = 41 | List.isEmpty index.chunks 42 | in 43 | Html.form 44 | [ classList 45 | [ ( "searchForm", True ) 46 | , ( "searchFormDisabled", isDisabled ) 47 | ] 48 | , action "." 49 | , onSubmit RunFilter 50 | ] 51 | [ input 52 | [ name "q" 53 | , type_ "search" 54 | , onInput SetFilterQueryString 55 | , value filter.queryString 56 | , autofocus True 57 | ] 58 | [] 59 | , button 60 | [ type_ "submit" 61 | , disabled isDisabled 62 | ] 63 | [ text "Search" ] 64 | ] 65 | 66 | 67 | viewSearchBody : Model -> Html Msg 68 | viewSearchBody model = 69 | let 70 | searchBody = 71 | if String.isEmpty model.filter.lastQuery then 72 | viewSearchIntro 73 | 74 | else 75 | viewSearchResults model 76 | in 77 | div [ class "searchBody" ] 78 | [ searchBody ] 79 | 80 | 81 | viewSearchIntro : Html Msg 82 | viewSearchIntro = 83 | let 84 | exampleQueries = 85 | [ "map" 86 | , "(a -> b -> b) -> b -> List a -> b" 87 | , "Result x a -> (a -> Result x b) -> Result x b" 88 | , "String -> Int" 89 | ] 90 | 91 | exampleSearchItem query = 92 | li [] 93 | [ a 94 | [ style "cursor" "pointer" 95 | , onClick (SetFilterQueryStringAndRunFilter query) 96 | ] 97 | [ text query ] 98 | ] 99 | in 100 | div [ class "searchIntro" ] 101 | [ h1 [] [ text "Welcome to Elm Search" ] 102 | , p [] [ text "Search the modules of the latest Elm packages by either function name or by approximate type signature." ] 103 | , h2 [] [ text "Example queries" ] 104 | , ul [] (List.map exampleSearchItem exampleQueries) 105 | ] 106 | 107 | 108 | viewSearchResults : Model -> Html Msg 109 | viewSearchResults { filter, result } = 110 | let 111 | viewQuery = 112 | div [ class "searchQuery" ] 113 | [ text <| "Showing results for: " 114 | , b [] [ text filter.lastQuery ] 115 | ] 116 | 117 | viewChunks = 118 | if not <| List.isEmpty result.chunks then 119 | List.map viewChunk result.chunks 120 | 121 | else 122 | [ p [] [ text "No Results Found." ] ] 123 | in 124 | div [ class "searchResult" ] 125 | (viewQuery :: viewChunks) 126 | 127 | 128 | viewChunk : Chunk -> Html Msg 129 | viewChunk chunk = 130 | div [ class "searchChunk" ] 131 | [ div [ class "chunkAnnotation" ] 132 | [ annotationBlock (annotation chunk) ] 133 | , div [ class "chunkDocumentation" ] 134 | [ Maybe.map Markdown.block chunk.docs 135 | |> Maybe.withDefault (text "---") 136 | ] 137 | , div [ class "chunkMeta" ] 138 | [ div [ class "chunkPath" ] 139 | [ a [ href (Chunk.pathToPackage chunk.context) ] 140 | [ text (Chunk.identifierHome chunk.context) ] 141 | ] 142 | , div [ class "chunkModule" ] 143 | [ a [ href (Chunk.pathToModule chunk.context) ] 144 | [ text chunk.context.moduleName ] 145 | ] 146 | ] 147 | ] 148 | 149 | 150 | annotationBlock : List (List (Html msg)) -> Html msg 151 | annotationBlock bits = 152 | pre [] [ code [] (List.concat (List.intersperse [ text "\n" ] bits)) ] 153 | 154 | 155 | annotation : Chunk -> List (List (Html msg)) 156 | annotation chunk = 157 | case chunk.tipe of 158 | Type.Function args result -> 159 | if String.length chunk.context.name + 3 + typeLength Other chunk.tipe > 64 then 160 | [ annotationName chunk ] :: longFunctionAnnotation args result 161 | 162 | else 163 | [ annotationName chunk :: Code.padded Code.colon ++ viewType Other chunk.tipe ] 164 | 165 | _ -> 166 | [ annotationName chunk :: Code.padded Code.colon ++ viewType Other chunk.tipe ] 167 | 168 | 169 | annotationName : Chunk -> Html msg 170 | annotationName { context } = 171 | a [ href (Chunk.pathToValue context) ] 172 | [ text context.name ] 173 | 174 | 175 | longFunctionAnnotation : List Type -> Type -> List (List (Html msg)) 176 | longFunctionAnnotation args result = 177 | let 178 | tipeHtml = 179 | List.map (viewType Func) (args ++ [ result ]) 180 | 181 | starters = 182 | [ text " ", Code.colon, text " " ] 183 | :: List.repeat (List.length args) [ text " ", Code.arrow, Code.space ] 184 | in 185 | List.map2 (++) starters tipeHtml 186 | 187 | 188 | 189 | -- TYPE 190 | 191 | 192 | type Context 193 | = Func 194 | | App 195 | | Other 196 | 197 | 198 | viewType : Context -> Type -> List (Html msg) 199 | viewType context tipe = 200 | case tipe of 201 | Type.Function args result -> 202 | let 203 | maybeAddParens = 204 | case context of 205 | Func -> 206 | Code.addParens 207 | 208 | App -> 209 | Code.addParens 210 | 211 | Other -> 212 | identity 213 | 214 | argsHtml = 215 | List.concatMap (\arg -> viewType Func arg ++ Code.padded Code.arrow) args 216 | in 217 | maybeAddParens (argsHtml ++ viewType Func result) 218 | 219 | Type.Var name -> 220 | [ text name ] 221 | 222 | Type.Apply name [] -> 223 | [ text name.name ] 224 | 225 | Type.Apply name args -> 226 | let 227 | maybeAddParens = 228 | case context of 229 | Func -> 230 | identity 231 | 232 | App -> 233 | Code.addParens 234 | 235 | Other -> 236 | identity 237 | 238 | argsHtml = 239 | List.concatMap (\arg -> Code.space :: viewType App arg) args 240 | in 241 | maybeAddParens (text name.name :: argsHtml) 242 | 243 | Type.Tuple args -> 244 | List.map (viewType Other) args 245 | |> List.intersperse [ text ", " ] 246 | |> List.concat 247 | |> Code.addParens 248 | 249 | Type.Record fields ext -> 250 | let 251 | fieldsHtml = 252 | List.map viewField fields 253 | |> List.intersperse [ text ", " ] 254 | |> List.concat 255 | 256 | recordInsides = 257 | case ext of 258 | Nothing -> 259 | fieldsHtml 260 | 261 | Just extName -> 262 | text extName :: text " | " :: fieldsHtml 263 | in 264 | text "{ " :: recordInsides ++ [ text " }" ] 265 | 266 | 267 | viewField : ( String, Type ) -> List (Html msg) 268 | viewField ( field, tipe ) = 269 | text field :: Code.space :: Code.colon :: Code.space :: viewType Other tipe 270 | 271 | 272 | typeLength : Context -> Type -> Int 273 | typeLength context tipe = 274 | case tipe of 275 | Type.Function args result -> 276 | let 277 | parens = 278 | case context of 279 | Func -> 280 | 2 281 | 282 | App -> 283 | 2 284 | 285 | Other -> 286 | 0 287 | 288 | argLengths = 289 | List.map (\t -> 4 + typeLength Func t) args 290 | in 291 | parens + List.sum argLengths + typeLength Func result 292 | 293 | Type.Var name -> 294 | String.length name 295 | 296 | Type.Apply { name } [] -> 297 | String.length name 298 | 299 | Type.Apply { name } args -> 300 | let 301 | parens = 302 | case context of 303 | Func -> 304 | 0 305 | 306 | App -> 307 | 2 308 | 309 | Other -> 310 | 0 311 | 312 | argsLength = 313 | List.sum (List.map (\t -> 1 + typeLength App t) args) 314 | in 315 | parens + String.length name + argsLength 316 | 317 | Type.Tuple args -> 318 | List.sum (List.map (\t -> 2 + typeLength Other t) args) 319 | 320 | Type.Record fields ext -> 321 | let 322 | fieldLength ( field, tipe_ ) = 323 | String.length field + 3 + typeLength Other tipe_ 324 | 325 | recordLength = 326 | 2 + List.sum (List.map (\ft -> 2 + fieldLength ft) fields) 327 | 328 | extLength = 329 | case ext of 330 | Nothing -> 331 | 0 332 | 333 | Just extName -> 334 | 2 + String.length extName 335 | in 336 | recordLength + extLength 337 | --------------------------------------------------------------------------------