{-# OPTIONS_GHC -fno-warn-orphans #-}

module Unison.Codebase.Path
  ( Path,
    Path' (..),
    Pathy (..),
    Namey (..),
    Absolute (..),
    absPath_,
    Relative (..),
    relPath_,
    Resolve (..),
    pattern Current,
    pattern Current',
    pattern Root,
    pattern Root',
    singleton,
    isAbsolute,
    isRelative,
    parentOfName,
    maybePrefix,
    unprefix,
    maybePrefixName,
    prefixNameIfRel,
    unprefixName,
    Split,
    ancestors,

    -- * utilities
    longestPathPrefix,

    -- * tests
    isRoot,

    -- * conversions
    absoluteToPath',
    fromList,
    fromName,
    fromName',
    fromPath',
    unsafeParseText,
    unsafeParseText',
    toAbsoluteSplit,
    toList,
    splitFromName,
  )
where

import Control.Lens
import Data.Foldable qualified as Foldable
import Data.List.Extra (dropPrefix)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as List.NonEmpty
import Data.Sequence (Seq ((:|>)))
import Data.Sequence qualified as Seq
import Data.Text qualified as Text
import GHC.Exts qualified as GHC
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment (NameSegment)
import Unison.Prelude hiding (empty, toList)
import Unison.Syntax.Name qualified as Name (toText, unsafeParseText)
import Unison.Util.List qualified as List
import Unison.Util.Recursion (Recursive, XNor, cata, embed)

-- | A `Path` is an internal structure representing some namespace in the codebase.
--
--  @Foo.Bar.baz@ becomes @["Foo", "Bar", "baz"]@.
--
--  __NB__:  This shouldn’t be exposed outside of this module (prefer`Path'`, `Absolute`, or `Relative`), but it’s
--   currently used pretty widely. Such usage should be replaced when encountered.
newtype Path = Path {Path -> Seq NameSegment
toSeq :: Seq NameSegment}
  deriving stock (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Eq Path
Eq Path =>
(Path -> Path -> Ordering)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Bool)
-> (Path -> Path -> Path)
-> (Path -> Path -> Path)
-> Ord Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Path -> Path -> Ordering
compare :: Path -> Path -> Ordering
$c< :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
>= :: Path -> Path -> Bool
$cmax :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
min :: Path -> Path -> Path
Ord, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show)
  deriving newtype (NonEmpty Path -> Path
Path -> Path -> Path
(Path -> Path -> Path)
-> (NonEmpty Path -> Path)
-> (forall b. Integral b => b -> Path -> Path)
-> Semigroup Path
forall b. Integral b => b -> Path -> Path
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Path -> Path -> Path
<> :: Path -> Path -> Path
$csconcat :: NonEmpty Path -> Path
sconcat :: NonEmpty Path -> Path
$cstimes :: forall b. Integral b => b -> Path -> Path
stimes :: forall b. Integral b => b -> Path -> Path
Semigroup, Semigroup Path
Path
Semigroup Path =>
Path -> (Path -> Path -> Path) -> ([Path] -> Path) -> Monoid Path
[Path] -> Path
Path -> Path -> Path
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Path
mempty :: Path
$cmappend :: Path -> Path -> Path
mappend :: Path -> Path -> Path
$cmconcat :: [Path] -> Path
mconcat :: [Path] -> Path
Monoid)

instance Recursive Path (XNor NameSegment) where
  cata :: forall a. Algebra (XNor NameSegment) a -> Path -> a
cata Algebra (XNor NameSegment) a
φ = Algebra (XNor NameSegment) a -> Seq NameSegment -> a
forall a. Algebra (XNor NameSegment) a -> Seq NameSegment -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata Algebra (XNor NameSegment) a
φ (Seq NameSegment -> a) -> (Path -> Seq NameSegment) -> Path -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Seq NameSegment
toSeq
  embed :: XNor NameSegment Path -> Path
embed = Seq NameSegment -> Path
Path (Seq NameSegment -> Path)
-> (XNor NameSegment Path -> Seq NameSegment)
-> XNor NameSegment Path
-> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNor NameSegment (Seq NameSegment) -> Seq NameSegment
forall t (f :: * -> *). Recursive t f => f t -> t
embed (XNor NameSegment (Seq NameSegment) -> Seq NameSegment)
-> (XNor NameSegment Path -> XNor NameSegment (Seq NameSegment))
-> XNor NameSegment Path
-> Seq NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Seq NameSegment)
-> XNor NameSegment Path -> XNor NameSegment (Seq NameSegment)
forall a b. (a -> b) -> XNor NameSegment a -> XNor NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path -> Seq NameSegment
toSeq

-- | Meant for use mostly in doc-tests where it's
-- sometimes convenient to specify paths as lists.
instance GHC.IsList Path where
  type Item Path = NameSegment
  toList :: Path -> [Item Path]
toList (Path Seq NameSegment
segs) = Seq NameSegment -> [NameSegment]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq NameSegment
segs
  fromList :: [Item Path] -> Path
fromList = Seq NameSegment -> Path
Path (Seq NameSegment -> Path)
-> ([NameSegment] -> Seq NameSegment) -> [NameSegment] -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> Seq NameSegment
forall a. [a] -> Seq a
Seq.fromList

