unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-11 10:35:57 +03:00
Code Issues Projects Releases Wiki Activity

Don't expose Branch0 internals, (and add add lens utils to prelude)

Browse Source
This commit is contained in:
Chris Penner 2024-05-30 14:29:27 -07:00
parent 5732d9a822
commit 6384038ee0
65 changed files with 361 additions and 347 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lib/unison-prelude/src/Unison/Prelude.hs
View File

@ -38,12 +38,21 @@ module Unison.Prelude
throwEitherMWith,
throwExceptT,
throwExceptTWith,
-- * Basic lensy stuff we use all over
(^.),
(.~),
(%~),
view,
set,
over,
)
where
import Control.Applicative as X
import Control.Category as X ((>>>))
import Control.Exception as X (Exception, IOException, SomeException)
import Control.Lens (over, set, view, (%~), (.~), (^.))
import Control.Monad as X
import Control.Monad.Extra as X (ifM, mapMaybeM, unlessM, whenM)
import Control.Monad.IO.Class as X (MonadIO (liftIO))

6
parser-typechecker/src/Unison/Builtin/Decls.hs
View File

@ -1,11 +1,10 @@
module Unison.Builtin.Decls where
import Control.Lens (over, _3)
import Control.Lens (_3)
import Data.List (elemIndex, find)
import Data.Map qualified as Map
import Data.Maybe qualified as Maybe
import Data.Sequence (Seq)
import Data.Text (Text, unpack)
import Data.Text (unpack)
import Unison.ABT qualified as ABT
import Unison.ConstructorReference (GConstructorReference (..))
import Unison.ConstructorType qualified as CT
@ -14,6 +13,7 @@ import Unison.DataDeclaration qualified as DD
import Unison.DataDeclaration.ConstructorId (ConstructorId)
import Unison.Hashing.V2.Convert (hashDataDecls, typeToReference)
import Unison.Pattern qualified as Pattern
import Unison.Prelude
import Unison.Reference (Reference)
import Unison.Reference qualified as Reference
import Unison.Referent (Referent)

212
parser-typechecker/src/Unison/Codebase/Branch.hs
View File

