{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The private Unison.Name innards. Prefer importing Unison.Name instead, unless you need the data constructor of
-- Name.
module Unison.Name.Internal
  ( Name (..),
    isAbsolute,
    segments,
  )
where

import Control.Lens as Lens
import Data.List.NonEmpty (pattern (:|))
import Data.List.NonEmpty qualified as List (NonEmpty)
import Data.List.NonEmpty qualified as List.NonEmpty
import GHC.TypeLits (TypeError)
import GHC.TypeLits qualified as TypeError (ErrorMessage (Text))
import Unison.NameSegment (NameSegment)
import Unison.Position (Position (..))
import Unison.Prelude
import Unison.Util.Alphabetical

-- | A name is an absolute-or-relative non-empty list of name segments. It is used to represent the path to a
--   definition.
--
--   A few example names:
--
-- - "foo.bar"  --> Name Relative ("bar" :| ["foo"])
-- - ".foo.bar" --> Name Absolute ("bar" :| ["foo"])
-- - "|>.<|"    --> Name Relative ("<|" :| ["|>"])
-- - "."        --> Name Relative ("." :| [])
-- - ".."       --> Name Absolute (".." :| [])
data Name
  = Name
      -- | whether the name is positioned absolutely (to some arbitrary root namespace), or relatively
      Position
      -- | the name segments in reverse order
      (List.NonEmpty NameSegment)
  deriving stock (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, (forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Name -> Rep Name x
from :: forall x. Name -> Rep Name x
$cto :: forall x. Rep Name x -> Name
to :: forall x. Rep Name x -> Name
Generic, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show)

-- | Compare names (kinda) alphabetically: absolute comes before relative, but otherwise compare the name segments
-- alphabetically, in order.
instance Alphabetical Name where
  compareAlphabetical :: Name -> Name -> Ordering
compareAlphabetical Name
n1 Name
n2 =
    case (Name -> Bool
isAbsolute Name
n1, Name -> Bool
isAbsolute Name
n2) of
      (Bool
True, Bool
False) -> Ordering
LT
      (Bool
False, Bool
True) -> Ordering
GT
      (Bool, Bool)
_ -> NonEmpty NameSegment -> NonEmpty NameSegment -> Ordering
forall n. Alphabetical n => n -> n -> Ordering
compareAlphabetical (Name -> NonEmpty NameSegment
segments Name
n1) (Name -> NonEmpty NameSegment
segments Name
n2)

instance
  ( TypeError
      ( 'TypeError.Text
          "You cannot make a Name from a string literal because there may (some day) be more than one syntax"
      )
  ) =>
  IsString Name
  where
  fromString :: String -> Name
fromString = String -> Name
forall a. HasCallStack => a
undefined

instance Ord Name where
  compare :: Name -> Name -> Ordering
compare (Name Position
p0 NonEmpty NameSegment
ss0) (Name Position
p1 NonEmpty NameSegment
ss1) =
    NonEmpty NameSegment -> NonEmpty NameSegment -> Ordering
forall a. Ord a => a -> a -> Ordering
compare NonEmpty NameSegment
ss0 NonEmpty NameSegment
ss1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Position -> Position -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Position
p0 Position
p1

instance Lens.Snoc Name Name NameSegment NameSegment where
  _Snoc :: Prism Name Name (Name, NameSegment) (Name, NameSegment)
_Snoc =
    ((Name, NameSegment) -> Name)
-> (Name -> Either Name (Name, NameSegment))
-> Prism Name Name (Name, NameSegment) (Name, NameSegment)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
Lens.prism (Name, NameSegment) -> Name
snoc Name -> Either Name (Name, NameSegment)
unsnoc
    where
      snoc :: (Name, NameSegment) -> Name
      snoc :: (Name, NameSegment) -> Name
snoc (Name Position
p (NameSegment
x :| [NameSegment]
xs), NameSegment
y) =
        Position -> NonEmpty NameSegment -> Name
Name Position
p (NameSegment
y NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| NameSegment
x NameSegment -> [NameSegment] -> [NameSegment]
forall a. a -> [a] -> [a]
: [NameSegment]
xs)
      unsnoc :: Name -> Either Name (Name, NameSegment)
      unsnoc :: Name -> Either Name (Name, NameSegment)
unsnoc Name
name =
        case Name
name of
          Name Position
_ (NameSegment
_ :| []) -> Name -> Either Name (Name, NameSegment)
forall a b. a -> Either a b
Left Name
name
          Name Position
p (NameSegment
x :| NameSegment
y : [NameSegment]
ys) -> (Name, NameSegment) -> Either Name (Name, NameSegment)
forall a b. b -> Either a b
Right (Position -> NonEmpty NameSegment -> Name
Name Position
p (NameSegment
y NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| [NameSegment]
ys), NameSegment
x)

-- | Is this name absolute?
--
-- /O(1)/.
isAbsolute :: Name -> Bool
isAbsolute :: Name -> Bool
isAbsolute = \case
  Name Position
Absolute NonEmpty NameSegment
_ -> Bool
True
  Name Position
Relative NonEmpty NameSegment
_ -> Bool
False

-- | Return the name segments of a name.
--
-- >>> segments "a.b.c"
-- "a" :| ["b", "c"]
--
-- /O(n)/, where /n/ is the number of name segments.
segments :: Name -> List.NonEmpty NameSegment
segments :: Name -> NonEmpty NameSegment
segments (Name Position
_ NonEmpty NameSegment
ss) =
  NonEmpty NameSegment -> NonEmpty NameSegment
forall a. NonEmpty a -> NonEmpty a
List.NonEmpty.reverse NonEmpty NameSegment
ss