{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Distribution.Utils.Path
  ( -- * Symbolic path endpoints
    FileOrDir (..)
  , AllowAbsolute (..)

    -- ** Abstract directory locations
  , CWD
  , Pkg
  , Dist
  , Source
  , Include
  , Lib
  , Framework
  , Build
  , Artifacts
  , PkgDB
  , DataDir
  , Mix
  , Tix
  , Tmp
  , Response

    -- * Symbolic paths
  , RelativePath
  , SymbolicPath
  , SymbolicPathX -- NB: constructor not exposed, to retain type safety.

    -- ** Symbolic path API
  , getSymbolicPath
  , sameDirectory
  , makeRelativePathEx
  , makeSymbolicPath
  , unsafeMakeSymbolicPath
  , coerceSymbolicPath
  , unsafeCoerceSymbolicPath
  , relativeSymbolicPath
  , symbolicPathRelative_maybe
  , interpretSymbolicPath

    -- ** General filepath API
  , (</>)
  , (<.>)
  , takeDirectorySymbolicPath
  , dropExtensionsSymbolicPath
  , replaceExtensionSymbolicPath
  , normaliseSymbolicPath

    -- ** Working directory handling
  , interpretSymbolicPathCWD
  , absoluteWorkingDir
  , tryMakeRelativeToWorkingDir

    -- ** Module names
  , moduleNameSymbolicPath
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Data.Coerce

import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
  ( toFilePath
  )
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Utils.Generic (isAbsoluteOnAnyPlatform)

import qualified Distribution.Compat.CharParsing as P

import qualified System.Directory as Directory
import qualified System.FilePath as FilePath

import Data.Kind
  ( Type
  )
import GHC.Stack
  ( HasCallStack
  )

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

-- * SymbolicPath

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

{- Note [Symbolic paths]
~~~~~~~~~~~~~~~~~~~~~~~~
We want functions within the Cabal library to support getting the working
directory from their arguments, rather than retrieving it from the current
directory, which depends on the the state of the current process
(via getCurrentDirectory).

With such a constraint, to ensure correctness we need to know, for each relative
filepath, whether it is relative to the passed in working directory or to the
current working directory. We achieve this with the following API:

  - newtype SymbolicPath from to
  - getSymbolicPath :: SymbolicPath from to -> FilePath
  - interpretSymbolicPath
      :: Maybe (SymbolicPath CWD (Dir from)) -> SymbolicPath from to -> FilePath

Note that, in the type @SymbolicPath from to@, @from@ is the name of a directory,
whereas @to@ is either @Dir toDir@ or @File@. For example, a source directory
typically has the type @SymbolicPath Pkg (Dir Source)@, while a source
file has a type such as @SymbolicPath "Source" File@.

Here, a symbolic path refers to an **uninterpreted** file path, i.e. any
passed in working directory **has not** been taken into account.
Whenever we see a symbolic path, it is a sign we must take into account this
working directory in some way.
Thus, whenever we interact with the file system, we do the following:

  - in a direct interaction (e.g. `doesFileExist`), we interpret the
    path relative to a working directory argument, e.g.

      doCheck :: Maybe (SymbolicPath CWD (Dir from))
              -> SymbolicPath from File
              -> Bool
      doCheck mbWorkDir file = doesFileExist $ interpretSymbolicPath mbWorkDir file

  - when invoking a sub-process (such as GHC), we ensure that the working directory
    of the sub-process is the same as the passed-in working directory, in which
    case we interpret the symbolic paths by using `interpretSymbolicPathCWD`:

      callGhc :: Maybe (SymbolicPath CWD (Dir Pkg))
              -> SymbolicPath (Dir Pkg) File
              -> IO ()
      callGhc mbWorkDir inputFile =
        runProgramInvocation $
          programInvocationCwd mbWorkDir ghcProg [interpretSymbolicPathCWD inputFile]

In practice, we often use:

  -- Interpret a symbolic path with respect to the working directory argument
  -- @'mbWorkDir' :: Maybe (SymbolicPath CWD (Dir Pkg))@.
  i :: SymbolicPath Pkg to -> FilePath
  i = interpretSymbolicPath mbWorkDir

  -- Interpret a symbolic path, provided that the current working directory
  -- is the package directory.
  u :: SymbolicPath Pkg to -> FilePath
  u = interpretSymbolicPathCWD

Note [Symbolic relative paths]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This module defines:

  data kind AllowAbsolute = AllowAbsolute | OnlyRelative
  data kind FileOrDir = File | Dir Symbol

  type SymbolicPathX :: AllowAbsolute -> Symbol -> FileOrDir -> Type
  newtype SymbolicPathX allowAbsolute from to = SymbolicPath FilePath

  type RelativePath = SymbolicPathX 'OnlyRelative
  type SymbolicPath = SymbolicPathX 'AllowAbsolute

A 'SymbolicPath' is thus a symbolic path that is allowed to be absolute, whereas
a 'RelativePath' is a symbolic path that is additionally required to be relative.

This distinction allows us to keep track of which filepaths must be kept
relative.
-}

-- | A type-level symbolic name, to an abstract file or directory
-- (e.g. the Cabal package directory).
data FileOrDir
  = -- | A file (with no further information).
    File
  | -- | The abstract name of a directory or category of directories,
    -- e.g. the package directory or a source directory.
    Dir Type

-- | Is this symbolic path allowed to be absolute, or must it be relative?
data AllowAbsolute
  = -- | The path may be absolute, or it may be relative.
    AllowAbsolute
  | -- | The path must be relative.
    OnlyRelative

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

type role SymbolicPathX nominal nominal nominal

-- | A symbolic relative path, relative to an abstract location specified
-- by the @from@ type parameter.
--
-- They are *symbolic*, which means we cannot perform any 'IO'
-- until we interpret them (using e.g. 'interpretSymbolicPath').
type RelativePath = SymbolicPathX 'OnlyRelative

-- | A symbolic path which is allowed to be absolute.
--
-- They are *symbolic*, which means we cannot perform any 'IO'
-- until we interpret them (using e.g. 'interpretSymbolicPath').
type SymbolicPath = SymbolicPathX 'AllowAbsolute

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

-- | Extract the 'FilePath' underlying a 'SymbolicPath' or 'RelativePath',
-- without interpreting it.
--
-- Use this function e.g. to validate the underlying filepath.
--
-- When interacting with the file system, you should instead use
-- 'interpretSymbolicPath' or 'interpretSymbolicPathCWD'.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
getSymbolicPath :: SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath (SymbolicPath String
p) = String
p

-- | A symbolic path from a directory to itself.
sameDirectory :: SymbolicPathX allowAbsolute from (Dir to)
sameDirectory :: forall (allowAbsolute :: AllowAbsolute) from to.
SymbolicPathX allowAbsolute from ('Dir to)
sameDirectory = String -> SymbolicPathX allowAbsolute from ('Dir to)
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
"."

-- | Make a 'RelativePath', ensuring the path is not absolute,
-- but performing no further checks.
makeRelativePathEx :: HasCallStack => FilePath -> RelativePath from to
makeRelativePathEx :: forall from (to :: FileOrDir).
HasCallStack =>
String -> RelativePath from to
makeRelativePathEx String
fp
  | String -> Bool
isAbsoluteOnAnyPlatform String
fp =
      String -> RelativePath from to
forall a. HasCallStack => String -> a
error (String -> RelativePath from to) -> String -> RelativePath from to
forall a b. (a -> b) -> a -> b
$ String
"Cabal internal error: makeRelativePathEx: absolute path " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp
  | Bool
otherwise =
      String -> RelativePath from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
fp

-- | Make a 'SymbolicPath', which may be relative or absolute.
makeSymbolicPath :: FilePath -> SymbolicPath from to
makeSymbolicPath :: forall from (to :: FileOrDir). String -> SymbolicPath from to
makeSymbolicPath String
fp = String -> SymbolicPathX 'AllowAbsolute from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
fp

-- | Make a 'SymbolicPath' which may be relative or absolute,
-- without performing any checks.
--
-- Avoid using this function in new code.
unsafeMakeSymbolicPath :: FilePath -> SymbolicPathX allowAbs from to
unsafeMakeSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
unsafeMakeSymbolicPath String
fp = String -> SymbolicPathX allowAbs from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
fp

-- | Like 'System.FilePath.takeDirectory', for symbolic paths.
takeDirectorySymbolicPath :: SymbolicPathX allowAbsolute from File -> SymbolicPathX allowAbsolute from (Dir to')
takeDirectorySymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from to'.
SymbolicPathX allowAbsolute from 'File
-> SymbolicPathX allowAbsolute from ('Dir to')
takeDirectorySymbolicPath (SymbolicPath String
fp) = String -> SymbolicPathX allowAbsolute from ('Dir to')
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (ShowS
FilePath.takeDirectory String
fp)

-- | Like 'System.FilePath.dropExtensions', for symbolic paths.
dropExtensionsSymbolicPath :: SymbolicPathX allowAbsolute from File -> SymbolicPathX allowAbsolute from File
dropExtensionsSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from.
SymbolicPathX allowAbsolute from 'File
-> SymbolicPathX allowAbsolute from 'File
dropExtensionsSymbolicPath (SymbolicPath String
fp) = String -> SymbolicPathX allowAbsolute from 'File
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (ShowS
FilePath.dropExtensions String
fp)

-- | Like 'System.FilePath.replaceExtension', for symbolic paths.
replaceExtensionSymbolicPath :: SymbolicPathX allowAbsolute from File -> String -> SymbolicPathX allowAbsolute from File
replaceExtensionSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from.
SymbolicPathX allowAbsolute from 'File
-> String -> SymbolicPathX allowAbsolute from 'File
replaceExtensionSymbolicPath (SymbolicPath String
fp) String
ext = String -> SymbolicPathX allowAbsolute from 'File
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (String -> ShowS
FilePath.replaceExtension String
fp String
ext)

-- | Like 'System.FilePath.normalise', for symbolic paths.
normaliseSymbolicPath :: SymbolicPathX allowAbsolute from to -> SymbolicPathX allowAbsolute from to
normaliseSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to
-> SymbolicPathX allowAbsolute from to
normaliseSymbolicPath (SymbolicPath String
fp) = String -> SymbolicPathX allowAbsolute from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (ShowS
FilePath.normalise String
fp)

-- | Retrieve the relative symbolic path to a Haskell module.
moduleNameSymbolicPath :: ModuleName -> SymbolicPathX allowAbsolute Source File
moduleNameSymbolicPath :: forall (allowAbsolute :: AllowAbsolute).
ModuleName -> SymbolicPathX allowAbsolute Source 'File
moduleNameSymbolicPath ModuleName
modNm = String -> SymbolicPathX allowAbsolute Source 'File
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (String -> SymbolicPathX allowAbsolute Source 'File)
-> String -> SymbolicPathX allowAbsolute Source 'File
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
ModuleName.toFilePath ModuleName
modNm

-- | Interpret a symbolic path with respect to the given directory.
--
-- Use this function before directly interacting with the file system in order
-- to take into account a working directory argument.
--
-- NB: when invoking external programs (such as @GHC@), it is preferable to set
-- the working directory of the process and use 'interpretSymbolicPathCWD'
-- rather than calling this function, as this function will turn relative paths
-- into absolute paths if the working directory is an absolute path.
-- This can degrade error messages, or worse, break the behaviour entirely
-- (because the program might expect certain paths to be relative).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
interpretSymbolicPath :: Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir (SymbolicPath String
p) =
  -- Note that this properly handles an absolute symbolic path,
  -- because if @q@ is absolute, then @p </> q = q@.
  String
-> (SymbolicPath CWD ('Dir Pkg) -> String)
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
p ((String -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> String
p) ShowS
-> (SymbolicPath CWD ('Dir Pkg) -> String)
-> SymbolicPath CWD ('Dir Pkg)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath CWD ('Dir Pkg) -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath) Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir

-- | Interpret a symbolic path, **under the assumption that the working
-- directory is the package directory**.
--
-- Use 'interpretSymbolicPath' instead if you need to take into account a
-- working directory argument before directly interacting with the file system.
--
-- Use this function instead of 'interpretSymbolicPath' when invoking a child
-- process: set the working directory of the sub-process, and use this function,
-- e.g.:
--
-- > callGhc :: Maybe (SymbolicPath CWD (Dir Pkg))
-- >         -> SymbolicPath (Dir Pkg) File
-- >         -> IO ()
-- > callGhc mbWorkDir inputFile =
-- >   runProgramInvocation $
-- >     programInvocationCwd mbWorkDir ghcProg [interpretSymbolicPathCWD inputFile]
--
-- In this example, 'programInvocationCwd' sets the working directory, so it is
-- appropriate to use 'interpretSymbolicPathCWD' to provide its arguments.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
interpretSymbolicPathCWD :: SymbolicPathX allowAbsolute Pkg to -> FilePath
interpretSymbolicPathCWD :: forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
SymbolicPathX allowAbsolute Pkg to -> String
interpretSymbolicPathCWD (SymbolicPath String
p) = String
p

-- | Change what a symbolic path is pointing to.
coerceSymbolicPath :: SymbolicPathX allowAbsolute from to1 -> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from (to1 :: FileOrDir)
       (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
coerceSymbolicPath = SymbolicPathX allowAbsolute from to1
-> SymbolicPathX allowAbsolute from to2
forall a b. Coercible a b => a -> b
coerce

-- | Change both what a symbolic path is pointing from and pointing to.
--
-- Avoid using this in new code.
unsafeCoerceSymbolicPath :: SymbolicPathX allowAbsolute from1 to1 -> SymbolicPathX allowAbsolute from2 to2
unsafeCoerceSymbolicPath :: forall (allowAbsolute :: AllowAbsolute) from1 (to1 :: FileOrDir)
       from2 (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from1 to1
-> SymbolicPathX allowAbsolute from2 to2
unsafeCoerceSymbolicPath = SymbolicPathX allowAbsolute from1 to1
-> SymbolicPathX allowAbsolute from2 to2
forall a b. Coercible a b => a -> b
coerce

-- | Weakening: convert a relative symbolic path to a symbolic path,
-- \"forgetting\" that it is relative.
relativeSymbolicPath :: RelativePath from to -> SymbolicPath from to
relativeSymbolicPath :: forall from (to :: FileOrDir).
RelativePath from to -> SymbolicPath from to
relativeSymbolicPath (SymbolicPath String
fp) = String -> SymbolicPathX 'AllowAbsolute from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
fp

-- | Is this symbolic path a relative symbolic path?
symbolicPathRelative_maybe :: SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe :: forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe (SymbolicPath String
fp) =
  if String -> Bool
isAbsoluteOnAnyPlatform String
fp
    then Maybe (RelativePath from to)
forall a. Maybe a
Nothing
    else RelativePath from to -> Maybe (RelativePath from to)
forall a. a -> Maybe a
Just (RelativePath from to -> Maybe (RelativePath from to))
-> RelativePath from to -> Maybe (RelativePath from to)
forall a b. (a -> b) -> a -> b
$ String -> RelativePath from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
fp

-- | Absolute path to the current working directory.
absoluteWorkingDir :: Maybe (SymbolicPath CWD to) -> IO FilePath
absoluteWorkingDir :: forall (to :: FileOrDir). Maybe (SymbolicPath CWD to) -> IO String
absoluteWorkingDir Maybe (SymbolicPath CWD to)
Nothing = IO String
Directory.getCurrentDirectory
absoluteWorkingDir (Just SymbolicPath CWD to
wd) = String -> IO String
Directory.makeAbsolute (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ SymbolicPath CWD to -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath SymbolicPath CWD to
wd

-- | Try to make a path relative to the current working directory.
--
-- NB: this function may fail to make the path relative.
tryMakeRelativeToWorkingDir :: Maybe (SymbolicPath CWD (Dir dir)) -> SymbolicPath dir to -> IO (SymbolicPath dir to)
tryMakeRelativeToWorkingDir :: forall dir (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir dir))
-> SymbolicPath dir to -> IO (SymbolicPath dir to)
tryMakeRelativeToWorkingDir Maybe (SymbolicPath CWD ('Dir dir))
mbWorkDir (SymbolicPath String
fp) = do
  String
wd <- Maybe (SymbolicPath CWD ('Dir dir)) -> IO String
forall (to :: FileOrDir). Maybe (SymbolicPath CWD to) -> IO String
absoluteWorkingDir Maybe (SymbolicPath CWD ('Dir dir))
mbWorkDir
  SymbolicPathX 'AllowAbsolute dir to
-> IO (SymbolicPathX 'AllowAbsolute dir to)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SymbolicPathX 'AllowAbsolute dir to
 -> IO (SymbolicPathX 'AllowAbsolute dir to))
-> SymbolicPathX 'AllowAbsolute dir to
-> IO (SymbolicPathX 'AllowAbsolute dir to)
forall a b. (a -> b) -> a -> b
$ String -> SymbolicPathX 'AllowAbsolute dir to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (String -> ShowS
FilePath.makeRelative String
wd String
fp)

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

-- ** Parsing and pretty printing

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

instance Parsec (SymbolicPathX 'OnlyRelative from to) where
  parsec :: forall (m :: * -> *).
CabalParsing m =>
m (SymbolicPathX 'OnlyRelative 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 (SymbolicPathX 'OnlyRelative 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 (SymbolicPathX 'OnlyRelative from to)
forall a. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected String
"absolute FilePath"
          else SymbolicPathX 'OnlyRelative from to
-> m (SymbolicPathX 'OnlyRelative from to)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SymbolicPathX 'OnlyRelative from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
token)

instance Parsec (SymbolicPathX 'AllowAbsolute from to) where
  parsec :: forall (m :: * -> *).
CabalParsing m =>
m (SymbolicPathX 'AllowAbsolute 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 (SymbolicPathX 'AllowAbsolute from to)
forall a. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected String
"empty FilePath"
      else SymbolicPathX 'AllowAbsolute from to
-> m (SymbolicPathX 'AllowAbsolute from to)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> SymbolicPathX 'AllowAbsolute from to
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath String
token)

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

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

-- * Composition

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

infixr 7 <.>

-- | Types that support 'System.FilePath.<.>'.
class FileLike p where
  -- | Like 'System.FilePath.<.>', but also supporting symbolic paths.
  (<.>) :: p -> String -> p

instance FileLike FilePath where
  <.> :: String -> ShowS
(<.>) = String -> ShowS
(FilePath.<.>)

instance p ~ File => FileLike (SymbolicPathX allowAbsolute dir p) where
  SymbolicPath String
p <.> :: SymbolicPathX allowAbsolute dir p
-> String -> SymbolicPathX allowAbsolute dir p
<.> String
ext = String -> SymbolicPathX allowAbsolute dir p
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (String
p String -> ShowS
forall p. FileLike p => p -> String -> p
<.> String
ext)

infixr 5 </>

-- | Types that support 'System.FilePath.</>'.
class PathLike p q r | q r -> p, p r -> q, p q -> r where
  -- | Like 'System.FilePath.</>', but also supporting symbolic paths.
  (</>) :: p -> q -> r

instance PathLike FilePath FilePath FilePath where
  </> :: String -> ShowS
(</>) = String -> ShowS
(FilePath.</>)

-- | This instance ensures we don't accidentally discard a symbolic path
-- in a 'System.FilePath.</>' operation due to the second path being absolute.
--
-- (Recall that @a </> b = b@ whenever @b@ is absolute.)
instance
  (b1 ~ 'Dir b2, a3 ~ a1, c2 ~ c3, midAbsolute ~ OnlyRelative)
  => PathLike
      (SymbolicPathX allowAbsolute a1 b1)
      (SymbolicPathX midAbsolute b2 c2)
      (SymbolicPathX allowAbsolute a3 c3)
  where
  SymbolicPath String
p1 </> :: SymbolicPathX allowAbsolute a1 b1
-> SymbolicPathX midAbsolute b2 c2
-> SymbolicPathX allowAbsolute a3 c3
</> SymbolicPath String
p2 = String -> SymbolicPathX allowAbsolute a3 c3
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
String -> SymbolicPathX allowAbsolute from to
SymbolicPath (String
p1 String -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> String
p2)

--------------------------------------------------------------------------------
-- Abstract directory locations.

-- | Abstract directory: current working directory.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data CWD

-- | Abstract directory: package directory (e.g. a directory containing the @.cabal@ file).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Pkg

-- | Abstract directory: dist directory (e.g. @dist-newstyle@).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Dist

-- | Abstract directory: source directory (a search directory for source files).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Source

-- | Abstract directory: include directory (a search directory for CPP includes like header files, e.g. with @ghc -I@).
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Include

-- | Abstract directory: search directory for extra libraries.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Lib

-- | Abstract directory: MacOS framework directory.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Framework

-- | Abstract directory: build directory.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Build

-- | Abstract directory: directory for build artifacts, such as documentation or @.hie@ files.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Artifacts

-- | Abstract directory: package database directory.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data PkgDB

-- | Abstract directory: data files directory.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data DataDir

-- | Abstract directory: directory for HPC @.mix@ files.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Mix

-- | Abstract directory: directory for HPC @.tix@ files.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Tix

-- | Abstract directory: a temporary directory.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Tmp

-- | Abstract directory: directory for response files.
--
-- See Note [Symbolic paths] in Distribution.Utils.Path.
data Response