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

module Unison.Codebase.Path
  ( Path (..),
    Path' (..),
    Absolute (..),
    pattern AbsolutePath',
    absPath_,
    Relative (..),
    relPath_,
    pattern RelativePath',
    Resolve (..),
    pattern Empty,
    pattern (Lens.:<),
    pattern (Lens.:>),
    singleton,
    Unison.Codebase.Path.uncons,
    empty,
    isAbsolute,
    isRelative,
    absoluteEmpty,
    absoluteEmpty',
    relativeEmpty,
    relativeEmpty',
    currentPath,
    prefix,
    prefixAbs,
    prefixRel,
    maybePrefix,
    unprefix,
    maybePrefixName,
    prefixNameIfRel,
    unprefixName,
    HQSplit,
    HQSplitAbsolute,
    AbsSplit,
    Split,
    Split',
    HQSplit',
    ancestors,

    -- * utilities
    longestPathPrefix,

    -- * tests
    isCurrentPath,
    isRoot,
    isRoot',

    -- * conversions
    absoluteToPath',
    fromList,
    fromName,
    fromName',
    fromPath',
    unsafeParseText,
    unsafeParseText',
    toAbsoluteSplit,
    toSplit',
    toList,
    toName,
    toName',
    toText,
    toText',
    absToText,
    relToText,
    unsplit,
    unsplit',
    unsplitAbsolute,
    nameFromHQSplit,
    nameFromHQSplit',
    nameFromSplit',
    splitFromName,
    splitFromName',
    hqSplitFromName',

    -- * things that could be replaced with `Cons` instances
    cons,

    -- * things that could be replaced with `Snoc` instances
    snoc,
    unsnoc,
  )
where

import Control.Lens hiding (cons, snoc, unsnoc, pattern Empty)
import Control.Lens qualified as Lens
import Data.Bitraversable (bitraverse)
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.HashQualifiedPrime qualified as HQ'
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

-- | 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)
  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)

-- | 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)

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 (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)

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.
newtype Path' = Path' {Path' -> Either Absolute Relative
unPath' :: Either Absolute 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)

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

isCurrentPath :: Path' -> Bool
isCurrentPath :: Path' -> Bool
isCurrentPath Path'
p = Path'
p Path' -> Path' -> Bool
forall a. Eq a => a -> a -> Bool
== Path'
currentPath

currentPath :: Path'
currentPath :: Path'
currentPath = Either Absolute Relative -> Path'
Path' (Relative -> Either Absolute Relative
forall a b. b -> Either a b
Right (Path -> Relative
Relative (Seq NameSegment -> Path
Path Seq NameSegment
forall a. Monoid a => a
mempty)))

isRoot' :: Path' -> Bool
isRoot' :: Path' -> Bool
isRoot' = (Absolute -> Bool)
-> (Relative -> Bool) -> Either Absolute Relative -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Absolute -> Bool
isRoot (Bool -> Relative -> Bool
forall a b. a -> b -> a
const Bool
False) (Either Absolute Relative -> Bool)
-> (Path' -> Either Absolute Relative) -> Path' -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> Either Absolute Relative
unPath'

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'

instance Show Path' where
  show :: Path' -> String
show = \case
    AbsolutePath' Absolute
abs -> Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Absolute -> Text
absToText Absolute
abs
    RelativePath' Relative
rel -> Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Relative -> Text
relToText Relative
rel

instance Show Absolute where
  show :: Absolute -> String
show Absolute
s = Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Absolute -> Text
absToText Absolute
s

instance Show Relative where
  show :: Relative -> String
show = Text -> String
Text.unpack (Text -> String) -> (Relative -> Text) -> Relative -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Text
relToText

unsplit' :: Split' -> Path'
unsplit' :: Split' -> Path'
unsplit' = \case
  (AbsolutePath' (Absolute Path
p), NameSegment
seg) -> Absolute -> Path'
AbsolutePath' (Path -> Absolute
Absolute (Split -> Path
unsplit (Path
p, NameSegment
seg)))
  (RelativePath' (Relative Path
p), NameSegment
seg) -> Relative -> Path'
RelativePath' (Path -> Relative
Relative (Split -> Path
unsplit (Path
p, NameSegment
seg)))

unsplit :: Split -> Path
unsplit :: Split -> Path
unsplit (Path Seq NameSegment
p, NameSegment
a) = Seq NameSegment -> Path
Path (Seq NameSegment
p Seq NameSegment -> NameSegment -> Seq NameSegment
forall a. Seq a -> a -> Seq a
:|> NameSegment
a)

