-- |
-- Module      :  HPath
-- Copyright   :  © 2015–2016 FP Complete, 2016 Julian Ospald
-- License     :  BSD 3 clause
--
-- Maintainer  :  Julian Ospald <hasufell@posteo.de>
-- Stability   :  experimental
-- Portability :  portable
--
-- Support for well-typed paths.


{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}

module HPath
  (
  -- * Types
   Path
  ,Abs
  ,Rel
  ,PathParseException
  ,PathException
#if __GLASGOW_HASKELL__ >= 708
  -- * PatternSynonyms/ViewPatterns
  ,pattern Path
#endif
   -- * Path Construction
  ,parseAbs
  ,parseRel
  ,parseAny
  ,rootPath
  ,pwdPath
  -- * Path Conversion
  ,fromAbs
  ,fromRel
  ,toFilePath
  ,fromAny
  -- * Path Operations
  ,(</>)
  ,basename
  ,basename'
  ,dirname
  ,getAllParents
  ,getAllComponents
  ,getAllComponentsAfterRoot
  ,stripDir
  -- * Path Examination
  ,isParentOf
  ,isRootPath
  ,isPwdPath
  -- * Path IO helpers
  ,withAbsPath
  ,withRelPath
  -- * Quasiquoters
  ,abs
  ,rel
  )
  where

import           Control.Exception (Exception)
import           Control.Monad.Catch (MonadThrow(..))
#if MIN_VERSION_bytestring(0,10,8)
import           Data.ByteString(ByteString, stripPrefix)
#else
import           Data.ByteString(ByteString)
import qualified Data.List as L
#endif
import qualified Data.ByteString as BS
import           Data.ByteString.UTF8
import           Data.Data
import           Data.Maybe
import           Data.Word8
import           HPath.Internal
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax (Lift(..), lift)
import qualified Language.Haskell.TH.Syntax as TH
import           Language.Haskell.TH.Quote (QuasiQuoter(..))
import           Prelude hiding (abs, any)
import           System.Posix.FilePath hiding ((</>))


--------------------------------------------------------------------------------
-- Types

-- | An absolute path.
data Abs deriving (Typeable)

-- | A relative path; one without a root.
data Rel deriving (Typeable)

-- | Exception when parsing a location.
data PathParseException
  = InvalidAbs ByteString
  | InvalidRel ByteString
  | Couldn'tStripPrefixTPS ByteString ByteString
  deriving (Int -> PathParseException -> ShowS
[PathParseException] -> ShowS
PathParseException -> String
(Int -> PathParseException -> ShowS)
-> (PathParseException -> String)
-> ([PathParseException] -> ShowS)
-> Show PathParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathParseException] -> ShowS
$cshowList :: [PathParseException] -> ShowS
show :: PathParseException -> String
$cshow :: PathParseException -> String
showsPrec :: Int -> PathParseException -> ShowS
$cshowsPrec :: Int -> PathParseException -> ShowS
Show,Typeable)
instance Exception PathParseException

data PathException = RootDirHasNoBasename
  deriving (Int -> PathException -> ShowS
[PathException] -> ShowS
PathException -> String
(Int -> PathException -> ShowS)
-> (PathException -> String)
-> ([PathException] -> ShowS)
-> Show PathException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathException] -> ShowS
$cshowList :: [PathException] -> ShowS
show :: PathException -> String
$cshow :: PathException -> String
showsPrec :: Int -> PathException -> ShowS
$cshowsPrec :: Int -> PathException -> ShowS
Show,Typeable)
instance Exception PathException


--------------------------------------------------------------------------------
-- PatternSynonyms