@ -5,7 +5,7 @@ module Unison.Codebase.Branch
( -- * Branch types
Branch (..),
UnwrappedBranch,
Branch0 (..),
Branch0,
Raw,
Star,
NamespaceHash,
@ -25,6 +25,7 @@ module Unison.Codebase.Branch
-- * Branch tests
isEmpty,
isEmpty0,
isOne,
before,
lca,
@ -83,6 +84,10 @@ module Unison.Codebase.Branch
edits,
-- ** Term/type queries
deepTerms,
deepTypes,
deepEdits,
deepPaths,
deepReferents,
deepTermReferences,
deepTypeReferences,
@ -91,13 +96,8 @@ module Unison.Codebase.Branch
where
import Control.Lens hiding (children, cons, transform, uncons)
import Control.Monad.State (State)
import Control.Monad.State qualified as State
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Semialign qualified as Align
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import Data.These (These (..))
import U.Codebase.Branch.Type (NamespaceStats (..))
import U.Codebase.HashTags (CausalHash, PatchHash (..))
@ -108,15 +108,23 @@ import Unison.Codebase.Branch.Type
NamespaceHash,
Star,
UnwrappedBranch,
branch0,
children,
deepEdits,
deepPaths,
deepTerms,
deepTypes,
edits,
head,
headHash,
history,
namespaceHash,
isEmpty0,
nonEmptyChildren,
terms,
types,
)
import Unison.Codebase.Causal (Causal)
import Unison.Codebase.Causal qualified as Causal
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Patch (Patch)
import Unison.Codebase.Patch qualified as Patch
import Unison.Codebase.Path (Path (..))
@ -132,7 +140,6 @@ import Unison.Reference (TermReference, TypeReference)
import Unison.Referent (Referent)
import Unison.Referent qualified as Referent
import Unison.Util.List qualified as List
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Relation qualified as R
import Unison.Util.Relation qualified as Relation
import Unison.Util.Set qualified as Set
@ -198,180 +205,14 @@ deepTermReferences =
deepTypeReferences :: Branch0 m -> Set TypeReference
deepTypeReferences = R.dom . deepTypes
terms :: Lens' (Branch0 m) (Star Referent NameSegment)
terms =
lens
_terms
\branch terms ->
branch {_terms = terms}
& deriveDeepTerms
types :: Lens' (Branch0 m) (Star TypeReference NameSegment)
types =
lens
_types
\branch types ->
branch {_types = types}
& deriveDeepTypes
children :: Lens' (Branch0 m) (Map NameSegment (Branch m))
children = lens _children (\Branch0 {..} x -> branch0 _terms _types x _edits)
nonEmptyChildren :: Branch0 m -> Map NameSegment (Branch m)
nonEmptyChildren b =
b
& _children
& Map.filter (not . isEmpty0 . head)
namespaceStats :: Branch0 m -> NamespaceStats
namespaceStats Branch0 {deepTerms, deepTypes, deepEdits} =
namespaceStats b =
NamespaceStats
{ numContainedTerms = Relation.size deepTerms,
numContainedTypes = Relation.size deepTypes,
numContainedPatches = Map.size deepEdits
{ numContainedTerms = Relation.size $ deepTerms b,
numContainedTypes = Relation.size $ deepTypes b,
numContainedPatches = Map.size $ deepEdits b
}
-- creates a Branch0 from the primary fields and derives the others.
branch0 ::
forall m.
Metadata.Star Referent NameSegment ->
Metadata.Star TypeReference NameSegment ->
Map NameSegment (Branch m) ->
Map NameSegment (PatchHash, m Patch) ->
Branch0 m
branch0 terms types children edits =
Branch0
{ _terms = terms,
_types = types,
_children = children,
_edits = edits,
isEmpty0 =
R.null (Star2.d1 terms)
&& R.null (Star2.d1 types)
&& Map.null edits
&& all (isEmpty0 . head) children,
-- These are all overwritten immediately
deepTerms = R.empty,
deepTypes = R.empty,
deepPaths = Set.empty,
deepEdits = Map.empty
}
& deriveDeepTerms
& deriveDeepTypes
& deriveDeepPaths
& deriveDeepEdits
-- | Derive the 'deepTerms' field of a branch.
deriveDeepTerms :: Branch0 m -> Branch0 m
deriveDeepTerms branch =
branch {deepTerms = R.fromList (makeDeepTerms branch)}
where
makeDeepTerms :: Branch0 m -> [(Referent, Name)]
makeDeepTerms branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
-- `reversePrefix` might be ["Nat", "base", "lib"], and `b0` the `Nat` sub-namespace.
-- Then `R.toList` might produce the NameSegment "+", and we put the two together to
-- construct the name `Name Relative ("+" :| ["Nat","base","lib"])`.
go ::
forall m.
Seq (DeepChildAcc m) ->
[(Referent, Name)] ->
DeepState m [(Referent, Name)]
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let terms :: [(Referent, Name)]
terms =
map
(second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix)))
(R.toList (Star2.d1 (_terms b0)))
children <- deepChildrenHelper e
go (work <> children) (terms <> acc)
-- | Derive the 'deepTypes' field of a branch.
deriveDeepTypes :: forall m. Branch0 m -> Branch0 m
deriveDeepTypes branch =
branch {deepTypes = R.fromList (makeDeepTypes branch)}
where
makeDeepTypes :: Branch0 m -> [(TypeReference, Name)]
makeDeepTypes branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
go ::
Seq (DeepChildAcc m) ->
[(TypeReference, Name)] ->
DeepState m [(TypeReference, Name)]
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let types :: [(TypeReference, Name)]
types = map (second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix))) (R.toList (Star2.d1 (_types b0)))
children <- deepChildrenHelper e
go (work <> children) (types <> acc)
-- | Derive the 'deepPaths' field of a branch.
deriveDeepPaths :: forall m. Branch0 m -> Branch0 m
deriveDeepPaths branch =
branch {deepPaths = makeDeepPaths branch}
where
makeDeepPaths :: Branch0 m -> Set Path
makeDeepPaths branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
go :: Seq (DeepChildAcc m) -> Set Path -> DeepState m (Set Path)
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let paths :: Set Path
paths =
if isEmpty0 b0
then Set.empty
else (Set.singleton . Path . Seq.fromList . reverse) reversePrefix
children <- deepChildrenHelper e
go (work <> children) (paths <> acc)
-- | Derive the 'deepEdits' field of a branch.
deriveDeepEdits :: forall m. Branch0 m -> Branch0 m
deriveDeepEdits branch =
branch {deepEdits = makeDeepEdits branch}
where
makeDeepEdits :: Branch0 m -> Map Name PatchHash
makeDeepEdits branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
go :: (Seq (DeepChildAcc m)) -> Map Name PatchHash -> DeepState m (Map Name PatchHash)
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let edits :: Map Name PatchHash
edits =
Map.mapKeysMonotonic
(Name.fromReverseSegments . (NonEmpty.:| reversePrefix))
(fst <$> _edits b0)
children <- deepChildrenHelper e
go (work <> children) (edits <> acc)
-- | State used by deepChildrenHelper to determine whether to descend into a child branch.
-- Contains the set of visited namespace hashes.
type DeepState m = State (Set (NamespaceHash m))
-- | Represents a unit of remaining work in traversing children for computing `deep*`.
-- (reverse prefix to a branch, the number of `lib` segments in the reverse prefix, and the branch itself)
type DeepChildAcc m = ([NameSegment], Int, Branch0 m)
-- | Helper for knowing whether to descend into a child branch or not.
-- Accepts child namespaces with previously unseen hashes, and any nested under 1 or fewer `lib` segments.
deepChildrenHelper :: forall m. DeepChildAcc m -> DeepState m (Seq (DeepChildAcc m))
deepChildrenHelper (reversePrefix, libDepth, b0) = do
let go :: (NameSegment, Branch m) -> DeepState m (Seq (DeepChildAcc m))
go (ns, b) = do
let h = namespaceHash b
result <- do
let isShallowDependency = libDepth <= 1
isUnseenNamespace <- State.gets (Set.notMember h)
pure
if isShallowDependency || isUnseenNamespace
then
let libDepth' = if ns == NameSegment.libSegment then libDepth + 1 else libDepth
in Seq.singleton (ns : reversePrefix, libDepth', head b)
else Seq.empty
State.modify' (Set.insert h)
pure result
Monoid.foldMapM go (Map.toList (nonEmptyChildren b0))
-- | Update the head of the current causal.
-- This re-hashes the current causal head after modifications.
head_ :: Lens' (Branch m) (Branch0 m)
@ -445,18 +286,7 @@ one :: Branch0 m -> Branch m
one = Branch . Causal.one
empty0 :: Branch0 m
empty0 =
Branch0
{ _terms = mempty,
_types = mempty,
_children = Map.empty,
_edits = Map.empty,
isEmpty0 = True,
deepTerms = Relation.empty,
deepTypes = Relation.empty,
deepPaths = Set.empty,
deepEdits = Map.empty
}
empty0 = branch0 mempty mempty mempty mempty
-- | Checks whether a branch is empty AND has no history.
isEmpty :: Branch m -> Bool

16
parser-typechecker/src/Unison/Codebase/Branch/BranchDiff.hs
View File

@ -1,9 +1,11 @@
module Unison.Codebase.Branch.BranchDiff where
import Control.Lens
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Map.Merge.Lazy qualified as MapMerge
import Unison.Codebase.Branch.Type (Branch0 (_edits, _terms, _types))
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Patch qualified as Patch
import Unison.NameSegment (NameSegment)
@ -27,8 +29,8 @@ data BranchDiff = BranchDiff
diff0 :: (Monad m) => Branch0 m -> Branch0 m -> m BranchDiff
diff0 old new = do
newEdits <- sequenceA $ snd <$> _edits new
oldEdits <- sequenceA $ snd <$> _edits old
newEdits <- sequenceA $ snd <$> new ^. Branch.edits
oldEdits <- sequenceA $ snd <$> old ^. Branch.edits
let diffEdits =
MapMerge.merge
(MapMerge.mapMissing $ \_ p -> Patch.diff p mempty)
@ -38,10 +40,10 @@ diff0 old new = do
oldEdits
pure $
BranchDiff
{ addedTerms = Star2.difference (_terms new) (_terms old),
removedTerms = Star2.difference (_terms old) (_terms new),
addedTypes = Star2.difference (_types new) (_types old),
removedTypes = Star2.difference (_types old) (_types new),
{ addedTerms = Star2.difference (new ^. Branch.terms) (old ^. Branch.terms),
removedTerms = Star2.difference (old ^. Branch.terms) (new ^. Branch.terms),
addedTypes = Star2.difference (new ^. Branch.types) (old ^. Branch.types),
removedTypes = Star2.difference (old ^. Branch.types) (new ^. Branch.types),
changedPatches = diffEdits
}

29
parser-typechecker/src/Unison/Codebase/Branch/Merge.hs
View File

@ -15,7 +15,7 @@ import Data.Map.Merge.Lazy qualified as Map
import U.Codebase.HashTags (PatchHash (..))
import Unison.Codebase.Branch
( Branch (..),
Branch0 (_children, _edits, _terms, _types),
Branch0,
branch0,
cons,
discardHistory0,
@ -24,6 +24,7 @@ import Unison.Codebase.Branch
isEmpty,
isEmpty0,
)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.BranchDiff (BranchDiff (BranchDiff))
import Unison.Codebase.Branch.BranchDiff qualified as BDiff
import Unison.Codebase.Causal qualified as Causal
@ -67,12 +68,12 @@ merge'' lca mode (Branch x) (Branch y) =
(Map.traverseMaybeMissing $ combineMissing ca)
(Map.traverseMaybeMissing $ combineMissing ca)
(Map.zipWithAMatched $ const (merge'' lca mode))
(_children l)
(_children r)
pure $ branch0 (_terms head0) (_types head0) children (_edits head0)
(l ^. Branch.children)
(r ^. Branch.children)
pure $ branch0 (head0 ^. Branch.terms) (head0 ^. Branch.types) children (head0 ^. Branch.edits)
combineMissing ca k cur =
case Map.lookup k (_children ca) of
case Map.lookup k (ca ^. Branch.children) of
Nothing -> pure $ Just cur
Just old -> do
nw <- merge'' lca mode (cons empty0 old) cur
@ -84,16 +85,16 @@ merge'' lca mode (Branch x) (Branch y) =
apply b0 (BranchDiff addedTerms removedTerms addedTypes removedTypes changedPatches) = do
patches <-
sequenceA $
Map.differenceWith patchMerge (pure @m <$> _edits b0) changedPatches
let newPatches = makePatch <$> Map.difference changedPatches (_edits b0)
Map.differenceWith patchMerge (pure @m <$> b0 ^. Branch.edits) changedPatches
let newPatches = makePatch <$> Map.difference changedPatches (b0 ^. Branch.edits)
makePatch Patch.PatchDiff {..} =
let p = Patch.Patch _addedTermEdits _addedTypeEdits
in (PatchHash (H.hashPatch p), pure p)
pure $
branch0
(Star2.difference (_terms b0) removedTerms <> addedTerms)
(Star2.difference (_types b0) removedTypes <> addedTypes)
(_children b0)
(Star2.difference (b0 ^. Branch.terms) removedTerms <> addedTerms)
(Star2.difference (b0 ^. Branch.types) removedTypes <> addedTypes)
(b0 ^. Branch.children)
(patches <> newPatches)
patchMerge mhp Patch.PatchDiff {..} = Just $ do
(_, mp) <- mhp
@ -118,12 +119,12 @@ merge0 ::
Branch0 m ->
m (Branch0 m)
merge0 lca mode b1 b2 = do
c3 <- unionWithM (merge'' lca mode) (_children b1) (_children b2)
e3 <- unionWithM g (_edits b1) (_edits b2)
c3 <- unionWithM (merge'' lca mode) (b1 ^. Branch.children) (b2 ^. Branch.children)
e3 <- unionWithM g (b1 ^. Branch.edits) (b2 ^. Branch.edits)
pure $
branch0
(_terms b1 <> _terms b2)
(_types b1 <> _types b2)
(b1 ^. Branch.terms <> b2 ^. Branch.terms)
(b1 ^. Branch.types <> b2 ^. Branch.types)
c3
e3
where

5
parser-typechecker/src/Unison/Codebase/Branch/Names.hs
View File

@ -6,6 +6,7 @@ module Unison.Codebase.Branch.Names
where
import Unison.Codebase.Branch
import Unison.Codebase.Branch.Type qualified as Branch
import Unison.Names (Names (..))
import Unison.NamesWithHistory qualified as Names
import Unison.PrettyPrintEnv.Names qualified as PPE
@ -24,8 +25,8 @@ toPrettyPrintEnvDecl hashLength b =
toNames :: Branch0 m -> Names
toNames b =
Names
(R.swap . deepTerms $ b)
(R.swap . deepTypes $ b)
(R.swap . Branch.deepTerms $ b)
(R.swap . Branch.deepTypes $ b)
namesDiff :: Branch m -> Branch m -> Names.Diff
namesDiff b1 b2 = Names.diff (toNames (head b1)) (toNames (head b2))

233
parser-typechecker/src/Unison/Codebase/Branch/Type.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
module Unison.Codebase.Branch.Type
@ -6,30 +7,50 @@ module Unison.Codebase.Branch.Type
headHash,
namespaceHash,
Branch (..),
Branch0 (..),
Branch0,
branch0,
terms,
types,
children,
nonEmptyChildren,
history,
edits,
isEmpty0,
deepTerms,
deepTypes,
deepPaths,
deepEdits,
Star,
UnwrappedBranch,
)
where
import Control.Lens
import Data.Map (Map)
import Data.Set (Set)
import U.Codebase.HashTags (CausalHash, PatchHash)
import Control.Lens hiding (children, cons, transform, uncons)
import Control.Monad.State (State)
import Control.Monad.State qualified as State
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Sequence qualified as Seq
import Data.Set qualified as Set
import U.Codebase.HashTags (CausalHash, PatchHash (..))
import Unison.Codebase.Causal.Type (Causal)
import Unison.Codebase.Causal.Type qualified as Causal
import Unison.Codebase.Metadata qualified as Metadata
import Unison.Codebase.Patch (Patch)
import Unison.Codebase.Path (Path)
import Unison.Codebase.Path (Path (..))
import Unison.Hash qualified as Hash
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.Reference (Reference)
import Unison.NameSegment qualified as NameSegment
import Unison.Prelude hiding (empty)
import Unison.Reference (Reference, TypeReference)
import Unison.Referent (Referent)
import Unison.Util.Monoid qualified as Monoid
import Unison.Util.Relation (Relation)
import Prelude hiding (head)
import Unison.Util.Relation qualified as R
import Unison.Util.Star2 qualified as Star2
import Prelude hiding (head, read, subtract)
-- | A node in the Unison namespace hierarchy
-- along with its history.
@ -59,7 +80,10 @@ namespaceHash (Branch c) = Causal.valueHash c
-- '_edits' are the 'Patch's stored at this node in the code.
--
-- The remaining fields are derived from the four above.
-- Please don't set them manually; use Branch.empty0 or Branch.branch0 to construct them.
-- None of the record fields are exported to avoid accidental tweaking without updating the
-- associated derived fields.
--
-- Use either the lensy accessors or the field getters.
data Branch0 m = Branch0
{ _terms :: Star Referent NameSegment,
_types :: Star Reference NameSegment,
@ -69,12 +93,12 @@ data Branch0 m = Branch0
_edits :: Map NameSegment (PatchHash, m Patch),
-- | True if a branch and its children have no definitions or edits in them.
-- (Computed recursively, and small enough to justify storing here to avoid computing more than once.)
isEmpty0 :: Bool,
_isEmpty0 :: Bool,
-- names for this branch and its children
deepTerms :: Relation Referent Name,
deepTypes :: Relation Reference Name,
deepPaths :: Set Path,
deepEdits :: Map Name PatchHash
_deepTerms :: Relation Referent Name,
_deepTypes :: Relation Reference Name,
_deepPaths :: Set Path,
_deepEdits :: Map Name PatchHash
}
instance Eq (Branch0 m) where
@ -89,3 +113,184 @@ history = iso _history Branch
edits :: Lens' (Branch0 m) (Map NameSegment (PatchHash, m Patch))
edits = lens _edits (\b0 e -> b0 {_edits = e})
terms :: Lens' (Branch0 m) (Star Referent NameSegment)
terms =
lens
_terms
\branch terms ->
branch {_terms = terms}
& deriveDeepTerms
types :: Lens' (Branch0 m) (Star TypeReference NameSegment)
types =
lens
_types
\branch types ->
branch {_types = types}
& deriveDeepTypes
isEmpty0 :: Branch0 m -> Bool
isEmpty0 = _isEmpty0
deepTerms :: Branch0 m -> Relation Referent Name
deepTerms = _deepTerms
deepTypes :: Branch0 m -> Relation TypeReference Name
deepTypes = _deepTypes
deepPaths :: Branch0 m -> Set Path
deepPaths = _deepPaths
deepEdits :: Branch0 m -> Map Name PatchHash
deepEdits = _deepEdits
children :: Lens' (Branch0 m) (Map NameSegment (Branch m))
children = lens _children (\Branch0 {_terms, _types, _edits} x -> branch0 _terms _types x _edits)
nonEmptyChildren :: Branch0 m -> Map NameSegment (Branch m)
nonEmptyChildren b =
b
& _children
& Map.filter (not . isEmpty0 . head)
-- creates a Branch0 from the primary fields and derives the others.
branch0 ::
forall m.
Metadata.Star Referent NameSegment ->
Metadata.Star TypeReference NameSegment ->
Map NameSegment (Branch m) ->
Map NameSegment (PatchHash, m Patch) ->
Branch0 m
branch0 terms types children edits =
Branch0
{ _terms = terms,
_types = types,
_children = children,
_edits = edits,
_isEmpty0 =
R.null (Star2.d1 terms)
&& R.null (Star2.d1 types)
&& Map.null edits
&& all (isEmpty0 . head) children,
-- These are all overwritten immediately
_deepTerms = R.empty,
_deepTypes = R.empty,
_deepPaths = Set.empty,
_deepEdits = Map.empty
}
& deriveDeepTerms
& deriveDeepTypes
& deriveDeepPaths
& deriveDeepEdits
-- | Derive the 'deepTerms' field of a branch.
deriveDeepTerms :: Branch0 m -> Branch0 m
deriveDeepTerms branch =
branch {_deepTerms = R.fromList (makeDeepTerms branch)}
where
makeDeepTerms :: Branch0 m -> [(Referent, Name)]
makeDeepTerms branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
-- `reversePrefix` might be ["Nat", "base", "lib"], and `b0` the `Nat` sub-namespace.
-- Then `R.toList` might produce the NameSegment "+", and we put the two together to
-- construct the name `Name Relative ("+" :| ["Nat","base","lib"])`.
go ::
forall m.
Seq (DeepChildAcc m) ->
[(Referent, Name)] ->
DeepState m [(Referent, Name)]
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let terms :: [(Referent, Name)]
terms =
map
(second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix)))
(R.toList (Star2.d1 (_terms b0)))
children <- deepChildrenHelper e
go (work <> children) (terms <> acc)
-- | Derive the 'deepTypes' field of a branch.
deriveDeepTypes :: forall m. Branch0 m -> Branch0 m
deriveDeepTypes branch =
branch {_deepTypes = R.fromList (makeDeepTypes branch)}
where
makeDeepTypes :: Branch0 m -> [(TypeReference, Name)]
makeDeepTypes branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
go ::
Seq (DeepChildAcc m) ->
[(TypeReference, Name)] ->
DeepState m [(TypeReference, Name)]
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let types :: [(TypeReference, Name)]
types = map (second (Name.fromReverseSegments . (NonEmpty.:| reversePrefix))) (R.toList (Star2.d1 (_types b0)))
children <- deepChildrenHelper e
go (work <> children) (types <> acc)
-- | Derive the 'deepPaths' field of a branch.
deriveDeepPaths :: forall m. Branch0 m -> Branch0 m
deriveDeepPaths branch =
branch {_deepPaths = makeDeepPaths branch}
where
makeDeepPaths :: Branch0 m -> Set Path
makeDeepPaths branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
go :: Seq (DeepChildAcc m) -> Set Path -> DeepState m (Set Path)
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let paths :: Set Path
paths =
if isEmpty0 b0
then Set.empty
else (Set.singleton . Path . Seq.fromList . reverse) reversePrefix
children <- deepChildrenHelper e
go (work <> children) (paths <> acc)
-- | Derive the 'deepEdits' field of a branch.
deriveDeepEdits :: forall m. Branch0 m -> Branch0 m
deriveDeepEdits branch =
branch {_deepEdits = makeDeepEdits branch}
where
makeDeepEdits :: Branch0 m -> Map Name PatchHash
makeDeepEdits branch = State.evalState (go (Seq.singleton ([], 0, branch)) mempty) Set.empty
where
go :: (Seq (DeepChildAcc m)) -> Map Name PatchHash -> DeepState m (Map Name PatchHash)
go Seq.Empty acc = pure acc
go (e@(reversePrefix, _, b0) Seq.:<| work) acc = do
let edits :: Map Name PatchHash
edits =
Map.mapKeysMonotonic
(Name.fromReverseSegments . (NonEmpty.:| reversePrefix))
(fst <$> _edits b0)
children <- deepChildrenHelper e
go (work <> children) (edits <> acc)
-- | State used by deepChildrenHelper to determine whether to descend into a child branch.
-- Contains the set of visited namespace hashes.
type DeepState m = State (Set (NamespaceHash m))
-- | Represents a unit of remaining work in traversing children for computing `deep*`.
-- (reverse prefix to a branch, the number of `lib` segments in the reverse prefix, and the branch itself)
type DeepChildAcc m = ([NameSegment], Int, Branch0 m)
-- | Helper for knowing whether to descend into a child branch or not.
-- Accepts child namespaces with previously unseen hashes, and any nested under 1 or fewer `lib` segments.
deepChildrenHelper :: forall m. DeepChildAcc m -> DeepState m (Seq (DeepChildAcc m))
deepChildrenHelper (reversePrefix, libDepth, b0) = do
let go :: (NameSegment, Branch m) -> DeepState m (Seq (DeepChildAcc m))
go (ns, b) = do
let h = namespaceHash b
result <- do
let isShallowDependency = libDepth <= 1
isUnseenNamespace <- State.gets (Set.notMember h)
pure
if isShallowDependency || isUnseenNamespace
then
let libDepth' = if ns == NameSegment.libSegment then libDepth + 1 else libDepth
in Seq.singleton (ns : reversePrefix, libDepth', head b)
else Seq.empty
State.modify' (Set.insert h)
pure result
Monoid.foldMapM go (Map.toList (nonEmptyChildren b0))

2
parser-typechecker/src/Unison/Codebase/BranchDiff.hs
View File

@ -3,7 +3,7 @@ module Unison.Codebase.BranchDiff where
import Data.Map qualified as Map
import Data.Set qualified as Set
import U.Codebase.HashTags (PatchHash)
import Unison.Codebase.Branch (Branch0 (..))
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Patch (Patch, PatchDiff)
import Unison.Codebase.Patch qualified as Patch

9
parser-typechecker/src/Unison/Codebase/BranchUtil.hs
View File

@ -18,6 +18,7 @@ module Unison.Codebase.BranchUtil
)
where
import Control.Lens
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Codebase.Branch (Branch, Branch0)
@ -51,7 +52,7 @@ getTerm (p, hq) b = case hq of
HashQualified n sh -> filter sh $ Star2.lookupD1 n terms
where
filter sh = Set.filter (SH.isPrefixOf sh . Referent.toShortHash)
terms = Branch._terms (Branch.getAt0 p b)
terms = (Branch.getAt0 p b) ^. Branch.terms
getType :: Path.HQSplit -> Branch0 m -> Set Reference.TypeReference
getType (p, hq) b = case hq of
@ -59,13 +60,13 @@ getType (p, hq) b = case hq of
HashQualified n sh -> filter sh $ Star2.lookupD1 n types
where
filter sh = Set.filter (SH.isPrefixOf sh . Reference.toShortHash)
types = Branch._types (Branch.getAt0 p b)
types = (Branch.getAt0 p b) ^. Branch.types
getBranch :: Path.Split -> Branch0 m -> Maybe (Branch m)
getBranch (p, seg) b = case Path.toList p of
[] -> Map.lookup seg (Branch._children b)
[] -> Map.lookup seg (b ^. Branch.children)
h : p ->
(Branch.head <$> Map.lookup h (Branch._children b))
(Branch.head <$> Map.lookup h (b ^. Branch.children))
>>= getBranch (Path.fromList p, seg)
makeAddTermName :: Path.Split -> Referent -> (Path, Branch0 m -> Branch0 m)

