diff --git a/src/Unison/Edit/Term/Path.hs b/src/Unison/Edit/Term/Path.hs index e4632bf04..01ae0a50d 100644 --- a/src/Unison/Edit/Term/Path.hs +++ b/src/Unison/Edit/Term/Path.hs @@ -3,7 +3,10 @@ module Unison.Edit.Term.Path where import qualified Unison.Syntax.Term as E import Control.Applicative -data E = Fn | Arg | Body +data E + = Fn -- ^ Points at function in a function application + | Arg -- ^ Points at the argument of a function application + | Body -- ^ Points at the body of a lambda newtype Path = Path [E] diff --git a/src/Unison/Edit/Type/Path.hs b/src/Unison/Edit/Type/Path.hs new file mode 100644 index 000000000..d7ce8587b --- /dev/null +++ b/src/Unison/Edit/Type/Path.hs @@ -0,0 +1,6 @@ +module Unison.Edit.Type.Path where + +-- | Represents a path into an ADT. We choose which numbered constructor, +-- and then which argument of that constructor we are addressing, where +-- @0@ denotes the overall constructor itself. +data Path = Path { constructor :: !Int, arg :: !Int } diff --git a/src/Unison/Node.hs b/src/Unison/Node.hs index 89476c5d9..499138df7 100644 --- a/src/Unison/Node.hs +++ b/src/Unison/Node.hs @@ -1,16 +1,53 @@ module Unison.Node where +import Data.Set as S +import Data.Text import Unison.Node.Panel import Unison.Node.Metadata as M +import Unison.Edit.Term.Action as A +import Unison.Edit.Term.Path as P +import Unison.Edit.Type.Path as TP +import Unison.Type.Note as N data Node m k t e = Node { - term :: k -> m (Maybe e), -- ^ Lookup the source of the term identified by @k@ - typ :: k -> m (Maybe t), -- ^ Lookup the source of the type identified by @k@ - metadata :: k -> m (Maybe (M.Metadata k)), -- ^ Access the metadata for the term or type identified by @k@ - panel :: k -> m (Maybe (Panel k t e)) -- ^ Render the term or type identified by @k@ as a panel + -- | Create a new term and provide its metadata + createTerm :: e -> M.Metadata k -> m k, + -- | Create a new type and provide its metadata + createType :: t -> M.Metadata k -> m k, + -- | Lookup the direct dependencies of @k@, optionally limited to the given set + dependencies :: Maybe (S.Set k) -> k -> m (S.Set k), + -- | Lookup the set of terms/types depending directly on the given @k@, optionally limited to the given set + dependents :: Maybe (S.Set k) -> k -> m (S.Set k), + -- | Modify the given subterm, which may fail + edit :: k -> P.Path -> A.Action k -> m (Either N.Note (k, e)), + -- | Modify the given type, which may fail + editType :: k -> P.Path -> A.Action k -> m (Either N.Note (k, t)), + -- | Access the metadata for the term or type identified by @k@ + metadata :: k -> m (Maybe (M.Metadata k)), + -- | Render the term or type identified by @k@ as a panel-- + panel :: k -> m (Maybe (Panel k t e)), + -- | Lookup a term by name, optionally constrained to be of the given type + search :: Maybe t -> Query -> m [(k, Metadata k)], + -- | Lookup the source of the term identified by @k@ + term :: k -> m (Maybe e), + -- | Lookup the dependencies of @k@, optionally limited to those that intersect the given set + transitiveDependencies :: Maybe (S.Set k) -> k -> m (S.Set k), + -- | Lookup the set of terms or types which depend on the given @k@, optionally limited to those that intersect the given set + transitiveDependents :: Maybe (S.Set k) -> k -> m (S.Set k), + -- | Lookup the source of the type identified by @k@ + typ :: k -> m (Maybe t), + -- | Obtain the type of the given subterm, assuming the path is valid + typeOf :: k -> P.Path -> m (Maybe t), + -- | Obtain the type of a constructor argument of a type + typeOfConstructorArg :: k -> TP.Path -> m (Maybe t), + -- | Update the metadata associated with the given term or type + updateMetadata :: k -> M.Metadata k -> m Bool - -- editing, creating terms and types - -- evaluation + -- possibly later + -- editConstructor :: k -> -> A.Action -> m (Either N.Note (k, t)), -- ^ Modify the given type, which may fail + -- examples :: k -> m (Maybe [k]), -- ^ } +data Query = Query Text + diff --git a/todo.markdown b/todo.markdown index ca4f5f378..c1908b45c 100644 --- a/todo.markdown +++ b/todo.markdown @@ -1,3 +1,18 @@ testing of typechecker editing combinators editor backend + + +-- a layout tree uses hashes, not names +-- merely a convention of the editor that it +-- transitively updates dependent hashes +-- that is, given: +-- y = 42 +-- f x = x + y +-- the editor just adopts the convention that +-- updating `y` will update `f` to point to the +-- new hash of the thing called `y`, rather than +-- continuing to point at old hash +-- + +-- need path and action type for ADTs diff --git a/unison.cabal b/unison.cabal index 7fe4b1c47..8ef33825a 100644 --- a/unison.cabal +++ b/unison.cabal @@ -51,6 +51,7 @@ library Unison.Edit.Term.Movement Unison.Edit.Term.Path Unison.Edit.Term.Edit + Unison.Edit.Type.Path Unison.Edit.Layout Unison.Edit.Layout.Style Unison.Node