-- | An absolute from the current project root
newtype Absolute = Absolute {Absolute -> Path
unabsolute :: Path} deriving (Absolute -> Absolute -> Bool
(Absolute -> Absolute -> Bool)
-> (Absolute -> Absolute -> Bool) -> Eq Absolute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Absolute -> Absolute -> Bool
== :: Absolute -> Absolute -> Bool
$c/= :: Absolute -> Absolute -> Bool
/= :: Absolute -> Absolute -> Bool
Eq, Eq Absolute
Eq Absolute =>
(Absolute -> Absolute -> Ordering)
-> (Absolute -> Absolute -> Bool)
-> (Absolute -> Absolute -> Bool)
-> (Absolute -> Absolute -> Bool)
-> (Absolute -> Absolute -> Bool)
-> (Absolute -> Absolute -> Absolute)
-> (Absolute -> Absolute -> Absolute)
-> Ord Absolute
Absolute -> Absolute -> Bool
Absolute -> Absolute -> Ordering
Absolute -> Absolute -> Absolute
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Absolute -> Absolute -> Ordering
compare :: Absolute -> Absolute -> Ordering
$c< :: Absolute -> Absolute -> Bool
< :: Absolute -> Absolute -> Bool
$c<= :: Absolute -> Absolute -> Bool
<= :: Absolute -> Absolute -> Bool
$c> :: Absolute -> Absolute -> Bool
> :: Absolute -> Absolute -> Bool
$c>= :: Absolute -> Absolute -> Bool
>= :: Absolute -> Absolute -> Bool
$cmax :: Absolute -> Absolute -> Absolute
max :: Absolute -> Absolute -> Absolute
$cmin :: Absolute -> Absolute -> Absolute
min :: Absolute -> Absolute -> Absolute
Ord, Int -> Absolute -> ShowS
[Absolute] -> ShowS
Absolute -> String
(Int -> Absolute -> ShowS)
-> (Absolute -> String) -> ([Absolute] -> ShowS) -> Show Absolute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Absolute -> ShowS
showsPrec :: Int -> Absolute -> ShowS
$cshow :: Absolute -> String
show :: Absolute -> String
$cshowList :: [Absolute] -> ShowS
showList :: [Absolute] -> ShowS
Show)

instance Recursive Absolute (XNor NameSegment) where
  cata :: forall a. Algebra (XNor NameSegment) a -> Absolute -> a
cata Algebra (XNor NameSegment) a
φ = Algebra (XNor NameSegment) a -> Path -> a
forall a. Algebra (XNor NameSegment) a -> Path -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata Algebra (XNor NameSegment) a
φ (Path -> a) -> (Absolute -> Path) -> Absolute -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path
unabsolute
  embed :: XNor NameSegment Absolute -> Absolute
embed = Path -> Absolute
Absolute (Path -> Absolute)
-> (XNor NameSegment Absolute -> Path)
-> XNor NameSegment Absolute
-> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNor NameSegment Path -> Path
forall t (f :: * -> *). Recursive t f => f t -> t
embed (XNor NameSegment Path -> Path)
-> (XNor NameSegment Absolute -> XNor NameSegment Path)
-> XNor NameSegment Absolute
-> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Absolute -> Path)
-> XNor NameSegment Absolute -> XNor NameSegment Path
forall a b. (a -> b) -> XNor NameSegment a -> XNor NameSegment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Absolute -> Path
unabsolute

absPath_ :: Lens' Absolute Path
absPath_ :: Lens' Absolute Path
absPath_ = (Absolute -> Path)
-> (Absolute -> Path -> Absolute) -> Lens' Absolute Path
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Absolute -> Path
unabsolute (\Absolute
_ Path
new -> Path -> Absolute
Absolute Path
new)

-- | A namespace path that doesn’t necessarily start from the root.
-- Typically refers to a path from the current namespace.
newtype Relative = Relative {Relative -> Path
unrelative :: Path}
  deriving stock (Relative -> Relative -> Bool
(Relative -> Relative -> Bool)
-> (Relative -> Relative -> Bool) -> Eq Relative
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Relative -> Relative -> Bool
== :: Relative -> Relative -> Bool
$c/= :: Relative -> Relative -> Bool
/= :: Relative -> Relative -> Bool
Eq, Eq Relative
Eq Relative =>
(Relative -> Relative -> Ordering)
-> (Relative -> Relative -> Bool)
-> (Relative -> Relative -> Bool)
-> (Relative -> Relative -> Bool)
-> (Relative -> Relative -> Bool)
-> (Relative -> Relative -> Relative)
-> (Relative -> Relative -> Relative)
-> Ord Relative
Relative -> Relative -> Bool
Relative -> Relative -> Ordering
Relative -> Relative -> Relative
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Relative -> Relative -> Ordering
compare :: Relative -> Relative -> Ordering
$c< :: Relative -> Relative -> Bool
< :: Relative -> Relative -> Bool
$c<= :: Relative -> Relative -> Bool
<= :: Relative -> Relative -> Bool
$c> :: Relative -> Relative -> Bool
> :: Relative -> Relative -> Bool
$c>= :: Relative -> Relative -> Bool
>= :: Relative -> Relative -> Bool
$cmax :: Relative -> Relative -> Relative
max :: Relative -> Relative -> Relative
$cmin :: Relative -> Relative -> Relative
min :: Relative -> Relative -> Relative
Ord, Int -> Relative -> ShowS
[Relative] -> ShowS
Relative -> String
(Int -> Relative -> ShowS)
-> (Relative -> String) -> ([Relative] -> ShowS) -> Show Relative
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Relative -> ShowS
showsPrec :: Int -> Relative -> ShowS
$cshow :: Relative -> String
show :: Relative -> String
$cshowList :: [Relative] -> ShowS
showList :: [Relative] -> ShowS
Show)
  deriving newtype (NonEmpty Relative -> Relative
Relative -> Relative -> Relative
(Relative -> Relative -> Relative)
-> (NonEmpty Relative -> Relative)
-> (forall b. Integral b => b -> Relative -> Relative)
-> Semigroup Relative
forall b. Integral b => b -> Relative -> Relative
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Relative -> Relative -> Relative
<> :: Relative -> Relative -> Relative
$csconcat :: NonEmpty Relative -> Relative
sconcat :: NonEmpty Relative -> Relative
$cstimes :: forall b. Integral b => b -> Relative -> Relative
stimes :: forall b. Integral b => b -> Relative -> Relative
Semigroup, Semigroup Relative
Relative
Semigroup Relative =>
Relative
-> (Relative -> Relative -> Relative)
-> ([Relative] -> Relative)
-> Monoid Relative
[Relative] -> Relative
Relative -> Relative -> Relative
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Relative
mempty :: Relative
$cmappend :: Relative -> Relative -> Relative
mappend :: Relative -> Relative -> Relative
$cmconcat :: [Relative] -> Relative
mconcat :: [Relative] -> Relative
Monoid)

