{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuasiQuotes #-}

module Path.Internal where

import Data.ByteString (ByteString)
import Data.Foldable
import Data.Maybe
import Data.Sequence
import Data.String
import Data.Void
import GHC.Generics (Generic)
import Instances.TH.Lift ()
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Text.Megaparsec

type Parser = Parsec Void ByteString

data PathSeg
  = Parent
  | PathSeg {-# UNPACK #-} !ByteString
  deriving (Int -> PathSeg -> ShowS
[PathSeg] -> ShowS
PathSeg -> String
(Int -> PathSeg -> ShowS)
-> (PathSeg -> String) -> ([PathSeg] -> ShowS) -> Show PathSeg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathSeg] -> ShowS
$cshowList :: [PathSeg] -> ShowS
show :: PathSeg -> String
$cshow :: PathSeg -> String
showsPrec :: Int -> PathSeg -> ShowS
$cshowsPrec :: Int -> PathSeg -> ShowS
Show, PathSeg -> PathSeg -> Bool
(PathSeg -> PathSeg -> Bool)
-> (PathSeg -> PathSeg -> Bool) -> Eq PathSeg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathSeg -> PathSeg -> Bool
$c/= :: PathSeg -> PathSeg -> Bool
== :: PathSeg -> PathSeg -> Bool
$c== :: PathSeg -> PathSeg -> Bool
Eq, PathSeg -> Q Exp
PathSeg -> Q (TExp PathSeg)
(PathSeg -> Q Exp) -> (PathSeg -> Q (TExp PathSeg)) -> Lift PathSeg
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: PathSeg -> Q (TExp PathSeg)
$cliftTyped :: PathSeg -> Q (TExp PathSeg)
lift :: PathSeg -> Q Exp
$clift :: PathSeg -> Q Exp
Lift, (forall x. PathSeg -> Rep PathSeg x)
-> (forall x. Rep PathSeg x -> PathSeg) -> Generic PathSeg
forall x. Rep PathSeg x -> PathSeg
forall x. PathSeg -> Rep PathSeg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PathSeg x -> PathSeg
$cfrom :: forall x. PathSeg -> Rep PathSeg x
Generic)

fromPathSeg :: PathSeg -> ByteString
fromPathSeg :: PathSeg -> ByteString
fromPathSeg PathSeg
Parent = ByteString
".."
fromPathSeg (PathSeg ByteString
p) = ByteString
p

pathSeg :: Parser (Maybe PathSeg)
pathSeg :: Parser (Maybe PathSeg)
pathSeg = Parser (Maybe PathSeg) -> Parser (Maybe PathSeg)
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
try Parser (Maybe PathSeg)
parentP Parser (Maybe PathSeg)
-> Parser (Maybe PathSeg) -> Parser (Maybe PathSeg)
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe PathSeg) -> Parser (Maybe PathSeg)
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
try Parser (Maybe PathSeg)
forall a. ParsecT Void ByteString Identity (Maybe a)
dot Parser (Maybe PathSeg)
-> Parser (Maybe PathSeg) -> Parser (Maybe PathSeg)
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Parser (Maybe PathSeg)
normalSeg
  where
    parentP :: Parser (Maybe PathSeg)
parentP = do
      Token ByteString
_ <- Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Token ByteString
46
      Token ByteString
_ <- Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Token ByteString
46
      Maybe PathSeg -> Parser (Maybe PathSeg)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PathSeg -> Maybe PathSeg
forall a. a -> Maybe a
Just PathSeg
Parent)
    normalSeg :: Parser (Maybe PathSeg)
normalSeg = PathSeg -> Maybe PathSeg
forall a. a -> Maybe a
Just (PathSeg -> Maybe PathSeg)
-> (ByteString -> PathSeg) -> ByteString -> Maybe PathSeg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> PathSeg
PathSeg (ByteString -> Maybe PathSeg)
-> ParsecT Void ByteString Identity ByteString
-> Parser (Maybe PathSeg)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token ByteString -> Bool)
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing (Token ByteString -> Token ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Token ByteString
47)
    dot :: ParsecT Void ByteString Identity (Maybe a)
dot = do
      Token ByteString