10
parser-typechecker/src/Unison/Codebase/SqliteCodebase/Conversions.hs
View File

@ -1,5 +1,6 @@
module Unison.Codebase.SqliteCodebase.Conversions where
import Control.Lens
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text (pack)
@ -20,6 +21,7 @@ import U.Codebase.TypeEdit qualified as V2.TypeEdit
import U.Codebase.WatchKind qualified as V2
import U.Codebase.WatchKind qualified as V2.WatchKind
import U.Core.ABT qualified as ABT
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch qualified as V1.Branch
import Unison.Codebase.Causal.Type qualified as V1.Causal
import Unison.Codebase.Metadata qualified as V1.Metadata
@ -425,10 +427,10 @@ causalbranch1to2 (V1.Branch.Branch c) =
branch1to2 b =
pure $
V2.Branch.Branch
(doTerms (V1.Branch._terms b))
(doTypes (V1.Branch._types b))
(doPatches (V1.Branch._edits b))
(doChildren (V1.Branch._children b))
(doTerms (b ^. Branch.terms))
(doTypes (b ^. Branch.types))
(doPatches (b ^. Branch.edits))
(doChildren (b ^. Branch.children))
where
-- is there a more readable way to structure these that's also linear?
doTerms :: V1.Branch.Star V1.Referent.Referent NameSegment -> Map NameSegment (Map V2.Referent.Referent (m V2.Branch.MdValues))