relPath_ :: Lens' Relative Path
relPath_ :: Lens' Relative Path
relPath_ = (Relative -> Path)
-> (Relative -> Path -> Relative) -> Lens' Relative Path
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Relative -> Path
unrelative (\Relative
_ Path
new -> Path -> Relative
Relative Path
new)

-- | A namespace that may be either absolute or relative, This is the most general type that should be used.
data Path'
  = AbsolutePath' Absolute
  | RelativePath' Relative
  deriving (Path' -> Path' -> Bool
(Path' -> Path' -> Bool) -> (Path' -> Path' -> Bool) -> Eq Path'
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path' -> Path' -> Bool
== :: Path' -> Path' -> Bool
$c/= :: Path' -> Path' -> Bool
/= :: Path' -> Path' -> Bool
Eq, Eq Path'
Eq Path' =>
(Path' -> Path' -> Ordering)
-> (Path' -> Path' -> Bool)
-> (Path' -> Path' -> Bool)
-> (Path' -> Path' -> Bool)
-> (Path' -> Path' -> Bool)
-> (Path' -> Path' -> Path')
-> (Path' -> Path' -> Path')
-> Ord Path'
Path' -> Path' -> Bool
Path' -> Path' -> Ordering
Path' -> Path' -> Path'
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Path' -> Path' -> Ordering
compare :: Path' -> Path' -> Ordering
$c< :: Path' -> Path' -> Bool
< :: Path' -> Path' -> Bool
$c<= :: Path' -> Path' -> Bool
<= :: Path' -> Path' -> Bool
$c> :: Path' -> Path' -> Bool
> :: Path' -> Path' -> Bool
$c>= :: Path' -> Path' -> Bool
>= :: Path' -> Path' -> Bool
$cmax :: Path' -> Path' -> Path'
max :: Path' -> Path' -> Path'
$cmin :: Path' -> Path' -> Path'
min :: Path' -> Path' -> Path'
Ord, Int -> Path' -> ShowS
[Path'] -> ShowS
Path' -> String
(Int -> Path' -> ShowS)
-> (Path' -> String) -> ([Path'] -> ShowS) -> Show Path'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path' -> ShowS
showsPrec :: Int -> Path' -> ShowS
$cshow :: Path' -> String
show :: Path' -> String
$cshowList :: [Path'] -> ShowS
showList :: [Path'] -> ShowS
Show)

isAbsolute :: Path' -> Bool
isAbsolute :: Path' -> Bool
isAbsolute (AbsolutePath' Absolute
_) = Bool
True
isAbsolute Path'
_ = Bool
False

isRelative :: Path' -> Bool
isRelative :: Path' -> Bool
isRelative (RelativePath' Relative
_) = Bool
True
isRelative Path'
_ = Bool
False

pattern Current :: Relative
pattern $mCurrent :: forall {r}. Relative -> ((# #) -> r) -> ((# #) -> r) -> r
$bCurrent :: Relative
Current = Relative (Path Seq.Empty)

pattern Current' :: Path'
pattern $mCurrent' :: forall {r}. Path' -> ((# #) -> r) -> ((# #) -> r) -> r
$bCurrent' :: Path'
Current' = RelativePath' Current

isRoot :: Absolute -> Bool
isRoot :: Absolute -> Bool
isRoot = Seq NameSegment -> Bool
forall a. Seq a -> Bool
Seq.null (Seq NameSegment -> Bool)
-> (Absolute -> Seq NameSegment) -> Absolute -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Seq NameSegment
toSeq (Path -> Seq NameSegment)
-> (Absolute -> Path) -> Absolute -> Seq NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path
unabsolute

absoluteToPath' :: Absolute -> Path'
absoluteToPath' :: Absolute -> Path'
absoluteToPath' = Absolute -> Path'
AbsolutePath'

type Split path = (path, NameSegment)

-- | examples:
--   unprefix foo.bar .blah == .blah (absolute paths left alone)
--   unprefix foo.bar id    == id    (relative paths starting w/ nonmatching prefix left alone)
--   unprefix foo.bar foo.bar.baz == baz (relative paths w/ common prefix get stripped)
unprefix :: Relative -> Path' -> Path'
unprefix :: Relative -> Path' -> Path'
unprefix (Relative Path
prefix) = \case
  AbsolutePath' Absolute
abs -> Absolute -> Path'
AbsolutePath' Absolute
abs
  RelativePath' Relative
rel -> Relative -> Path'
RelativePath' (Relative -> Path') -> (Path -> Relative) -> Path -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Relative (Path -> Relative) -> (Path -> Path) -> Path -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> Path
fromList ([NameSegment] -> Path) -> (Path -> [NameSegment]) -> Path -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> [NameSegment] -> [NameSegment]
forall a. Eq a => [a] -> [a] -> [a]
dropPrefix (Path -> [NameSegment]
toList Path
prefix) ([NameSegment] -> [NameSegment])
-> (Path -> [NameSegment]) -> Path -> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> [NameSegment]
toList (Path -> Path') -> Path -> Path'
forall a b. (a -> b) -> a -> b
$ Relative -> Path
unrelative Relative
rel

-- | Returns `Nothing` if the second argument is absolute. A common pattern is
--   @fromMaybe path $ maybePrefix prefix path@ to use the unmodified path in that case.
maybePrefix :: Path' -> Path' -> Maybe Path'
maybePrefix :: Path' -> Path' -> Maybe Path'
maybePrefix Path'
pre = \case
  AbsolutePath' Absolute
_ -> Maybe Path'
forall a. Maybe a
Nothing
  RelativePath' Relative
rel -> Path' -> Maybe Path'
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path' -> Maybe Path') -> Path' -> Maybe Path'
forall a b. (a -> b) -> a -> b
$ Path' -> Relative -> Path'
forall path. Pathy path => path -> Relative -> path
prefix Path'
pre Relative
rel

-- | Finds the longest shared path prefix of two paths.
-- Returns (shared prefix, path to first location from shared prefix, path to second location from shared prefix)
--
-- >>> longestPathPrefix ("a" :< "b" :< "x" :< Empty) ("a" :< "b" :< "c" :< Empty)
-- (a.b,x,c)
--
-- >>> longestPathPrefix Empty ("a" :< "b" :< "c" :< Empty)
-- (,,a.b.c)
longestPathPrefix :: Absolute -> Absolute -> (Absolute, Relative, Relative)
longestPathPrefix :: Absolute -> Absolute -> (Absolute, Relative, Relative)
longestPathPrefix Absolute
a Absolute
b =
  [NameSegment]
-> [NameSegment] -> ([NameSegment], [NameSegment], [NameSegment])
forall a. Eq a => [a] -> [a] -> ([a], [a], [a])
List.splitOnLongestCommonPrefix (Path -> [NameSegment]
toList (Path -> [NameSegment]) -> Path -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Absolute -> Path
unabsolute Absolute
a) (Path -> [NameSegment]
toList (Path -> [NameSegment]) -> Path -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Absolute -> Path
unabsolute Absolute
b)
    ([NameSegment], [NameSegment], [NameSegment])
-> (([NameSegment], [NameSegment], [NameSegment])
    -> (Absolute, Relative, Relative))
-> (Absolute, Relative, Relative)
forall a b. a -> (a -> b) -> b
& \([NameSegment]
a, [NameSegment]
b, [NameSegment]
c) -> (Path -> Absolute
Absolute (Path -> Absolute) -> Path -> Absolute
forall a b. (a -> b) -> a -> b
$ [NameSegment] -> Path
fromList [NameSegment]
a, Path -> Relative
Relative (Path -> Relative) -> Path -> Relative
forall a b. (a -> b) -> a -> b
$ [NameSegment] -> Path
fromList [NameSegment]
b, Path -> Relative
Relative (Path -> Relative) -> Path -> Relative
forall a b. (a -> b) -> a -> b
$ [NameSegment] -> Path
fromList [NameSegment]
c)

toAbsoluteSplit :: Absolute -> Split Path' -> Split Absolute
toAbsoluteSplit :: Absolute -> Split Path' -> Split Absolute
toAbsoluteSplit = (Path' -> Absolute) -> Split Path' -> Split Absolute
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Path' -> Absolute) -> Split Path' -> Split Absolute)
-> (Absolute -> Path' -> Absolute)
-> Absolute
-> Split Path'
-> Split Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path' -> Absolute
forall l r o. Resolve l r o => l -> r -> o
resolve

pattern Root :: Absolute
pattern $mRoot :: forall {r}. Absolute -> ((# #) -> r) -> ((# #) -> r) -> r
$bRoot :: Absolute
Root = Absolute (Path Seq.Empty)

pattern Root' :: Path'
pattern $mRoot' :: forall {r}. Path' -> ((# #) -> r) -> ((# #) -> r) -> r
$bRoot' :: Path'
Root' = AbsolutePath' Root

-- Forget whether the path is absolute or relative
fromPath' :: Path' -> Path
fromPath' :: Path' -> Path
fromPath' = \case
  AbsolutePath' (Absolute Path
p) -> Path
p
  RelativePath' (Relative Path
p) -> Path
p

toList :: Path -> [NameSegment]
toList :: Path -> [NameSegment]
toList = Seq NameSegment -> [NameSegment]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList (Seq NameSegment -> [NameSegment])
-> (Path -> Seq NameSegment) -> Path -> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Seq NameSegment
toSeq

fromList :: [NameSegment] -> Path
fromList :: [NameSegment] -> Path
fromList = Seq NameSegment -> Path
Path (Seq NameSegment -> Path)
-> ([NameSegment] -> Seq NameSegment) -> [NameSegment] -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NameSegment] -> Seq NameSegment
forall a. [a] -> Seq a
Seq.fromList

ancestors :: Absolute -> Seq Absolute
ancestors :: Absolute -> Seq Absolute
ancestors (Absolute (Path Seq NameSegment
segments)) = Path -> Absolute
Absolute (Path -> Absolute)
-> (Seq NameSegment -> Path) -> Seq NameSegment -> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq NameSegment -> Path
Path (Seq NameSegment -> Absolute)
-> Seq (Seq NameSegment) -> Seq Absolute
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq NameSegment -> Seq (Seq NameSegment)
forall a. Seq a -> Seq (Seq a)
Seq.inits Seq NameSegment
segments

-- |
-- >>> splitFromName "a.b.c"
-- (a.b,c)
--
-- >>> splitFromName "foo"
-- (,foo)
splitFromName :: Name -> Split Path
splitFromName :: Name -> Split Path
splitFromName Name
name = case Name -> NonEmpty NameSegment
Name.reverseSegments Name
name of
  NameSegment
h :| [NameSegment]
t -> ([NameSegment] -> Path
fromList ([NameSegment] -> Path) -> [NameSegment] -> Path
forall a b. (a -> b) -> a -> b
$ [NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse [NameSegment]
t, NameSegment
h)

-- | Remove a path prefix from a name.
-- Returns 'Nothing' if there are no remaining segments to construct the name from.
--
-- >>> unprefixName (Relative $ fromList ["base", "List"]) (Name.unsafeFromText "base.List.map")
-- Just (Name Relative (NameSegment {toText = "map"} :| []))
unprefixName :: Relative -> Name -> Maybe Name
unprefixName :: Relative -> Name -> Maybe Name
unprefixName Relative
prefix = Path' -> Maybe Name
forall path. Namey path => path -> Maybe Name
toName (Path' -> Maybe Name) -> (Name -> Path') -> Name -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Path' -> Path'
unprefix Relative
prefix (Path' -> Path') -> (Name -> Path') -> Name -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Path'
fromName'

-- | Returns `Nothing` if the second argument is absolute. A common pattern is
--   @fromMaybe name $ maybePrefixName prefix name@ to use the unmodified path in that case.
maybePrefixName :: Path' -> Name -> Maybe Name
maybePrefixName :: Path' -> Name -> Maybe Name
maybePrefixName Path'
pre Name
name =
  if Name -> Bool
Name.isAbsolute Name
name
    then Maybe Name
forall a. Maybe a
Nothing
    else
      Name -> Maybe Name
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        let newName :: Name
newName = case Name -> NonEmpty NameSegment
Name.reverseSegments Name
name of
              NameSegment
h :| [NameSegment]
t -> NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name) -> NonEmpty NameSegment -> Name
forall a b. (a -> b) -> a -> b
$ NameSegment
h NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| [NameSegment]
t [NameSegment] -> [NameSegment] -> [NameSegment]
forall a. Semigroup a => a -> a -> a
<> [NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse (Path -> [NameSegment]
toList (Path -> [NameSegment]) -> Path -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Path' -> Path
fromPath' Path'
pre)
         in if Path' -> Bool
isAbsolute Path'
pre then Name -> Name
Name.makeAbsolute Name
newName else Name
newName

prefixNameIfRel :: Path' -> Name -> Name
prefixNameIfRel :: Path' -> Name -> Name
prefixNameIfRel Path'
p Name
name = Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe Name
name (Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$ Path' -> Name -> Maybe Name
maybePrefixName Path'
p Name
name

singleton :: NameSegment -> Path
singleton :: NameSegment -> Path
singleton NameSegment
n = [NameSegment] -> Path
fromList [NameSegment
n]

class Pathy path where
  ascend :: path -> Maybe path
  ascend = ((path, NameSegment) -> path)
-> Maybe (path, NameSegment) -> Maybe path
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (path, NameSegment) -> path
forall a b. (a, b) -> a
fst (Maybe (path, NameSegment) -> Maybe path)
-> (path -> Maybe (path, NameSegment)) -> path -> Maybe path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. path -> Maybe (path, NameSegment)
forall path. Pathy path => path -> Maybe (path, NameSegment)
split
  descend :: path -> NameSegment -> path

  -- | This always prefixes, since the second argument can never be absolute.
  prefix :: path -> Relative -> path

  split :: path -> Maybe (Split path)

  unsplit :: Split path -> path
  unsplit = (path -> NameSegment -> path) -> (path, NameSegment) -> path
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry path -> NameSegment -> path
forall path. Pathy path => path -> NameSegment -> path
descend
  toText :: path -> Text

class (Pathy path) => Namey path where
  nameFromSplit :: Split path -> Name

  -- | Convert a path' to a `Name`
  toName :: path -> Maybe Name
  toName = (Split path -> Name) -> Maybe (Split path) -> Maybe Name
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Split path -> Name
forall path. Namey path => Split path -> Name
nameFromSplit (Maybe (Split path) -> Maybe Name)
-> (path -> Maybe (Split path)) -> path -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. path -> Maybe (Split path)
forall path. Pathy path => path -> Maybe (path, NameSegment)
split

instance Pathy Path where
  descend :: Path -> NameSegment -> Path
descend (Path Seq NameSegment
p) = Seq NameSegment -> Path
Path (Seq NameSegment -> Path)
-> (NameSegment -> Seq NameSegment) -> NameSegment -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq NameSegment
p Seq NameSegment -> NameSegment -> Seq NameSegment
forall a. Seq a -> a -> Seq a
:|>)
  prefix :: Path -> Relative -> Path
prefix Path
pre = Seq NameSegment -> Path
Path (Seq NameSegment -> Path)
-> (Relative -> Seq NameSegment) -> Relative -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Seq NameSegment
toSeq Path
pre Seq NameSegment -> Seq NameSegment -> Seq NameSegment
forall a. Semigroup a => a -> a -> a
<>) (Seq NameSegment -> Seq NameSegment)
-> (Relative -> Seq NameSegment) -> Relative -> Seq NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Seq NameSegment
toSeq (Path -> Seq NameSegment)
-> (Relative -> Path) -> Relative -> Seq NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Path
unrelative
  split :: Path -> Maybe (Split Path)
split (Path Seq NameSegment
seq) = case Seq NameSegment
seq of
    Seq NameSegment
Seq.Empty -> Maybe (Split Path)
forall a. Maybe a
Nothing
    Seq NameSegment
p :|> NameSegment
n -> Split Path -> Maybe (Split Path)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq NameSegment -> Path
Path Seq NameSegment
p, NameSegment
n)

  -- Note: This treats the path as relative.
  toText :: Path -> Text
toText = Text -> (Name -> Text) -> Maybe Name -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
Text.empty Name -> Text
Name.toText (Maybe Name -> Text) -> (Path -> Maybe Name) -> Path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Maybe Name
forall path. Namey path => path -> Maybe Name
toName

instance Namey Path where
  nameFromSplit :: Split Path -> Name
nameFromSplit = NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name)
-> (Split Path -> NonEmpty NameSegment) -> Split Path -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NameSegment] -> NameSegment -> NonEmpty NameSegment)
-> ([NameSegment], NameSegment) -> NonEmpty NameSegment
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((NameSegment -> [NameSegment] -> NonEmpty NameSegment)
-> [NameSegment] -> NameSegment -> NonEmpty NameSegment
forall a b c. (a -> b -> c) -> b -> a -> c
flip NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
(:|)) (([NameSegment], NameSegment) -> NonEmpty NameSegment)
-> (Split Path -> ([NameSegment], NameSegment))
-> Split Path
-> NonEmpty NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> [NameSegment])
-> Split Path -> ([NameSegment], NameSegment)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse ([NameSegment] -> [NameSegment])
-> (Path -> [NameSegment]) -> Path -> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> [NameSegment]
toList)

instance Pathy Absolute where
  descend :: Absolute -> NameSegment -> Absolute
descend (Absolute Path
p) = Path -> Absolute
Absolute (Path -> Absolute)
-> (NameSegment -> Path) -> NameSegment -> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> NameSegment -> Path
forall path. Pathy path => path -> NameSegment -> path
descend Path
p
  prefix :: Absolute -> Relative -> Absolute
prefix (Absolute Path
pre) = Path -> Absolute
Absolute (Path -> Absolute) -> (Relative -> Path) -> Relative -> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative -> Path
forall path. Pathy path => path -> Relative -> path
prefix Path
pre
  split :: Absolute -> Maybe (Split Absolute)
split (Absolute Path
p) = (Path -> Absolute) -> Split Path -> Split Absolute
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Path -> Absolute
Absolute (Split Path -> Split Absolute)
-> Maybe (Split Path) -> Maybe (Split Absolute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> Maybe (Split Path)
forall path. Pathy path => path -> Maybe (path, NameSegment)
split Path
p
  toText :: Absolute -> Text
toText = (Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Absolute -> Text) -> Absolute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
forall path. Pathy path => path -> Text
toText (Path -> Text) -> (Absolute -> Path) -> Absolute -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path
unabsolute

instance Namey Absolute where
  nameFromSplit :: Split Absolute -> Name
nameFromSplit = Name -> Name
Name.makeAbsolute (Name -> Name)
-> (Split Absolute -> Name) -> Split Absolute -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split Path -> Name
forall path. Namey path => Split path -> Name
nameFromSplit (Split Path -> Name)
-> (Split Absolute -> Split Path) -> Split Absolute -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Absolute -> Path) -> Split Absolute -> Split Path
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Absolute -> Path
unabsolute

instance Pathy Relative where
  descend :: Relative -> NameSegment -> Relative
descend (Relative Path
p) = Path -> Relative
Relative (Path -> Relative)
-> (NameSegment -> Path) -> NameSegment -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> NameSegment -> Path
forall path. Pathy path => path -> NameSegment -> path
descend Path
p
  prefix :: Relative -> Relative -> Relative
prefix (Relative Path
pre) = Path -> Relative
Relative (Path -> Relative) -> (Relative -> Path) -> Relative -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative -> Path
forall path. Pathy path => path -> Relative -> path
prefix Path
pre
  split :: Relative -> Maybe (Split Relative)
split (Relative Path
p) = (Path -> Relative) -> Split Path -> Split Relative
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Path -> Relative
Relative (Split Path -> Split Relative)
-> Maybe (Split Path) -> Maybe (Split Relative)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> Maybe (Split Path)
forall path. Pathy path => path -> Maybe (path, NameSegment)
split Path
p
  toText :: Relative -> Text
toText = Path -> Text
forall path. Pathy path => path -> Text
toText (Path -> Text) -> (Relative -> Path) -> Relative -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Path
unrelative

instance Namey Relative where
  nameFromSplit :: Split Relative -> Name
nameFromSplit = Name -> Name
Name.makeRelative (Name -> Name)
-> (Split Relative -> Name) -> Split Relative -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Split Path -> Name
forall path. Namey path => Split path -> Name
nameFromSplit (Split Path -> Name)
-> (Split Relative -> Split Path) -> Split Relative -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Relative -> Path) -> Split Relative -> Split Path
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Relative -> Path
unrelative

instance Pathy Path' where
  descend :: Path' -> NameSegment -> Path'
descend = \case
    AbsolutePath' Absolute
p -> Absolute -> Path'
AbsolutePath' (Absolute -> Path')
-> (NameSegment -> Absolute) -> NameSegment -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> NameSegment -> Absolute
forall path. Pathy path => path -> NameSegment -> path
descend Absolute
p
    RelativePath' Relative
p -> Relative -> Path'
RelativePath' (Relative -> Path')
-> (NameSegment -> Relative) -> NameSegment -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> NameSegment -> Relative
forall path. Pathy path => path -> NameSegment -> path
descend Relative
p
  prefix :: Path' -> Relative -> Path'
prefix = \case
    AbsolutePath' Absolute
p -> Absolute -> Path'
AbsolutePath' (Absolute -> Path') -> (Relative -> Absolute) -> Relative -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Relative -> Absolute
forall path. Pathy path => path -> Relative -> path
prefix Absolute
p
    RelativePath' Relative
p -> Relative -> Path'
RelativePath' (Relative -> Path') -> (Relative -> Relative) -> Relative -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Relative -> Relative
forall path. Pathy path => path -> Relative -> path
prefix Relative
p
  split :: Path' -> Maybe (Split Path')
