1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE DeriveGeneric #-} 3{-# LANGUAGE StandaloneDeriving #-} 4module Distribution.Utils.Path ( 5 -- * Symbolic path 6 SymbolicPath, 7 getSymbolicPath, 8 sameDirectory, 9 unsafeMakeSymbolicPath, 10 -- * Path ends 11 PackageDir, 12 SourceDir, 13 LicenseFile, 14 IsDir, 15) where 16 17import Prelude () 18import Distribution.Compat.Prelude 19 20import Distribution.Parsec 21import Distribution.Pretty 22import Distribution.Utils.Generic (isAbsoluteOnAnyPlatform) 23 24import qualified Distribution.Compat.CharParsing as P 25-- import qualified Text.PrettyPrint as Disp 26 27------------------------------------------------------------------------------- 28-- * SymbolicPath 29------------------------------------------------------------------------------- 30 31-- | Symbolic paths. 32-- 33-- These paths are system independent and relative. 34-- They are *symbolic* which means we cannot perform any 'IO' 35-- until we interpret them. 36-- 37newtype SymbolicPath from to = SymbolicPath FilePath 38 deriving (Generic, Show, Read, Eq, Typeable, Data) 39 40instance Binary (SymbolicPath from to) 41instance (Typeable from, Typeable to) => Structured (SymbolicPath from to) 42instance NFData (SymbolicPath from to) where rnf = genericRnf 43 44-- | Extract underlying 'FilePath'. 45-- 46-- Avoid using this in new code. 47-- 48getSymbolicPath :: SymbolicPath from to -> FilePath 49getSymbolicPath (SymbolicPath p) = p 50 51sameDirectory :: (IsDir from, IsDir to) => SymbolicPath from to 52sameDirectory = SymbolicPath "." 53 54-- | Make 'SymbolicPath' without performing any checks. 55unsafeMakeSymbolicPath :: FilePath -> SymbolicPath from to 56unsafeMakeSymbolicPath = SymbolicPath 57 58------------------------------------------------------------------------------- 59-- ** Parsing and pretty printing 60------------------------------------------------------------------------------- 61 62instance Parsec (SymbolicPath from to) where 63 parsec = do 64 token <- parsecToken 65 if null token then P.unexpected "empty FilePath" 66 else if isAbsoluteOnAnyPlatform token then P.unexpected "absolute FilePath" 67 else return (SymbolicPath token) -- TODO: normalise 68 69instance Pretty (SymbolicPath from to) where 70 pretty = showFilePath . getSymbolicPath 71 72------------------------------------------------------------------------------- 73-- * Composition 74------------------------------------------------------------------------------- 75 76-- TODO 77-- infixr 5 <//> 78-- 79-- -- | Path composition 80-- -- 81-- -- We don't reuse @</>@ name to not clash with "System.FilePath". 82-- -- 83-- (<//>) :: path a b -> path b c -> path a c 84 85------------------------------------------------------------------------------- 86-- * Path ends 87------------------------------------------------------------------------------- 88 89-- | Class telling that index is for directories. 90class IsDir dir 91 92data PackageDir deriving (Typeable) 93data SourceDir deriving (Typeable) 94 95data LicenseFile deriving (Typeable) 96 97-- These instances needs to be derived standalone at least on GHC-7.6 98deriving instance Data PackageDir 99deriving instance Data SourceDir 100deriving instance Data LicenseFile 101 102instance IsDir PackageDir 103instance IsDir SourceDir 104