9
parser-typechecker/src/Unison/Hashing/V2/Convert.hs
View File

@ -15,17 +15,11 @@ module Unison.Hashing.V2.Convert
where
import Control.Applicative
import Control.Lens (over, _3)
import Control.Lens (_3)
import Control.Lens qualified as Lens
import Control.Monad.Trans.Writer.CPS (Writer)
import Control.Monad.Trans.Writer.CPS qualified as Writer
import Data.Bifunctor (bimap)
import Data.Foldable (toList)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import U.Codebase.HashTags (CausalHash (..), PatchHash (..))
import Unison.ABT qualified as ABT
@ -43,6 +37,7 @@ import Unison.Kind qualified as Memory.Kind
import Unison.NameSegment qualified as Memory.NameSegment
import Unison.Names.ResolutionResult (ResolutionResult)
import Unison.Pattern qualified as Memory.Pattern
import Unison.Prelude
import Unison.Reference qualified as Memory.Reference
import Unison.Referent qualified as Memory.Referent
import Unison.Syntax.Name qualified as Name (unsafeParseVar)

2
parser-typechecker/src/Unison/KindInference/Error.hs
View File

@ -6,7 +6,6 @@ module Unison.KindInference.Error
)
where
import Control.Lens ((^.))
import Unison.ABT qualified as ABT
import Unison.KindInference.Constraint.Context (ConstraintContext (..))
import Unison.KindInference.Constraint.Provenance (Provenance (..))
@ -18,6 +17,7 @@ import Unison.KindInference.Solve.Monad
Solve (..),
)
import Unison.KindInference.UVar (UVar (..))
import Unison.Prelude
import Unison.Type (Type)
import Unison.Var (Var)

