-
Notifications
You must be signed in to change notification settings - Fork 4
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
60 changed files
with
2,796 additions
and
300 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -15,3 +15,6 @@ docker/tmp | |
| *.prof | ||
| *.prof.html | ||
| prelude.output.md | ||
|
|
||
| # Scratch files | ||
| *.u | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,92 @@ | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| -- pTrace is marked deprecated so you get warnings when you use it. | ||
| {-# OPTIONS_GHC -Wno-deprecations #-} | ||
|
|
||
| module Share.Debug | ||
| ( debug, | ||
| debugM, | ||
| whenDebug, | ||
| debugLog, | ||
| debugLogM, | ||
| shouldDebug, | ||
| DebugFlag (..), | ||
| ) | ||
| where | ||
|
|
||
| import Control.Monad | ||
| import Data.Set (Set) | ||
| import Data.Set qualified as Set | ||
| import Data.Text qualified as Text | ||
| import Debug.Pretty.Simple (pTrace, pTraceM) | ||
| import Debug.Trace | ||
| import System.IO.Unsafe (unsafePerformIO) | ||
| import Text.Pretty.Simple (pShow) | ||
| import UnliftIO.Environment (lookupEnv) | ||
| import Witch (into) | ||
|
|
||
| data DebugFlag | ||
| = Timing | ||
| | Queries | ||
| deriving (Eq, Ord, Show, Bounded, Enum) | ||
|
|
||
| debugFlags :: Set DebugFlag | ||
| debugFlags = case (unsafePerformIO (lookupEnv "SHARE_DEBUG")) of | ||
| Nothing -> Set.empty | ||
| Just "" -> Set.fromList [minBound .. maxBound] | ||
| Just s -> Set.fromList $ do | ||
| w <- (Text.splitOn "," . Text.pack $ s) | ||
| case Text.toUpper . Text.strip $ w of | ||
| "TIMING" -> pure Timing | ||
| "QUERIES" -> pure Queries | ||
| _ -> mempty | ||
| {-# NOINLINE debugFlags #-} | ||
|
|
||
| debugTiming :: Bool | ||
| debugTiming = Timing `Set.member` debugFlags | ||
| {-# NOINLINE debugTiming #-} | ||
|
|
||
| debugQueries :: Bool | ||
| debugQueries = Queries `Set.member` debugFlags | ||
| {-# NOINLINE debugQueries #-} | ||
|
|
||
| -- | Use for trace-style selective debugging. | ||
| -- E.g. 1 + (debug Sync "The second number" 2) | ||
| -- | ||
| -- Or, use in pattern matching to view arguments. | ||
| -- E.g. | ||
| -- myFunc (debug Sync "argA" -> argA) = ... | ||
| debug :: (Show a) => DebugFlag -> String -> a -> a | ||
| debug flag msg a = | ||
| if shouldDebug flag | ||
| then (trace (msg <> ":\n" <> into @String (pShow a)) a) | ||
| else a | ||
|
|
||
| -- | Use for selective debug logging in monadic contexts. | ||
| -- E.g. | ||
| -- do | ||
| -- debugM Sync "source repo" srcRepo | ||
| -- ... | ||
| debugM :: (Show a, Monad m) => DebugFlag -> String -> a -> m () | ||
| debugM flag msg a = | ||
| whenDebug flag do | ||
| traceM (msg <> ":\n" <> into @String (pShow a)) | ||
|
|
||
| debugLog :: DebugFlag -> String -> a -> a | ||
| debugLog flag msg = | ||
| if shouldDebug flag | ||
| then pTrace msg | ||
| else id | ||
|
|
||
| debugLogM :: (Monad m) => DebugFlag -> String -> m () | ||
| debugLogM flag msg = | ||
| whenDebug flag $ pTraceM msg | ||
|
|
||
| -- | A 'when' block which is triggered if the given flag is being debugged. | ||
| whenDebug :: (Monad m) => DebugFlag -> m () -> m () | ||
| whenDebug flag action = do | ||
| when (shouldDebug flag) action | ||
|
|
||
| shouldDebug :: DebugFlag -> Bool | ||
| shouldDebug = \case | ||
| Timing -> debugTiming | ||
| Queries -> debugQueries |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,43 @@ | ||
| -- Allows us to create composite indexes over traditionally non-GIN indexable types. | ||
| -- In this case it allows us to include the project_id and release_id in the GIN index for search tokens. | ||
| CREATE EXTENSION IF NOT EXISTS btree_gin; | ||
|
|
||
| -- Allows us to create trigram indexes for fuzzy searching. | ||
| CREATE EXTENSION IF NOT EXISTS pg_trgm; | ||
|
|
||
| -- New table for coordinating background job for syncing global definitions for search. | ||
|
|
||
| -- Table of all releases which have been published, but not yet synced to the global definition search index. | ||
| CREATE TABLE global_definition_search_release_queue ( | ||
| release_id UUID PRIMARY KEY REFERENCES project_releases(id) ON DELETE CASCADE, | ||
| created_at TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP | ||
| ); | ||
|
|
||
| -- Every defn fits into one of these categories. | ||
| CREATE TYPE definition_tag AS ENUM ('doc', 'test', 'plain', 'data', 'ability', 'data-constructor', 'ability-constructor'); | ||
|
|
||
| CREATE TABLE global_definition_search_docs ( | ||
| project_id UUID NOT NULL REFERENCES projects(id) ON DELETE CASCADE, | ||
| release_id UUID NOT NULL REFERENCES project_releases(id) ON DELETE CASCADE, | ||
| -- Fully qualified name | ||
| name TEXT NOT NULL, | ||
| search_tokens TSVECTOR NOT NULL, | ||
| -- Number of arguments. 0 for values. | ||
| arity INT NOT NULL, | ||
| tag definition_tag NOT NULL, | ||
|
|
||
| -- Contains the rendered type signature, type, hash, etc. | ||
| -- so we don't need to look up types for hundreds of search results on the fly. | ||
| metadata JSONB NOT NULL, | ||
|
|
||
| -- Ostensibly there's the possibility of name conflicts, | ||
| -- but those are rare enough we don't care, we just insert with ON CONFLICT DO NOTHING. | ||
| PRIMARY KEY (project_id, release_id, name) | ||
| ); | ||
|
|
||
| -- Index for searching global definitions by 'search token', with an optional project/release filter. | ||
| -- P.s. there's a search token type for name, so we don't need to index that separately. | ||
| CREATE INDEX global_definition_search_tokens ON global_definition_search_docs USING GIN(search_tokens, tag, project_id, release_id); | ||
|
|
||
| -- Index for fuzzy-searching on the fully qualified name. | ||
| CREATE INDEX global_definition_search_name_trigram ON global_definition_search_docs USING GIST (name gist_trgm_ops); |
Oops, something went wrong.