#if __GLASGOW_HASKELL__ >= 710
pattern Path :: ByteString -> Path a
#endif
#if __GLASGOW_HASKELL__ >= 708
pattern $mPath :: forall r a. Path a -> (ByteString -> r) -> (Void# -> r) -> r
Path x <- (MkPath x)
#endif

--------------------------------------------------------------------------------
-- Path Parsers



-- | Get a location for an absolute path. Produces a normalised path.
--
-- Throws: 'PathParseException'
--
-- >>> parseAbs "/abc"
-- "/abc"
-- >>> parseAbs "/"
-- "/"
-- >>> parseAbs "/abc/def"
-- "/abc/def"
-- >>> parseAbs "/abc/def/.///"
-- "/abc/def"
-- >>> parseAbs "abc"
-- *** Exception: InvalidAbs "abc"
-- >>> parseAbs ""
-- *** Exception: InvalidAbs ""
-- >>> parseAbs "/abc/../foo"
-- *** Exception: InvalidAbs "/abc/../foo"
parseAbs :: MonadThrow m
         => ByteString -> m (Path Abs)
parseAbs :: ByteString -> m (Path Abs)
parseAbs ByteString
filepath =
  if ByteString -> Bool
isAbsolute ByteString
filepath Bool -> Bool -> Bool
&&
     ByteString -> Bool
isValid ByteString
filepath Bool -> Bool -> Bool
&&
     Bool -> Bool
not (ByteString -> Bool
hasParentDir ByteString
filepath)
     then Path Abs -> m (Path Abs)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Path Abs
forall b. ByteString -> Path b
MkPath (ByteString -> Path Abs)
-> (ByteString -> ByteString) -> ByteString -> Path Abs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropTrailingPathSeparator (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
normalise (ByteString -> Path Abs) -> ByteString -> Path Abs
forall a b. (a -> b) -> a -> b
$ ByteString
filepath)
     else PathParseException -> m (Path Abs)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> PathParseException
InvalidAbs ByteString
filepath)


-- | Get a location for a relative path. Produces a normalised
-- path.
--
-- Note that @filepath@ may contain any number of @./@,
-- but not a single @..@ anywhere.
--
-- Throws: 'PathParseException'
--
-- >>> parseRel "abc"
-- "abc"
-- >>> parseRel "def/"
-- "def"
-- >>> parseRel "abc/def"
-- "abc/def"
-- >>> parseRel "abc/def/."
-- "abc/def"
-- >>> parseRel "/abc"
-- *** Exception: InvalidRel "/abc"
-- >>> parseRel ""
-- *** Exception: InvalidRel ""
-- >>> parseRel "abc/../foo"
-- *** Exception: InvalidRel "abc/../foo"
-- >>> parseRel "."
-- "."
-- >>> parseRel "././././."
-- "."
-- >>> parseRel "./..."
-- "..."
-- >>> parseRel ".."
-- *** Exception: InvalidRel ".."
parseRel :: MonadThrow m
         => ByteString -> m (Path Rel)
parseRel :: ByteString -> m (Path Rel)
parseRel ByteString
filepath =
  if Bool -> Bool
not (ByteString -> Bool
isAbsolute ByteString
filepath) Bool -> Bool -> Bool
&&
     ByteString
filepath ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8] -> ByteString
BS.pack [Word8
_period, Word8
_period] Bool -> Bool -> Bool
&&
     Bool -> Bool
not (ByteString -> Bool
hasParentDir ByteString
filepath) Bool -> Bool -> Bool
&&
     ByteString -> Bool
isValid ByteString
filepath
     then Path Rel -> m (Path Rel)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Path Rel
forall b. ByteString -> Path b
MkPath (ByteString -> Path Rel)
-> (ByteString -> ByteString) -> ByteString -> Path Rel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dropTrailingPathSeparator (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
normalise (ByteString -> Path Rel) -> ByteString -> Path Rel
forall a b. (a -> b) -> a -> b
$ ByteString
filepath)
     else PathParseException -> m (Path Rel)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> PathParseException
InvalidRel ByteString
filepath)



-- | Parses a path, whether it's relative or absolute.
--
-- Throws: 'PathParseException'
--
-- >>> parseAny "/abc"
-- Left "/abc"
-- >>> parseAny "..."
-- Right "..."
-- >>> parseAny "abc/def"
-- Right "abc/def"
-- >>> parseAny "abc/def/."
-- Right "abc/def"
-- >>> parseAny "/abc"
-- Left "/abc"
-- >>> parseAny ""
-- *** Exception: InvalidRel ""
-- >>> parseAny "abc/../foo"
-- *** Exception: InvalidRel "abc/../foo"
-- >>> parseAny "."
-- Right "."
-- >>> parseAny ".."
-- *** Exception: InvalidRel ".."
parseAny :: MonadThrow m => ByteString -> m (Either (Path Abs) (Path Rel))
parseAny :: ByteString -> m (Either (Path Abs) (Path Rel))
parseAny ByteString
filepath = case ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
filepath of
  Just Path Abs