4
parser-typechecker/src/Unison/KindInference/Generate.hs
View File

@ -8,7 +8,6 @@ module Unison.KindInference.Generate
)
where
import Control.Lens ((^.))
import Data.Foldable (foldlM)
import Data.Set qualified as Set
import U.Core.ABT qualified as ABT
@ -30,7 +29,6 @@ import Unison.Term qualified as Term
import Unison.Type qualified as Type
import Unison.Var (Type (User), Var (typed), freshIn)
--------------------------------------------------------------------------------
-- Constraints arising from Types
--------------------------------------------------------------------------------
@ -108,7 +106,6 @@ typeConstraintTree resultVar term@ABT.Term {annotation, out} = do
effConstraints <- typeConstraintTree effKind eff
pure $ ParentConstraint (IsAbility effKind (Provenance EffectsList $ ABT.annotation eff)) effConstraints
handleIntroOuter :: Var v => v -> loc -> (GeneratedConstraint v loc -> Gen v loc r) -> Gen v loc r
handleIntroOuter v loc k = do
let typ = Type.var loc v
@ -141,7 +138,6 @@ termConstraintTree = fmap Node . dfAnns processAnn cons nil . hackyStripAnns
cons mlhs mrhs = (++) <$> mlhs <*> mrhs
nil = pure []
-- | Helper for @termConstraints@ that instantiates the outermost
-- foralls and keeps the type in scope (in the type map) while
-- checking lexically nested type annotations.

25
parser-typechecker/src/Unison/KindInference/Solve.hs
View File

@ -10,7 +10,7 @@ module Unison.KindInference.Solve
)
where
import Control.Lens (Prism', prism', review, (%~))
import Control.Lens (Prism', prism', review)
import Control.Monad.Reader (asks)
import Control.Monad.Reader qualified as M
import Control.Monad.State.Strict qualified as M
@ -127,19 +127,19 @@ reduce cs0 = dbg "reduce" cs0 (go False [])
-- Signal that we solved something on this pass (by passing
-- @True@) and continue
Right () -> go True acc cs
-- | tracing helper
-- \| tracing helper
dbg ::
forall a.
-- | A hanging prefix or header
-- \| A hanging prefix or header
P.Pretty P.ColorText ->
-- | The constraints to print
-- \| The constraints to print
[GeneratedConstraint v loc] ->
([GeneratedConstraint v loc] -> Solve v loc a) ->
Solve v loc a
dbg = traceApp \ppe cs -> prettyConstraints ppe (map (review _Generated) cs)
-- | Like @dbg@, but for a single constraint
-- \| Like @dbg@, but for a single constraint
dbgSingle ::
forall a.
P.Pretty P.ColorText ->
@ -148,7 +148,7 @@ reduce cs0 = dbg "reduce" cs0 (go False [])
Solve v loc a
dbgSingle = traceApp \ppe c -> prettyConstraintD' ppe (review _Generated c)
-- | A helper for @dbg*@
-- \| A helper for @dbg*@
traceApp ::
forall a b.
(PrettyPrintEnv -> a -> P.Pretty P.ColorText) ->
@ -231,21 +231,21 @@ addConstraint' = \case
_ -> Nothing
Unsolved.Unify l a b -> Right <$> union l a b
where
-- | A helper for solving various @Is*@ constraints. In each case
-- \| A helper for solving various @Is*@ constraints. In each case
-- we want to lookup any existing constraints on the constrained
-- variable. If none exist then we simply add the new constraint,
-- as it can't conflict with anything. If there is an existing
-- constraint we defer to the passed in function.
handleConstraint ::
-- | The variable mentioned in the input constraint
-- \| The variable mentioned in the input constraint
UVar v loc ->
-- | The new constraint
-- \| The new constraint
Solved.Constraint (UVar v loc) v loc ->
-- | How to handle the an existing constraint
-- \| How to handle the an existing constraint
( Solved.Constraint (UVar v loc) v loc ->
Maybe (Solved.Constraint (UVar v loc) v loc, [UnsolvedConstraint v loc])
) ->
-- | An error or a list of implied constraints
-- \| An error or a list of implied constraints
Solve v loc (Either (ConstraintConflict v loc) [UnsolvedConstraint v loc])
handleConstraint s solvedConstraint phi = do
st@SolveState {constraints} <- M.get
@ -322,7 +322,6 @@ initialState env =
let ((), finalState) = run env emptyState initializeState
in finalState
initializeState :: forall v loc. (BuiltinAnnotation loc, Ord loc, Show loc, Var v) => Solve v loc ()
initializeState = assertGen do
builtinConstraints

