{-# 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 qualified Data.List as L
import qualified Language.Haskell.TH.Syntax as TH
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)
DataType
Constr
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 -> DataType
Path b t -> Constr
(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 -> DataType
forall b t. (Data b, Data t) => Path b t -> Constr
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 FilePath
x) (Path 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 FilePath
x) (Path 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
'.' 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 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 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 Int
n 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 -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"..") Bool -> Bool -> Bool
||
     (FilePath
"/.." FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
filepath) Bool -> Bool -> Bool
||
     (FilePath
"/../" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` FilePath
filepath) Bool -> Bool -> Bool
||
     (FilePath
"../" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` FilePath
filepath)
  where
    filepath :: FilePath
filepath =
        case Char
FilePath.pathSeparator of
            Char
'/' -> FilePath
filepath'
            Char
x   -> (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\Char
y -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y then Char
'/' else Char
y) FilePath
filepath'

instance (Typeable a, Typeable b) => TH.Lift (Path a b) where
  lift :: Path a b -> Q Exp
lift p :: Path a b
p@(Path FilePath
str) = do
    let btc :: TyCon
btc = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ Path a b -> Proxy a
forall a b. Path a b -> Proxy a
mkBaseProxy Path a b
p
        ttc :: TyCon
ttc = TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> TypeRep -> TyCon
forall a b. (a -> b) -> a -> b
$ Proxy b -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy b -> TypeRep) -> Proxy b -> TypeRep
forall a b. (a -> b) -> a -> b
$ Path a b -> Proxy b
forall a b. Path a b -> Proxy b
mkTypeProxy Path a b
p
    Name
bn <- FilePath -> Q Name
lookupTypeNameThrow (FilePath -> Q Name) -> FilePath -> Q Name
forall a b. (a -> b) -> a -> b
$ TyCon -> FilePath
tyConName TyCon
btc
    Name
tn <- FilePath -> Q Name
lookupTypeNameThrow (FilePath -> Q Name) -> FilePath -> Q Name
forall a b. (a -> b) -> a -> b
$ TyCon -> FilePath
tyConName TyCon
ttc
    [|Path $(return (TH.LitE (TH.StringL str))) :: Path
      $(return $ TH.ConT bn)
      $(return $ TH.ConT tn)
      |]
    where
      mkBaseProxy :: Path a b -> Proxy a
      mkBaseProxy :: Path a b -> Proxy a
mkBaseProxy Path a b
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

      mkTypeProxy :: Path a b -> Proxy b
      mkTypeProxy :: Path a b -> Proxy b
mkTypeProxy Path a b
_ = Proxy b
forall k (t :: k). Proxy t
Proxy

      lookupTypeNameThrow :: FilePath -> Q Name
lookupTypeNameThrow FilePath
n = FilePath -> Q (Maybe Name)
TH.lookupTypeName FilePath
n
        Q (Maybe Name) -> (Maybe Name -> Q Name) -> Q Name
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Q Name -> (Name -> Q Name) -> Maybe Name -> Q Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Q Name
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Q Name) -> FilePath -> Q Name
forall a b. (a -> b) -> a -> b
$ FilePath
"Not in scope: type constructor ‘" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"’") Name -> Q Name
forall (m :: * -> *) a. Monad m => a -> m a
return

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: Path a b -> Q (TExp (Path a b))
liftTyped = Q Exp -> Q (TExp (Path a b))
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp (Path a b)))
-> (Path a b -> Q Exp) -> Path a b -> Q (TExp (Path a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path a b -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif