mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-24 08:47:19 +03:00
compiles, but autocomplete still incomplete!
still need a parser for Referents and Reference hash literals Lost the ability to align terms' type signatures, due to interleaving them with types instead of treating them as a block. Maybe there's a non-horrible way to reconstruct it.
This commit is contained in:
Arya Irani
parent
46aa728d25
commit
7c5e2eeb31
@ -33,13 +33,11 @@ import Data.Text ( Text )
|
||||
import Data.Traversable ( for )
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Builtin as Builtin
|
||||
import Unison.Codebase.Branch ( Branch, Branch0, Namespace )
|
||||
import Unison.Codebase.Branch ( Branch, Branch0 )
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import qualified Unison.Codebase.CodeLookup as CL
|
||||
import qualified Unison.Codebase.TermEdit as TermEdit
|
||||
import Unison.Codebase.TermEdit ( TermEdit )
|
||||
import qualified Unison.Codebase.SearchResult as SR
|
||||
import Unison.Codebase.SearchResult ( SearchResult, SearchResult0(..) )
|
||||
import qualified Unison.DataDeclaration as DD
|
||||
import Unison.HashQualified ( HashQualified )
|
||||
import qualified Unison.HashQualified as HQ
|
||||
@ -61,8 +59,7 @@ import qualified Unison.Typechecker.Context as Context
|
||||
import Unison.Typechecker.TypeLookup (TypeLookup(TypeLookup))
|
||||
import qualified Unison.Typechecker.TypeLookup as TL
|
||||
import qualified Unison.UnisonFile as UF
|
||||
import Unison.Util.AnnotatedText ( AnnotatedText )
|
||||
import Unison.Util.ColorText ( Color, ColorText )
|
||||
import Unison.Util.ColorText ( ColorText )
|
||||
import qualified Unison.Util.Components as Components
|
||||
import Unison.Util.Pretty ( Pretty )
|
||||
import qualified Unison.Util.Pretty as PP
|
||||
@ -85,8 +82,7 @@ data Codebase m v a =
|
||||
, putTerm :: Reference.Id -> Term v a -> Type v a -> m ()
|
||||
, getTypeDeclaration :: Reference.Id -> m (Maybe (Decl v a))
|
||||
, putTypeDeclarationImpl :: Reference.Id -> Decl v a -> m ()
|
||||
, allTerms :: m [Reference.Id]
|
||||
, allTypes :: m [Reference.Id]
|
||||
|
||||
, branches :: m [BranchName]
|
||||
, getBranch :: BranchName -> m (Maybe Branch)
|
||||
-- thought: this merges the given branch with the existing branch
|
||||
@ -172,82 +168,6 @@ typecheckingEnvironment code t = do
|
||||
prettyTypeSource :: (Monad m, Var v) => Codebase m v a -> Name -> Reference -> Branch -> m (Maybe (Pretty ColorText))
|
||||
prettyTypeSource = error "todo"
|
||||
|
||||
-- Search for names / hashes in branch / codebase
|
||||
searchNamespace :: Ord score =>
|
||||
Namespace -> (Name -> Name -> Maybe score) -> [HashQualified] -> SearchResult0
|
||||
searchNamespace = error "todo"
|
||||
|
||||
loadSRTypes :: forall m v a.
|
||||
(Var v, Monad m) => Codebase m v a -> SearchResult0 -> m (SearchResult v a)
|
||||
loadSRTypes code (SearchResult0 tms typs) = do
|
||||
tms' <- traverse loadTermType tms
|
||||
pure $ SR.SearchResult tms' typs
|
||||
where
|
||||
loadTermType :: SR.TermResult0 -> m (SR.TermResult v a)
|
||||
loadTermType (SR.TermResult0 t r0 as) = case r0 of
|
||||
Referent.Ref r -> setType <$> getTypeOfTerm code r
|
||||
Referent.Con r i -> setType <$> getTypeOfConstructor code r i
|
||||
where setType typ = SR.TermResult t r0 typ as
|
||||
|
||||
|
||||
searchBranch :: (Monad m, Var v, Ord score) => Codebase m v a -> Branch0 -> (Name -> Name -> Maybe score) -> [HashQualified] -> m (SearchResult v a)
|
||||
searchBranch code b score queries = error "todo"
|
||||
|
||||
|
||||
searchCodebase :: forall m v a score.
|
||||
(Var v, Monad m, Ord score)
|
||||
=> Codebase m v a
|
||||
-> Branch0
|
||||
-> (Name -> Name -> Maybe score)
|
||||
-> [HashQualified]
|
||||
-> m (SearchResult v a)
|
||||
searchCodebase code b score queries = loadSRTypes code =<< results0
|
||||
where
|
||||
results0 = (localResults <>) <$> namelessResults
|
||||
localResults, oldResults :: SearchResult0
|
||||
localResults = searchNamespace (Branch.namespace b) score queries
|
||||
oldResults = searchNamespace (Branch.oldNamespace b) score queries
|
||||
namelessResults :: m SearchResult0
|
||||
namelessResults = do
|
||||
_ <- allTerms code
|
||||
_ <- allTypes code
|
||||
terms <- error "todo"
|
||||
types <- error "todo"
|
||||
pure $ SearchResult0 terms types
|
||||
|
||||
-- aggregateResults <$> traverse search queries
|
||||
-- where
|
||||
-- aggregateResults :: [SearchResult v' a' score] -> SearchResult v' a' score
|
||||
-- aggregateResults = mconcat
|
||||
-- search :: HashQualified -> m (SearchResult v a score)
|
||||
-- search = \case
|
||||
-- HQ.NameOnly n -> error "todo"
|
||||
-- HQ.HashOnly n -> error "todo"
|
||||
-- HQ.HashQualified n h -> error "todo"
|
||||
|
||||
|
||||
-- listReferencesMatching
|
||||
-- :: (Var v, Monad m) => Codebase m v a -> Branch -> [String] -> m String
|
||||
-- listReferencesMatching code (Branch.head -> b) query = do
|
||||
-- let
|
||||
-- termNames = toList (Branch.allTermNames b)
|
||||
-- typeNames = toList (Branch.allTypeNames b)
|
||||
-- matchingTerms = if null query
|
||||
-- then termNames
|
||||
-- else query >>= \q -> asStrings (sortedApproximateMatches q) termNames
|
||||
-- matchingTypes = if null query
|
||||
-- then typeNames
|
||||
-- else query >>= \q -> asStrings (sortedApproximateMatches q) typeNames
|
||||
-- matchingTypeRefs = matchingTypes
|
||||
-- >>= \name -> Set.toList (Branch.typesNamed name b)
|
||||
-- matchingTermRefs = matchingTerms
|
||||
-- >>= \name -> Set.toList (Branch.termsNamed name b)
|
||||
-- asStrings f names = Name.fromString <$> f (Name.toString <$> names)
|
||||
--
|
||||
-- listReferences code
|
||||
-- b
|
||||
-- (matchingTypeRefs ++ [ r | Ref r <- matchingTermRefs ])
|
||||
|
||||
listReferences
|
||||
:: (Var v, Monad m) => Codebase m v a -> Branch0 -> [Reference] -> m String
|
||||
listReferences code branch refs = do
|
||||
@ -332,17 +252,6 @@ prettyBindings cb tms b = do
|
||||
ds <- catMaybes <$> (forM tms $ \(name,r) -> prettyBinding cb name r b)
|
||||
pure $ PP.linesSpaced ds
|
||||
|
||||
prettyListingQ
|
||||
:: (Var.Var v, Monad m)
|
||||
=> Codebase m v a
|
||||
-> String
|
||||
-> Branch
|
||||
-> m (AnnotatedText Color)
|
||||
prettyListingQ _cb _query _b =
|
||||
error
|
||||
$ "todo - find all matches, display similar output to "
|
||||
<> "PrintError.prettyTypecheckedFile"
|
||||
|
||||
typeLookupForDependencies
|
||||
:: Monad m => Codebase m v a -> Set Reference -> m (TL.TypeLookup v a)
|
||||
typeLookupForDependencies codebase refs = foldM go mempty refs
|
||||
|
||||
@ -22,6 +22,8 @@ import qualified Data.Set as Set
|
||||
import Prelude hiding (head,subtract)
|
||||
import Unison.Codebase.Causal (Causal)
|
||||
import qualified Unison.Codebase.Causal as Causal
|
||||
import Unison.Codebase.SearchResult (SearchResult)
|
||||
import qualified Unison.Codebase.SearchResult as SR
|
||||
import Unison.Codebase.TermEdit (TermEdit, Typing)
|
||||
import qualified Unison.Codebase.TermEdit as TermEdit
|
||||
import Unison.Codebase.TypeEdit (TypeEdit)
|
||||
@ -33,11 +35,13 @@ import qualified Unison.Hashable as H
|
||||
import Unison.HashQualified (HashQualified)
|
||||
import qualified Unison.HashQualified as HashQualified
|
||||
import qualified Unison.HashQualified as HQ
|
||||
import qualified Unison.ShortHash as SH
|
||||
import Unison.Name (Name)
|
||||
import Unison.Names (Names (..))
|
||||
import qualified Unison.Name as Name
|
||||
import qualified Unison.Names as Names
|
||||
import Unison.Reference (Reference)
|
||||
import qualified Unison.Reference as Reference
|
||||
import Unison.Referent (Referent)
|
||||
import qualified Unison.Referent as Referent
|
||||
import qualified Unison.UnisonFile as UF
|
||||
@ -269,6 +273,7 @@ instance Monoid Branch0 where
|
||||
mempty = Branch0 mempty mempty R.empty R.empty
|
||||
mappend = (<>)
|
||||
|
||||
-- todo: audit uses of these functions
|
||||
allNamesHashQualified :: Branch0 -> Set HashQualified
|
||||
allNamesHashQualified b =
|
||||
Set.union (allTermsHashQualified b) (allTypesHashQualified b)
|
||||
@ -330,14 +335,14 @@ hashQualifyTermName :: Int -> Name -> Set Referent -> Map Referent HashQualified
|
||||
hashQualifyTermName numHashChars n rs =
|
||||
if Set.size rs < 2
|
||||
then Map.fromList [(r, HashQualified.fromName n) | r <- toList rs ]
|
||||
else Map.fromList [ (r, HQ.take numHashChars $ HQ.fromNamedReferent r n)
|
||||
else Map.fromList [ (r, HQ.take numHashChars $ HQ.fromNamedReferent n r)
|
||||
| r <- toList rs ]
|
||||
|
||||
hashQualifyTypeName :: Int -> Name -> Set Reference -> Map Reference HashQualified
|
||||
hashQualifyTypeName numHashChars n rs =
|
||||
if Set.size rs < 2
|
||||
then Map.fromList [(r, HashQualified.fromName n) | r <- toList rs ]
|
||||
else Map.fromList [ (r, HQ.take numHashChars $ HQ.fromNamedReference r n)
|
||||
else Map.fromList [ (r, HQ.take numHashChars $ HQ.fromNamedReference n r)
|
||||
| r <- toList rs ]
|
||||
|
||||
-- Get the appropriately hash-qualified version of a name for term.
|
||||
@ -346,25 +351,25 @@ hashQualifiedTermName :: Branch0 -> Name -> Referent -> HashQualified
|
||||
hashQualifiedTermName b n r =
|
||||
if (> 1) . length . R.lookupDom n . termNamespace $ b then
|
||||
-- name is conflicted
|
||||
HQ.take (numHashChars b) $ HashQualified.fromNamedReferent r n
|
||||
HQ.take (numHashChars b) $ HashQualified.fromNamedReferent n r
|
||||
else HashQualified.fromName n
|
||||
|
||||
hashQualifiedTypeName :: Branch0 -> Name -> Reference -> HashQualified
|
||||
hashQualifiedTypeName b n r =
|
||||
if (> 1) . length . R.lookupDom n . typeNamespace $ b then
|
||||
-- name is conflicted
|
||||
HQ.take (numHashChars b) $ HashQualified.fromNamedReference r n
|
||||
HQ.take (numHashChars b) $ HashQualified.fromNamedReference n r
|
||||
else HashQualified.fromName n
|
||||
|
||||
oldNamesForTerm :: Int -> Referent -> Branch0 -> Set HashQualified
|
||||
oldNamesForTerm numHashChars ref
|
||||
= Set.map (HQ.take numHashChars . HashQualified.fromNamedReferent ref)
|
||||
= Set.map (HQ.take numHashChars . flip HashQualified.fromNamedReferent ref)
|
||||
. R.lookupRan ref
|
||||
. (view $ oldNamespaceL . terms)
|
||||
|
||||
oldNamesForType :: Int -> Reference -> Branch0 -> Set HashQualified
|
||||
oldNamesForType numHashChars ref
|
||||
= Set.map (HQ.take numHashChars . HashQualified.fromNamedReference ref)
|
||||
= Set.map (HQ.take numHashChars . flip HashQualified.fromNamedReference ref)
|
||||
. R.lookupRan ref
|
||||
. (view $ oldNamespaceL . types)
|
||||
|
||||
@ -856,3 +861,55 @@ toNames b' = Names terms types
|
||||
termRefs = Map.fromList . R.toList $ termNamespace b
|
||||
types = Map.fromList . R.toList $ typeNamespace b
|
||||
terms = termRefs
|
||||
|
||||
searchTermNamespace :: forall score. Ord score =>
|
||||
Branch0
|
||||
-> (Name -> Name -> Maybe score)
|
||||
-> [HashQualified]
|
||||
-> Set (Maybe score, SearchResult)
|
||||
searchTermNamespace b score queries = foldMap do1query queries
|
||||
where
|
||||
do1query :: HashQualified -> Set (Maybe score, SearchResult)
|
||||
do1query q = foldMap (score1hq q) (R.toList . termNamespace $ b)
|
||||
-- hashNamesForTerm r b
|
||||
score1hq :: HashQualified -> (Name, Referent) -> Set (Maybe score, SearchResult)
|
||||
score1hq query (name, ref) = case query of
|
||||
HQ.NameOnly qn ->
|
||||
pair qn
|
||||
HQ.HashQualified qn h | h `SH.isPrefixOf` (Referent.toShortHash ref) ->
|
||||
pair qn
|
||||
HQ.HashOnly h | h `SH.isPrefixOf` (Referent.toShortHash ref) ->
|
||||
Set.singleton (Nothing, result)
|
||||
_ -> mempty
|
||||
where
|
||||
result = SR.termResult (hashQualifiedTermName b name ref) ref (aliases ref)
|
||||
pair qn = case score qn name of
|
||||
Just score -> Set.singleton (Just score, result)
|
||||
Nothing -> mempty
|
||||
aliases r = hashNamesForTerm r b
|
||||
|
||||
searchTypeNamespace :: forall score. Ord score =>
|
||||
Branch0
|
||||
-> (Name -> Name -> Maybe score)
|
||||
-> [HashQualified]
|
||||
-> Set (Maybe score, SearchResult)
|
||||
searchTypeNamespace b score queries = foldMap do1query queries
|
||||
where
|
||||
do1query :: HashQualified -> Set (Maybe score, SearchResult)
|
||||
do1query q = foldMap (score1hq q) (R.toList . typeNamespace $ b)
|
||||
-- hashNamesForTerm r b
|
||||
score1hq :: HashQualified -> (Name, Reference) -> Set (Maybe score, SearchResult)
|
||||
score1hq query (name, ref) = case query of
|
||||
HQ.NameOnly qn ->
|
||||
pair qn
|
||||
HQ.HashQualified qn h | h `SH.isPrefixOf` (Reference.toShortHash ref) ->
|
||||
pair qn
|
||||
HQ.HashOnly h | h `SH.isPrefixOf` (Reference.toShortHash ref) ->
|
||||
Set.singleton (Nothing, result)
|
||||
_ -> mempty
|
||||
where
|
||||
result = SR.typeResult (hashQualifiedTypeName b name ref) ref (aliases ref)
|
||||
pair qn = case score qn name of
|
||||
Just score -> Set.singleton (Just score, result)
|
||||
Nothing -> mempty
|
||||
aliases r = hashNamesForType r b
|
||||
|
||||
@ -37,7 +37,7 @@ import Unison.Codebase.Branch ( Branch
|
||||
, Branch0
|
||||
)
|
||||
import qualified Unison.Codebase.Branch as Branch
|
||||
import Unison.Codebase.SearchResult ( SearchResult )
|
||||
import qualified Unison.Codebase.SearchResult as SR
|
||||
import qualified Unison.DataDeclaration as DD
|
||||
import Unison.FileParsers ( parseAndSynthesizeFile )
|
||||
import Unison.HashQualified ( HashQualified )
|
||||
@ -174,6 +174,24 @@ type AllowUpdates = Bool
|
||||
data DisplayThing a = BuiltinThing | MissingThing Reference.Id | RegularThing a
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data SearchResult' v a
|
||||
= Tm'' (TermResult' v a)
|
||||
| Tp'' (TypeResult' v a)
|
||||
deriving (Eq, Show)
|
||||
data TermResult' v a =
|
||||
TermResult'' HashQualified (Maybe (Type v a)) Referent (Set HashQualified)
|
||||
deriving (Eq, Show)
|
||||
data TypeResult' v a =
|
||||
TypeResult'' HashQualified (DisplayThing (Decl v a)) Reference (Set HashQualified)
|
||||
deriving (Eq, Show)
|
||||
pattern Tm h t r as = Tm'' (TermResult'' h t r as)
|
||||
pattern Tp h t r as = Tp'' (TypeResult'' h t r as)
|
||||
|
||||
searchResult' :: (TermResult' v a -> b) -> (TypeResult' v a -> b) -> SearchResult' v a -> b
|
||||
searchResult' f g = \case
|
||||
Tm'' tm -> f tm
|
||||
Tp'' tp -> g tp
|
||||
|
||||
data Output v
|
||||
= Success Input
|
||||
| NoUnisonFile
|
||||
@ -187,9 +205,7 @@ data Output v
|
||||
| ConflictedName BranchName NameTarget Name
|
||||
| BranchAlreadyExists BranchName
|
||||
| ListOfBranches BranchName [BranchName]
|
||||
| ListOfDefinitions Branch
|
||||
[(HashQualified, Referent, Maybe (Type v Ann))]
|
||||
[(HashQualified, Reference, DisplayThing (Decl v Ann))]
|
||||
| ListOfDefinitions Branch [SearchResult' v Ann]
|
||||
| SlurpOutput (SlurpResult v)
|
||||
-- Original source, followed by the errors:
|
||||
| ParseErrors Text [Parser.Err v]
|
||||
@ -326,7 +342,7 @@ data Command i v a where
|
||||
GetConflicts :: Branch -> Command i v Branch0
|
||||
|
||||
-- Return a list of definitions whose names match the given queries.
|
||||
SearchBranch :: Branch -> [HashQualified] -> Command i v (SearchResult v Ann)
|
||||
SearchBranch :: Branch -> [HashQualified] -> Command i v [SearchResult' v Ann]
|
||||
|
||||
LoadTerm :: Reference.Id -> Command i v (Maybe (Term v Ann))
|
||||
|
||||
@ -652,8 +668,10 @@ commandLine awaitInput rt branchChange notifyUser codebase command = do
|
||||
MergeBranch branchName branch -> mergeBranch codebase branch branchName
|
||||
GetConflicts branch -> pure $ Branch.conflicts' (Branch.head branch)
|
||||
SwitchBranch branch branchName -> branchChange branch branchName
|
||||
SearchBranch branch queries ->
|
||||
Codebase.searchBranch codebase (Branch.head branch) nameDistance queries
|
||||
SearchBranch (Branch.head -> branch) queries -> do
|
||||
let termResults = Branch.searchTermNamespace branch nameDistance queries
|
||||
typeResults = Branch.searchTypeNamespace branch nameDistance queries
|
||||
loadSearchResults codebase . fmap snd . toList $ termResults <> typeResults
|
||||
LoadTerm r -> Codebase.getTerm codebase r
|
||||
LoadType r -> Codebase.getTypeDeclaration codebase r
|
||||
Todo b -> doTodo codebase (Branch.head b)
|
||||
@ -689,6 +707,24 @@ doTodo code b = do
|
||||
(dirtyTermsNamed, dirtyTypesNamed)
|
||||
(Branch.conflicts' b)
|
||||
|
||||
loadSearchResults :: (Monad m, Var v) =>
|
||||
Codebase m v a -> [SR.SearchResult] -> m [SearchResult' v a]
|
||||
loadSearchResults code = traverse loadSearchResult
|
||||
where
|
||||
loadSearchResult = \case
|
||||
SR.Tm (SR.TermResult name r aliases) -> do
|
||||
typ <- case r of
|
||||
Referent.Ref r -> Codebase.getTypeOfTerm code r
|
||||
Referent.Con r cid -> Codebase.getTypeOfConstructor code r cid
|
||||
pure $ Tm name typ r aliases
|
||||
SR.Tp (SR.TypeResult name r aliases) -> do
|
||||
dt <- case r of
|
||||
Reference.Builtin _ -> pure BuiltinThing
|
||||
Reference.DerivedId id ->
|
||||
maybe (MissingThing id) RegularThing <$>
|
||||
Codebase.getTypeDeclaration code id
|
||||
pure $ Tp name dt r aliases
|
||||
|
||||
loadDefinitions :: Monad m => Codebase m v a -> Set Reference
|
||||
-> m ( [(Reference, Maybe (Type v a))],
|
||||
[(Reference, DisplayThing (Decl v a))] )
|
||||
@ -706,6 +742,7 @@ loadDefinitions code refs = do
|
||||
Just d -> pure (r, RegularThing d)
|
||||
pure (terms, types)
|
||||
|
||||
|
||||
nameDistance :: Name -> Name -> Maybe Int
|
||||
nameDistance (Name.toString -> q) (Name.toString -> n) =
|
||||
if q == n then Just 0-- exact match is top choice
|
||||
|
||||
@ -23,7 +23,7 @@ import Control.Monad.Trans.Maybe ( MaybeT(..)
|
||||
import Data.Foldable ( foldl'
|
||||
, toList
|
||||
)
|
||||
import Data.Maybe ( fromMaybe )
|
||||
import Data.Maybe ( catMaybes, fromMaybe )
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import Data.Traversable ( for )
|
||||
@ -48,7 +48,6 @@ import Unison.Codebase.Editor ( Command(..)
|
||||
, collateReferences
|
||||
)
|
||||
import qualified Unison.Codebase.Editor as Editor
|
||||
import qualified Unison.Codebase.SearchResult as SR
|
||||
import qualified Unison.HashQualified as HQ
|
||||
import Unison.Name ( Name )
|
||||
import Unison.Names ( NameTarget )
|
||||
@ -145,25 +144,22 @@ loop s = Free.unfold' (evalStateT (maybe (Left ()) Right <$> runMaybeT (go *> ge
|
||||
latestFile .= Just (Text.unpack sourceName, False)
|
||||
latestTypecheckedFile .= Just unisonFile
|
||||
Right input -> case input of
|
||||
SearchByNameI (fmap HQ.fromString -> qs) -> do
|
||||
SR.SearchResult terms types <- eval $ SearchBranch currentBranch' qs
|
||||
let terms' = fmap go terms where
|
||||
go (SR.TermResult name ref typ _aliases) = (name, ref, typ)
|
||||
let types0 = traverse go types where
|
||||
go (SR.TypeResult name ref _aliases) = case ref of
|
||||
-- We load the type to determine if data or ability.
|
||||
Reference.DerivedId id ->
|
||||
(name, ref, ) . maybe (MissingThing id) RegularThing <$> eval (LoadType id)
|
||||
_ -> pure (name, ref, BuiltinThing)
|
||||
types0 >>= respond . ListOfDefinitions currentBranch' terms'
|
||||
SearchByNameI (fmap HQ.fromString -> qs) ->
|
||||
(eval $ SearchBranch currentBranch' qs)
|
||||
>>= respond . ListOfDefinitions currentBranch'
|
||||
ShowDefinitionI outputLoc (fmap HQ.fromString -> qs) -> do
|
||||
SR.SearchResult terms types <- eval $ SearchBranch currentBranch' qs
|
||||
let termTypes = Map.fromList
|
||||
results <- eval $ SearchBranch currentBranch' qs
|
||||
let termTypes :: Map.Map Reference (Editor.Type v Ann)
|
||||
termTypes = Map.fromList
|
||||
[ (r, t)
|
||||
| SR.TermResult _ (Referent.Ref r) (Just t) _ <- terms ]
|
||||
| Editor.Tm _ (Just t) (Referent.Ref r) _ <- results ]
|
||||
termReferent (Editor.Tm _ _ r _) = Just r
|
||||
termReferent _ = Nothing
|
||||
typeReference (Editor.Tp _ _ r _) = Just r
|
||||
typeReference _ = Nothing
|
||||
(collatedTerms, collatedTypes) =
|
||||
collateReferences (SR.referent <$> terms)
|
||||
(SR.reference <$> types)
|
||||
collateReferences (catMaybes . map termReferent $ results)
|
||||
(catMaybes . map typeReference $ results)
|
||||
loadedTerms <- for collatedTerms $ \r -> case r of
|
||||
Reference.DerivedId i -> do
|
||||
tm <- eval (LoadTerm i)
|
||||
@ -174,17 +170,17 @@ loop s = Free.unfold' (evalStateT (maybe (Left ()) Right <$> runMaybeT (go *> ge
|
||||
Just (tm, typ) -> case tm of
|
||||
Term.Ann' _ _ -> RegularThing tm
|
||||
_ -> RegularThing (Term.ann (ABT.annotation tm) tm typ)
|
||||
_ -> pure (r, BuiltinThing)
|
||||
Reference.Builtin _ -> pure (r, BuiltinThing)
|
||||
loadedTypes <- for collatedTypes $ \r -> case r of
|
||||
Reference.DerivedId i ->
|
||||
(r, ) . maybe (MissingThing i) RegularThing <$> eval (LoadType i)
|
||||
_ -> pure (r, BuiltinThing)
|
||||
Reference.Builtin _ -> pure (r, BuiltinThing)
|
||||
-- makes sure that the user search terms get used as the names
|
||||
-- in the pretty-printer
|
||||
let
|
||||
ppe =
|
||||
PPE.fromTermNames [ (r, n) | SR.TermResult n r _ _ <- terms ] <>
|
||||
PPE.fromTypeNames [ (r, n) | SR.TypeResult n r _ <- types ] <>
|
||||
PPE.fromTermNames [ (r, n) | Editor.Tm n _ r _ <- results ] <>
|
||||
PPE.fromTypeNames [ (r, n) | Editor.Tp n _ r _ <- results ] <>
|
||||
Branch.prettyPrintEnv (Branch.head currentBranch')
|
||||
loc = case outputLoc of
|
||||
Editor.ConsoleLocation -> Nothing
|
||||
|
||||
@ -291,8 +291,6 @@ codebase1 builtinTypeAnnotation (S.Format getV putV) (S.Format getA putA) path
|
||||
putTerm
|
||||
getDecl
|
||||
putDecl
|
||||
(error "todo")
|
||||
(error "todo")
|
||||
branches
|
||||
getBranch
|
||||
mergeBranch
|
||||
|
||||
@ -1,95 +1,26 @@
|
||||
module Unison.Codebase.SearchResult where
|
||||
|
||||
-- import Data.List (sortOn)
|
||||
-- import Data.Map (Map)
|
||||
import Data.Set (Set)
|
||||
import Unison.HashQualified (HashQualified)
|
||||
import Unison.Reference (Reference)
|
||||
import Unison.Referent (Referent)
|
||||
import qualified Unison.Term as Term
|
||||
import qualified Unison.Type as Type
|
||||
|
||||
type Term v a = Term.AnnotatedTerm v a
|
||||
type Type v a = Type.AnnotatedType v a
|
||||
data SearchResult = Tm TermResult | Tp TypeResult deriving (Eq, Ord, Show)
|
||||
|
||||
data SearchResult v a = SearchResult
|
||||
{ termResults :: [TermResult v a]
|
||||
, typeResults :: [TypeResult]
|
||||
}
|
||||
|
||||
data SearchResult' v a score = SearchResult'
|
||||
{ termResults' :: [(score, TermResult v a)]
|
||||
, typeResults' :: [(score, TypeResult)]
|
||||
} deriving (Eq, Show) -- ABT.Term lacks Ord instance
|
||||
|
||||
data TermResult v a = TermResult
|
||||
data TermResult = TermResult
|
||||
{ termName :: HashQualified
|
||||
, referent :: Referent
|
||||
, termType :: Maybe (Type v a)
|
||||
, termAliases :: Set HashQualified
|
||||
} deriving (Eq, Show)
|
||||
} deriving (Eq, Ord, Show)
|
||||
|
||||
data TypeResult = TypeResult
|
||||
{ typeName :: HashQualified
|
||||
, reference :: Reference
|
||||
, typeAliases :: [HashQualified]
|
||||
} deriving (Eq, Show)
|
||||
, typeAliases :: Set HashQualified
|
||||
} deriving (Eq, Ord, Show)
|
||||
|
||||
-- May eventually want a version that includes the term or type,
|
||||
-- but think about which fields this new case actually needs.
|
||||
termResult :: HashQualified -> Referent -> Set HashQualified -> SearchResult
|
||||
termResult hq r as = Tm (TermResult hq r as)
|
||||
|
||||
instance Semigroup (SearchResult v a) where
|
||||
left <> right = SearchResult (termResults left <> termResults right)
|
||||
(typeResults left <> typeResults right)
|
||||
instance Monoid (SearchResult v a) where
|
||||
mempty = SearchResult [] []
|
||||
mappend = (<>)
|
||||
|
||||
|
||||
-- note: don't use Down
|
||||
-- instance Ord score => Semigroup (SearchResult' v a score) where
|
||||
-- left <> right = SearchResult'
|
||||
-- (sortOn (Down . fst) $ termResults left <> termResults right)
|
||||
-- (sortOn (Down . fst) $ typeResults left <> typeResults right)
|
||||
-- instance Ord score => Monoid (SearchResult' v a score) where
|
||||
-- mempty = SearchResult' [] []
|
||||
-- mappend = (<>)
|
||||
|
||||
data SearchResult0' score = SearchResult0'
|
||||
{ termResults0' :: [(score, TermResult0)]
|
||||
, typeResults0' :: [(score, TypeResult)]
|
||||
-- , byReferent0 :: Map Referent TermResult0
|
||||
-- , byReference0 :: Map Reference TypeResult
|
||||
}
|
||||
|
||||
data SearchResult0 = SearchResult0
|
||||
{ termResults0 :: [TermResult0]
|
||||
, typeResults0 :: [TypeResult]
|
||||
-- , byReferent0 :: Map Referent TermResult0
|
||||
-- , byReference0 :: Map Reference TypeResult
|
||||
}
|
||||
|
||||
data TermResult0 = TermResult0
|
||||
{ termName0 :: HashQualified
|
||||
, referent0 :: Referent
|
||||
, termAliases0 :: Set HashQualified
|
||||
}
|
||||
|
||||
-- instance Ord score => Semigroup (SearchResult0' score) where
|
||||
-- left <> right = SearchResult0
|
||||
-- (sortOn (Down . fst) $ termResults0 left <> termResults0 right)
|
||||
-- (sortOn (Down . fst) $ typeResults0 left <> typeResults0 right)
|
||||
-- -- (byReferent0 left <> byReferent0 right)
|
||||
-- -- (byReference0 left <> byReference0 right)
|
||||
-- instance Ord score => Monoid (SearchResult0' score) where
|
||||
-- mempty = SearchResult0 mempty mempty -- mempty mempty
|
||||
-- mappend = (<>)
|
||||
|
||||
instance Semigroup SearchResult0 where
|
||||
left <> right = SearchResult0
|
||||
(termResults0 left <> termResults0 right)
|
||||
(typeResults0 left <> typeResults0 right)
|
||||
|
||||
instance Monoid SearchResult0 where
|
||||
mempty = SearchResult0 mempty mempty -- mempty mempty
|
||||
mappend = (<>)
|
||||
typeResult :: HashQualified -> Reference -> Set HashQualified -> SearchResult
|
||||
typeResult hq r as = Tp (TypeResult hq r as)
|
||||
|
||||
@ -120,7 +120,7 @@ completion s = Line.Completion s s True
|
||||
|
||||
autoComplete :: String -> [String] -> [Line.Completion]
|
||||
autoComplete q ss = fixup $
|
||||
completion <$> error "todo"--Codebase.sortedApproximateMatches q ss
|
||||
completion <$> error "todo" ss--Codebase.sortedApproximateMatches q ss
|
||||
where
|
||||
-- workaround for https://github.com/judah/haskeline/issues/100
|
||||
-- if the common prefix of all the completions is smaller than
|
||||
|
||||
@ -15,11 +15,12 @@ import Control.Applicative ((<|>))
|
||||
import Control.Monad (join, when, unless)
|
||||
import Data.Foldable (toList, traverse_)
|
||||
import Data.List (sort)
|
||||
import Data.ListLike (ListLike)
|
||||
import Data.List.Extra (nubOrdOn)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (listToMaybe)
|
||||
import qualified Data.Set as Set
|
||||
import Data.String (fromString)
|
||||
import Data.String (IsString, fromString)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Text.IO (readFile, writeFile)
|
||||
import Prelude hiding (readFile, writeFile)
|
||||
@ -52,7 +53,6 @@ import qualified Unison.Referent as Referent
|
||||
import qualified Unison.Result as Result
|
||||
import Unison.Term (AnnotatedTerm)
|
||||
import qualified Unison.TermPrinter as TermPrinter
|
||||
import Unison.Type (AnnotatedType)
|
||||
import qualified Unison.TypePrinter as TypePrinter
|
||||
import qualified Unison.Typechecker.TypeLookup as TL
|
||||
import qualified Unison.UnisonFile as UF
|
||||
@ -140,8 +140,8 @@ notifyUser dir o = case o of
|
||||
then P.bold ("* " <> P.text n)
|
||||
else " " <> P.text n
|
||||
in intercalateMap "\n" go (sort branches)
|
||||
ListOfDefinitions branch terms types ->
|
||||
listOfDefinitions (Branch.head branch) terms types
|
||||
ListOfDefinitions branch results ->
|
||||
listOfDefinitions (Branch.head branch) results
|
||||
SlurpOutput s -> slurpOutput s
|
||||
ParseErrors src es -> do
|
||||
Console.setTitle "Unison ☹︎"
|
||||
@ -290,15 +290,31 @@ displayDefinitions outputLoc ppe terms types =
|
||||
<> P.newline
|
||||
<> tip "You might need to repair the codebase manually."
|
||||
|
||||
unsafePrettyTermResult' :: Var v =>
|
||||
PPE.PrettyPrintEnv -> E.TermResult' v a -> P.Pretty P.ColorText
|
||||
unsafePrettyTermResult' ppe = \case
|
||||
E.TermResult'' name (Just typ) _r aliases ->
|
||||
prettyAliases aliases <> head (TypePrinter.prettySignatures' ppe [(name,typ)])
|
||||
_ -> error "Don't use Nothing"
|
||||
|
||||
prettyTypeResult' :: E.TypeResult' v a -> P.Pretty P.ColorText
|
||||
prettyTypeResult' (E.TypeResult'' name dt r aliases) =
|
||||
prettyAliases aliases <> prettyDeclTriple (name, r, dt)
|
||||
|
||||
prettyAliases ::
|
||||
(Foldable t, ListLike s Char, IsString s) => t HQ.HashQualified -> P.Pretty s
|
||||
prettyAliases aliases = if null aliases then mempty else
|
||||
(P.commented . (:[]) . P.wrap . P.commas . fmap prettyHashQualified . toList) aliases <> P.newline
|
||||
|
||||
prettyDeclTriple ::
|
||||
(HQ.HashQualified, Reference.Reference, DisplayThing (TL.Decl v a))
|
||||
-> P.Pretty P.ColorText
|
||||
prettyDeclTriple (name, _, displayDecl) = case displayDecl of
|
||||
BuiltinThing -> P.wrap $ TypePrinter.prettyDataHeader name <> "(built-in)"
|
||||
MissingThing _ -> mempty -- these need to be handled elsewhere
|
||||
RegularThing decl -> case decl of
|
||||
Left _ability -> TypePrinter.prettyEffectHeader name
|
||||
Right _d -> TypePrinter.prettyDataHeader name
|
||||
BuiltinThing -> P.wrap $ TypePrinter.prettyDataHeader name <> "(built-in)"
|
||||
MissingThing _ -> mempty -- these need to be handled elsewhere
|
||||
RegularThing decl -> case decl of
|
||||
Left _ability -> TypePrinter.prettyEffectHeader name
|
||||
Right _data -> TypePrinter.prettyDataHeader name
|
||||
|
||||
renderNameConflicts :: Set.Set Name -> Set.Set Name -> P.Pretty CT.ColorText
|
||||
renderNameConflicts conflictedTypeNames conflictedTermNames =
|
||||
@ -386,29 +402,33 @@ todoOutput (Branch.head -> branch) todo =
|
||||
, formatMissingStuff corruptTerms corruptTypes
|
||||
]
|
||||
|
||||
listOfDefinitions :: Var v =>
|
||||
Branch0
|
||||
-> [(HQ.HashQualified, Referent.Referent, Maybe (AnnotatedType v a1))]
|
||||
-> [(HQ.HashQualified, Reference.Reference, DisplayThing (TL.Decl v2 a2))]
|
||||
-> IO ()
|
||||
listOfDefinitions branch terms types = do
|
||||
putPrettyLn . P.lines $
|
||||
typeResults ++
|
||||
TypePrinter.prettySignatures' ppe termsWithTypes ++
|
||||
listOfDefinitions :: Var v => Branch0 -> [E.SearchResult' v a] -> IO ()
|
||||
listOfDefinitions branch results = do
|
||||
putPrettyLn . P.lines $ prettyResults ++
|
||||
[formatMissingStuff termsWithMissingTypes missingTypes]
|
||||
unless (null impossible) . error $ "Compiler bug, these referents are missing types: " <> show impossible
|
||||
unless (null impossible) . error $
|
||||
"Compiler bug, these referents are missing types: " <> show impossible
|
||||
where
|
||||
ppe = Branch.prettyPrintEnv branch
|
||||
typeResults = map prettyDeclTriple types
|
||||
termsWithTypes = [(name,t) | (name, Just t) <- sigs0 ]
|
||||
where sigs0 = (\(name, _, typ) -> (name, typ)) <$> terms
|
||||
prettyResults =
|
||||
map (E.searchResult' (unsafePrettyTermResult' ppe) prettyTypeResult')
|
||||
(filter (not . missingType) results)
|
||||
-- typeResults = map prettyDeclTriple types
|
||||
missingType (E.Tm _ Nothing _ _) = True
|
||||
missingType (E.Tp _ (MissingThing _) _ _) = True
|
||||
missingType _ = False
|
||||
-- termsWithTypes = [(name,t) | (name, Just t) <- sigs0 ]
|
||||
-- where sigs0 = (\(name, _, typ) -> (name, typ)) <$> terms
|
||||
termsWithMissingTypes =
|
||||
[ (name, r) | (name, Referent.Ref (Reference.DerivedId r), Nothing) <- terms ]
|
||||
[ (name, r)
|
||||
| E.Tm name Nothing (Referent.Ref (Reference.DerivedId r)) _ <- results ]
|
||||
missingTypes = nubOrdOn snd $
|
||||
[ (name, Reference.DerivedId r) | (name, _, MissingThing r) <- types ] <>
|
||||
[ (name, r) | (name, Referent.toTypeReference -> Just r, Nothing) <- terms]
|
||||
impossible = terms >>= \case
|
||||
(name, r@(Referent.Ref (Reference.Builtin _)), Nothing) -> [(name,r)]
|
||||
[ (name, Reference.DerivedId r)
|
||||
| E.Tp name (MissingThing r) _ _ <- results ] <>
|
||||
[ (name, r)
|
||||
| E.Tm name Nothing (Referent.toTypeReference -> Just r) _ <- results]
|
||||
impossible = results >>= \case
|
||||
E.Tm name Nothing r@(Referent.Ref (Reference.Builtin _)) _ -> [(name,r)]
|
||||
_ -> []
|
||||
|
||||
-- todo: could probably use more cleanup
|
||||
|
||||
@ -41,7 +41,7 @@ data DataDeclaration' v a = DataDeclaration {
|
||||
annotation :: a,
|
||||
bound :: [v],
|
||||
constructors' :: [(a, v, AnnotatedType v a)]
|
||||
} deriving (Show, Functor)
|
||||
} deriving (Eq, Show, Functor)
|
||||
|
||||
generateConstructorRefs
|
||||
:: (Reference -> Int -> Reference)
|
||||
@ -136,7 +136,7 @@ type EffectDeclaration v = EffectDeclaration' v ()
|
||||
|
||||
newtype EffectDeclaration' v a = EffectDeclaration {
|
||||
toDataDecl :: DataDeclaration' v a
|
||||
} deriving (Show,Functor)
|
||||
} deriving (Eq,Show,Functor)
|
||||
|
||||
withEffectDecl :: (DataDeclaration' v a -> DataDeclaration' v' a') -> (EffectDeclaration' v a -> EffectDeclaration' v' a')
|
||||
withEffectDecl f e = EffectDeclaration (f . toDataDecl $ e)
|
||||
|
||||
@ -3,6 +3,7 @@
|
||||
|
||||
module Unison.HashQualified where
|
||||
|
||||
import Data.Maybe (isJust)
|
||||
import Data.String (IsString, fromString)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
@ -28,6 +29,15 @@ toName = \case
|
||||
HashQualified name _ -> Just name
|
||||
HashOnly _ -> Nothing
|
||||
|
||||
hasName :: HashQualified -> Bool
|
||||
hasName = isJust . toName
|
||||
|
||||
toHash :: HashQualified -> Maybe ShortHash
|
||||
toHash = \case
|
||||
NameOnly _ -> Nothing
|
||||
HashQualified _ sh -> Just sh
|
||||
HashOnly sh -> Just sh
|
||||
|
||||
take :: Int -> HashQualified -> HashQualified
|
||||
take i = \case
|
||||
n@(NameOnly _) -> n
|
||||
@ -47,8 +57,9 @@ fromText t =
|
||||
case Text.breakOn "#" t of
|
||||
("", "") -> error "don't give me that" -- a hash mark with nothing else
|
||||
(name, "") -> NameOnly (Name.unsafeFromText name) -- safe bc breakOn #
|
||||
("", hash) -> HashOnly (SH.fromText hash)
|
||||
(name, hash) -> HashQualified (Name.unsafeFromText name) (SH.fromText hash)
|
||||
("", hash) -> HashOnly (SH.unsafeFromText hash) -- safe bc breakOn #
|
||||
(name, hash) -> HashQualified (Name.unsafeFromText name)
|
||||
(SH.unsafeFromText hash)
|
||||
|
||||
toText :: HashQualified -> Text
|
||||
toText = \case
|
||||
@ -56,12 +67,12 @@ toText = \case
|
||||
HashQualified name hash -> Name.toText name <> SH.toText hash
|
||||
HashOnly ref -> Text.pack (show ref)
|
||||
|
||||
fromNamedReferent :: Referent -> Name -> HashQualified
|
||||
fromNamedReferent r n =
|
||||
fromNamedReferent :: Name -> Referent -> HashQualified
|
||||
fromNamedReferent n r =
|
||||
HashQualified n (Referent.toShortHash r)
|
||||
|
||||
fromNamedReference :: Reference -> Name -> HashQualified
|
||||
fromNamedReference r n =
|
||||
fromNamedReference :: Name -> Reference -> HashQualified
|
||||
fromNamedReference n r =
|
||||
HashQualified n (Reference.toShortHash r)
|
||||
|
||||
fromReferent :: Referent -> HashQualified
|
||||
|
||||
@ -3,7 +3,6 @@
|
||||
module Unison.NamePrinter where
|
||||
|
||||
import Data.String (IsString, fromString)
|
||||
import qualified Data.Text as Text
|
||||
import Unison.HashQualified (HashQualified)
|
||||
import qualified Unison.HashQualified as HQ
|
||||
import Unison.Name (Name)
|
||||
|
||||
@ -32,6 +32,9 @@ unqualified = Name.unsafeFromText . unqualified' . Name.toText
|
||||
unqualified' :: Text -> Text
|
||||
unqualified' = last . Text.splitOn "."
|
||||
|
||||
-- Names is like Branch.Namespace, but:
|
||||
-- - there are no conflicts
|
||||
-- - lookup is one-directional
|
||||
data Names = Names
|
||||
{ termNames :: Map Name Referent
|
||||
, typeNames :: Map Name Reference
|
||||
|
||||
@ -25,7 +25,7 @@ import Control.Monad (join)
|
||||
import Data.Foldable (toList)
|
||||
import Data.List
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe (fromJust, fromMaybe, maybe)
|
||||
import Data.Maybe (fromJust, maybe)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text (Text)
|
||||
@ -64,7 +64,7 @@ data Id = Id H.Hash Pos Size deriving (Eq,Ord,Generic)
|
||||
-- but Show Reference currently depends on SH
|
||||
toShortHash :: Reference -> ShortHash
|
||||
toShortHash (Builtin b) = SH.Builtin b
|
||||
toShortHash (Derived h i n) = SH.ShortHash (H.base58 h) Nothing Nothing
|
||||
toShortHash (Derived h 0 _) = SH.ShortHash (H.base58 h) Nothing Nothing
|
||||
toShortHash (Derived h i n) = SH.ShortHash (H.base58 h) index Nothing
|
||||
where
|
||||
-- todo: remove `n` parameter; must also update readSuffix
|
||||
@ -74,6 +74,7 @@ toShortHash (Derived h i n) = SH.ShortHash (H.base58 h) index Nothing
|
||||
encode58 = decodeUtf8 . Base58.encodeBase58 Base58.bitcoinAlphabet
|
||||
put = putLength i >> putLength n
|
||||
putLength = serialize . VarInt
|
||||
toShortHash (DerivedId _) = error "this should be covered above"
|
||||
|
||||
showShort :: Int -> Reference -> Text
|
||||
showShort numHashChars = SH.toText . SH.take numHashChars . toShortHash
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
|
||||
module Unison.Referent where
|
||||
|
||||
import Data.Maybe (fromMaybe)
|
||||
-- import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Word (Word64)
|
||||
@ -23,7 +23,7 @@ import Data.Bytes.VarInt (VarInt (..))
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Base58 as Base58
|
||||
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
|
||||
import Safe (readMay)
|
||||
-- import Safe (readMay)
|
||||
|
||||
data Referent = Ref Reference | Con Reference Int
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
@ -3,11 +3,9 @@
|
||||
|
||||
module Unison.ShortHash where
|
||||
|
||||
import Data.Either (fromRight)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Safe (readMay)
|
||||
|
||||
-- Arya created this type to be able to query the Codebase for anonymous definitions. The parsing functions can't fail, because they only try to pull apart the syntactic elements "#" and ".". They don't necessarily produce a meaningful reference; you'll figure that out during base58 decoding. We don't attempt base58 decoding here because the base58 prefix doesn't correspond to anything useful. We'll just compare strings against the codebase or namespace later.
|
||||
data ShortHash
|
||||
@ -24,16 +22,28 @@ data ShortHash
|
||||
-- `#cWkiC1x89#1` — constructor
|
||||
-- `#DCxrnCAPS.WD#0` — constructor of a type in a cycle
|
||||
-- Anything to the left of the first # is ignored.
|
||||
fromText :: Text -> ShortHash
|
||||
-- e.g. foo#abc is parsed as #abc
|
||||
-- Anything including and following a third # is ignored.
|
||||
-- e.g. foo#abc#2#hello is parsed as #abc#2
|
||||
-- Anything after a second . before a second # is ignored.
|
||||
-- e.g. foo#abc.1f.x is parsed as #abc.1f
|
||||
fromText :: Text -> Maybe ShortHash
|
||||
fromText t = case Text.split (=='#') t of
|
||||
[_, "", b] -> Builtin b -- builtin gets ##
|
||||
[_, h] -> uncurry ShortHash (getCycle h) Nothing
|
||||
[_, h, c] -> uncurry ShortHash (getCycle h) (Just c)
|
||||
[_, "", b] -> Just $ Builtin b -- builtin gets ##
|
||||
[_, h] -> Just $ uncurry ShortHash (getCycle h) Nothing
|
||||
_ : h : c : _garbage -> Just $ uncurry ShortHash (getCycle h) (Just c)
|
||||
_ -> Nothing
|
||||
where
|
||||
getCycle :: Text -> (Text, Maybe Text)
|
||||
getCycle h = case Text.split (=='.') h of
|
||||
[] -> ("", Nothing) -- e.g. foo#.1j
|
||||
[hash] -> (hash, Nothing)
|
||||
[hash, suffix] -> (hash, Just suffix)
|
||||
hash : suffix : _garbage -> (hash, Just suffix)
|
||||
|
||||
unsafeFromText :: Text -> ShortHash
|
||||
unsafeFromText t = fromMaybe
|
||||
(error . Text.unpack $ "can't parse ShortHash from: " <> t)
|
||||
(fromText t)
|
||||
|
||||
toText :: ShortHash -> Text
|
||||
toText (Builtin b) = "##" <> b
|
||||
@ -49,5 +59,17 @@ take :: Int -> ShortHash -> ShortHash
|
||||
take _ b@(Builtin _) = b
|
||||
take i s@(ShortHash{..}) = s { prefix = (Text.take i prefix) }
|
||||
|
||||
-- x `isPrefixOf` y is True iff x might be a shorter version of y
|
||||
isPrefixOf :: ShortHash -> ShortHash -> Bool
|
||||
isPrefixOf (Builtin t) (Builtin t2) = t `Text.isPrefixOf` t2
|
||||
isPrefixOf (ShortHash h n cid) (ShortHash h2 n2 cid2) =
|
||||
(Text.isPrefixOf h h2) && (maybePrefixOf n n2) && (maybePrefixOf cid cid2)
|
||||
where
|
||||
Nothing `maybePrefixOf` Nothing = True
|
||||
Nothing `maybePrefixOf` Just _ = True
|
||||
Just _ `maybePrefixOf` Nothing = False
|
||||
Just a `maybePrefixOf` Just b = a `Text.isPrefixOf` b
|
||||
isPrefixOf _ _ = False
|
||||
|
||||
instance Show ShortHash where
|
||||
show = Text.unpack . toText
|
||||
|
||||
@ -111,6 +111,7 @@ pretty' :: Var v => Maybe Int -> PrettyPrintEnv -> AnnotatedType v a -> String
|
||||
pretty' (Just width) n t = PP.render width $ pretty n (-1) t
|
||||
pretty' Nothing n t = PP.render maxBound $ pretty n (-1) t
|
||||
|
||||
-- todo: provide sample output in comment
|
||||
prettySignatures'
|
||||
:: Var v => PrettyPrintEnv
|
||||
-> [(HashQualified, AnnotatedType v a)]
|
||||
@ -121,6 +122,7 @@ prettySignatures' env ts = PP.align
|
||||
| (name, typ) <- ts
|
||||
]
|
||||
|
||||
-- todo: provide sample output in comment; different from prettySignatures'
|
||||
prettySignaturesAlt'
|
||||
:: Var v => PrettyPrintEnv
|
||||
-> [([HashQualified], AnnotatedType v a)]
|
||||
|
||||
@ -16,6 +16,7 @@ module Unison.Util.Pretty (
|
||||
warnCallout, fatalCallout, okCallout,
|
||||
column2,
|
||||
commas,
|
||||
commented,
|
||||
oxfordCommas,
|
||||
dashed,
|
||||
flatMap,
|
||||
@ -254,13 +255,22 @@ lines = intercalateMap newline id
|
||||
linesSpaced :: (Foldable f, IsString s) => f (Pretty s) -> Pretty s
|
||||
linesSpaced ps = lines (intersperse "" $ toList ps)
|
||||
|
||||
prefixed :: (Foldable f, LL.ListLike s Char, IsString s)
|
||||
=> Pretty s -> Pretty s -> f (Pretty s) -> Pretty s
|
||||
prefixed first rest =
|
||||
intercalateMap newline (\b -> first <> indentAfterNewline rest b)
|
||||
|
||||
bulleted
|
||||
:: (Foldable f, LL.ListLike s Char, IsString s) => f (Pretty s) -> Pretty s
|
||||
bulleted = intercalateMap newline (\b -> "* " <> indentAfterNewline " " b)
|
||||
bulleted = prefixed "* " " "
|
||||
|
||||
dashed
|
||||
:: (Foldable f, LL.ListLike s Char, IsString s) => f (Pretty s) -> Pretty s
|
||||
dashed = intercalateMap newline (\b -> "- " <> indentAfterNewline " " b)
|
||||
dashed = prefixed "- " " "
|
||||
|
||||
commented
|
||||
:: (Foldable f, LL.ListLike s Char, IsString s) => f (Pretty s) -> Pretty s
|
||||
commented = prefixed "-- " "-- "
|
||||
|
||||
numbered
|
||||
:: (Foldable f, LL.ListLike s Char, IsString s)
|
||||
|
||||
@ -88,6 +88,7 @@ library
|
||||
Unison.Runtime.Vector
|
||||
Unison.Runtime.SparseVector
|
||||
Unison.Settings
|
||||
Unison.ShortHash
|
||||
Unison.Symbol
|
||||
Unison.Term
|
||||
Unison.TermParser
|
||||
|
||||
Loading…
Reference in New Issue
Block a user