p -> Either (Path Abs) (Path Rel) -> m (Either (Path Abs) (Path Rel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Abs) (Path Rel) -> m (Either (Path Abs) (Path Rel)))
-> Either (Path Abs) (Path Rel) -> m (Either (Path Abs) (Path Rel))
forall a b. (a -> b) -> a -> b
$ Path Abs -> Either (Path Abs) (Path Rel)
forall a b. a -> Either a b
Left Path Abs
p
  Maybe (Path Abs)
Nothing         -> case ByteString -> Maybe (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel ByteString
filepath of
    Just Path Rel
p -> Either (Path Abs) (Path Rel) -> m (Either (Path Abs) (Path Rel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Abs) (Path Rel) -> m (Either (Path Abs) (Path Rel)))
-> Either (Path Abs) (Path Rel) -> m (Either (Path Abs) (Path Rel))
forall a b. (a -> b) -> a -> b
$ Path Rel -> Either (Path Abs) (Path Rel)
forall a b. b -> Either a b
Right Path Rel
p
    Maybe (Path Rel)
Nothing       -> PathParseException -> m (Either (Path Abs) (Path Rel))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> PathParseException
InvalidRel ByteString
filepath)


-- | The @"/"@ root path.
rootPath :: Path Abs
rootPath :: Path Abs
rootPath = (ByteString -> Path Abs
forall b. ByteString -> Path b
MkPath (Word8 -> ByteString
BS.singleton Word8
_slash))

-- | The @"."@ pwd path.
pwdPath :: Path Rel
pwdPath :: Path Rel
pwdPath = (ByteString -> Path Rel
forall b. ByteString -> Path b
MkPath (Word8 -> ByteString
BS.singleton Word8
_period))


--------------------------------------------------------------------------------
-- Path Conversion

-- | Convert any Path to a ByteString type.
toFilePath :: Path b -> ByteString
toFilePath :: Path b -> ByteString
toFilePath (MkPath ByteString
l) = ByteString
l

-- | Convert an absolute Path to a ByteString type.
fromAbs :: Path Abs -> ByteString
fromAbs :: Path Abs -> ByteString
fromAbs = Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath

-- | Convert a relative Path to a ByteString type.
fromRel :: Path Rel -> ByteString
fromRel :: Path Rel -> ByteString
fromRel = Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath

fromAny :: Either (Path Abs) (Path Rel) -> ByteString
fromAny :: Either (Path Abs) (Path Rel) -> ByteString
fromAny = (Path Abs -> ByteString)
-> (Path Rel -> ByteString)
-> Either (Path Abs) (Path Rel)
-> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath


--------------------------------------------------------------------------------
-- Path Operations

-- | Append two paths.
--
-- The second argument must always be a relative path, which ensures
-- that undefinable things like `"/abc" </> "/def"` cannot happen.
--
-- Technically, the first argument can be a path that points to a non-directory,
-- because this library is IO-agnostic and makes no assumptions about
-- file types.
--
-- >>> [abs|/|] </> [rel|file|]
-- "/file"
-- >>> [abs|/path/to|] </> [rel|file|]
-- "/path/to/file"
-- >>> [abs|/|] </> [rel|file/lal|]
-- "/file/lal"
-- >>> [abs|/|] </> [rel|.|]
-- "/"
-- >>> [rel|.|] </> [rel|.|]
-- "."
(</>) :: Path b -> Path Rel -> Path b
</> :: Path b -> Path Rel -> Path b
(</>) (MkPath ByteString
a) (MkPath ByteString
b) =
  ByteString -> Path b
