{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}

module Distribution.Utils.Path
  ( -- * Symbolic path
    SymbolicPath
  , getSymbolicPath
  , sameDirectory
  , unsafeMakeSymbolicPath

    -- * Path ends
  , PackageDir
  , SourceDir
  , LicenseFile
  , IsDir
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic (isAbsoluteOnAnyPlatform)

import qualified Distribution.Compat.CharParsing as P

-- import qualified Text.PrettyPrint                as Disp

-------------------------------------------------------------------------------

-- * SymbolicPath

-------------------------------------------------------------------------------

-- | Symbolic paths.
--
-- These paths are system independent and relative.
-- They are *symbolic* which means we cannot perform any 'IO'
-- until we interpret them.
newtype SymbolicPath from to = SymbolicPath FilePath
  deriving ((forall x. SymbolicPath from to -> Rep (SymbolicPath from to) x)
-> (forall x. Rep (SymbolicPath from to) x -> SymbolicPath from to)
-> Generic (SymbolicPath from to)
forall x. Rep (SymbolicPath from to) x -> SymbolicPath from to
forall x. SymbolicPath from to -> Rep (SymbolicPath from to) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall from to x.
Rep (SymbolicPath from to) x -> SymbolicPath from to
forall from to x.
SymbolicPath from to -> Rep (SymbolicPath from to) x
$cfrom :: forall from to x.
SymbolicPath from to -> Rep (SymbolicPath from to) x
from :: forall x. SymbolicPath from to -> Rep (SymbolicPath from to) x
$cto :: forall from to x.
Rep (SymbolicPath from to) x -> SymbolicPath from to
to :: forall x. Rep (SymbolicPath from to) x -> SymbolicPath from to
Generic, Int -> SymbolicPath from to -> ShowS
[SymbolicPath from to] -> ShowS
SymbolicPath from to -> String
(Int -> SymbolicPath from to -> ShowS)
-> (SymbolicPath from to -> String)
-> ([SymbolicPath from to] -> ShowS)
-> Show (SymbolicPath from to)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall from to. Int -> SymbolicPath from to -> ShowS
forall from to. [SymbolicPath from to] -> ShowS
forall from to. SymbolicPath from to -> String
$cshowsPrec :: forall from to. Int -> SymbolicPath from to -> ShowS
showsPrec :: Int -> SymbolicPath from to -> ShowS
$cshow :: forall from to. SymbolicPath from to -> String
show :: SymbolicPath from to -> String
$cshowList :: forall from to. [SymbolicPath from to] -> ShowS
showList :: [SymbolicPath from to] -> ShowS
Show, ReadPrec [SymbolicPath from to]
ReadPrec (SymbolicPath from to)
Int -> ReadS (SymbolicPath from to)
ReadS [SymbolicPath from to]
(Int -> ReadS (SymbolicPath from to))
-> ReadS [SymbolicPath from to]
-> ReadPrec (SymbolicPath from to)
-> ReadPrec [SymbolicPath from to]
-> Read (SymbolicPath from to)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall from to. ReadPrec [SymbolicPath from to]
forall from to. ReadPrec (SymbolicPath from to)
forall from to. Int -> ReadS (SymbolicPath from to)
forall from to. ReadS [SymbolicPath from to]
$creadsPrec :: forall from to. Int -> ReadS (SymbolicPath from to)
readsPrec :: Int -> ReadS (SymbolicPath from to)
$creadList :: forall from to. ReadS [SymbolicPath from to]
readList :: ReadS [SymbolicPath from to]
$creadPrec :: forall from to. ReadPrec (SymbolicPath from to)
readPrec :: ReadPrec (SymbolicPath from to)
$creadListPrec :: forall from to. ReadPrec [SymbolicPath from to]
readListPrec :: ReadPrec [SymbolicPath from to]
Read, SymbolicPath from to -> SymbolicPath from to -> Bool
(SymbolicPath from to -> SymbolicPath from to -> Bool)
-> (SymbolicPath from to -> SymbolicPath from to -> Bool)
-> Eq (SymbolicPath from to)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
$c== :: forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
== :: SymbolicPath from to -> SymbolicPath from to -> Bool
$c/= :: forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
/= :: SymbolicPath from to -> SymbolicPath from to -> Bool
Eq, Eq (SymbolicPath from to)
Eq (SymbolicPath from to) =>
(SymbolicPath from to -> SymbolicPath from to -> Ordering)
-> (SymbolicPath from to -> SymbolicPath from to -> Bool)
-> (SymbolicPath from to -> SymbolicPath from to -> Bool)
-> (SymbolicPath from to -> SymbolicPath from to -> Bool)
-> (SymbolicPath from to -> SymbolicPath from to -> Bool)
-> (SymbolicPath from to
    -> SymbolicPath from to -> SymbolicPath from to)
-> (SymbolicPath from to
    -> SymbolicPath from to -> SymbolicPath from to)
-> Ord (SymbolicPath from to)
SymbolicPath from to -> SymbolicPath from to -> Bool
SymbolicPath from to -> SymbolicPath from to -> Ordering
SymbolicPath from to
-> SymbolicPath from to -> SymbolicPath from to
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
forall from to. Eq (SymbolicPath from to)
forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
forall from to.
SymbolicPath from to -> SymbolicPath from to -> Ordering
forall from to.
SymbolicPath from to
-> SymbolicPath from to -> SymbolicPath from to
$ccompare :: forall from to.
SymbolicPath from to -> SymbolicPath from to -> Ordering
compare :: SymbolicPath from to -> SymbolicPath from to -> Ordering
$c< :: forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
< :: SymbolicPath from to -> SymbolicPath from to -> Bool
$c<= :: forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
<= :: SymbolicPath from to -> SymbolicPath from to -> Bool
$c> :: forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
> :: SymbolicPath from to -> SymbolicPath from to -> Bool
$c>= :: forall from to.
SymbolicPath from to -> SymbolicPath from to -> Bool
>= :: SymbolicPath from to -> SymbolicPath from to -> Bool
$cmax :: forall from to.
SymbolicPath from to
-> SymbolicPath from to -> SymbolicPath from to
max :: SymbolicPath from to
-> SymbolicPath from to -> SymbolicPath from to
$cmin :: forall from to.
SymbolicPath from to
-> SymbolicPath from to -> SymbolicPath from to
min :: SymbolicPath from to
-> SymbolicPath from to -> SymbolicPath from to
Ord, Typeable, Typeable (SymbolicPath from to)
Typeable (SymbolicPath from to) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> SymbolicPath from to
 -> c (SymbolicPath from to))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (SymbolicPath from to))
