NameSegment and Name fiffing

2024-11-11 17:16:30 +03:00 · 2020-05-28 21:53:50 -04:00 · 2020-05-28 21:53:50 -04:00 · d066190f8e
commit d066190f8e
parent 901032cc27
18 changed files with 103 additions and 106 deletions
--- a/parser-typechecker/src/Unison/Codebase/Branch.hs
+++ b/parser-typechecker/src/Unison/Codebase/Branch.hs
@ -128,8 +128,8 @@ import           Unison.Codebase.Causal         ( Causal
                                                )
 import           Unison.Codebase.Path           ( Path(..) )
 import qualified Unison.Codebase.Path          as Path
-import           Unison.Codebase.NameSegment    ( NameSegment )
-import qualified Unison.Codebase.NameSegment   as NameSegment
+import           Unison.NameSegment             ( NameSegment )
+import qualified Unison.NameSegment            as NameSegment
 import qualified Unison.Codebase.Metadata      as Metadata
 import qualified Unison.Hash                   as Hash
 import           Unison.Hashable                ( Hashable )
@ -350,11 +350,11 @@ deepEdits' b = go id b where
  -- can change this to an actual prefix once Name is a [NameSegment]
  go :: (Name -> Name) -> Branch0 m -> Map Name (EditHash, m Patch)
  go addPrefix Branch0{..} =
-    Map.mapKeysMonotonic (addPrefix . NameSegment.toName) _edits
+    Map.mapKeysMonotonic (addPrefix . Name.fromSegment) _edits
      <> foldMap f (Map.toList _children)
    where
    f :: (NameSegment, Branch m) -> Map Name (EditHash, m Patch)
-    f (c, b) =  go (addPrefix . Name.joinDot (NameSegment.toName c)) (head b)
+    f (c, b) =  go (addPrefix . Name.joinDot (Name.fromSegment c)) (head b)

 data MergeMode = RegularMerge | SquashMerge deriving (Eq,Ord,Show)