unsplitAbsolute :: (Absolute, NameSegment) -> Absolute
unsplitAbsolute :: (Absolute, NameSegment) -> Absolute
unsplitAbsolute =
  (Split -> Path) -> (Absolute, NameSegment) -> Absolute
forall a b. Coercible a b => a -> b
coerce Split -> Path
unsplit

nameFromHQSplit :: HQSplit -> HQ'.HashQualified Name
nameFromHQSplit :: HQSplit -> HashQualified Name
nameFromHQSplit = HQSplit' -> HashQualified Name
nameFromHQSplit' (HQSplit' -> HashQualified Name)
-> (HQSplit -> HQSplit') -> HQSplit -> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Path') -> HQSplit -> HQSplit'
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' (Relative -> Path') -> (Path -> Relative) -> Path -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Relative)

nameFromHQSplit' :: HQSplit' -> HQ'.HashQualified Name
nameFromHQSplit' :: HQSplit' -> HashQualified Name
nameFromHQSplit' (Path'
p, HQSegment
a) = (NameSegment -> Name) -> HQSegment -> HashQualified Name
forall a b. (a -> b) -> HashQualified a -> HashQualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Split' -> Name
nameFromSplit' (Split' -> Name) -> (NameSegment -> Split') -> NameSegment -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path'
p,)) HQSegment
a

type AbsSplit = (Absolute, NameSegment)

type Split = (Path, NameSegment)

type HQSplit = (Path, HQ'.HQSegment)

type Split' = (Path', NameSegment)

type HQSplit' = (Path', HQ'.HQSegment)

type HQSplitAbsolute = (Absolute, HQ'.HQSegment)

-- | 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 :: Absolute -> Path' -> Path
unprefix :: Absolute -> Path' -> Path
unprefix (Absolute Path
prefix) = \case
  AbsolutePath' Absolute
abs -> Absolute -> Path
unabsolute Absolute
abs
  RelativePath' Relative
rel -> [NameSegment] -> Path
fromList ([NameSegment] -> Path) -> [NameSegment] -> Path
forall a b. (a -> b) -> a -> b
$ [NameSegment] -> [NameSegment] -> [NameSegment]
forall a. Eq a => [a] -> [a] -> [a]
dropPrefix (Path -> [NameSegment]
toList Path
prefix) (Path -> [NameSegment]
toList (Relative -> Path
unrelative Relative
rel))

prefixAbs :: Absolute -> Relative -> Absolute
prefixAbs :: Absolute -> Relative -> Absolute
prefixAbs Absolute
prefix = Path -> Absolute
Absolute (Path -> Absolute) -> (Relative -> Path) -> Relative -> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Absolute -> Path
unabsolute Absolute
prefix) 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

prefixRel :: Relative -> Relative -> Relative
prefixRel :: Relative -> Relative -> Relative
prefixRel Relative
prefix = Path -> Relative
Relative (Path -> Relative) -> (Relative -> Path) -> Relative -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (Relative -> Path
unrelative Relative
prefix) 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

-- | This always prefixes, since the secend argument can never be Absolute.
prefix :: Path' -> Relative -> Path'
prefix :: Path' -> Relative -> Path'
prefix Path'
prefix =
  Either Absolute Relative -> Path'
Path' (Either Absolute Relative -> Path')
-> (Relative -> Either Absolute Relative) -> Relative -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Path'
prefix of
    AbsolutePath' Absolute
abs -> Absolute -> Either Absolute Relative
forall a b. a -> Either a b
Left (Absolute -> Either Absolute Relative)
-> (Relative -> Absolute) -> Relative -> Either Absolute Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Relative -> Absolute
prefixAbs Absolute
abs
    RelativePath' Relative
rel -> Relative -> Either Absolute Relative
forall a. a -> Either Absolute a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relative -> Either Absolute Relative)
-> (Relative -> Relative) -> Relative -> Either Absolute Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relative -> Relative -> Relative
prefixRel 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'
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 :: Path -> Path -> (Path, Path, Path)
longestPathPrefix :: Path -> Path -> (Path, Path, Path)
longestPathPrefix Path
a Path
b =
  [NameSegment]
-> [NameSegment] -> ([NameSegment], [NameSegment], [NameSegment])
forall a. Eq a => [a] -> [a] -> ([a], [a], [a])
List.splitOnLongestCommonPrefix (Path -> [NameSegment]
toList Path
a) (Path -> [NameSegment]
toList Path
b)
    ([NameSegment], [NameSegment], [NameSegment])