1
parser-typechecker/src/Unison/PatternMatchCoverage/Solve.hs
View File

@ -9,7 +9,6 @@ module Unison.PatternMatchCoverage.Solve
)
where
import Control.Lens (view)
import Control.Monad.State
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Maybe

4
parser-typechecker/src/Unison/PrettyPrintEnv/MonadPretty.hs
View File

@ -2,10 +2,10 @@
module Unison.PrettyPrintEnv.MonadPretty where
import Control.Lens (over, set, view, views, _1, _2)
import Control.Lens (views, _1, _2)
import Control.Monad.Reader (MonadReader, Reader, local, runReader)
import Data.Set qualified as Set
import Unison.Prelude (Set)
import Unison.Prelude
import Unison.PrettyPrintEnv (PrettyPrintEnv)
import Unison.Var (Var)

1
parser-typechecker/src/Unison/PrintError.hs
View File

@ -14,7 +14,6 @@ module Unison.PrintError
)
where
import Control.Lens ((%~))
import Control.Lens.Tuple (_1, _2, _3)
import Data.Foldable qualified as Foldable
import Data.Function (on)

2
parser-typechecker/src/Unison/Runtime/IOSource.hs
View File

@ -3,7 +3,7 @@
module Unison.Runtime.IOSource where
import Control.Lens (view, _2)
import Control.Lens (_2)
import Control.Monad.Morph (hoist)
import Data.List (elemIndex, genericIndex)
import Data.Map qualified as Map

12
parser-typechecker/src/Unison/Runtime/Pattern.hs
View File

@ -12,20 +12,15 @@ module Unison.Runtime.Pattern
)
where
import Control.Lens ((<&>), (^.))
import Control.Monad.State (State, evalState, modify, runState, state)
import Data.List (transpose)
import Data.Map.Strict
( Map,
fromListWith,
( fromListWith,
insertWith,
toList,
)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes, listToMaybe)
import Data.Set (Set, member)
import Data.Set (member)
import Data.Set qualified as Set
import Data.Word (Word64)
import Unison.ABT
( absChain',
renames,
@ -38,6 +33,7 @@ import Unison.ConstructorReference qualified as ConstructorReference
import Unison.DataDeclaration (declFields)
import Unison.Pattern
import Unison.Pattern qualified as P
import Unison.Prelude hiding (guard)
import Unison.Reference (Reference, Reference' (Builtin, DerivedId))
import Unison.Runtime.ANF (internalBug)
import Unison.Term hiding (Term, matchPattern)
@ -417,7 +413,7 @@ splitMatrixBuiltin ::
[(P.Pattern (), [(v, PType)], PatternMatrix v)]
splitMatrixBuiltin v (PM rs) =
fmap (\(a, (b, c)) -> (a, b, c))
. toList
. Map.toList
. fmap buildMatrix
. fromListWith (flip (++))
. expandIrrefutable

2
parser-typechecker/src/Unison/Syntax/TermPrinter.hs
View File

@ -13,7 +13,7 @@ module Unison.Syntax.TermPrinter
)
where
import Control.Lens (unsnoc, (^.))
import Control.Lens (unsnoc)
import Control.Monad.State (evalState)
import Control.Monad.State qualified as State
import Data.Char (isPrint)

2
parser-typechecker/src/Unison/Typechecker/Context.hs
View File

@ -42,7 +42,7 @@ module Unison.Typechecker.Context
)
where
import Control.Lens (over, view, _2)
import Control.Lens (_2)
import Control.Monad.Fail qualified as MonadFail
import Control.Monad.Fix (MonadFix (..))
import Control.Monad.State

1
parser-typechecker/tests/Unison/Test/UnisonSources.hs
View File

@ -1,7 +1,6 @@
module Unison.Test.UnisonSources where
import Control.Exception (throwIO)
import Control.Lens (view)
import Control.Lens.Tuple (_5)
import Data.Map qualified as Map
import Data.Text (unpack)

2
unison-cli/src/Unison/Cli/MonadUtils.hs
View File

@ -94,7 +94,7 @@ import U.Codebase.HashTags (CausalHash (..))
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch (..), Branch0 (..))
import Unison.Codebase.Branch (Branch (..), Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Input qualified as Input

1
unison-cli/src/Unison/Cli/Share/Projects.hs
View File

@ -31,7 +31,6 @@ module Unison.Cli.Share.Projects
)
where
import Control.Lens ((^.))
import Control.Monad.Reader (ask)
import Data.Proxy
import Network.HTTP.Client qualified as Http.Client

31
unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
View File

@ -42,7 +42,7 @@ import Unison.Cli.PrettyPrintUtils qualified as Cli
import Unison.Cli.ProjectUtils qualified as ProjectUtils
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch (..), Branch0 (..))
import Unison.Codebase.Branch (Branch (..), Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Merge qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
@ -886,21 +886,20 @@ loop e = do
Causal.Cons h _bh b tail -> goBranch h b [fst tail] (tail : queue)
Causal.Merge h _bh b (Map.toList -> tails) -> goBranch h b (map fst tails) (tails ++ queue)
goBranch :: forall m. (Monad m) => CausalHash -> Branch0 m -> [CausalHash] -> [(CausalHash, m (Branch.UnwrappedBranch m))] -> StateT (Set CausalHash) m ()
goBranch h b (Set.fromList -> causalParents) queue = case b of
Branch0 terms0 types0 children0 patches0 _ _ _ _ _ ->
let ignoreMetadata :: (Ord r, Ord n) => Metadata.Star r n -> r -> (r, Set n)
ignoreMetadata s r =
(r, R.lookupDom r $ Star2.d1 s)
terms = Map.fromList . map (ignoreMetadata terms0) . Foldable.toList $ Star2.fact terms0
types = Map.fromList . map (ignoreMetadata types0) . Foldable.toList $ Star2.fact types0
patches = fmap fst patches0
children = fmap Branch.headHash children0
in do
let d = Output.DN.DumpNamespace terms types patches children causalParents
-- the alternate implementation that doesn't rely on `traceM` blows up
traceM $ P.toPlain 200 (prettyDump (h, d))
set h
goCausal (map getCausal (Foldable.toList children0) ++ queue)
goBranch h b (Set.fromList -> causalParents) queue =
let ignoreMetadata :: (Ord r, Ord n) => Metadata.Star r n -> r -> (r, Set n)
ignoreMetadata s r =
(r, R.lookupDom r $ Star2.d1 s)
terms = Map.fromList . map (ignoreMetadata (b ^. Branch.terms)) . Foldable.toList $ Star2.fact (b ^. Branch.terms)
types = Map.fromList . map (ignoreMetadata (b ^. Branch.types)) . Foldable.toList $ Star2.fact (b ^. Branch.types)
patches = fmap fst (b ^. Branch.edits)
children = fmap Branch.headHash (b ^. Branch.children)
in do
let d = Output.DN.DumpNamespace terms types patches children causalParents
-- the alternate implementation that doesn't rely on `traceM` blows up
traceM $ P.toPlain 200 (prettyDump (h, d))
set h
goCausal (map getCausal (Foldable.toList (b ^. Branch.children)) ++ queue)
prettyDump (h, Output.DN.DumpNamespace terms types patches children causalParents) =
P.lit "Namespace "
<> P.shown h

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/Branch.hs
View File

@ -7,7 +7,6 @@ module Unison.Codebase.Editor.HandleInput.Branch
)
where
import Control.Lens ((^.))
import Data.These (These (..))
import Data.UUID.V4 qualified as UUID
import U.Codebase.Sqlite.DbId

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/BranchRename.hs
View File