split = \case
    AbsolutePath' Absolute
p -> (Absolute -> Path') -> Split Absolute -> Split Path'
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Absolute -> Path'
AbsolutePath' (Split Absolute -> Split Path')
-> Maybe (Split Absolute) -> Maybe (Split Path')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Absolute -> Maybe (Split Absolute)
forall path. Pathy path => path -> Maybe (path, NameSegment)
split Absolute
p
    RelativePath' Relative
p -> (Relative -> Path') -> Split Relative -> Split Path'
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Relative -> Path'
RelativePath' (Split Relative -> Split Path')
-> Maybe (Split Relative) -> Maybe (Split Path')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Relative -> Maybe (Split Relative)
forall path. Pathy path => path -> Maybe (path, NameSegment)
split Relative
p
  toText :: Path' -> Text
toText = \case
    AbsolutePath' Absolute
p -> Absolute -> Text
forall path. Pathy path => path -> Text
toText Absolute
p
    RelativePath' Relative
p -> Relative -> Text
forall path. Pathy path => path -> Text
toText Relative
p

instance Namey Path' where
  nameFromSplit :: Split Path' -> Name
nameFromSplit (Path'
path, NameSegment
ns) = case Path'
path of
    AbsolutePath' Absolute
p -> Split Absolute -> Name
forall path. Namey path => Split path -> Name
nameFromSplit (Absolute
p, NameSegment
ns)
    RelativePath' Relative
p -> Split Relative -> Name
forall path. Namey path => Split path -> Name
nameFromSplit (Relative
p, NameSegment
ns)

-- > Path.fromName . Name.unsafeFromText $ ".Foo.bar"
-- /Foo/bar
-- Int./  -> "Int"/"/"
-- pkg/Int.. -> "pkg"/"Int"/"."
-- Int./foo -> error because "/foo" is not a valid NameSegment
--                      and "Int." is not a valid NameSegment
--                      and "Int" / "" / "foo" is not a valid path (internal "")
-- todo: fromName needs to be a little more complicated if we want to allow
--       identifiers called Function.(.)
fromName :: Name -> Path
fromName :: Name -> Path
fromName = [NameSegment] -> Path
fromList ([NameSegment] -> Path) -> (Name -> [NameSegment]) -> Name -> Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NameSegment -> [NameSegment]
forall a. NonEmpty a -> [a]
List.NonEmpty.toList (NonEmpty NameSegment -> [NameSegment])
-> (Name -> NonEmpty NameSegment) -> Name -> [NameSegment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NonEmpty NameSegment
Name.segments

parentOfName :: Name -> Split Path'
parentOfName :: Name -> Split Path'
parentOfName Name
name =
  let NameSegment
h :| [NameSegment]
t = Name -> NonEmpty NameSegment
Name.reverseSegments Name
name
      path :: Path
path = [NameSegment] -> Path
fromList ([NameSegment] -> Path) -> [NameSegment] -> Path
forall a b. (a -> b) -> a -> b
$ [NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse [NameSegment]
t
   in ( if Name -> Bool
Name.isAbsolute Name
name
          then Absolute -> Path'
AbsolutePath' (Path -> Absolute
Absolute Path
path)
          else Relative -> Path'
RelativePath' (Path -> Relative
Relative Path
path),
        NameSegment
h
      )

fromName' :: Name -> Path'
fromName' :: Name -> Path'
fromName' Name
n
  | Name -> Bool
Name.isAbsolute Name
n = Absolute -> Path'
AbsolutePath' (Path -> Absolute
Absolute Path
path)
  | Bool
otherwise = Relative -> Path'
RelativePath' (Path -> Relative
Relative Path
path)
  where
    path :: Path