forall b. ByteString -> Path b
MkPath (ByteString -> ByteString
dropTrailingPathSeparator (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
normalise (ByteString -> ByteString
addTrailingPathSeparator ByteString
a ByteString -> ByteString -> ByteString
`BS.append` ByteString
b))


-- | Strip directory from path, making it relative to that directory.
-- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path.
--
-- The bases must match.
--
-- >>> [abs|/lal/lad|]     `stripDir` [abs|/lal/lad/fad|]
-- "fad"
-- >>> [rel|lal/lad|]      `stripDir` [rel|lal/lad/fad|]
-- "fad"
-- >>> [abs|/|]            `stripDir` [abs|/|]
-- "."
-- >>> [abs|/lal/lad/fad|] `stripDir` [abs|/lal/lad|]
-- *** Exception: Couldn'tStripPrefixTPS "/lal/lad/fad" "/lal/lad"
-- >>> [abs|/abs|]         `stripDir` [abs|/lal/lad|]
-- *** Exception: Couldn'tStripPrefixTPS "/abs" "/lal/lad"
-- >>> [rel|fad|]          `stripDir` [rel|fad|]
-- "."
-- >>> [rel|.|]            `stripDir` [rel|.|]
-- "."
-- >>> [rel|.|]            `stripDir` [rel|.foo|]
-- *** Exception: Couldn'tStripPrefixTPS "." ".foo"
stripDir :: MonadThrow m => Path b -> Path b -> m (Path Rel)
stripDir :: Path b -> Path b -> m (Path Rel)
stripDir (MkPath ByteString
p) (MkPath ByteString
l)
  | ByteString
p ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
l = Path Rel -> m (Path Rel)
forall (m :: * -> *) a. Monad m => a -> m a
return Path Rel
pwdPath
  | Bool
otherwise = case ByteString -> ByteString -> Maybe ByteString
stripPrefix (ByteString -> ByteString
addTrailingPathSeparator ByteString
p) ByteString
l of
    Maybe ByteString
Nothing -> PathParseException -> m (Path Rel)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ByteString -> ByteString -> PathParseException
Couldn'tStripPrefixTPS ByteString
p ByteString
l)
    Just ByteString
ok -> Path Rel -> m (Path Rel)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Path Rel
forall b. ByteString -> Path b
MkPath ByteString
ok)


-- |Get all parents of a path.
--
-- >>> getAllParents [abs|/abs/def/dod|]
-- ["/abs/def","/abs","/"]
-- >>> getAllParents [abs|/foo|]
-- ["/"]
-- >>> getAllParents [abs|/|]
-- []
getAllParents :: Path Abs -> [Path Abs]
getAllParents :: Path Abs -> [Path Abs]
getAllParents (MkPath ByteString
p)
  | ByteString
np ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> ByteString
BS.singleton Word8
pathSeparator = []
  | Bool
otherwise = Path Abs -> Path Abs
dirname (ByteString -> Path Abs
forall b. ByteString -> Path b
MkPath ByteString
np) Path Abs -> [Path Abs] -> [Path Abs]
forall a. a -> [a] -> [a]
: Path Abs -> [Path Abs]
getAllParents (Path Abs -> Path Abs
dirname (Path Abs -> Path Abs) -> Path Abs -> Path Abs
forall a b. (a -> b) -> a -> b
$ ByteString -> Path Abs
forall b. ByteString -> Path b
MkPath ByteString
np)
  where
    np :: ByteString
np = ByteString -> ByteString
normalise ByteString
p


-- | Gets all path components.
--
-- >>> getAllComponents [rel|abs/def/dod|]
-- ["abs","def","dod"]
-- >>> getAllComponents [rel|abs|]
-- ["abs"]
-- >>> getAllComponents [rel|.|]
-- ["."]
getAllComponents :: Path Rel -> [Path Rel]
getAllComponents :: Path Rel -> [Path Rel]
getAllComponents (MkPath ByteString
p) = (ByteString -> Path Rel) -> [ByteString] -> [Path Rel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Path Rel
forall b. ByteString -> Path b
MkPath ([ByteString] -> [Path Rel])
-> (ByteString -> [ByteString]) -> ByteString -> [Path Rel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitDirectories (ByteString -> [Path Rel]) -> ByteString -> [Path Rel]
forall a b. (a -> b) -> a -> b
$ ByteString
p


-- | Gets all path components after the "/" root directory.
--
-- >>> getAllComponentsAfterRoot [abs|/abs/def/dod|]
-- ["abs","def","dod"]
-- >>> getAllComponentsAfterRoot [abs|/abs|]
-- ["abs"]
getAllComponentsAfterRoot :: Path Abs -> [Path Rel]
getAllComponentsAfterRoot :: Path Abs -> [Path Rel]
getAllComponentsAfterRoot Path Abs
p = Path Rel -> [Path Rel]
getAllComponents (Maybe (Path Rel) -> Path Rel
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Path Rel) -> Path Rel) -> Maybe (Path Rel) -> Path Rel
forall a b. (a -> b) -> a -> b
$ Path Abs -> Path Abs -> Maybe (Path Rel)
forall (m :: * -> *) b.
MonadThrow m =>
Path b -> Path b -> m (Path Rel)
stripDir Path Abs
rootPath Path Abs
p)


