module Distribution.Simple.InstallDirs.Internal
( PathComponent(..)
, PathTemplateVariable(..)
) where
import Prelude ()
import Distribution.Compat.Prelude
data PathComponent =
Ordinary FilePath
| Variable PathTemplateVariable
deriving (Eq, Ord, Generic, Typeable)
instance Binary PathComponent
instance Structured PathComponent
data PathTemplateVariable =
PrefixVar
| BindirVar
| LibdirVar
| LibsubdirVar
| DynlibdirVar
| DatadirVar
| DatasubdirVar
| DocdirVar
| HtmldirVar
| PkgNameVar
| PkgVerVar
| PkgIdVar
| LibNameVar
| CompilerVar
| OSVar
| ArchVar
| AbiVar
| AbiTagVar
| ExecutableNameVar
| TestSuiteNameVar
| TestSuiteResultVar
| BenchmarkNameVar
deriving (Eq, Ord, Generic, Typeable)
instance Binary PathTemplateVariable
instance Structured PathTemplateVariable
instance Show PathTemplateVariable where
show PrefixVar = "prefix"
show LibNameVar = "libname"
show BindirVar = "bindir"
show LibdirVar = "libdir"
show LibsubdirVar = "libsubdir"
show DynlibdirVar = "dynlibdir"
show DatadirVar = "datadir"
show DatasubdirVar = "datasubdir"
show DocdirVar = "docdir"
show HtmldirVar = "htmldir"
show PkgNameVar = "pkg"
show PkgVerVar = "version"
show PkgIdVar = "pkgid"
show CompilerVar = "compiler"
show OSVar = "os"
show ArchVar = "arch"
show AbiTagVar = "abitag"
show AbiVar = "abi"
show ExecutableNameVar = "executablename"
show TestSuiteNameVar = "test-suite"
show TestSuiteResultVar = "result"
show BenchmarkNameVar = "benchmark"
instance Read PathTemplateVariable where
readsPrec _ s =
take 1
[ (var, drop (length varStr) s)
| (varStr, var) <- vars
, varStr `isPrefixOf` s ]
where vars = [("prefix", PrefixVar)
,("bindir", BindirVar)
,("libdir", LibdirVar)
,("libsubdir", LibsubdirVar)
,("dynlibdir", DynlibdirVar)
,("datadir", DatadirVar)
,("datasubdir", DatasubdirVar)
,("docdir", DocdirVar)
,("htmldir", HtmldirVar)
,("pkgid", PkgIdVar)
,("libname", LibNameVar)
,("pkgkey", LibNameVar)
,("pkg", PkgNameVar)
,("version", PkgVerVar)
,("compiler", CompilerVar)
,("os", OSVar)
,("arch", ArchVar)
,("abitag", AbiTagVar)
,("abi", AbiVar)
,("executablename", ExecutableNameVar)
,("test-suite", TestSuiteNameVar)
,("result", TestSuiteResultVar)
,("benchmark", BenchmarkNameVar)]
instance Show PathComponent where
show (Ordinary path) = path
show (Variable var) = '$':show var
showList = foldr (\x -> (shows x .)) id
instance Read PathComponent where
readsPrec _ = lex0
where lex0 [] = []
lex0 ('$':'$':s') = lex0 ('$':s')
lex0 ('$':s') = case [ (Variable var, s'')
| (var, s'') <- reads s' ] of
[] -> lex1 "$" s'
ok -> ok
lex0 s' = lex1 [] s'
lex1 "" "" = []
lex1 acc "" = [(Ordinary (reverse acc), "")]
lex1 acc ('$':'$':s) = lex1 acc ('$':s)
lex1 acc ('$':s) = [(Ordinary (reverse acc), '$':s)]
lex1 acc (c:s) = lex1 (c:acc) s
readList [] = [([],"")]
readList s = [ (component:components, s'')
| (component, s') <- reads s
, (components, s'') <- readList s' ]