path = Name -> Path
fromName Name
n

unsafeParseText :: Text -> Path
unsafeParseText :: Text -> Path
unsafeParseText = \case
  Text
"" -> Path
forall a. Monoid a => a
mempty
  Text
text -> Name -> Path
fromName (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
text)

-- | Construct a Path' from a text
--
-- >>> fromText' "a.b.c"
-- a.b.c
--
-- >>> fromText' ".a.b.c"
-- .a.b.c
--
-- >>> show $ fromText' ""
-- ""
unsafeParseText' :: Text -> Path'
unsafeParseText' :: Text -> Path'
unsafeParseText' = \case
  Text
"" -> Relative -> Path'
RelativePath' (Path -> Relative
Relative Path
forall a. Monoid a => a
mempty)
  Text
"." -> Absolute -> Path'
AbsolutePath' (Path -> Absolute
Absolute Path
forall a. Monoid a => a
mempty)
  Text
text -> Name -> Path'
fromName' (HasCallStack => Text -> Name
Text -> Name
Name.unsafeParseText Text
text)

class Resolve l r o where
  resolve :: l -> r -> o

instance Resolve Path Path Path where
  resolve :: Path -> Path -> Path
resolve (Path Seq NameSegment
l) (Path Seq NameSegment
r) = Seq NameSegment -> Path
Path (Seq NameSegment
l Seq NameSegment -> Seq NameSegment -> Seq NameSegment
forall a. Semigroup a => a -> a -> a
<> Seq NameSegment
r)