-- | Extract the directory name of a path.
--
-- >>> dirname [abs|/abc/def/dod|]
-- "/abc/def"
-- >>> dirname [abs|/|]
-- "/"
dirname :: Path Abs -> Path Abs
dirname :: Path Abs -> Path Abs
dirname (MkPath ByteString
fp) = ByteString -> Path Abs
forall b. ByteString -> Path b
MkPath (ByteString -> ByteString
takeDirectory ByteString
fp)

-- | Extract the file part of a path.
--
--
-- The following properties hold:
--
-- @basename (p \<\/> a) == basename a@
--
-- Throws: `PathException` if given the root path "/"
--
-- >>> basename [abs|/abc/def/dod|]
-- "dod"
-- >>> basename [rel|abc/def/dod|]
-- "dod"
-- >>> basename [rel|dod|]
-- "dod"
-- >>> basename [rel|.|]
-- "."
-- >>> basename [abs|/|]
-- *** Exception: RootDirHasNoBasename
basename :: MonadThrow m => Path b -> m (Path Rel)
basename :: Path b -> m (Path Rel)
basename (MkPath ByteString
l)
  | Bool -> Bool
not (ByteString -> Bool
isAbsolute ByteString
rl) = Path Rel -> m (Path Rel)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Rel -> m (Path Rel)) -> Path Rel -> m (Path Rel)
forall a b. (a -> b) -> a -> b
$ ByteString -> Path Rel
forall b. ByteString -> Path b
MkPath ByteString
rl
  | Bool
otherwise           = PathException -> m (Path Rel)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM PathException
RootDirHasNoBasename
  where
    rl :: ByteString
rl = [ByteString] -> ByteString
forall a. [a] -> a
last ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitPath (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
l

-- | Extract the file part of a relative path.
--
-- The following properties hold:
--
-- @basename' (p \<\/> a) == basename' a@
--
-- >>> basename' [rel|abc/def/dod|]
-- "dod"
-- >>> basename' [rel|dod|]
-- "dod"
-- >>> basename' [rel|.|]
-- "."
basename' :: Path Rel -> Path Rel
basename' :: Path Rel -> Path Rel
basename' (MkPath ByteString
l) = ByteString -> Path Rel
forall b. ByteString -> Path b
MkPath (ByteString -> Path Rel)
-> (ByteString -> ByteString) -> ByteString -> Path Rel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
last ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitPath (ByteString -> Path Rel) -> ByteString -> Path Rel
forall a b. (a -> b) -> a -> b
$ ByteString
l


--------------------------------------------------------------------------------
-- Path Examination

-- | Is p a parent of the given location? Implemented in terms of
-- 'stripDir'. The bases must match.
--
-- >>> [abs|/lal/lad|]     `isParentOf` [abs|/lal/lad/fad|]
-- True
-- >>> [rel|lal/lad|]      `isParentOf` [rel|lal/lad/fad|]
-- True
-- >>> [abs|/|]            `isParentOf` [abs|/|]
-- False
-- >>> [abs|/lal/lad/fad|] `isParentOf` [abs|/lal/lad|]
-- False
-- >>> [rel|fad|]          `isParentOf` [rel|fad|]
-- False
-- >>> [rel|.|]            `isParentOf` [rel|.foo|]
-- False
isParentOf :: Path b -> Path b -> Bool
isParentOf :: Path b -> Path b -> Bool
isParentOf Path b
p Path b
l = case Path b -> Path b -> Maybe (Path Rel)
forall (m :: * -> *) b.
MonadThrow m =>
Path b -> Path b -> m (Path Rel)
stripDir Path b
p Path b
l :: Maybe (Path Rel) of
  Maybe (Path Rel)
Nothing -> Bool
False
  Just Path Rel
ok
    | Path Rel -> Bool
isPwdPath Path Rel
ok -> Bool
False
    | Bool
otherwise -> Bool
True


-- | Check whether the given Path is the root "/" path.
--
-- >>> isRootPath [abs|/lal/lad|]
-- False
-- >>> isRootPath [abs|/|]
-- True
isRootPath :: Path Abs -> Bool
isRootPath :: Path Abs -> Bool
isRootPath = (Path Abs -> Path Abs -> Bool
forall a. Eq a => a -> a -> Bool
== Path Abs
rootPath)

