mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Merge branch 'wip/branchless' of github.com:unisonweb/unison into wip/branchless
This commit is contained in:
commit
9463b55aef
@ -12,6 +12,7 @@ module Unison.Builtin2 where
|
||||
import Control.Applicative ( liftA2
|
||||
-- , (<|>)
|
||||
)
|
||||
import Data.Bifunctor ( second )
|
||||
import Data.Foldable ( foldl' )
|
||||
import Data.Map ( Map )
|
||||
import qualified Data.Map as Map
|
||||
@ -98,7 +99,11 @@ parseType = error "todo" -- is `Names` something we want to keep using?
|
||||
|
||||
names0 :: Names0
|
||||
names0 = Names terms types where
|
||||
terms = Rel.mapRan Referent.Ref $ Rel.fromMap termNameRefs
|
||||
terms = Rel.mapRan Referent.Ref (Rel.fromMap termNameRefs) <>
|
||||
Rel.fromList [ (Name.fromVar vc, Referent.Con r cid)
|
||||
| (_,(r,decl)) <- builtinDataDecls @Symbol <>
|
||||
((second . second) DD.toDataDecl <$> builtinEffectDecls)
|
||||
, ((_,vc,_), cid) <- DD.constructors' decl `zip` [0..]]
|
||||
types = Rel.fromList builtinTypes <>
|
||||
Rel.fromList [ (Name.fromVar v, r) | (v,(r,_)) <- builtinDataDecls @Symbol ] <>
|
||||
Rel.fromList [ (Name.fromVar v, r) | (v,(r,_)) <- builtinEffectDecls @Symbol ]
|
||||
|
@ -607,9 +607,9 @@ loop = do
|
||||
-- UpdateBuiltinsI -> do
|
||||
-- stepAt updateBuiltins
|
||||
-- checkTodo
|
||||
-- ListEditsI -> do
|
||||
-- (Branch.head -> b) <- use currentBranch
|
||||
-- respond $ ListEdits b
|
||||
ListEditsI (Path.toAbsoluteSplit currentPath' -> (p,seg)) -> do
|
||||
patch <- eval . Eval . Branch.getPatch seg . Branch.head =<< getAt p
|
||||
respond $ ListEdits patch (Branch.toNames0 currentBranch0)
|
||||
PullRemoteBranchI repo path -> do
|
||||
loadRemoteBranchAt repo $ Path.toAbsolutePath currentPath' path
|
||||
success
|
||||
|
@ -56,7 +56,7 @@ data Input
|
||||
| UpdateI EditPath [HashQualified]
|
||||
| TodoI EditPath Path'
|
||||
| PropagateI EditPath Path'
|
||||
| ListEditsI EditPath Path'
|
||||
| ListEditsI EditPath
|
||||
-- -- create and remove update directives
|
||||
| DeprecateTermI EditPath Path.HQ'Split'
|
||||
| DeprecateTypeI EditPath Path.HQ'Split'
|
||||
|
@ -96,7 +96,7 @@ data Output v
|
||||
(Map Reference (DisplayThing (Term v Ann)))
|
||||
| TodoOutput Names0 (TodoOutput v Ann)
|
||||
| CantUndo UndoFailureReason
|
||||
-- | ListEdits Edits Names
|
||||
| ListEdits Patch Names0
|
||||
|
||||
-- new/unrepresented references followed by old/removed
|
||||
-- todo: eventually replace these sets with [SearchResult' v Ann]
|
||||
|
@ -424,9 +424,14 @@ validInputs =
|
||||
else pure . Input.ExecuteI $ unwords ws)
|
||||
, quit
|
||||
, updateBuiltins
|
||||
-- , InputPattern "edit.list" [] []
|
||||
-- "Lists all the edits in the current branch."
|
||||
-- (const . pure $ Input.ListEditsI)
|
||||
, InputPattern "view.patch" [] [(Required, patchPathArg)]
|
||||
"Lists all the edits in the given patch."
|
||||
(\case
|
||||
patchStr : [] -> first fromString $ do
|
||||
patch <- Path.parseSplit' Path.wordyNameSegment patchStr
|
||||
Right $ Input.ListEditsI patch
|
||||
_ -> Left $ warn "`view.patch` takes a patch and that's it."
|
||||
)
|
||||
]
|
||||
|
||||
allTargets :: Set.Set Names.NameTarget
|
||||
|
@ -235,6 +235,32 @@ notifyUser dir o = case o of
|
||||
putPrettyLn' . P.wrap $ "I couldn't do a git checkout of "
|
||||
<> P.text t <> ". Make sure there's a branch or commit "
|
||||
<> "with that name."
|
||||
ListEdits patch names0 -> do
|
||||
let
|
||||
ppe = PPE.fromNames0 names0
|
||||
types = Patch._typeEdits patch
|
||||
terms = Patch._termEdits patch
|
||||
|
||||
prettyTermEdit (r, TermEdit.Deprecate) =
|
||||
(prettyHashQualified . PPE.termName ppe . Referent.Ref $ r
|
||||
, "-> (deprecated)")
|
||||
prettyTermEdit (r, TermEdit.Replace r' _typing) =
|
||||
(prettyHashQualified . PPE.termName ppe . Referent.Ref $ r
|
||||
, "-> " <> (prettyHashQualified . PPE.termName ppe . Referent.Ref $ r'))
|
||||
prettyTypeEdit (r, TypeEdit.Deprecate) =
|
||||
(prettyHashQualified $ PPE.typeName ppe r
|
||||
, "-> (deprecated)")
|
||||
prettyTypeEdit (r, TypeEdit.Replace r') =
|
||||
(prettyHashQualified $ PPE.typeName ppe r
|
||||
, "-> " <> (prettyHashQualified . PPE.typeName ppe $ r'))
|
||||
when (not $ R.null types) $
|
||||
putPrettyLn $ "Edited Types:" `P.hang`
|
||||
P.column2 (prettyTypeEdit <$> R.toList types)
|
||||
when (not $ R.null terms) $
|
||||
putPrettyLn $ "Edited Terms:" `P.hang`
|
||||
P.column2 (prettyTermEdit <$> R.toList terms)
|
||||
when (R.null types && R.null terms)
|
||||
(putPrettyLn "This patch is empty.")
|
||||
BustedBuiltins (Set.toList -> new) (Set.toList -> old) ->
|
||||
-- todo: this could be prettier! Have a nice list like `find` gives, but
|
||||
-- that requires querying the codebase to determine term types. Probably
|
||||
|
@ -19,6 +19,27 @@ andThen f g x = g (f x)
|
||||
const : a -> b -> a
|
||||
const a _ = a
|
||||
|
||||
use Sequence take at size drop snoc cons ++
|
||||
|
||||
use Nat + /
|
||||
|
||||
use Universal compare
|
||||
|
||||
use Pair Pair
|
||||
|
||||
namespace Tuple where
|
||||
at1 : Pair a b -> a
|
||||
at1 p = case p of Pair.Pair a b -> a
|
||||
|
||||
at2 : Pair a (Pair b c) -> b
|
||||
at2 p = case p of (_, (b, _)) -> b
|
||||
|
||||
at3 : Pair a (Pair b (Pair c d)) -> c
|
||||
at3 p = case p of (_, (_, (c, _))) -> c
|
||||
|
||||
at4 : Pair a (Pair b (Pair c (Pair d e))) -> d
|
||||
at4 p = case p of (_, (_, (_, (d, _)))) -> d
|
||||
|
||||
namespace Sequence where
|
||||
|
||||
map : (a -> b) -> [a] -> [b]
|
||||
@ -73,7 +94,7 @@ namespace Sequence where
|
||||
|
||||
sortBy : (a -> b) -> [a] -> [a]
|
||||
sortBy f as =
|
||||
tweak p = (f (Tuple.at1 p), Tuple.at2 p, Tuple.at1 p)
|
||||
tweak p = case p of (p1,p2) -> (f p1, p2, p1)
|
||||
Heap.sort (map tweak (indexed as)) |> map Tuple.at3
|
||||
|
||||
halve : [a] -> ([a], [a])
|
||||
@ -95,7 +116,7 @@ namespace Sequence where
|
||||
|
||||
unsnoc : [a] -> Optional ([a], a)
|
||||
unsnoc as =
|
||||
i = size as `drop` 1
|
||||
i = size (drop 1 as)
|
||||
case at i as of
|
||||
None -> None
|
||||
Some a -> Some (take i as, a)
|
||||
@ -168,20 +189,6 @@ namespace Search where
|
||||
-- > Sequence.map (e -> indexOf e ex) ex
|
||||
-- > lubIndexOf 193 ex
|
||||
|
||||
use Pair Pair
|
||||
|
||||
namespace Tuple where
|
||||
at1 : Pair a b -> a
|
||||
at1 p = case p of Pair a _ -> a
|
||||
|
||||
at2 : Pair a (Pair b c) -> b
|
||||
at2 p = case p of Pair _ (Pair b _) -> b
|
||||
|
||||
at3 : Pair a (Pair b (Pair c d)) -> c
|
||||
at3 p = case p of Pair _ (Pair _ (Pair c _)) -> c
|
||||
|
||||
at4 : Pair a (Pair b (Pair c (Pair d e))) -> d
|
||||
at4 p = case p of Pair _ (Pair _ (Pair _ (Pair d _))) -> d
|
||||
|
||||
(|>) : a -> (a -> b) -> b
|
||||
a |> f = f a
|
||||
@ -379,7 +386,8 @@ namespace Heap where
|
||||
Some a -> case b of
|
||||
None -> Some a
|
||||
Some b -> Some (union a b)
|
||||
single kv = Some (singleton (Tuple.at1 kv) (Tuple.at2 kv))
|
||||
single kv = case kv of
|
||||
(k, v) -> Some (singleton k v)
|
||||
Sequence.foldb single op None kvs
|
||||
|
||||
fromKeys : [a] -> Optional (Heap a a)
|
||||
|
Loading…
Reference in New Issue
Block a user