instance Resolve Relative Relative Relative where
  resolve :: Relative -> Relative -> Relative
resolve (Relative (Path Seq NameSegment
l)) (Relative (Path Seq NameSegment
r)) = Path -> Relative
Relative (Seq NameSegment -> Path
Path (Seq NameSegment
l Seq NameSegment -> Seq NameSegment -> Seq NameSegment
forall a. Semigroup a => a -> a -> a
<> Seq NameSegment
r))

instance Resolve Absolute Relative Absolute where
  resolve :: Absolute -> Relative -> Absolute
resolve (Absolute Path
l) (Relative Path
r) = Path -> Absolute
Absolute (Path -> Path -> Path
forall l r o. Resolve l r o => l -> r -> o
resolve Path
l Path
r)

instance Resolve Absolute Relative Path' where
  resolve :: Absolute -> Relative -> Path'
resolve Absolute
l Relative
r = Absolute -> Path'
AbsolutePath' (Absolute -> Relative -> Absolute
forall l r o. Resolve l r o => l -> r -> o
resolve Absolute
l Relative
r)

instance Resolve Absolute Path Absolute where
  resolve :: Absolute -> Path -> Absolute
resolve (Absolute Path
l) Path
r = Path -> Absolute
Absolute (Path -> Path -> Path
forall l r o. Resolve l r o => l -> r -> o
resolve Path
l Path
r)