-- | Check whether the given Path is the pwd "." path.
--
-- >>> isPwdPath [rel|lal/lad|]
-- False
-- >>> isPwdPath [rel|.|]
-- True
isPwdPath :: Path Rel -> Bool
isPwdPath :: Path Rel -> Bool
isPwdPath = (Path Rel -> Path Rel -> Bool
forall a. Eq a => a -> a -> Bool
== Path Rel
pwdPath)


--------------------------------------------------------------------------------
-- Path IO helpers


withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a
withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a
withAbsPath (MkPath ByteString
p) ByteString -> IO a
action = ByteString -> IO a
action ByteString
p


withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a
withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a
withRelPath (MkPath ByteString
p) ByteString -> IO a
action = ByteString -> IO a
action ByteString
p



------------------------
-- ByteString helpers

#if MIN_VERSION_bytestring(0,10,8)
#else
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b)
#endif


------------------------
-- QuasiQuoters

instance Typeable a => Lift (Path a) where
  lift :: Path a -> Q Exp
lift (MkPath ByteString
bs) = [| MkPath (BS.pack $(lift $ BS.unpack bs)) :: Path $(pure a) |]
    where
      a :: Type
a = Name -> Type
TH.ConT (Name -> Type) -> Name -> Type
forall a b. (a -> b) -> a -> b
$ OccName -> NameFlavour -> Name
TH.Name OccName
occ NameFlavour
flav
        where
        tc :: TyCon
tc   = TypeRep -> TyCon
typeRepTyCon (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))
        occ :: OccName
occ  = String -> OccName
TH.OccName (TyCon -> String
tyConName TyCon
tc)
        flav :: NameFlavour
flav = NameSpace -> PkgName -> ModName -> NameFlavour
TH.NameG NameSpace
TH.TcClsName (String -> PkgName
TH.PkgName (TyCon -> String
tyConPackage TyCon
tc)) (String -> ModName
TH.ModName (TyCon -> String
tyConModule TyCon
tc))


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  = (\String
s -> ByteString -> Q Exp
quoteExp' (ByteString -> Q Exp) -> (String -> ByteString) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
fromString (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
s)
  , quotePat :: String -> Q Pat
quotePat  = \String
_ ->
      String -> Q Pat
forall (m :: * -> *) 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 :: * -> *) 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 :: * -> *) a. MonadFail m => String -> m a
fail String
"illegal QuasiQuote (allowed as expression only, used as a declaration)"
  }

mkAbs :: ByteString -> Q Exp
mkAbs :: ByteString -> Q Exp
mkAbs = (SomeException -> Q Exp)
-> (Path Abs -> Q Exp) -> Either SomeException (Path Abs) -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. HasCallStack => String -> a
error (String -> Q Exp)
-> (SomeException -> String) -> SomeException -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) Path Abs -> Q Exp
forall t. Lift t => t -> Q Exp
lift (Either SomeException (Path Abs) -> Q Exp)
-> (ByteString -> Either SomeException (Path Abs))
-> ByteString
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either SomeException (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs

mkRel :: ByteString -> Q Exp
mkRel :: ByteString -> Q Exp
mkRel = (SomeException -> Q Exp)
-> (Path Rel -> Q Exp) -> Either SomeException (Path Rel) -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall a. HasCallStack => String -> a
error (String -> Q Exp)
-> (SomeException -> String) -> SomeException -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) Path Rel -> Q Exp
forall t. Lift t => t -> Q Exp
lift (Either SomeException (Path Rel) -> Q Exp)
-> (ByteString -> Either SomeException (Path Rel))
-> ByteString
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either SomeException (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel

-- | Quasiquote an absolute Path. This accepts Unicode Chars and will encode as UTF-8.
--
-- >>> [abs|/etc/profile|] :: Path Abs
-- "/etc/profile"
-- >>> [abs|/|] :: Path Abs
-- "/"
-- >>> [abs|/|] :: Path Abs
-- "/\239\131\144"
abs :: QuasiQuoter
abs :: QuasiQuoter
abs = (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
mkAbs

-- | Quasiquote a relative Path. This accepts Unicode Chars and will encode as UTF-8.
--
-- >>> [rel|etc|] :: Path Rel
-- "etc"
-- >>> [rel|bar/baz|] :: Path Rel
-- "bar/baz"
-- >>> [rel||] :: Path Rel
-- "\239\131\144"
rel :: QuasiQuoter
rel :: QuasiQuoter
rel = (ByteString -> Q Exp) -> QuasiQuoter
qq ByteString -> Q Exp
mkRel