--- a/parser-typechecker/src/Unison/Codebase/Branch/Dependencies.hs
+++ b/parser-typechecker/src/Unison/Codebase/Branch/Dependencies.hs
@ -1,4 +1,3 @@
-{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
@ -18,9 +17,8 @@ import qualified Unison.Referent as Referent
 import GHC.Generics (Generic)
 import Data.Monoid.Generic
 import Data.Map (Map)
-import Unison.Codebase.NameSegment (NameSegment)
+import Unison.NameSegment (NameSegment)
 import Unison.Referent (Referent)
-import Unison.Reference (Reference)
 import Unison.Codebase.Patch (Patch)
 import qualified Unison.Util.Star3 as Star3
 import qualified Unison.Util.Relation as R
--- a/parser-typechecker/src/Unison/Codebase/BranchUtil.hs
+++ b/parser-typechecker/src/Unison/Codebase/BranchUtil.hs
@ -24,7 +24,7 @@ import Unison.Codebase.Metadata (Metadata)
 import qualified Unison.Codebase.Metadata as Metadata
 import qualified Unison.Util.List as List
 import Unison.Codebase.Patch (Patch)
-import Unison.Codebase.NameSegment (HQSegment, NameSegment)
+import Unison.NameSegment (NameSegment)
 import Control.Lens (view)

 fromNames0 :: Monad m => Names0 -> Branch m
@ -60,12 +60,16 @@ getTerm (p, hq) b = case hq of
  filter sh = Set.filter (SH.isPrefixOf sh . Referent.toShortHash)
  terms = Branch._terms (Branch.getAt0 p b)

-getTermMetadataHQNamed :: (Path.Path, HQSegment) -> Branch0 m -> Metadata.R4 Referent NameSegment
+getTermMetadataHQNamed
+  :: (Path.Path, HQ'.HQSegment) -> Branch0 m -> Metadata.R4 Referent NameSegment
 getTermMetadataHQNamed (path, hqseg) b =
  R4.filter (\(r,n,_t,_v) -> HQ'.matchesNamedReferent n r hqseg) terms
  where terms = Metadata.starToR4 . Branch._terms $ Branch.getAt0 path b

-getTypeMetadataHQNamed :: (Path.Path, HQSegment) -> Branch0 m -> Metadata.R4 Reference NameSegment
+getTypeMetadataHQNamed
+  :: (Path.Path, HQ'.HQSegment)
+  -> Branch0 m
+  -> Metadata.R4 Reference NameSegment
 getTypeMetadataHQNamed (path, hqseg) b =
  R4.filter (\(r,n,_t,_v) -> HQ'.matchesNamedReference n r hqseg) types
  where types = Metadata.starToR4 . Branch._types $ Branch.getAt0 path b
--- a/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs
@ -70,7 +70,6 @@ import qualified Unison.Codebase.Patch         as Patch
 import           Unison.Codebase.Path           ( Path
                                                , Path'(..) )
 import qualified Unison.Codebase.Path          as Path
-import qualified Unison.Codebase.NameSegment   as NameSegment
 import qualified Unison.Codebase.Reflog        as Reflog
 import           Unison.Codebase.SearchResult   ( SearchResult )
 import qualified Unison.Codebase.SearchResult  as SR
@ -127,7 +126,8 @@ import Unison.LabeledDependency (LabeledDependency)
 import Unison.Term (Term)
 import Unison.Type (Type)
 import qualified Unison.Builtin as Builtin
-import Unison.Codebase.NameSegment (NameSegment(..))
+import Unison.NameSegment (NameSegment(..))
+import qualified Unison.NameSegment as NameSegment
 import Unison.Codebase.ShortBranchHash (ShortBranchHash)
 import qualified Unison.Codebase.Editor.Propagate as Propagate
 import qualified Unison.Codebase.Editor.UriParser as UriParser
@ -552,7 +552,7 @@ loop = do
        -- `op` is the operation to add/remove/alter metadata mappings.
        --   e.g. `Metadata.insert` is passed to add metadata links.
        manageLinks :: Bool
-                    -> [(Path', NameSegment.HQSegment)]
+                    -> [(Path', HQ'.HQSegment)]
                    -> [HQ.HashQualified]
                    -> (forall r. Ord r
                        => (r, Reference, Reference)
--- a/parser-typechecker/src/Unison/Codebase/Editor/Input.hs
+++ b/parser-typechecker/src/Unison/Codebase/Editor/Input.hs
@ -20,7 +20,7 @@ import           Unison.Codebase.ShortBranchHash (ShortBranchHash)
 import qualified Unison.Codebase.ShortBranchHash as SBH
 import           Unison.Codebase.SyncMode       ( SyncMode )
 import qualified Data.Text as Text
-import Unison.Codebase.NameSegment (NameSegment)
+import           Unison.NameSegment             ( NameSegment )

 data Event
  = UnisonFileChanged SourceName Source
--- a/parser-typechecker/src/Unison/Codebase/Editor/Output.hs
+++ b/parser-typechecker/src/Unison/Codebase/Editor/Output.hs
@ -50,7 +50,7 @@ import Unison.Term (Term)
 import Unison.Type (Type)
 import qualified Unison.Names3 as Names
 import qualified Data.Set as Set
-import Unison.Codebase.NameSegment (NameSegment, HQSegment)
+import Unison.NameSegment (NameSegment)
 import Unison.ShortHash (ShortHash)
 import Unison.Var (Var)
 import Unison.Codebase.ShortBranchHash (ShortBranchHash)
@ -211,8 +211,8 @@ data ReflogEntry =
  deriving (Show)

 data ShallowListEntry v a
-  = ShallowTermEntry Referent HQSegment (Maybe (Type v a))
-  | ShallowTypeEntry Reference HQSegment
+  = ShallowTermEntry Referent HQ'.HQSegment (Maybe (Type v a))
+  | ShallowTypeEntry Reference HQ'.HQSegment
  | ShallowBranchEntry NameSegment Int -- number of child definitions
  | ShallowPatchEntry NameSegment
  deriving (Eq, Show)
--- a/parser-typechecker/src/Unison/Codebase/Editor/UriParser.hs
+++ b/parser-typechecker/src/Unison/Codebase/Editor/UriParser.hs
@ -15,7 +15,7 @@ import Unison.Codebase.ShortBranchHash (ShortBranchHash(..))
 import Unison.Prelude
 import qualified Unison.Hash as Hash
 import qualified Unison.Lexer
-import Unison.Codebase.NameSegment (NameSegment(..))
+import Unison.NameSegment (NameSegment(..))
 import Data.Sequence as Seq
 import Data.Char (isAlphaNum, isSpace, isDigit)

--- a/parser-typechecker/src/Unison/Codebase/Path.hs
+++ b/parser-typechecker/src/Unison/Codebase/Path.hs
@ -21,10 +21,8 @@ import qualified Unison.Lexer                  as Lexer
 import qualified Unison.HashQualified' as HQ'
 import qualified Unison.ShortHash as SH

-import           Unison.Codebase.NameSegment    ( NameSegment(NameSegment)
-                                                , HQSegment
-                                                )
-import qualified Unison.Codebase.NameSegment as NameSegment
+import           Unison.NameSegment             ( NameSegment(NameSegment))
+import qualified Unison.NameSegment            as NameSegment

 -- `Foo.Bar.baz` becomes ["Foo", "Bar", "baz"]
 newtype Path = Path { toSeq :: Seq NameSegment } deriving (Eq, Ord)
@ -73,13 +71,13 @@ unsplitHQ' :: HQSplit' -> HQ'.HashQualified' Path'
 unsplitHQ' (p, a) = fmap (snoc' p) a

 type Split = (Path, NameSegment)
-type HQSplit = (Path, HQSegment)
+type HQSplit = (Path, HQ'.HQSegment)

 type Split' = (Path', NameSegment)
-type HQSplit' = (Path', HQSegment)
+type HQSplit' = (Path', HQ'.HQSegment)

 type SplitAbsolute = (Absolute, NameSegment)
-type HQSplitAbsolute = (Absolute, HQSegment)
+type HQSplitAbsolute = (Absolute, HQ'.HQSegment)

 -- examples:
 --   unprefix .foo.bar .blah == .blah (absolute paths left alone)
--- a/parser-typechecker/src/Unison/Codebase/Serialization/V1.hs
+++ b/parser-typechecker/src/Unison/Codebase/Serialization/V1.hs
@ -37,8 +37,8 @@ import           Unison.Codebase.Causal         ( Raw(..)
                                                )
 import qualified Unison.Codebase.Causal         as Causal
 import qualified Unison.Codebase.Metadata       as Metadata
-import           Unison.Codebase.NameSegment    ( NameSegment )
-import           Unison.Codebase.NameSegment    as NameSegment
+import           Unison.NameSegment             ( NameSegment )
+import           Unison.NameSegment            as NameSegment
 import           Unison.Codebase.Patch          ( Patch(..) )
 import qualified Unison.Codebase.Patch          as Patch
 import           Unison.Codebase.TermEdit       ( TermEdit )
--- a/parser-typechecker/src/Unison/CommandLine/OutputMessages.hs
+++ b/parser-typechecker/src/Unison/CommandLine/OutputMessages.hs
@ -60,7 +60,6 @@ import qualified Unison.HashQualified          as HQ
 import qualified Unison.HashQualified'         as HQ'
 import           Unison.Name                   (Name)
 import qualified Unison.Name                   as Name
-import qualified Unison.Codebase.NameSegment   as NameSegment
 import           Unison.NamePrinter            (prettyHashQualified,
                                                prettyReference, prettyReferent,
                                                prettyLabeledDependency,
@ -233,7 +232,7 @@ notifyNumbered o = case o of
      [ p
      , ""
      , tip $ "Add" <> prettyName "License" <> "values for"
-           <> prettyName (NameSegment.toName authorNS)
+           <> prettyName (Name.fromSegment authorNS)
           <> "under" <> P.group (prettyPath' authorPath' <> ".")
      ]) (showDiffNamespace ShowNumbers ppe bAbs bAbs diff)
  where
@ -508,18 +507,18 @@ notifyUser dir o = case o of
    formatEntry :: ShallowListEntry v a -> (P.Pretty P.ColorText, P.Pretty P.ColorText)
    formatEntry = \case
      ShallowTermEntry _r hq ot ->
-        (P.syntaxToColor . prettyHashQualified' . fmap NameSegment.toName $ hq
+        (P.syntaxToColor . prettyHashQualified' . fmap Name.fromSegment $ hq
        , P.lit "(" <> maybe "type missing" (TypePrinter.pretty ppe) ot <> P.lit ")" )
      ShallowTypeEntry r hq ->
-        (P.syntaxToColor . prettyHashQualified' . fmap NameSegment.toName $ hq
+        (P.syntaxToColor . prettyHashQualified' . fmap Name.fromSegment $ hq
        ,isBuiltin r)
      ShallowBranchEntry ns count ->
-        ((P.syntaxToColor . prettyName . NameSegment.toName) ns <> "/"
+        ((P.syntaxToColor . prettyName . Name.fromSegment) ns <> "/"
        ,case count of
          1 -> P.lit ("(1 definition)")
          _n -> P.lit "(" <> P.shown count <> P.lit " definitions)")
      ShallowPatchEntry ns ->
-        ((P.syntaxToColor . prettyName . NameSegment.toName) ns
+        ((P.syntaxToColor . prettyName . Name.fromSegment) ns
        ,P.lit "(patch)")
    isBuiltin = \case
      Reference.Builtin{} -> P.lit "(builtin type)"
--- a/parser-typechecker/tests/Unison/Core/Test/Name.hs
+++ b/parser-typechecker/tests/Unison/Core/Test/Name.hs
@ -4,6 +4,7 @@ module Unison.Core.Test.Name where

 import           EasyTest
 import           Unison.Name                   as Name
+import           Unison.NameSegment            as NameSegment
 import           Data.List                      ( intercalate )
 import           Data.Text                      ( pack )

@ -24,5 +25,5 @@ test = scope "name" $ tests
    n       <- int' 0 10
    segs <- listOf n . pick $ replicate numDots "." ++ replicate numSegs "foo"
    expectEqual (segments $ Name . pack $ intercalate "." segs)
-                (Name . pack <$> segs)
+                (NameSegment . pack <$> segs)
  ]
--- a/parser-typechecker/tests/Unison/Test/Codebase/Path.hs
+++ b/parser-typechecker/tests/Unison/Test/Codebase/Path.hs
@ -6,7 +6,7 @@ import EasyTest
 import Unison.Codebase.Path
 import Data.Sequence
 import Data.Text
-import Unison.Codebase.NameSegment
+import Unison.NameSegment
 import Data.Either
 import qualified Unison.HashQualified' as HQ'
 import qualified Unison.ShortHash as SH
--- a/parser-typechecker/tests/Unison/Test/UriParser.hs
+++ b/parser-typechecker/tests/Unison/Test/UriParser.hs
@ -11,7 +11,7 @@ import qualified Unison.Codebase.Editor.UriParser as UriParser
 import qualified Data.Sequence as Seq
 import Unison.Codebase.ShortBranchHash (ShortBranchHash(..))
 import Data.Text (Text)
-import Unison.Codebase.NameSegment (NameSegment(..))
+import Unison.NameSegment (NameSegment(..))
 import qualified Data.Text as Text

 test :: Test ()
--- a/unison-core/src/Unison/Codebase/NameSegment.hs
+++ b/unison-core/src/Unison/Codebase/NameSegment.hs
@ -1,54 +0,0 @@
-{-# LANGUAGE PatternSynonyms   #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-module Unison.Codebase.NameSegment where
-
-import Unison.Prelude
-
-import qualified Unison.Name                   as Name
-import qualified Data.Text                     as Text
-import qualified Unison.Hashable               as H
-import qualified Unison.HashQualified'         as HQ'
-import qualified Control.Lens as Lens
-import Unison.Name (Name(Name))
-
-- Represents the parts of a name between the `.`s
-newtype NameSegment = NameSegment { toText :: Text } deriving (Eq, Ord)
-type HQSegment = HQ'.HashQualified' NameSegment
-
-instance H.Hashable NameSegment where
-  tokens s = [H.Text (toText s)]
-
-isEmpty :: NameSegment -> Bool
-isEmpty ns = toText ns == mempty
-
-isPrefixOf :: NameSegment -> NameSegment -> Bool
-isPrefixOf n1 n2 = Text.isPrefixOf (toText n1) (toText n2)
-
-toString :: NameSegment -> String
-toString = Text.unpack . toText
-
-toName :: NameSegment -> Name.Name
-toName = Name.unsafeFromText . toText
-
-segments :: Name.Name -> [NameSegment]
-segments name = NameSegment <$> Text.splitOn "." (Name.toText name)
-
-instance Show NameSegment where
-  show = Text.unpack . toText
-
-instance IsString NameSegment where
-  fromString = NameSegment . Text.pack
-
-instance Lens.Snoc Name Name NameSegment NameSegment where
-  _Snoc = Lens.prism snoc unsnoc
-    where
-    snoc :: (Name, NameSegment) -> Name
-    snoc (n,s) = Name.joinDot n (toName s)
-    unsnoc :: Name -> Either Name (Name, NameSegment)
-    unsnoc n@(Name (Text.splitOn "." -> ns)) = case Lens.unsnoc ns of
-      Nothing -> Left n
-      Just ([],_) -> Left n
-      Just (init, last) -> Right (Name (Text.intercalate "." init), NameSegment last)
--- a/unison-core/src/Unison/HashQualified'.hs
+++ b/unison-core/src/Unison/HashQualified'.hs
@ -8,6 +8,7 @@ import qualified Data.Text                     as Text
 import           Prelude                 hiding ( take )
 import           Unison.Name                    ( Name )
 import qualified Unison.Name                   as Name
+import           Unison.NameSegment             ( NameSegment )
 import           Unison.Reference               ( Reference )
 import qualified Unison.Reference              as Reference
 import           Unison.Referent                ( Referent )
@ -19,6 +20,8 @@ import qualified Unison.HashQualified          as HQ
 data HashQualified' n = NameOnly n | HashQualified n ShortHash
  deriving (Eq, Functor)

+type HQSegment = HashQualified' NameSegment
+
 type HashQualified = HashQualified' Name

 toHQ :: HashQualified' n -> HQ.HashQualified' n
--- a/unison-core/src/Unison/Name.hs
+++ b/unison-core/src/Unison/Name.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE OverloadedStrings   #-}

 module Unison.Name
@ -12,6 +14,7 @@ module Unison.Name
  , sortNamed'
  , stripNamePrefix
  , stripPrefixes
+  , segments
  , suffixes
  , toString
  , toText
@ -20,14 +23,17 @@ module Unison.Name
  , unqualified'
  , unsafeFromText
  , unsafeFromString
+  , fromSegment
  , fromVar
-  , segments
  )
 where

-import Unison.Prelude
+import           Unison.Prelude
+import qualified Unison.NameSegment            as NameSegment
+import           Unison.NameSegment             ( NameSegment(NameSegment) )

 import           Control.Lens                   ( unsnoc )
+import qualified Control.Lens                  as Lens
 import qualified Data.Text                     as Text
 import qualified Unison.Hashable               as H
 import           Unison.Var                     ( Var )
@ -94,7 +100,7 @@ stripNamePrefix prefix name =

 -- a.b.c.d -> d
 stripPrefixes :: Name -> Name
-stripPrefixes = last . segments
+stripPrefixes = fromSegment . last . segments

 joinDot :: Name -> Name -> Name
 joinDot prefix suffix =
@ -104,24 +110,13 @@ joinDot prefix suffix =
 unqualified :: Name -> Name
 unqualified = unsafeFromText . unqualified' . toText

-- Smarter segmentation than `text.splitOn "."`
-- e.g. split `base..` into `[base,.]`
-segments :: Name -> [Name]
-segments (Name n) = unsafeFromText <$> go parse
-  where
-    parse = Text.splitOn "." n
-    go [] = []
-    go ("" : "" : z) = "." : go z
-    go ("" : z) = go z
-    go (x : y) = x : go y
-
 -- parent . -> Nothing
 -- parent + -> Nothing
 -- parent foo -> Nothing
 -- parent foo.bar -> foo
 -- parent foo.bar.+ -> foo.bar
 parent :: Name -> Maybe Name
-parent n = case unsnoc (toText <$> segments n) of
+parent n = case unsnoc (NameSegment.toText <$> segments n) of
  Nothing        -> Nothing
  Just ([]  , _) -> Nothing
  Just (init, _) -> Just $ Name (Text.intercalate "." init)
@ -157,3 +152,28 @@ instance IsString Name where

 instance H.Hashable Name where
  tokens s = [H.Text (toText s)]
+
+fromSegment :: NameSegment -> Name
+fromSegment = unsafeFromText . NameSegment.toText
+
+-- Smarter segmentation than `text.splitOn "."`
+-- e.g. split `base..` into `[base,.]`
+segments :: Name -> [NameSegment]
+segments (Name n) = NameSegment <$> go split
+  where
+    split = Text.splitOn "." n
+    go [] = []
+    go ("" : "" : z) = "." : go z
+    go ("" : z) = go z
+    go (x : y) = x : go y
+
+instance Lens.Snoc Name Name NameSegment NameSegment where
+  _Snoc = Lens.prism snoc unsnoc
+    where
+    snoc :: (Name, NameSegment) -> Name
+    snoc (n,s) = joinDot n (fromSegment s)
+    unsnoc :: Name -> Either Name (Name, NameSegment)
+    unsnoc n@(Name (Text.splitOn "." -> ns)) = case Lens.unsnoc ns of
+      Nothing -> Left n
+      Just ([],_) -> Left n
+      Just (init, last) -> Right (Name (Text.intercalate "." init), NameSegment last)
--- a/unison-core/src/Unison/NameSegment.hs
+++ b/unison-core/src/Unison/NameSegment.hs
@ -0,0 +1,28 @@
+module Unison.NameSegment where
+
+import Unison.Prelude
+
+import qualified Data.Text                     as Text
+import qualified Unison.Hashable               as H
+
+-- Represents the parts of a name between the `.`s
+newtype NameSegment = NameSegment { toText :: Text } deriving (Eq, Ord)
+
+instance H.Hashable NameSegment where
+  tokens s = [H.Text (toText s)]
+
+isEmpty :: NameSegment -> Bool
+isEmpty ns = toText ns == mempty
+
+isPrefixOf :: NameSegment -> NameSegment -> Bool
+isPrefixOf n1 n2 = Text.isPrefixOf (toText n1) (toText n2)
+
+toString :: NameSegment -> String
+toString = Text.unpack . toText
+
+instance Show NameSegment where
+  show = Text.unpack . toText
+
+instance IsString NameSegment where
+  fromString = NameSegment . Text.pack
+
--- a/unison-core/unison-core.cabal
+++ b/unison-core/unison-core.cabal
@ -36,7 +36,6 @@ library
  exposed-modules:
    Unison.ABT
    Unison.Blank
-    Unison.Codebase.NameSegment
    Unison.ConstructorType
    Unison.DataDeclaration
    Unison.Hash
@ -48,6 +47,7 @@ library
    Unison.Name
    Unison.Names2
    Unison.Names3
+    Unison.NameSegment
    Unison.Paths
    Unison.Pattern
    Unison.PatternP