@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.BranchRename
)
where
import Control.Lens ((^.))
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/Branches.hs
View File

@ -4,7 +4,7 @@ module Unison.Codebase.Editor.HandleInput.Branches
)
where
import Control.Lens (mapped, over, (^.), _2)
import Control.Lens (mapped, _2)
import Data.Map.Strict qualified as Map
import Network.URI (URI)
import U.Codebase.Sqlite.Queries qualified as Queries

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteBranch.hs
View File

@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.DeleteBranch
)
where
import Control.Lens (over, (^.))
import Data.Map.Strict qualified as Map
import Data.These (These (..))
import U.Codebase.Sqlite.Queries qualified as Queries

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/DeleteProject.hs
View File

@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.DeleteProject
)
where
import Control.Lens (view, (^.))
import Data.Function (on)
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)

4
unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs
View File

@ -79,9 +79,9 @@ handleInstallLib (ProjectAndBranch libdepProjectName unresolvedLibdepBranchName)
pure $
fresh
(\i -> NameSegment.unsafeParseText . (<> "__" <> tShow i) . NameSegment.toUnescapedText)
( case Map.lookup NameSegment.libSegment currentBranchObject._children of
( case Map.lookup NameSegment.libSegment (currentBranchObject ^. Branch.children) of
Nothing -> Set.empty
Just libdeps -> Map.keysSet (Branch._children (Branch.head libdeps))
Just libdeps -> Map.keysSet ((Branch.head libdeps) ^. Branch.children)
)
(makeDependencyName libdepProjectName libdepBranchName)

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs
View File

@ -6,7 +6,7 @@ module Unison.Codebase.Editor.HandleInput.Load
)
where
import Control.Lens ((.=), (.~))
import Control.Lens ((.=))
import Control.Monad.Reader (ask)
import Control.Monad.State.Strict qualified as State
import Data.Map.Strict qualified as Map

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs
View File

@ -10,7 +10,7 @@ module Unison.Codebase.Editor.HandleInput.Merge2
)
where
import Control.Lens (mapped, over, set, view, _1)
import Control.Lens (mapped, _1)
import Control.Monad.Reader (ask)
import Control.Monad.Writer (Writer)
import Control.Monad.Writer qualified as Writer

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveTerm.hs
View File

@ -1,6 +1,6 @@
module Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm, moveTermSteps) where
import Control.Lens (over, _2)
import Control.Lens (_2)
import Data.Set qualified as Set
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/MoveType.hs
View File

@ -1,6 +1,6 @@
module Unison.Codebase.Editor.HandleInput.MoveType (doMoveType, moveTypeSteps) where
import Control.Lens (over, _2)
import Control.Lens (_2)
import Data.Set qualified as Set
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs
View File

@ -3,7 +3,6 @@ module Unison.Codebase.Editor.HandleInput.NamespaceDependencies
)
where
import Control.Lens (over)
import Control.Monad.Reader (ask)
import Control.Monad.Trans.Maybe
import Data.Map qualified as Map

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDiffUtils.hs
View File

@ -13,7 +13,7 @@ import Unison.Cli.NamesUtils qualified as Cli
import Unison.Cli.PrettyPrintUtils qualified as Cli
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0 (..))
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.BranchDiff qualified as BranchDiff
import Unison.Codebase.Editor.Output.BranchDiff qualified as OBranchDiff

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs
View File

@ -4,7 +4,7 @@ module Unison.Codebase.Editor.HandleInput.ProjectClone
)
where
import Control.Lens (over, (^.), _2)
import Control.Lens (_2)
import Control.Monad.Reader (ask)
import Data.These (These (..))
import Data.UUID.V4 qualified as UUID

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs
View File

@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ProjectCreate
)
where
import Control.Lens (over, (^.))
import Control.Monad.Reader (ask)
import Data.Map.Strict qualified as Map
import Data.Text qualified as Text

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectRename.hs
View File

@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ProjectRename
)
where
import Control.Lens ((^.))
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectSwitch.hs
View File

@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ProjectSwitch
)
where
import Control.Lens ((^.))
import Data.These (These (..))
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/Push.hs
View File

@ -6,7 +6,7 @@ module Unison.Codebase.Editor.HandleInput.Push
where
import Control.Concurrent.STM (atomically, modifyTVar', newTVarIO, readTVar, readTVarIO)
import Control.Lens (over, view, (.~), (^.), _1, _2)
import Control.Lens (_1, _2)
import Control.Monad.Reader (ask)
import Data.Set.NonEmpty qualified as Set.NonEmpty
import Data.Text as Text

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/ReleaseDraft.hs
View File

@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.ReleaseDraft
)
where
import Control.Lens ((^.))
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.ProjectUtils qualified as ProjectUtils

2
unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs
View File

@ -3,7 +3,7 @@ module Unison.Codebase.Editor.HandleInput.Run
)
where
import Control.Lens (view, (.=), _1)
import Control.Lens ((.=), _1)
import Control.Monad.Reader (ask)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set

4
unison-cli/src/Unison/Codebase/Editor/HandleInput/Update.hs
View File

@ -20,7 +20,7 @@ import Unison.Cli.NamesUtils qualified as Cli
import Unison.Cli.PrettyPrintUtils qualified as Cli
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0 (..))
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Input
@ -501,7 +501,7 @@ getSlurpResultForUpdate requestedNames slurpCheckNames = do
-- fresh2 = fresh1 + 2
-- fresh3 = fresh2 + 3
terms =
Map.fromList $ Map.elems refToGeneratedNameAndTerm <&> \(v,term) -> (v, (External, term)),
Map.fromList $ Map.elems refToGeneratedNameAndTerm <&> \(v, term) -> (v, (External, term)),
-- In the context of this update, whatever watches were in the latest typechecked Unison file are
-- irrelevant, so we don't need to copy them over.
watches = Map.empty

3
unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs
View File

@ -18,7 +18,6 @@ module Unison.Codebase.Editor.HandleInput.Update2
)
where
import Control.Lens (over, (%~), (.~))
import Control.Lens qualified as Lens
import Control.Monad.RWS (ask)
import Data.Bifoldable (bifoldMap)
@ -43,8 +42,8 @@ import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Branch.Type (Branch0)
import Unison.Codebase.BranchUtil qualified as BranchUtil
import Unison.Codebase.Editor.Output (Output)
import Unison.Codebase.Editor.Output qualified as Output

1
unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs
View File

@ -3,7 +3,6 @@ module Unison.Codebase.Editor.HandleInput.Upgrade
)
where
import Control.Lens ((^.))
import Control.Monad.Reader (ask)
import Data.Char qualified as Char
import Data.List.NonEmpty (pattern (:|))

10
unison-cli/src/Unison/Codebase/Editor/Propagate.hs
View File