-> (SymbolicPath from to -> Constr)
-> (SymbolicPath from to -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (SymbolicPath from to)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (SymbolicPath from to)))
-> ((forall b. Data b => b -> b)
    -> SymbolicPath from to -> SymbolicPath from to)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SymbolicPath from to -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SymbolicPath from to -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SymbolicPath from to -> m (SymbolicPath from to))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SymbolicPath from to -> m (SymbolicPath from to))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SymbolicPath from to -> m (SymbolicPath from to))
-> Data (SymbolicPath from to)
SymbolicPath from to -> Constr
SymbolicPath from to -> DataType
(forall b. Data b => b -> b)
-> SymbolicPath from to -> SymbolicPath from to
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) -> SymbolicPath from to -> u
forall u.
(forall d. Data d => d -> u) -> SymbolicPath from to -> [u]
forall from to.
(Data from, Data to) =>
Typeable (SymbolicPath from to)
forall from to.
(Data from, Data to) =>
SymbolicPath from to -> Constr
forall from to.
(Data from, Data to) =>
SymbolicPath from to -> DataType
forall from to.
(Data from, Data to) =>
(forall b. Data b => b -> b)
-> SymbolicPath from to -> SymbolicPath from to
forall from to u.
(Data from, Data to) =>
Int -> (forall d. Data d => d -> u) -> SymbolicPath from to -> u
forall from to u.
(Data from, Data to) =>
(forall d. Data d => d -> u) -> SymbolicPath from to -> [u]
forall from to r r'.
(Data from, Data to) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
forall from to r r'.
(Data from, Data to) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
forall from to (m :: * -> *).
(Data from, Data to, Monad m) =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
forall from to (m :: * -> *).
(Data from, Data to, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
forall from to (c :: * -> *).
(Data from, Data to) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SymbolicPath from to)
forall from to (c :: * -> *).
(Data from, Data to) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymbolicPath from to
-> c (SymbolicPath from to)
forall from to (t :: * -> *) (c :: * -> *).
(Data from, Data to, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SymbolicPath from to))
forall from to (t :: * -> * -> *) (c :: * -> *).
(Data from, Data to, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SymbolicPath from to))
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SymbolicPath from to)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymbolicPath from to
-> c (SymbolicPath from to)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SymbolicPath from to))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SymbolicPath from to))
$cgfoldl :: forall from to (c :: * -> *).
(Data from, Data to) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymbolicPath from to
-> c (SymbolicPath from to)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SymbolicPath from to
-> c (SymbolicPath from to)
$cgunfold :: forall from to (c :: * -> *).
(Data from, Data to) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SymbolicPath from to)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (SymbolicPath from to)
$ctoConstr :: forall from to.
(Data from, Data to) =>
SymbolicPath from to -> Constr
toConstr :: SymbolicPath from to -> Constr
$cdataTypeOf :: forall from to.
(Data from, Data to) =>
SymbolicPath from to -> DataType
dataTypeOf :: SymbolicPath from to -> DataType
$cdataCast1 :: forall from to (t :: * -> *) (c :: * -> *).
(Data from, Data to, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (SymbolicPath from to))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (SymbolicPath from to))
$cdataCast2 :: forall from to (t :: * -> * -> *) (c :: * -> *).
(Data from, Data to, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SymbolicPath from to))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (SymbolicPath from to))
$cgmapT :: forall from to.
(Data from, Data to) =>
(forall b. Data b => b -> b)
-> SymbolicPath from to -> SymbolicPath from to
gmapT :: (forall b. Data b => b -> b)
-> SymbolicPath from to -> SymbolicPath from to
$cgmapQl :: forall from to r r'.
(Data from, Data to) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
$cgmapQr :: forall from to r r'.
(Data from, Data to) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SymbolicPath from to -> r
$cgmapQ :: forall from to u.
(Data from, Data to) =>
(forall d. Data d => d -> u) -> SymbolicPath from to -> [u]
gmapQ :: forall u.
(forall d. Data d => d -> u) -> SymbolicPath from to -> [u]
$cgmapQi :: forall from to u.
(Data from, Data to) =>
Int -> (forall d. Data d => d -> u) -> SymbolicPath from to -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SymbolicPath from to -> u
$cgmapM :: forall from to (m :: * -> *).
(Data from, Data to, Monad m) =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
$cgmapMp :: forall from to (m :: * -> *).
(Data from, Data to, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
$cgmapMo :: forall from to (m :: * -> *).
(Data from, Data to, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SymbolicPath from to -> m (SymbolicPath from to)
Data)

instance Binary (SymbolicPath from to)
instance (Typeable from, Typeable to) => Structured (SymbolicPath from to)
instance NFData (SymbolicPath from to) where rnf :: SymbolicPath from to -> ()
rnf = SymbolicPath from to -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Extract underlying 'FilePath'.
--
-- Avoid using this in new code.
getSymbolicPath :: SymbolicPath from to -> FilePath
getSymbolicPath :: forall from to. SymbolicPath from to -> String
getSymbolicPath (SymbolicPath String
p) = String
p

sameDirectory :: (IsDir from, IsDir to) => SymbolicPath from to
sameDirectory :: forall from to. (IsDir from, IsDir to) => SymbolicPath from to
sameDirectory = String -> SymbolicPath from to
forall from to. String -> SymbolicPath from to
SymbolicPath String
"."

-- | Make 'SymbolicPath' without performing any checks.
unsafeMakeSymbolicPath :: FilePath -> SymbolicPath from to
unsafeMakeSymbolicPath :: forall from to. String -> SymbolicPath from to
unsafeMakeSymbolicPath = String -> SymbolicPath from to
forall from to. String -> SymbolicPath from to
SymbolicPath

-------------------------------------------------------------------------------

-- ** Parsing and pretty printing

-------------------------------------------------------------------------------

instance Parsec (SymbolicPath from to) where
  parsec :: forall (m :: * -> *). CabalParsing m => m (SymbolicPath from to)
parsec = do
    String
token <- m String
forall (m :: * -> *). CabalParsing m => m String
parsecToken
    if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
token
      then String -> m (SymbolicPath from to)
forall a. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected String
"empty FilePath"
      else
        if String -> Bool
isAbsoluteOnAnyPlatform String
token
          then String -> m (SymbolicPath from to)
forall a. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected String
"absolute FilePath"
          else SymbolicPath from to -> m (SymbolicPath from to)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SymbolicPath from to
forall from to. String -> SymbolicPath from to
SymbolicPath String
token) -- TODO: normalise

instance Pretty (SymbolicPath from to) where
  pretty :: SymbolicPath from to -> Doc
pretty = String -> Doc
showFilePath (String -> Doc)
-> (SymbolicPath from to -> String) -> SymbolicPath from to -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath from to -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath

-------------------------------------------------------------------------------

-- * Composition

-------------------------------------------------------------------------------

-- TODO
-- infixr 5 <//>
--
-- -- | Path composition
-- --
-- -- We don't reuse @</>@ name to not clash with "System.FilePath".
-- --
-- (<//>) :: path a b -> path b c -> path a c

-------------------------------------------------------------------------------

-- * Path ends

-------------------------------------------------------------------------------

-- | Class telling that index is for directories.
class IsDir dir

data PackageDir deriving (Typeable)
data SourceDir deriving (Typeable)

data LicenseFile deriving (Typeable)

-- These instances needs to be derived standalone at least on GHC-7.6
deriving instance Data PackageDir
deriving instance Data SourceDir
deriving instance Data LicenseFile

instance IsDir PackageDir
instance IsDir SourceDir