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