_ <- Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Token ByteString
46
      Maybe a -> ParsecT Void ByteString Identity (Maybe a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

pathSeg' :: Parser (Maybe PathSeg)
pathSeg' :: Parser (Maybe PathSeg)
pathSeg' = Parser (Maybe PathSeg)
pathSeg Parser (Maybe PathSeg)
-> Parser (Maybe PathSeg) -> Parser (Maybe PathSeg)
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Maybe PathSeg -> Parser (Maybe PathSeg)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe PathSeg
forall a. Maybe a
Nothing

relpath :: Parser (Path 'Rel)
relpath :: Parser (Path 'Rel)
relpath = do
  Maybe PathSeg
h <- Parser (Maybe PathSeg)
pathSeg
  [Maybe PathSeg]
t <- Parser (Maybe PathSeg)
-> ParsecT Void ByteString Identity [Maybe PathSeg]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
many (Parser (Maybe PathSeg)
 -> ParsecT Void ByteString Identity [Maybe PathSeg])
-> Parser (Maybe PathSeg)
-> ParsecT Void ByteString Identity [Maybe PathSeg]
forall a b. (a -> b) -> a -> b
$ Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Token ByteString
47 ParsecT Void ByteString Identity Word8
-> Parser (Maybe PathSeg) -> Parser (Maybe PathSeg)
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Parser (Maybe PathSeg)
pathSeg'
  Path 'Rel -> Parser (Path 'Rel)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Path 'Rel -> Parser (Path 'Rel))
-> Path 'Rel -> Parser (Path 'Rel)
forall a b. (a -> b) -> a -> b
$ Seq PathSeg -> Path 'Rel
forall (t :: PathType). Seq PathSeg -> Path t
Path (Seq PathSeg -> Path 'Rel) -> Seq PathSeg -> Path 'Rel
forall a b. (a -> b) -> a -> b
$ [PathSeg] -> Seq PathSeg
forall a. [a] -> Seq a
fromList ([PathSeg] -> Seq PathSeg) -> [PathSeg] -> Seq PathSeg
forall a b. (a -> b) -> a -> b
$ [Maybe PathSeg] -> [PathSeg]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe PathSeg] -> [PathSeg]) -> [Maybe PathSeg] -> [PathSeg]
forall a b. (a -> b) -> a -> b
$ Maybe PathSeg
h Maybe PathSeg -> [Maybe PathSeg] -> [Maybe PathSeg]
forall a. a -> [a] -> [a]
: [Maybe PathSeg]
t

abspath :: Parser (Path 'Abs)
abspath :: Parser (Path 'Abs)
abspath = do
  Word8
_ <- Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Token ByteString
47
  [Maybe PathSeg]
l <- Parser (Maybe PathSeg)
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Maybe PathSeg]
forall (m :: Type -> Type) a sep.
MonadPlus m =>
m a -> m sep -> m [a]
sepBy Parser (Maybe PathSeg)
pathSeg' (ParsecT Void ByteString Identity Word8
 -> ParsecT Void ByteString Identity [Maybe PathSeg])
-> ParsecT Void ByteString Identity Word8
-> ParsecT Void ByteString Identity [Maybe PathSeg]
forall a b. (a -> b) -> a -> b
$ Token ByteString
-> ParsecT Void ByteString Identity (Token ByteString)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Token s -> m (Token s)
single Token ByteString
47
  Path 'Abs -> Parser (Path 'Abs)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Path 'Abs -> Parser (Path 'Abs))
-> Path 'Abs -> Parser (Path 'Abs)
forall a b. (a -> b) -> a -> b
$ Seq PathSeg -> Path 'Abs
forall (t :: PathType). Seq PathSeg -> Path t
Path (Seq PathSeg -> Path 'Abs) -> Seq PathSeg -> Path 'Abs
forall a b. (a -> b) -> a -> b
$ [PathSeg] -> Seq PathSeg
forall a. [a] -> Seq a
fromList ([PathSeg] -> Seq PathSeg) -> [PathSeg] -> Seq PathSeg
forall a b. (a -> b) -> a -> b
$ [Maybe PathSeg] -> [PathSeg]
forall a. [Maybe a] -> [a]
catMaybes [Maybe PathSeg]
l

data PathType
  = Abs
  | Rel
  deriving (Int -> PathType -> ShowS
[PathType] -> ShowS
PathType -> String
(Int -> PathType -> ShowS)
-> (PathType -> String) -> ([PathType] -> ShowS) -> Show PathType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathType] -> ShowS
$cshowList :: [PathType] -> ShowS
show :: PathType -> String
$cshow :: PathType -> String
showsPrec :: Int -> PathType -> ShowS
$cshowsPrec :: Int -> PathType -> ShowS
Show, PathType -> PathType -> Bool
(PathType -> PathType -> Bool)
-> (PathType -> PathType -> Bool) -> Eq PathType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathType -> PathType -> Bool
$c/= :: PathType -> PathType -> Bool
== :: PathType -> PathType -> Bool
$c== :: PathType -> PathType -> Bool
Eq)

