{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell    #-}

-- | Internal types and functions.

module Path.Internal
  ( Path(..)
  , hasParentDir
  , relRootFP
  , toFilePath
  )
  where

import Control.DeepSeq (NFData (..))
import Data.Aeson (ToJSON (..), ToJSONKey(..))
import Data.Aeson.Types (toJSONKeyText)
import qualified Data.Text as T (pack)
import GHC.Generics (Generic)
import Data.Data
import Data.Hashable
import Data.List
import Language.Haskell.TH.Syntax (Exp(..), Lift(..), Lit(..))
import qualified System.FilePath as FilePath

-- | Path of some base and type.
--
-- The type variables are:
--
--   * @b@ — base, the base location of the path; absolute or relative.
--   * @t@ — type, whether file or directory.
--
-- Internally is a string. The string can be of two formats only:
--
-- 1. File format: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@
-- 2. Directory format: @foo\/@, @\/foo\/bar\/@
--
-- All directories end in a trailing separator. There are no duplicate
-- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc.
newtype Path b t = Path FilePath
  deriving (Typeable (Path b t)
Constr
DataType
Typeable (Path b t) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Path b t -> c (Path b t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Path b t))
-> (Path b t -> Constr)
-> (Path b t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Path b t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Path b t)))
-> ((forall b. Data b => b -> b) -> Path b t -> Path b t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Path b t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Path b t -> r)
-> (forall u. (forall d. Data d => d -> u) -> Path b t -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Path b t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Path b t -> m (Path b t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Path b t -> m (Path b t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Path b t -> m (Path b t))
-> Data (Path b t)
Path b t -> Constr
Path b t -> DataType
(forall b. Data b => b -> b) -> Path b t -> Path b t
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path b t -> c (Path b t)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Path b t)
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Path b t))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Path b t -> u
forall u. (forall d. Data d => d -> u) -> Path b t -> [u]
forall b t. (Data b, Data t) => Typeable (Path b t)
forall b t. (Data b, Data t) => Path b t -> Constr
forall b t. (Data b, Data t) => Path b t -> DataType
forall b t.
(Data b, Data t) =>
(forall b. Data b => b -> b) -> Path b t -> Path b t
forall b t u.
(Data b, Data t) =>
Int -> (forall d. Data d => d -> u) -> Path b t -> u
forall b t u.
(Data b, Data t) =>
(forall d. Data d => d -> u) -> Path b t -> [u]
forall b t r r'.
(Data b, Data t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
forall b t r r'.
(Data b, Data t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
forall b t (m :: * -> *).
(Data b, Data t, Monad m) =>
(forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
forall b t (m :: * -> *).
(Data b, Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
forall b t (c :: * -> *).
(Data b, Data t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Path b t)
forall b t (c :: * -> *).
(Data b, Data t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path b t -> c (Path b t)
forall b t (t :: * -> *) (c :: * -> *).
(Data b, Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Path b t))
forall b t (t :: * -> * -> *) (c :: * -> *).
(Data b, Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Path b t))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Path b t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path b t -> c (Path b t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Path b t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Path b t))
$cPath :: Constr
$tPath :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
$cgmapMo :: forall b t (m :: * -> *).
(Data b, Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
gmapMp :: (forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
$cgmapMp :: forall b t (m :: * -> *).
(Data b, Data t, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
gmapM :: (forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
$cgmapM :: forall b t (m :: * -> *).
(Data b, Data t, Monad m) =>
(forall d. Data d => d -> m d) -> Path b t -> m (Path b t)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Path b t -> u
$cgmapQi :: forall b t u.
(Data b, Data t) =>
Int -> (forall d. Data d => d -> u) -> Path b t -> u
gmapQ :: (forall d. Data d => d -> u) -> Path b t -> [u]
$cgmapQ :: forall b t u.
(Data b, Data t) =>
(forall d. Data d => d -> u) -> Path b t -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
$cgmapQr :: forall b t r r'.
(Data b, Data t) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
$cgmapQl :: forall b t r r'.
(Data b, Data t) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Path b t -> r
gmapT :: (forall b. Data b => b -> b) -> Path b t -> Path b t
$cgmapT :: forall b t.
(Data b, Data t) =>
(forall b. Data b => b -> b) -> Path b t -> Path b t
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Path b t))
$cdataCast2 :: forall b t (t :: * -> * -> *) (c :: * -> *).
(Data b, Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Path b t))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Path b t))
$cdataCast1 :: forall b t (t :: * -> *) (c :: * -> *).
(Data b, Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Path b t))
dataTypeOf :: Path b t -> DataType
$cdataTypeOf :: forall b t. (Data b, Data t) => Path b t -> DataType
toConstr :: Path b t -> Constr
$ctoConstr :: forall b t. (Data b, Data t) => Path b t -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Path b t)
$cgunfold :: forall b t (c :: * -> *).
(Data b, Data t) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Path b t)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path b t -> c (Path b t)
$cgfoldl :: forall b t (c :: * -> *).
(Data b, Data t) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Path b t -> c (Path b t)
$cp1Data :: forall b t. (Data b, Data t) => Typeable (Path b t)
Data, Typeable, (forall x. Path b t -> Rep (Path b t) x)
-> (forall x. Rep (Path b t) x -> Path b t) -> Generic (Path b t)
forall x. Rep (Path b t) x -> Path b t
forall x. Path b t -> Rep (Path b t) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall b t x. Rep (Path b t) x -> Path b t
forall b t x. Path b t -> Rep (Path b t) x
$cto :: forall b t x. Rep (Path b t) x -> Path b t
$cfrom :: forall b t x. Path b t -> Rep (Path b t) x
Generic)

