Path.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
module Distribution.Utils.Path (
    -- * Symbolic path
    SymbolicPath,
    getSymbolicPath,
    sameDirectory,
    unsafeMakeSymbolicPath,
    -- * Path ends
    PackageDir,
    SourceDir,
    LicenseFile,
    IsDir,
) where

import Prelude ()
import Distribution.Compat.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 (Generic, Show, Read, Eq, Typeable, Data)

instance Binary (SymbolicPath from to)
instance (Typeable from, Typeable to) => Structured (SymbolicPath from to)
instance NFData (SymbolicPath from to) where rnf = genericRnf

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

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

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

-------------------------------------------------------------------------------
-- ** Parsing and pretty printing
-------------------------------------------------------------------------------

instance Parsec (SymbolicPath from to) where
    parsec = do
        token <- parsecToken
        if null token then P.unexpected "empty FilePath"
        else if isAbsoluteOnAnyPlatform token then P.unexpected "absolute FilePath"
        else return (SymbolicPath token) -- TODO: normalise

instance Pretty (SymbolicPath from to) where
    pretty = showFilePath . 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