-- | A canonicalized file path
newtype Path (t :: PathType) = Path
  { Path t -> Seq PathSeg
unPath :: Seq PathSeg
  }
  deriving stock ((forall x. Path t -> Rep (Path t) x)
-> (forall x. Rep (Path t) x -> Path t) -> Generic (Path t)
forall x. Rep (Path t) x -> Path t
forall x. Path t -> Rep (Path t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (t :: PathType) x. Rep (Path t) x -> Path t
forall (t :: PathType) x. Path t -> Rep (Path t) x
$cto :: forall (t :: PathType) x. Rep (Path t) x -> Path t
$cfrom :: forall (t :: PathType) x. Path t -> Rep (Path t) x
Generic, Path t -> Q Exp
Path t -> Q (TExp (Path t))
(Path t -> Q Exp) -> (Path t -> Q (TExp (Path t))) -> Lift (Path t)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (t :: PathType). Path t -> Q Exp
forall (t :: PathType). Path t -> Q (TExp (Path t))
liftTyped :: Path t -> Q (TExp (Path t))
$cliftTyped :: forall (t :: PathType). Path t -> Q (TExp (Path t))
lift :: Path t -> Q Exp
$clift :: forall (t :: PathType). Path t -> Q Exp
Lift)
  deriving newtype (Path t -> Path t -> Bool
(Path t -> Path t -> Bool)
-> (Path t -> Path t -> Bool) -> Eq (Path t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: PathType). Path t -> Path t -> Bool
/= :: Path t -> Path t -> Bool
$c/= :: forall (t :: PathType). Path t -> Path t -> Bool
== :: Path t -> Path t -> Bool
$c== :: forall (t :: PathType). Path t -> Path t -> Bool
Eq, Int -> Path t -> ShowS
[Path t] -> ShowS
Path t -> String
(Int -> Path t -> ShowS)
-> (Path t -> String) -> ([Path t] -> ShowS) -> Show (Path t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: PathType). Int -> Path t -> ShowS
forall (t :: PathType). [Path t] -> ShowS
forall (t :: PathType). Path t -> String
showList :: [Path t] -> ShowS
$cshowList :: forall (t :: PathType). [Path t] -> ShowS
show :: Path t -> String
$cshow :: forall (t :: PathType). Path t -> String
showsPrec :: Int -> Path t -> ShowS
$cshowsPrec :: forall (t :: PathType). Int -> Path t -> ShowS
Show)

fromRel :: Path 'Rel -> ByteString
fromRel :: Path 'Rel -> ByteString
fromRel ((PathSeg -> ByteString) -> Seq PathSeg -> Seq ByteString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap PathSeg -> ByteString
fromPathSeg (Seq PathSeg -> Seq ByteString)
-> (Path 'Rel -> Seq PathSeg) -> Path 'Rel -> Seq ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path 'Rel -> Seq PathSeg
forall (t :: PathType). Path t -> Seq PathSeg
unPath -> Seq ByteString
l)
  | Seq ByteString
Empty <- Seq ByteString
l = ByteString
"."
  | ByteString
x :<| Seq ByteString
xs <- Seq ByteString
l = (ByteString -> ByteString -> ByteString)
-> ByteString -> Seq ByteString -> ByteString
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ByteString
p ByteString
s -> ByteString
p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s) ByteString
x Seq ByteString
xs

fromAbs :: Path 'Abs -> ByteString
fromAbs :: Path 'Abs -> ByteString
fromAbs ((PathSeg -> ByteString) -> Seq PathSeg -> Seq ByteString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap PathSeg -> ByteString
fromPathSeg (Seq PathSeg -> Seq ByteString)
-> (Path 'Abs -> Seq PathSeg) -> Path 'Abs -> Seq ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path 'Abs -> Seq PathSeg
forall (t :: PathType). Path t -> Seq PathSeg
unPath -> Seq ByteString
l)
  | Seq ByteString
Empty <- Seq ByteString
l = ByteString
"/"
  | ByteString
x :<| Seq ByteString
xs <- Seq ByteString
l = ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (ByteString -> ByteString -> ByteString)
-> ByteString -> Seq ByteString -> ByteString
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ByteString
p ByteString
s -> ByteString
p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"/" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s) ByteString
x Seq ByteString
xs

hush :: Either a b -> Maybe b
hush :: Either a b -> Maybe b
hush (Left a
_) = Maybe b
forall a. Maybe a
Nothing
hush (Right b
b) = b -> Maybe b
forall a. a -> Maybe a
Just b
b

parseRel :: ByteString -> Maybe (Path 'Rel)
parseRel :: ByteString -> Maybe (Path 'Rel)
parseRel = Either (ParseErrorBundle ByteString Void) (Path 'Rel)
-> Maybe (Path 'Rel)
forall a b. Either a b -> Maybe b
hush (Either (ParseErrorBundle ByteString Void) (Path 'Rel)
 -> Maybe (Path 'Rel))
-> (ByteString
    -> Either (ParseErrorBundle ByteString Void) (Path 'Rel))
-> ByteString
-> Maybe (Path 'Rel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Path 'Rel)
-> String
-> ByteString
-> Either (ParseErrorBundle ByteString Void) (Path 'Rel)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parser (Path 'Rel)
relpath String
""

parseAbs :: ByteString -> Maybe (Path 'Abs)
parseAbs :: ByteString -> Maybe (Path 'Abs)
parseAbs = Either (ParseErrorBundle ByteString Void) (Path 'Abs)
-> Maybe (Path 'Abs)
forall a b. Either a b -> Maybe b
hush (Either (ParseErrorBundle ByteString Void) (Path 'Abs)
 -> Maybe (Path 'Abs))
-> (ByteString
    -> Either (ParseErrorBundle ByteString Void) (Path 'Abs))
-> ByteString
-> Maybe (Path 'Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Path 'Abs)
-> String
-> ByteString
-> Either (ParseErrorBundle ByteString Void) (Path 'Abs)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parser (Path 'Abs)
abspath String
""

mkAbs :: ByteString -> Q Exp
mkAbs :: ByteString -> Q Exp
mkAbs = Path 'Abs -> Q Exp
forall t. Lift t => t -> Q Exp
lift (Path 'Abs -> Q Exp)
-> (ByteString -> Path 'Abs) -> ByteString -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path 'Abs -> Maybe (Path 'Abs) -> Path 'Abs
forall a. a -> Maybe a -> a
fromMaybe (String -> Path 'Abs
forall a. HasCallStack => String -> a
error String
"illformed absolute path") (Maybe (Path 'Abs) -> Path 'Abs)
-> (ByteString -> Maybe (Path 'Abs)) -> ByteString -> Path 'Abs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Path 'Abs)
parseAbs

mkRel :: ByteString -> Q Exp
mkRel :: ByteString -> Q Exp
mkRel = Path 'Rel -> Q Exp
forall t. Lift t => t -> Q Exp
lift (Path 'Rel -> Q Exp)
-> (ByteString -> Path 'Rel) -> ByteString -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path 'Rel -> Maybe (Path 'Rel) -> Path 'Rel
forall a. a -> Maybe a -> a
fromMaybe (String -> Path 'Rel
forall a. HasCallStack => String -> a
error String
"illformed relative path") (Maybe (Path 'Rel) -> Path 'Rel)
-> (ByteString -> Maybe (Path 'Rel)) -> ByteString -> Path 'Rel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Path 'Rel)
parseRel

qq :: (ByteString -> Q Exp) -> QuasiQuoter
qq :: (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
quoteExp' =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = ByteString -> Q Exp
quoteExp' (ByteString -> Q Exp) -> (String -> ByteString) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString,
      quotePat :: String -> Q Pat
quotePat = \String
_ ->
        String -> Q Pat
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a pattern)",
      quoteType :: String -> Q Type
quoteType = \String
_ ->
        String -> Q Type
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a type)",
      quoteDec :: String -> Q [Dec]
quoteDec = \String
_ ->
        String -> Q [Dec]
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a declaration)"
    }

absp :: QuasiQuoter
absp :: QuasiQuoter
absp = (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
mkAbs

relp :: QuasiQuoter
relp :: QuasiQuoter
relp = (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
mkRel

(</>) :: Path t -> Path 'Rel -> Path t
(Path Seq PathSeg
p1) </> :: Path t -> Path 'Rel -> Path t
</> (Path Seq PathSeg
p2) = Seq PathSeg -> Path t
forall (t :: PathType). Seq PathSeg -> Path t
Path (Seq PathSeg
p1 Seq PathSeg -> Seq PathSeg -> Seq PathSeg
forall a. Semigroup a => a -> a -> a
<> Seq PathSeg
p2)

stripPrefix :: Path t -> Path t -> Maybe (Path 'Rel)
stripPrefix :: Path t -> Path t -> Maybe (Path 'Rel)
stripPrefix (Path Seq PathSeg
p1) (Path Seq PathSeg
p2) =
  Seq PathSeg -> Path 'Rel
forall (t :: PathType). Seq PathSeg -> Path t
Path (Seq PathSeg -> Path 'Rel)
-> Maybe (Seq PathSeg) -> Maybe (Path 'Rel)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq PathSeg -> Seq PathSeg -> Maybe (Seq PathSeg)
forall a. Eq a => Seq a -> Seq a -> Maybe (Seq a)
stripPrefix' Seq PathSeg
p1 Seq PathSeg
p2
  where
    stripPrefix' :: Seq a -> Seq a -> Maybe (Seq a)
stripPrefix' Seq a
Empty Seq a
p = Seq a -> Maybe (Seq a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Seq a
p
    stripPrefix' Seq a
_ Seq a
Empty = Maybe (Seq a)
forall a. Maybe a
Nothing
    stripPrefix' (a
x :<| Seq a
xs) (a
y :<| Seq a
ys)
      | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = Seq a -> Seq a -> Maybe (Seq a)
stripPrefix' Seq a
xs Seq a
ys
      | Bool
otherwise = Maybe (Seq a)
forall a. Maybe a
Nothing

isPrefixOf :: Path t -> Path t -> Bool
isPrefixOf :: Path t -> Path t -> Bool
isPrefixOf Path t
p1 Path t
p2 = Maybe (Path 'Rel) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Path 'Rel) -> Bool) -> Maybe (Path 'Rel) -> Bool
forall a b. (a -> b) -> a -> b
$ Path t -> Path t -> Maybe (Path 'Rel)
forall (t :: PathType). Path t -> Path t -> Maybe (Path 'Rel)
stripPrefix Path t
p1 Path t
p2

parent :: Path t -> Path t
parent :: Path t -> Path t
parent (Path Seq PathSeg
Empty) = Seq PathSeg -> Path t
forall (t :: PathType). Seq PathSeg -> Path t
Path Seq PathSeg
forall a. Seq a
Empty
parent (Path (Seq PathSeg
xs :|> PathSeg
_)) = Seq PathSeg -> Path t
forall (t :: PathType). Seq PathSeg -> Path t
Path Seq PathSeg
xs

filename :: Path t -> Path 'Rel
filename :: Path t -> Path 'Rel
filename (Path Seq PathSeg
Empty) = Seq PathSeg -> Path 'Rel
forall (t :: PathType). Seq PathSeg -> Path t
Path Seq PathSeg
forall a. Seq a
Empty
filename (Path (Seq PathSeg
Empty :|> PathSeg
x)) = Seq PathSeg -> Path 'Rel
forall (t :: PathType). Seq PathSeg -> Path t
Path (Seq PathSeg -> Path 'Rel) -> Seq PathSeg -> Path 'Rel
forall a b. (a -> b) -> a -> b
$ PathSeg -> Seq PathSeg
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PathSeg
x
filename (Path (PathSeg
_ :<| Seq PathSeg
xs)) = Path Any -> Path 'Rel
forall (t :: PathType). Path t -> Path 'Rel
filename (Path Any -> Path 'Rel) -> Path Any -> Path 'Rel
forall a b. (a -> b) -> a -> b
$ Seq PathSeg -> Path Any
forall (t :: PathType). Seq PathSeg -> Path t
Path Seq PathSeg
xs