@ -18,7 +18,7 @@ import Unison.Cli.MonadUtils qualified as Cli
import Unison.Cli.TypeCheck qualified as Cli (computeTypecheckingEnvironment)
import Unison.Codebase (Codebase)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch (Branch0 (..))
import Unison.Codebase.Branch (Branch0)
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
import Unison.Codebase.Editor.Output
@ -620,14 +620,14 @@ applyPropagate patch Edits {termReplacements, typeReplacements, constructorRepla
Map Reference Reference ->
Branch0 m ->
Branch0 m
updateLevel termEdits typeEdits Branch0 {..} =
Branch.branch0 terms types _children _edits
updateLevel termEdits typeEdits b =
Branch.branch0 terms types (b ^. Branch.children) (b ^. Branch.edits)
where
isPropagatedReferent (Referent.Con _ _) = True
isPropagatedReferent (Referent.Ref r) = isPropagated r
terms0 :: Metadata.Star Referent NameSegment
terms0 = Star2.replaceFacts replaceConstructor constructorReplacements _terms
terms0 = Star2.replaceFacts replaceConstructor constructorReplacements (b ^. Branch.terms)
terms :: Branch.Star Referent NameSegment
terms =
updateMetadatas $
@ -635,7 +635,7 @@ applyPropagate patch Edits {termReplacements, typeReplacements, constructorRepla
types :: Branch.Star Reference NameSegment
types =
updateMetadatas $
Star2.replaceFacts replaceType typeEdits _types
Star2.replaceFacts replaceType typeEdits (b ^. Branch.types)
updateMetadatas ::
(Ord r) =>

2
unison-cli/src/Unison/Codebase/TranscriptParser.hs
View File

@ -18,7 +18,7 @@ module Unison.Codebase.TranscriptParser
)
where
import Control.Lens (use, (?~), (^.))
import Control.Lens (use, (?~))
import Crypto.Random qualified as Random
import Data.Aeson qualified as Aeson
import Data.Aeson.Encode.Pretty qualified as Aeson

1
unison-cli/src/Unison/CommandLine/BranchRelativePath.hs
View File

@ -8,7 +8,6 @@ module Unison.CommandLine.BranchRelativePath
)
where
import Control.Lens (view)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.These (These (..))

1
unison-cli/src/Unison/CommandLine/DisplayValues.hs
View File

@ -3,7 +3,6 @@
module Unison.CommandLine.DisplayValues where
import Control.Lens ((^.))
import Data.Map qualified as Map
import Unison.ABT qualified as ABT
import Unison.Builtin qualified as Builtin

4
unison-cli/src/Unison/CommandLine/InputPatterns.hs
View File

@ -135,7 +135,7 @@ module Unison.CommandLine.InputPatterns
)
where
import Control.Lens (preview, review, (^.))
import Control.Lens (preview, review)
import Control.Lens.Cons qualified as Cons
import Data.List (intercalate)
import Data.List.Extra qualified as List
@ -183,7 +183,7 @@ import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.NameSegment qualified as NameSegment
import Unison.Prelude
import Unison.Prelude hiding (view)
import Unison.Project
( ProjectAndBranch (..),
ProjectAndBranchNames (..),

2
unison-cli/src/Unison/CommandLine/Main.hs
View File

@ -6,7 +6,7 @@ where
import Compat (withInterruptHandler)
import Control.Concurrent.Async qualified as Async
import Control.Exception (catch, displayException, finally, mask)
import Control.Lens (preview, (?~), (^.))
import Control.Lens (preview, (?~))
import Crypto.Random qualified as Random
import Data.Configurator.Types (Config)
import Data.IORef

2
unison-core/src/Unison/DataDeclaration.hs
View File

@ -36,7 +36,7 @@ module Unison.DataDeclaration
)
where
import Control.Lens (Iso', Lens', imap, iso, lens, over, _3)
import Control.Lens (Iso', Lens', imap, iso, lens, _3)
import Control.Monad.State (evalState)
import Data.Map qualified as Map
import Data.Set qualified as Set

2
unison-core/src/Unison/Name.hs
View File

@ -56,7 +56,7 @@ module Unison.Name
)
where
import Control.Lens (mapped, over, _1, _2)
import Control.Lens (mapped, _1, _2)
import Data.List qualified as List
import Data.List.Extra qualified as List
import Data.List.NonEmpty (NonEmpty ((:|)))

2
unison-core/src/Unison/Term.hs
View File

@ -3,7 +3,7 @@
module Unison.Term where
import Control.Lens (Lens', Prism', lens, view, _2)
import Control.Lens (Lens', Prism', lens, _2)
import Control.Monad.State (evalState)
import Control.Monad.State qualified as State
import Control.Monad.Writer.Strict qualified as Writer

2
unison-hashing-v2/src/Unison/Hashing/V2/DataDeclaration.hs
View File

@ -7,7 +7,7 @@ module Unison.Hashing.V2.DataDeclaration
)
where
import Control.Lens (over, _3)
import Control.Lens (_3)
import Data.Map qualified as Map
import Unison.ABT qualified as ABT
import Unison.Hash (Hash)

1
unison-merge/src/Unison/Merge/CombineDiffs.hs
View File

@ -5,7 +5,6 @@ module Unison.Merge.CombineDiffs
)
where
import Control.Lens (view)
import Data.Semialign (alignWith)
import Data.These (These (..))
import Unison.Merge.DiffOp (DiffOp (..))

2
unison-merge/src/Unison/Merge/DeclCoherencyCheck.hs
View File

@ -85,7 +85,7 @@ module Unison.Merge.DeclCoherencyCheck
)
where
import Control.Lens (view, (%=), (.=))
import Control.Lens ((%=), (.=))
import Control.Monad.Except (ExceptT)
import Control.Monad.Except qualified as Except
import Control.Monad.State.Strict (StateT)

1
unison-merge/src/Unison/Merge/DeclNameLookup.hs
View File

@ -6,7 +6,6 @@ module Unison.Merge.DeclNameLookup
)
where
import Control.Lens (over)
import Data.Map.Strict qualified as Map
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Unison.DataDeclaration (Decl)

2
unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs
View File

@ -3,7 +3,7 @@ module Unison.Merge.PartitionCombinedDiffs
)
where
import Control.Lens (Lens', over, view, (%~), (.~))
import Control.Lens (Lens')
import Data.Bitraversable (bitraverse)
import Data.Map.Strict qualified as Map
import Unison.Merge.CombineDiffs (CombinedDiffOp (..))

2
unison-merge/src/Unison/Merge/TwoWay.hs
View File

@ -12,7 +12,7 @@ module Unison.Merge.TwoWay
)
where
import Control.Lens (Lens', view)
import Control.Lens (Lens')
import Data.Semialign (Semialign, alignWith)
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Data.These (These (These))

1
unison-merge/src/Unison/Merge/Unconflicts.hs
View File

@ -7,7 +7,6 @@ module Unison.Merge.Unconflicts
)
where
import Control.Lens (view)
import Data.Map.Strict qualified as Map
import Unison.Merge.TwoWay (TwoWay)
import Unison.Merge.TwoWayI (TwoWayI (..))

1
unison-share-api/src/Unison/Server/CodebaseServer.hs
View File

@ -8,7 +8,6 @@ module Unison.Server.CodebaseServer where
import Control.Concurrent (newEmptyMVar, putMVar, readMVar)
import Control.Concurrent.Async (race)
import Control.Exception (ErrorCall (..), throwIO)
import Control.Lens ((.~))
import Control.Monad.Reader
import Control.Monad.Trans.Except
import Data.Aeson ()

1
unison-share-api/src/Unison/Server/Doc.hs
View File

@ -8,7 +8,6 @@
module Unison.Server.Doc where
import Control.Lens (view, (^.))
import Control.Monad
import Data.Aeson (ToJSON)
import Data.Foldable