-- | String equality.
--
-- The following property holds:
--
-- @show x == show y ≡ x == y@
instance Eq (Path b t) where
  == :: Path b t -> Path b t -> Bool
(==) (Path x :: FilePath
x) (Path y :: FilePath
y) = FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
y

-- | String ordering.
--
-- The following property holds:
--
-- @show x \`compare\` show y ≡ x \`compare\` y@
instance Ord (Path b t) where
  compare :: Path b t -> Path b t -> Ordering
compare (Path x :: FilePath
x) (Path y :: FilePath
y) = FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
x FilePath
y

-- | Normalized file path representation for the relative path root
relRootFP :: FilePath
relRootFP :: FilePath
relRootFP = '.' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: [Char
FilePath.pathSeparator]

-- | Convert to a 'FilePath' type.
--
-- All directories have a trailing slash, so if you want no trailing
-- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from
-- the filepath package.
toFilePath :: Path b t -> FilePath
toFilePath :: Path b t -> FilePath
toFilePath (Path []) = FilePath
relRootFP
toFilePath (Path x :: FilePath
x)  = FilePath
x

-- | Same as 'show . Path.toFilePath'.
--
-- The following property holds:
--
-- @x == y ≡ show x == show y@
instance Show (Path b t) where
  show :: Path b t -> FilePath
show = FilePath -> FilePath
forall a. Show a => a -> FilePath
show (FilePath -> FilePath)
-> (Path b t -> FilePath) -> Path b t -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath

instance NFData (Path b t) where
  rnf :: Path b t -> ()
rnf (Path x :: FilePath
x) = FilePath -> ()
forall a. NFData a => a -> ()
rnf FilePath
x

instance ToJSON (Path b t) where
  toJSON :: Path b t -> Value
toJSON = FilePath -> Value
forall a. ToJSON a => a -> Value
toJSON (FilePath -> Value) -> (Path b t -> FilePath) -> Path b t -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath
  {-# INLINE toJSON #-}
#if MIN_VERSION_aeson(0,10,0)
  toEncoding :: Path b t -> Encoding
toEncoding = FilePath -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (FilePath -> Encoding)
-> (Path b t -> FilePath) -> Path b t -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath
  {-# INLINE toEncoding #-}
#endif

instance ToJSONKey (Path b t) where
  toJSONKey :: ToJSONKeyFunction (Path b t)
toJSONKey = (Path b t -> Text) -> ToJSONKeyFunction (Path b t)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText ((Path b t -> Text) -> ToJSONKeyFunction (Path b t))
-> (Path b t -> Text) -> ToJSONKeyFunction (Path b t)
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack (FilePath -> Text) -> (Path b t -> FilePath) -> Path b t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath

instance Hashable (Path b t) where
  -- A "." is represented as an empty string ("") internally. Hashing ""
  -- results in a hash that is the same as the salt. To produce a more
  -- reasonable hash we use "toFilePath" before hashing so that a "" gets
  -- converted back to a ".".
  hashWithSalt :: Int -> Path b t -> Int
hashWithSalt n :: Int
n path :: Path b t
path = Int -> FilePath -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n (Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path b t
path)

-- | Helper function: check if the filepath has any parent directories in it.
-- This handles the logic of checking for different path separators on Windows.
hasParentDir :: FilePath -> Bool
hasParentDir :: FilePath -> Bool
hasParentDir filepath' :: FilePath
filepath' =
     (FilePath
filepath' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "..") Bool -> Bool -> Bool
||
     ("/.." FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
filepath) Bool -> Bool -> Bool
||
     ("/../" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
filepath) Bool -> Bool -> Bool
||
     ("../" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
filepath)
  where
    filepath :: FilePath
filepath =
        case Char
FilePath.pathSeparator of
            '/' -> FilePath
filepath'
            x :: Char
x   -> (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\y :: Char
y -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y then '/' else Char
y) FilePath
filepath'

instance Lift (Path a b) where
  lift :: Path a b -> Q Exp
lift (Path str :: FilePath
str) = [|Path $(return (LitE (StringL str)))|]