-> (([NameSegment], [NameSegment], [NameSegment])
    -> (Path, Path, Path))
-> (Path, Path, Path)
forall a b. a -> (a -> b) -> b
& \([NameSegment]
a, [NameSegment]
b, [NameSegment]
c) -> ([NameSegment] -> Path
fromList [NameSegment]
a, [NameSegment] -> Path
fromList [NameSegment]
b, [NameSegment] -> Path
fromList [NameSegment]
c)

toSplit' :: Path' -> Maybe (Path', NameSegment)
toSplit' :: Path' -> Maybe Split'
toSplit' = Path' -> Maybe Split'
forall s a. Snoc s s a a => s -> Maybe (s, a)
Lens.unsnoc

toAbsoluteSplit :: Absolute -> (Path', a) -> (Absolute, a)
toAbsoluteSplit :: forall a. Absolute -> (Path', a) -> (Absolute, a)
toAbsoluteSplit Absolute
a (Path'
p, a
s) = (Absolute -> Path' -> Absolute
forall l r o. Resolve l r o => l -> r -> o
resolve Absolute
a Path'
p, a
s)

absoluteEmpty :: Absolute
absoluteEmpty :: Absolute
absoluteEmpty = Path -> Absolute
Absolute Path
empty

relativeEmpty :: Relative
relativeEmpty :: Relative
relativeEmpty = Path -> Relative
Relative Path
empty

relativeEmpty' :: Path'
relativeEmpty' :: Path'
relativeEmpty' = Relative -> Path'
RelativePath' (Path -> Relative
Relative Path
empty)

absoluteEmpty' :: Path'
absoluteEmpty' :: Path'
absoluteEmpty' = Absolute -> Path'
AbsolutePath' (Path -> Absolute
Absolute Path
empty)

-- 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

hqSplitFromName' :: Name -> HQSplit'
hqSplitFromName' :: Name -> HQSplit'
hqSplitFromName' = (NameSegment -> HQSegment) -> Split' -> HQSplit'
forall a b. (a -> b) -> (Path', a) -> (Path', b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.fromName (Split' -> HQSplit') -> (Name -> Split') -> Name -> HQSplit'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Split'
splitFromName'

-- |
-- >>> splitFromName "a.b.c"
-- (a.b,c)
--
-- >>> splitFromName "foo"
-- (,foo)
splitFromName :: Name -> Split
splitFromName :: Name -> Split
splitFromName =
  ASetter Split' Split Path' Path
-> (Path' -> Path) -> Split' -> Split
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Split' Split Path' Path
forall s t a b. Field1 s t a b => Lens s t a b
Lens Split' Split Path' Path
_1 Path' -> Path
fromPath' (Split' -> Split) -> (Name -> Split') -> Name -> Split
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Split'
splitFromName'

splitFromName' :: Name -> Split'
splitFromName' :: Name -> Split'
splitFromName' Name
name =
  case Name -> NonEmpty NameSegment
Name.reverseSegments Name
name of
    (NameSegment
seg :| [NameSegment]
pathSegments) ->
      let path :: Path
path = [NameSegment] -> Path
fromList ([NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse [NameSegment]
pathSegments)
       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
seg
          )

nameFromSplit' :: Split' -> Name
nameFromSplit' :: Split' -> Name
nameFromSplit' (Path'
path', NameSegment
seg) = case Path'
path' of
  AbsolutePath' Absolute
abs -> Name -> Name
Name.makeAbsolute (Name -> Name)
-> (NonEmpty NameSegment -> Name) -> NonEmpty NameSegment -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name) -> NonEmpty NameSegment -> Name
forall a b. (a -> b) -> a -> b
$ NameSegment
seg NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| [NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse (Path -> [NameSegment]
toList (Path -> [NameSegment]) -> Path -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Absolute -> Path
unabsolute Absolute
abs)
  RelativePath' Relative
rel -> Name -> Name
Name.makeRelative (Name -> Name)
-> (NonEmpty NameSegment -> Name) -> NonEmpty NameSegment -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty NameSegment -> Name
Name.fromReverseSegments (NonEmpty NameSegment -> Name) -> NonEmpty NameSegment -> Name
forall a b. (a -> b) -> a -> b
$ NameSegment
seg NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
:| [NameSegment] -> [NameSegment]
forall a. [a] -> [a]
reverse (Path -> [NameSegment]
toList (Path -> [NameSegment]) -> Path -> [NameSegment]
forall a b. (a -> b) -> a -> b
$ Relative -> Path
unrelative Relative
rel)

-- | Remove a path prefix from a name.
-- Returns 'Nothing' if there are no remaining segments to construct the name from.
--
-- >>> unprefixName (Absolute $ fromList ["base", "List"]) (Name.unsafeFromText "base.List.map")
-- Just (Name Relative (NameSegment {toText = "map"} :| []))
unprefixName :: Absolute -> Name -> Maybe Name
unprefixName :: Absolute -> Name -> Maybe Name
unprefixName Absolute
prefix = Path -> Maybe Name
toName (Path -> Maybe Name) -> (Name -> Path) -> Name -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Absolute -> Path' -> Path
unprefix Absolute
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 = (Split' -> Name) -> Maybe Split' -> 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' -> Name
nameFromSplit' (Maybe Split' -> Maybe Name)
-> (Name -> Maybe Split') -> Name -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path' -> Maybe Path')
-> (NameSegment -> Maybe NameSegment) -> Split' -> Maybe Split'
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Path' -> Path' -> Maybe Path'
maybePrefix Path'
pre) NameSegment -> Maybe NameSegment
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Split' -> Maybe Split')
-> (Name -> Split') -> Name -> Maybe Split'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Split'
splitFromName'

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]

cons :: NameSegment -> Path -> Path
cons :: NameSegment -> Path -> Path
cons = NameSegment -> Path -> Path
forall s a. Cons s s a a => a -> s -> s
Lens.cons

snoc :: Path -> NameSegment -> Path
snoc :: Path -> NameSegment -> Path
snoc = Path -> NameSegment -> Path
forall s a. Snoc s s a a => s -> a -> s
Lens.snoc

unsnoc :: Path -> Maybe (Path, NameSegment)
unsnoc :: Path -> Maybe Split
unsnoc = Path -> Maybe Split
forall s a. Snoc s s a a => s -> Maybe (s, a)
Lens.unsnoc

uncons :: Path -> Maybe (NameSegment, Path)
uncons :: Path -> Maybe (NameSegment, Path)
uncons = Path -> Maybe (NameSegment, Path)
forall s a. Cons s s a a => s -> Maybe (a, s)
Lens.uncons

-- > 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

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

toName :: Path -> Maybe Name
toName :: Path -> Maybe Name
toName = \case
  Path Seq NameSegment
Seq.Empty -> Maybe Name
forall a. Maybe a
Nothing
  (Path (NameSegment
p Seq.:<| Seq NameSegment
ps)) ->
    Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ NonEmpty NameSegment -> Name
Name.fromSegments (NameSegment
p NameSegment -> [NameSegment] -> NonEmpty NameSegment
forall a. a -> [a] -> NonEmpty a
List.NonEmpty.:| Seq NameSegment -> [NameSegment]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Seq NameSegment
ps)

-- | Convert a Path' to a Name
toName' :: Path' -> Maybe Name
toName' :: Path' -> Maybe Name
toName' = \case
  AbsolutePath' Absolute
p -> Name -> Name
Name.makeAbsolute (Name -> Name) -> Maybe Name -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> Maybe Name
toName (Absolute -> Path
unabsolute Absolute
p)
  RelativePath' Relative
p -> Name -> Name
Name.makeRelative (Name -> Name) -> Maybe Name -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path -> Maybe Name
toName (Relative -> Path
unrelative Relative
p)

pattern Empty :: Path
pattern $mEmpty :: forall {r}. Path -> ((# #) -> r) -> ((# #) -> r) -> r
$bEmpty :: Path
Empty = Path Seq.Empty

pattern AbsolutePath' :: Absolute -> Path'
pattern $mAbsolutePath' :: forall {r}. Path' -> (Absolute -> r) -> ((# #) -> r) -> r
$bAbsolutePath' :: Absolute -> Path'
AbsolutePath' p = Path' (Left p)

pattern RelativePath' :: Relative -> Path'
pattern $mRelativePath' :: forall {r}. Path' -> (Relative -> r) -> ((# #) -> r) -> r
$bRelativePath' :: Relative -> Path'
RelativePath' p = Path' (Right p)

{-# COMPLETE AbsolutePath', RelativePath' #-}

empty :: Path
empty :: Path
empty = Seq NameSegment -> Path
Path Seq NameSegment
forall a. Monoid a => a
mempty

instance Show Path where
  show :: Path -> String
show = Text -> String
Text.unpack (Text -> String) -> (Path -> Text) -> Path -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
toText

instance From Path Text where
  from :: Path -> Text
from = Path -> Text
toText

instance From Absolute Text where
  from :: Absolute -> Text
from = Absolute -> Text
absToText

instance From Relative Text where
  from :: Relative -> Text
from = Relative -> Text
relToText

instance From Path' Text where
  from :: Path' -> Text
from = Path' -> Text
toText'

-- | Note: This treats the path as relative.
toText :: Path -> Text
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
toName

absToText :: Absolute -> Text
absToText :: Absolute -> Text
absToText Absolute
abs = Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Path -> Text
toText (Absolute -> Path
unabsolute Absolute
abs)

relToText :: Relative -> Text
relToText :: Relative -> Text
relToText Relative
rel = Path -> Text
toText (Relative -> Path
unrelative Relative
rel)

unsafeParseText :: Text -> Path
unsafeParseText :: Text -> Path
unsafeParseText = \case
  Text
"" -> Path
empty
  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)

toText' :: Path' -> Text
toText' :: Path' -> Text
toText' Path'
path =
  case Path' -> Maybe Name
toName' Path'
path of
    Maybe Name
Nothing -> if Path' -> Bool
isAbsolute Path'
path then Text
"." else Text
""
    Just Name
name -> Name -> Text
Name.toText Name
name

{-# COMPLETE Empty, (:<) #-}

{-# COMPLETE Empty, (:>) #-}

deriving anyclass instance AsEmpty Path

instance Cons Path Path NameSegment NameSegment where
  _Cons :: Prism Path Path (NameSegment, Path) (NameSegment, Path)
_Cons = ((NameSegment, Path) -> Path)
-> (Path -> Either Path (NameSegment, Path))
-> Prism Path Path (NameSegment, Path) (NameSegment, Path)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((NameSegment -> Path -> Path) -> (NameSegment, Path) -> Path
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NameSegment -> Path -> Path
cons) Path -> Either Path (NameSegment, Path)
uncons
    where
      cons :: NameSegment -> Path -> Path
      cons :: NameSegment -> Path -> Path
cons NameSegment
ns (Path Seq NameSegment
p) = Seq NameSegment -> Path
Path (NameSegment
ns NameSegment -> Seq NameSegment -> Seq NameSegment
forall a. a -> Seq a -> Seq a
:<| Seq NameSegment
p)
      uncons :: Path -> Either Path (NameSegment, Path)
      uncons :: Path -> Either Path (NameSegment, Path)
uncons Path
p = case Path
p of
        Path (NameSegment
hd :<| Seq NameSegment
tl) -> (NameSegment, Path) -> Either Path (NameSegment, Path)
forall a b. b -> Either a b
Right (NameSegment
hd, Seq NameSegment -> Path
Path Seq NameSegment
tl)
        Path
_ -> Path -> Either Path (NameSegment, Path)
forall a b. a -> Either a b
Left Path
p

instance Cons Path' Path' NameSegment NameSegment where
  _Cons :: Prism Path' Path' (NameSegment, Path') (NameSegment, Path')
_Cons = ((NameSegment, Path') -> Path')
-> (Path' -> Either Path' (NameSegment, Path'))
-> Prism Path' Path' (NameSegment, Path') (NameSegment, Path')
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((NameSegment -> Path' -> Path') -> (NameSegment, Path') -> Path'
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NameSegment -> Path' -> Path'
cons) Path' -> Either Path' (NameSegment, Path')
uncons
    where
      cons :: NameSegment -> Path' -> Path'
      cons :: NameSegment -> Path' -> Path'
cons NameSegment
ns (AbsolutePath' Absolute
p) = Absolute -> Path'
AbsolutePath' (NameSegment
ns NameSegment -> Absolute -> Absolute
forall s a. Cons s s a a => a -> s -> s
:< Absolute
p)
      cons NameSegment
ns (RelativePath' Relative
p) = Relative -> Path'
RelativePath' (NameSegment
ns NameSegment -> Relative -> Relative
forall s a. Cons s s a a => a -> s -> s
:< Relative
p)
      uncons :: Path' -> Either Path' (NameSegment, Path')
      uncons :: Path' -> Either Path' (NameSegment, Path')
uncons Path'
p = case Path'
p of
        AbsolutePath' (NameSegment
ns :< Absolute
tl) -> (NameSegment, Path') -> Either Path' (NameSegment, Path')
forall a b. b -> Either a b
Right (NameSegment
ns, Absolute -> Path'
AbsolutePath' Absolute
tl)
        RelativePath' (NameSegment
ns :< Relative
tl) -> (NameSegment, Path') -> Either Path' (NameSegment, Path')
forall a b. b -> Either a b
Right (NameSegment
ns, Relative -> Path'
RelativePath' Relative
tl)
        Path'
_ -> Path' -> Either Path' (NameSegment, Path')
forall a b. a -> Either a b
Left Path'
p

instance Snoc Relative Relative NameSegment NameSegment where
  _Snoc :: Prism
  Relative Relative (Relative, NameSegment) (Relative, NameSegment)
_Snoc = ((Relative, NameSegment) -> Relative)
-> (Relative -> Either Relative (Relative, NameSegment))
-> Prism
     Relative Relative (Relative, NameSegment) (Relative, NameSegment)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Relative -> NameSegment -> Relative)
-> (Relative, NameSegment) -> Relative
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Relative -> NameSegment -> Relative
snocRelative) ((Relative -> Either Relative (Relative, NameSegment))
 -> Prism
      Relative Relative (Relative, NameSegment) (Relative, NameSegment))
-> (Relative -> Either Relative (Relative, NameSegment))
-> Prism
     Relative Relative (Relative, NameSegment) (Relative, NameSegment)
forall a b. (a -> b) -> a -> b
$ \case
    Relative (Path -> Maybe Split
forall s a. Snoc s s a a => s -> Maybe (s, a)
Lens.unsnoc -> Just (Path
s, NameSegment
a)) -> (Relative, NameSegment) -> Either Relative (Relative, NameSegment)
forall a b. b -> Either a b
Right (Path -> Relative
Relative Path
s, NameSegment
a)
    Relative
e -> Relative -> Either Relative (Relative, NameSegment)
forall a b. a -> Either a b
Left Relative
e
    where
      snocRelative :: Relative -> NameSegment -> Relative
      snocRelative :: Relative -> NameSegment -> Relative
snocRelative Relative
r NameSegment
n = Path -> Relative
Relative (Path -> Relative) -> (Path -> Path) -> Path -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> NameSegment -> Path
forall s a. Snoc s s a a => s -> a -> s
`Lens.snoc` NameSegment
n) (Path -> Relative) -> Path -> Relative
forall a b. (a -> b) -> a -> b
$ Relative -> Path
unrelative Relative
r

instance Cons Relative Relative NameSegment NameSegment where
  _Cons :: Prism
  Relative Relative (NameSegment, Relative) (NameSegment, Relative)
_Cons = ((NameSegment, Relative) -> Relative)
-> (Relative -> Either Relative (NameSegment, Relative))
-> Prism
     Relative Relative (NameSegment, Relative) (NameSegment, Relative)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((NameSegment -> Relative -> Relative)
-> (NameSegment, Relative) -> Relative
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NameSegment -> Relative -> Relative
cons) Relative -> Either Relative (NameSegment, Relative)
uncons
    where
      cons :: NameSegment -> Relative -> Relative
      cons :: NameSegment -> Relative -> Relative
cons NameSegment
ns (Relative Path
p) = Path -> Relative
Relative (NameSegment
ns NameSegment -> Path -> Path
forall s a. Cons s s a a => a -> s -> s
:< Path
p)
      uncons :: Relative -> Either Relative (NameSegment, Relative)
      uncons :: Relative -> Either Relative (NameSegment, Relative)
uncons Relative
p = case Relative
p of
        Relative (NameSegment
ns :< Path
tl) -> (NameSegment, Relative) -> Either Relative (NameSegment, Relative)
forall a b. b -> Either a b
Right (NameSegment
ns, Path -> Relative
Relative Path
tl)
        Relative
_ -> Relative -> Either Relative (NameSegment, Relative)
forall a b. a -> Either a b
Left Relative
p

instance Cons Absolute Absolute NameSegment NameSegment where
  _Cons :: Prism
  Absolute Absolute (NameSegment, Absolute) (NameSegment, Absolute)
_Cons = ((NameSegment, Absolute) -> Absolute)
-> (Absolute -> Either Absolute (NameSegment, Absolute))
-> Prism
     Absolute Absolute (NameSegment, Absolute) (NameSegment, Absolute)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((NameSegment -> Absolute -> Absolute)
-> (NameSegment, Absolute) -> Absolute
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NameSegment -> Absolute -> Absolute
cons) Absolute -> Either Absolute (NameSegment, Absolute)
uncons
    where
      cons :: NameSegment -> Absolute -> Absolute
      cons :: NameSegment -> Absolute -> Absolute
cons NameSegment
ns (Absolute Path
p) = Path -> Absolute
Absolute (NameSegment
ns NameSegment -> Path -> Path
forall s a. Cons s s a a => a -> s -> s
:< Path
p)
      uncons :: Absolute -> Either Absolute (NameSegment, Absolute)
      uncons :: Absolute -> Either Absolute (NameSegment, Absolute)
uncons Absolute
p = case Absolute
p of
        Absolute (NameSegment
ns :< Path
tl) -> (NameSegment, Absolute) -> Either Absolute (NameSegment, Absolute)
forall a b. b -> Either a b
Right (NameSegment
ns, Path -> Absolute
Absolute Path
tl)
        Absolute
_ -> Absolute -> Either Absolute (NameSegment, Absolute)
forall a b. a -> Either a b
Left Absolute
p

instance Snoc Absolute Absolute NameSegment NameSegment where
  _Snoc :: Prism
  Absolute Absolute (Absolute, NameSegment) (Absolute, NameSegment)
_Snoc = ((Absolute, NameSegment) -> Absolute)
-> (Absolute -> Either Absolute (Absolute, NameSegment))
-> Prism
     Absolute Absolute (Absolute, NameSegment) (Absolute, NameSegment)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Absolute -> NameSegment -> Absolute)
-> (Absolute, NameSegment) -> Absolute
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Absolute -> NameSegment -> Absolute
snocAbsolute) ((Absolute -> Either Absolute (Absolute, NameSegment))
 -> Prism
      Absolute Absolute (Absolute, NameSegment) (Absolute, NameSegment))
-> (Absolute -> Either Absolute (Absolute, NameSegment))
-> Prism
     Absolute Absolute (Absolute, NameSegment) (Absolute, NameSegment)
forall a b. (a -> b) -> a -> b
$ \case
    Absolute (Path -> Maybe Split
forall s a. Snoc s s a a => s -> Maybe (s, a)
Lens.unsnoc -> Just (Path
s, NameSegment
a)) -> (Absolute, NameSegment) -> Either Absolute (Absolute, NameSegment)
forall a b. b -> Either a b
Right (Path -> Absolute
Absolute Path
s, NameSegment
a)
    Absolute
e -> Absolute -> Either Absolute (Absolute, NameSegment)
forall a b. a -> Either a b
Left Absolute
e
    where
      snocAbsolute :: Absolute -> NameSegment -> Absolute
      snocAbsolute :: Absolute -> NameSegment -> Absolute
snocAbsolute Absolute
a NameSegment
n = Path -> Absolute
Absolute (Path -> Absolute) -> (Path -> Path) -> Path -> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> NameSegment -> Path
forall s a. Snoc s s a a => s -> a -> s
`Lens.snoc` NameSegment
n) (Path -> Absolute) -> Path -> Absolute
forall a b. (a -> b) -> a -> b
$ Absolute -> Path
unabsolute Absolute
a

instance Snoc Path Path NameSegment NameSegment where
  _Snoc :: Prism Path Path Split Split
_Snoc = (Split -> Path)
-> (Path -> Either Path Split) -> Prism Path Path Split Split
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Path -> NameSegment -> Path) -> Split -> Path
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Path -> NameSegment -> Path
snoc) Path -> Either Path Split
unsnoc
    where
      unsnoc :: Path -> Either Path (Path, NameSegment)
      unsnoc :: Path -> Either Path Split
unsnoc = \case
        Path (Seq NameSegment
s Seq.:|> NameSegment
a) -> Split -> Either Path Split
forall a b. b -> Either a b
Right (Seq NameSegment -> Path
Path Seq NameSegment
s, NameSegment
a)
        Path
e -> Path -> Either Path Split
forall a b. a -> Either a b
Left Path
e
      snoc :: Path -> NameSegment -> Path
      snoc :: Path -> NameSegment -> Path
snoc (Path Seq NameSegment
p) NameSegment
ns = Seq NameSegment -> Path
Path (Seq NameSegment
p Seq NameSegment -> Seq NameSegment -> Seq NameSegment
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Seq NameSegment
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameSegment
ns)

instance Snoc Path' Path' NameSegment NameSegment where
  _Snoc :: Prism Path' Path' Split' Split'
_Snoc = (Split' -> Path')
-> (Path' -> Either Path' Split')
-> Prism Path' Path' Split' Split'
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Path' -> NameSegment -> Path') -> Split' -> Path'
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Path' -> NameSegment -> Path'
snoc') \case
    AbsolutePath' (Absolute -> Maybe (Absolute, NameSegment)
forall s a. Snoc s s a a => s -> Maybe (s, a)
Lens.unsnoc -> Just (Absolute
s, NameSegment
a)) -> Split' -> Either Path' Split'
forall a b. b -> Either a b
Right (Absolute -> Path'
AbsolutePath' Absolute
s, NameSegment
a)
    RelativePath' (Relative -> Maybe (Relative, NameSegment)
forall s a. Snoc s s a a => s -> Maybe (s, a)
Lens.unsnoc -> Just (Relative
s, NameSegment
a)) -> Split' -> Either Path' Split'
forall a b. b -> Either a b
Right (Relative -> Path'
RelativePath' Relative
s, NameSegment
a)
    Path'
e -> Path' -> Either Path' Split'
forall a b. a -> Either a b
Left Path'
e
    where
      snoc' :: Path' -> NameSegment -> Path'
      snoc' :: Path' -> NameSegment -> Path'
snoc' = \case
        AbsolutePath' Absolute
abs -> Absolute -> Path'
AbsolutePath' (Absolute -> Path')
-> (NameSegment -> Absolute) -> NameSegment -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Absolute
Absolute (Path -> Absolute)
-> (NameSegment -> Path) -> NameSegment -> Absolute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> NameSegment -> Path
forall s a. Snoc s s a a => s -> a -> s
Lens.snoc (Absolute -> Path
unabsolute Absolute
abs)
        RelativePath' Relative
rel -> Relative -> Path'
RelativePath' (Relative -> Path')
-> (NameSegment -> Relative) -> NameSegment -> Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Relative
Relative (Path -> Relative)
-> (NameSegment -> Path) -> NameSegment -> Relative
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> NameSegment -> Path
forall s a. Snoc s s a a => s -> a -> s
Lens.snoc (Relative -> Path
unrelative Relative
rel)

instance Snoc Split' Split' NameSegment NameSegment where
  _Snoc :: Prism Split' Split' (Split', NameSegment) (Split', NameSegment)
_Snoc = ((Split', NameSegment) -> Split')
-> (Split' -> Either Split' (Split', NameSegment))
-> Prism Split' Split' (Split', NameSegment) (Split', NameSegment)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism ((Split' -> NameSegment -> Split')
-> (Split', NameSegment) -> Split'
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Split' -> NameSegment -> Split'
snoc') \case
    -- unsnoc
    (Path' -> Maybe Split'
forall s a. Snoc s s a a => s -> Maybe (s, a)
Lens.unsnoc -> Just (Path'
s, NameSegment
a), NameSegment
ns) -> (Split', NameSegment) -> Either Split' (Split', NameSegment)
forall a b. b -> Either a b
Right ((Path'
s, NameSegment
a), NameSegment
ns)
    Split'
e -> Split' -> Either Split' (Split', NameSegment)
forall a b. a -> Either a b
Left Split'
e
    where
      snoc' :: Split' -> NameSegment -> Split'
      snoc' :: Split' -> NameSegment -> Split'
snoc' (Path'
p, NameSegment
a) NameSegment
n = (Path' -> NameSegment -> Path'
forall s a. Snoc s s a a => s -> a -> s
Lens.snoc Path'
p NameSegment
a, NameSegment
n)

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 Path' Split' Path' where
  resolve :: Path' -> Split' -> Path'
resolve Path'
l Split'
r = Path' -> Path' -> Path'
forall l r o. Resolve l r o => l -> r -> o
resolve Path'
l (Split' -> Path'
unsplit' Split'
r)

instance Resolve Path' Split' Split' where
  resolve :: Path' -> Split' -> Split'
resolve Path'
l (Path'
r, NameSegment
ns) = (Path' -> Path' -> Path'
forall l r o. Resolve l r o => l -> r -> o
resolve Path'
l Path'
r, NameSegment
ns)

instance Resolve Absolute HQSplit HQSplitAbsolute where
  resolve :: Absolute -> HQSplit -> HQSplitAbsolute
resolve Absolute
l (Path
r, HQSegment
hq) = (Absolute -> Relative -> Absolute
forall l r o. Resolve l r o => l -> r -> o
resolve Absolute
l (Path -> Relative
Relative Path
r), HQSegment
hq)

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