instance Resolve Path' Path' Path' where
  resolve :: Path' -> Path' -> Path'
resolve Path'
_ a :: Path'
a@(AbsolutePath' {}) = Path'
a
  resolve (AbsolutePath' Absolute
a) (RelativePath' Relative
r) = Absolute -> Path'
AbsolutePath' (Absolute -> Relative -> Absolute
forall l r o. Resolve l r o => l -> r -> o
resolve Absolute
a Relative
r)
  resolve (RelativePath' Relative
r1) (RelativePath' Relative
r2) = Relative -> Path'
RelativePath' (Relative -> Relative -> Relative
forall l r o. Resolve l r o => l -> r -> o
resolve Relative
r1 Relative
r2)

instance Resolve Absolute (Split Path) (Split Absolute) where
  resolve :: Absolute -> Split Path -> Split Absolute
resolve Absolute
l Split Path
r = (Path -> Absolute) -> Split Path -> Split Absolute
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Absolute -> Path -> Absolute
forall l r o. Resolve l r o => l -> r -> o
resolve Absolute
l) Split Path
r

instance Resolve Absolute Path' Absolute where
  resolve :: Absolute -> Path' -> Absolute
resolve Absolute
_ (AbsolutePath' Absolute
a) = Absolute
a
  resolve Absolute
a (RelativePath' Relative
r) = Absolute -> Relative -> Absolute
forall l r o. Resolve l r o => l -> r -> o
resolve Absolute
a Relative
r