1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3module Distribution.Simple.InstallDirs.Internal
4  ( PathComponent(..)
5  , PathTemplateVariable(..)
6  ) where
7
8import Prelude ()
9import Distribution.Compat.Prelude
10
11data PathComponent =
12       Ordinary FilePath
13     | Variable PathTemplateVariable
14     deriving (Eq, Ord, Generic, Typeable)
15
16instance Binary PathComponent
17instance Structured PathComponent
18
19data PathTemplateVariable =
20       PrefixVar     -- ^ The @$prefix@ path variable
21     | BindirVar     -- ^ The @$bindir@ path variable
22     | LibdirVar     -- ^ The @$libdir@ path variable
23     | LibsubdirVar  -- ^ The @$libsubdir@ path variable
24     | DynlibdirVar  -- ^ The @$dynlibdir@ path variable
25     | DatadirVar    -- ^ The @$datadir@ path variable
26     | DatasubdirVar -- ^ The @$datasubdir@ path variable
27     | DocdirVar     -- ^ The @$docdir@ path variable
28     | HtmldirVar    -- ^ The @$htmldir@ path variable
29     | PkgNameVar    -- ^ The @$pkg@ package name path variable
30     | PkgVerVar     -- ^ The @$version@ package version path variable
31     | PkgIdVar      -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@
32     | LibNameVar    -- ^ The @$libname@ path variable
33     | CompilerVar   -- ^ The compiler name and version, eg @ghc-6.6.1@
34     | OSVar         -- ^ The operating system name, eg @windows@ or @linux@
35     | ArchVar       -- ^ The CPU architecture name, eg @i386@ or @x86_64@
36     | AbiVar        -- ^ The compiler's ABI identifier,
37                     ---  $arch-$os-$compiler-$abitag
38     | AbiTagVar     -- ^ The optional ABI tag for the compiler
39     | ExecutableNameVar -- ^ The executable name; used in shell wrappers
40     | TestSuiteNameVar   -- ^ The name of the test suite being run
41     | TestSuiteResultVar -- ^ The result of the test suite being run, eg
42                          -- @pass@, @fail@, or @error@.
43     | BenchmarkNameVar   -- ^ The name of the benchmark being run
44  deriving (Eq, Ord, Generic, Typeable)
45
46instance Binary PathTemplateVariable
47instance Structured PathTemplateVariable
48
49instance Show PathTemplateVariable where
50  show PrefixVar     = "prefix"
51  show LibNameVar    = "libname"
52  show BindirVar     = "bindir"
53  show LibdirVar     = "libdir"
54  show LibsubdirVar  = "libsubdir"
55  show DynlibdirVar  = "dynlibdir"
56  show DatadirVar    = "datadir"
57  show DatasubdirVar = "datasubdir"
58  show DocdirVar     = "docdir"
59  show HtmldirVar    = "htmldir"
60  show PkgNameVar    = "pkg"
61  show PkgVerVar     = "version"
62  show PkgIdVar      = "pkgid"
63  show CompilerVar   = "compiler"
64  show OSVar         = "os"
65  show ArchVar       = "arch"
66  show AbiTagVar     = "abitag"
67  show AbiVar        = "abi"
68  show ExecutableNameVar = "executablename"
69  show TestSuiteNameVar   = "test-suite"
70  show TestSuiteResultVar = "result"
71  show BenchmarkNameVar   = "benchmark"
72
73instance Read PathTemplateVariable where
74  readsPrec _ s =
75    take 1
76    [ (var, drop (length varStr) s)
77    | (varStr, var) <- vars
78    , varStr `isPrefixOf` s ]
79    -- NB: order matters! Longer strings first
80    where vars = [("prefix",     PrefixVar)
81                 ,("bindir",     BindirVar)
82                 ,("libdir",     LibdirVar)
83                 ,("libsubdir",  LibsubdirVar)
84                 ,("dynlibdir",  DynlibdirVar)
85                 ,("datadir",    DatadirVar)
86                 ,("datasubdir", DatasubdirVar)
87                 ,("docdir",     DocdirVar)
88                 ,("htmldir",    HtmldirVar)
89                 ,("pkgid",      PkgIdVar)
90                 ,("libname",    LibNameVar)
91                 ,("pkgkey",     LibNameVar) -- backwards compatibility
92                 ,("pkg",        PkgNameVar)
93                 ,("version",    PkgVerVar)
94                 ,("compiler",   CompilerVar)
95                 ,("os",         OSVar)
96                 ,("arch",       ArchVar)
97                 ,("abitag",     AbiTagVar)
98                 ,("abi",        AbiVar)
99                 ,("executablename", ExecutableNameVar)
100                 ,("test-suite", TestSuiteNameVar)
101                 ,("result", TestSuiteResultVar)
102                 ,("benchmark", BenchmarkNameVar)]
103
104instance Show PathComponent where
105  show (Ordinary path) = path
106  show (Variable var)  = '$':show var
107  showList = foldr (\x -> (shows x .)) id
108
109instance Read PathComponent where
110  -- for some reason we collapse multiple $ symbols here
111  readsPrec _ = lex0
112    where lex0 [] = []
113          lex0 ('$':'$':s') = lex0 ('$':s')
114          lex0 ('$':s') = case [ (Variable var, s'')
115                               | (var, s'') <- reads s' ] of
116                            [] -> lex1 "$" s'
117                            ok -> ok
118          lex0 s' = lex1 [] s'
119          lex1 ""  ""      = []
120          lex1 acc ""      = [(Ordinary (reverse acc), "")]
121          lex1 acc ('$':'$':s) = lex1 acc ('$':s)
122          lex1 acc ('$':s) = [(Ordinary (reverse acc), '$':s)]
123          lex1 acc (c:s)   = lex1 (c:acc) s
124  readList [] = [([],"")]
125  readList s  = [ (component:components, s'')
126                | (component, s') <- reads s
127                , (components, s'') <- readList s' ]
128