{-# 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,
longestPathPrefix,
isCurrentPath,
isRoot,
isRoot',
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',
cons,
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
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)
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
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)
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)
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)
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
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
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
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)
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 :: 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)
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'
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
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)
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'
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)
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
(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