{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Simple.InstallDirs.Internal
  ( PathComponent (..)
  , PathTemplateVariable (..)
  ) where

import Distribution.Compat.Prelude
import Prelude ()

data PathComponent
  = Ordinary FilePath
  | Variable PathTemplateVariable
  deriving (PathComponent -> PathComponent -> Bool
(PathComponent -> PathComponent -> Bool)
-> (PathComponent -> PathComponent -> Bool) -> Eq PathComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathComponent -> PathComponent -> Bool
== :: PathComponent -> PathComponent -> Bool
$c/= :: PathComponent -> PathComponent -> Bool
/= :: PathComponent -> PathComponent -> Bool
Eq, Eq PathComponent
Eq PathComponent =>
(PathComponent -> PathComponent -> Ordering)
-> (PathComponent -> PathComponent -> Bool)
-> (PathComponent -> PathComponent -> Bool)
-> (PathComponent -> PathComponent -> Bool)
-> (PathComponent -> PathComponent -> Bool)
-> (PathComponent -> PathComponent -> PathComponent)
-> (PathComponent -> PathComponent -> PathComponent)
-> Ord PathComponent
PathComponent -> PathComponent -> Bool
PathComponent -> PathComponent -> Ordering
PathComponent -> PathComponent -> PathComponent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PathComponent -> PathComponent -> Ordering
compare :: PathComponent -> PathComponent -> Ordering
$c< :: PathComponent -> PathComponent -> Bool
< :: PathComponent -> PathComponent -> Bool
$c<= :: PathComponent -> PathComponent -> Bool
<= :: PathComponent -> PathComponent -> Bool
$c> :: PathComponent -> PathComponent -> Bool
> :: PathComponent -> PathComponent -> Bool
$c>= :: PathComponent -> PathComponent -> Bool
>= :: PathComponent -> PathComponent -> Bool
$cmax :: PathComponent -> PathComponent -> PathComponent
max :: PathComponent -> PathComponent -> PathComponent
$cmin :: PathComponent -> PathComponent -> PathComponent
min :: PathComponent -> PathComponent -> PathComponent
Ord, (forall x. PathComponent -> Rep PathComponent x)
-> (forall x. Rep PathComponent x -> PathComponent)
-> Generic PathComponent
forall x. Rep PathComponent x -> PathComponent
forall x. PathComponent -> Rep PathComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathComponent -> Rep PathComponent x
from :: forall x. PathComponent -> Rep PathComponent x
$cto :: forall x. Rep PathComponent x -> PathComponent
to :: forall x. Rep PathComponent x -> PathComponent
Generic, Typeable)

instance Binary PathComponent
instance Structured PathComponent

data PathTemplateVariable
  = -- | The @$prefix@ path variable
    PrefixVar
  | -- | The @$bindir@ path variable
    BindirVar
  | -- | The @$libdir@ path variable
    LibdirVar
  | -- | The @$libsubdir@ path variable
    LibsubdirVar
  | -- | The @$dynlibdir@ path variable
    DynlibdirVar
  | -- | The @$datadir@ path variable
    DatadirVar
  | -- | The @$datasubdir@ path variable
    DatasubdirVar
  | -- | The @$docdir@ path variable
    DocdirVar
  | -- | The @$htmldir@ path variable
    HtmldirVar
  | -- | The @$pkg@ package name path variable
    PkgNameVar
  | -- | The @$version@ package version path variable
    PkgVerVar
  | -- | The @$pkgid@ package Id path variable, eg @foo-1.0@
    PkgIdVar
  | -- | The @$libname@ path variable
    LibNameVar
  | -- | The compiler name and version, eg @ghc-6.6.1@
    CompilerVar
  | -- | The operating system name, eg @windows@ or @linux@
    OSVar
  | -- | The CPU architecture name, eg @i386@ or @x86_64@
    ArchVar
  | -- | The compiler's ABI identifier,
    AbiVar
  | ---  $arch-$os-$compiler-$abitag

    -- | The optional ABI tag for the compiler
    AbiTagVar
  | -- | The executable name; used in shell wrappers
    ExecutableNameVar
  | -- | The name of the test suite being run
    TestSuiteNameVar
  | -- | The result of the test suite being run, eg
    -- @pass@, @fail@, or @error@.
    TestSuiteResultVar
  | -- | The name of the benchmark being run
    BenchmarkNameVar
  deriving (PathTemplateVariable -> PathTemplateVariable -> Bool
(PathTemplateVariable -> PathTemplateVariable -> Bool)
-> (PathTemplateVariable -> PathTemplateVariable -> Bool)
-> Eq PathTemplateVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathTemplateVariable -> PathTemplateVariable -> Bool
== :: PathTemplateVariable -> PathTemplateVariable -> Bool
$c/= :: PathTemplateVariable -> PathTemplateVariable -> Bool
/= :: PathTemplateVariable -> PathTemplateVariable -> Bool
Eq, Eq PathTemplateVariable
Eq PathTemplateVariable =>
(PathTemplateVariable -> PathTemplateVariable -> Ordering)
-> (PathTemplateVariable -> PathTemplateVariable -> Bool)
-> (PathTemplateVariable -> PathTemplateVariable -> Bool)
-> (PathTemplateVariable -> PathTemplateVariable -> Bool)
-> (PathTemplateVariable -> PathTemplateVariable -> Bool)
-> (PathTemplateVariable
    -> PathTemplateVariable -> PathTemplateVariable)
-> (PathTemplateVariable
    -> PathTemplateVariable -> PathTemplateVariable)
-> Ord PathTemplateVariable
PathTemplateVariable -> PathTemplateVariable -> Bool
PathTemplateVariable -> PathTemplateVariable -> Ordering
PathTemplateVariable
-> PathTemplateVariable -> PathTemplateVariable
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PathTemplateVariable -> PathTemplateVariable -> Ordering
compare :: PathTemplateVariable -> PathTemplateVariable -> Ordering
$c< :: PathTemplateVariable -> PathTemplateVariable -> Bool
< :: PathTemplateVariable -> PathTemplateVariable -> Bool
$c<= :: PathTemplateVariable -> PathTemplateVariable -> Bool
<= :: PathTemplateVariable -> PathTemplateVariable -> Bool
$c> :: PathTemplateVariable -> PathTemplateVariable -> Bool
> :: PathTemplateVariable -> PathTemplateVariable -> Bool
$c>= :: PathTemplateVariable -> PathTemplateVariable -> Bool
>= :: PathTemplateVariable -> PathTemplateVariable -> Bool
$cmax :: PathTemplateVariable
-> PathTemplateVariable -> PathTemplateVariable
max :: PathTemplateVariable
-> PathTemplateVariable -> PathTemplateVariable
$cmin :: PathTemplateVariable
-> PathTemplateVariable -> PathTemplateVariable
min :: PathTemplateVariable
-> PathTemplateVariable -> PathTemplateVariable
Ord, (forall x. PathTemplateVariable -> Rep PathTemplateVariable x)
-> (forall x. Rep PathTemplateVariable x -> PathTemplateVariable)
-> Generic PathTemplateVariable
forall x. Rep PathTemplateVariable x -> PathTemplateVariable
forall x. PathTemplateVariable -> Rep PathTemplateVariable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathTemplateVariable -> Rep PathTemplateVariable x
from :: forall x. PathTemplateVariable -> Rep PathTemplateVariable x
$cto :: forall x. Rep PathTemplateVariable x -> PathTemplateVariable
to :: forall x. Rep PathTemplateVariable x -> PathTemplateVariable
Generic, Typeable)

instance Binary PathTemplateVariable
instance Structured PathTemplateVariable

instance Show PathTemplateVariable where
  show :: PathTemplateVariable -> FilePath
show PathTemplateVariable
PrefixVar = FilePath
"prefix"
  show PathTemplateVariable
LibNameVar = FilePath
"libname"
  show PathTemplateVariable
BindirVar = FilePath
"bindir"
  show PathTemplateVariable
LibdirVar = FilePath
"libdir"
  show PathTemplateVariable
LibsubdirVar = FilePath
"libsubdir"
  show PathTemplateVariable
DynlibdirVar = FilePath
"dynlibdir"
  show PathTemplateVariable
DatadirVar = FilePath
"datadir"
  show PathTemplateVariable
DatasubdirVar = FilePath
"datasubdir"
  show PathTemplateVariable
DocdirVar = FilePath
"docdir"
  show PathTemplateVariable
HtmldirVar = FilePath
"htmldir"
  show PathTemplateVariable
PkgNameVar = FilePath
"pkg"
  show PathTemplateVariable
PkgVerVar = FilePath
"version"
  show PathTemplateVariable
PkgIdVar = FilePath
"pkgid"
  show PathTemplateVariable
CompilerVar = FilePath
"compiler"
  show PathTemplateVariable
OSVar = FilePath
"os"
  show PathTemplateVariable
ArchVar = FilePath
"arch"
  show PathTemplateVariable
AbiTagVar = FilePath
"abitag"
  show PathTemplateVariable
AbiVar = FilePath
"abi"
  show PathTemplateVariable
ExecutableNameVar = FilePath
"executablename"
  show PathTemplateVariable
TestSuiteNameVar = FilePath
"test-suite"
  show PathTemplateVariable
TestSuiteResultVar = FilePath
"result"
  show PathTemplateVariable
BenchmarkNameVar = FilePath
"benchmark"

instance Read PathTemplateVariable where
  readsPrec :: Int -> ReadS PathTemplateVariable
readsPrec Int
_ FilePath
s =
    Int
-> [(PathTemplateVariable, FilePath)]
-> [(PathTemplateVariable, FilePath)]
forall a. Int -> [a] -> [a]
take
      Int
1
      [ (PathTemplateVariable
var, Int -> ShowS
forall a. Int -> [a] -> [a]
drop (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
varStr) FilePath
s)
      | (FilePath
varStr, PathTemplateVariable
var) <- [(FilePath, PathTemplateVariable)]
vars
      , FilePath
varStr FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
s
      ]
    where
      -- NB: order matters! Longer strings first
      vars :: [(FilePath, PathTemplateVariable)]
vars =
        [ (FilePath
"prefix", PathTemplateVariable
PrefixVar)
        , (FilePath
"bindir", PathTemplateVariable
BindirVar)
        , (FilePath
"libdir", PathTemplateVariable
LibdirVar)
        , (FilePath
"libsubdir", PathTemplateVariable
LibsubdirVar)
        , (FilePath
"dynlibdir", PathTemplateVariable
DynlibdirVar)
        , (FilePath
"datadir", PathTemplateVariable
DatadirVar)
        , (FilePath
"datasubdir", PathTemplateVariable
DatasubdirVar)
        , (FilePath
"docdir", PathTemplateVariable
DocdirVar)
        , (FilePath
"htmldir", PathTemplateVariable
HtmldirVar)
        , (FilePath
"pkgid", PathTemplateVariable
PkgIdVar)
        , (FilePath
"libname", PathTemplateVariable
LibNameVar)
        , (FilePath
"pkgkey", PathTemplateVariable
LibNameVar) -- backwards compatibility
        , (FilePath
"pkg", PathTemplateVariable
PkgNameVar)
        , (FilePath
"version", PathTemplateVariable
PkgVerVar)
        , (FilePath
"compiler", PathTemplateVariable
CompilerVar)
        , (FilePath
"os", PathTemplateVariable
OSVar)
        , (FilePath
"arch", PathTemplateVariable
ArchVar)
        , (FilePath
"abitag", PathTemplateVariable
AbiTagVar)
        , (FilePath
"abi", PathTemplateVariable
AbiVar)
        , (FilePath
"executablename", PathTemplateVariable
ExecutableNameVar)
        , (FilePath
"test-suite", PathTemplateVariable
TestSuiteNameVar)
        , (FilePath
"result", PathTemplateVariable
TestSuiteResultVar)
        , (FilePath
"benchmark", PathTemplateVariable
BenchmarkNameVar)
        ]

instance Show PathComponent where
  show :: PathComponent -> FilePath
show (Ordinary FilePath
path) = FilePath
path
  show (Variable PathTemplateVariable
var) = Char
'$' Char -> ShowS
forall a. a -> [a] -> [a]
: PathTemplateVariable -> FilePath
forall a. Show a => a -> FilePath
show PathTemplateVariable
var
  showList :: [PathComponent] -> ShowS
showList = (PathComponent -> ShowS -> ShowS)
-> ShowS -> [PathComponent] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\PathComponent
x -> (PathComponent -> ShowS
forall a. Show a => a -> ShowS
shows PathComponent
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)) ShowS
forall a. a -> a
id

instance Read PathComponent where
  -- for some reason we collapse multiple $ symbols here
  readsPrec :: Int -> ReadS PathComponent
readsPrec Int
_ = ReadS PathComponent
lex0
    where
      lex0 :: ReadS PathComponent
lex0 [] = []
      lex0 (Char
'$' : Char
'$' : FilePath
s') = ReadS PathComponent
lex0 (Char
'$' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
s')
      lex0 (Char
'$' : FilePath
s') = case [ (PathTemplateVariable -> PathComponent
Variable PathTemplateVariable
var, FilePath
s'')
                             | (PathTemplateVariable
var, FilePath
s'') <- ReadS PathTemplateVariable
forall a. Read a => ReadS a
reads FilePath
s'
                             ] of
        [] -> FilePath -> ReadS PathComponent
lex1 FilePath
"$" FilePath
s'
        [(PathComponent, FilePath)]
ok -> [(PathComponent, FilePath)]
ok
      lex0 FilePath
s' = FilePath -> ReadS PathComponent
lex1 [] FilePath
s'
      lex1 :: FilePath -> ReadS PathComponent
lex1 FilePath
"" FilePath
"" = []
      lex1 FilePath
acc FilePath
"" = [(FilePath -> PathComponent
Ordinary (ShowS
forall a. [a] -> [a]
reverse FilePath
acc), FilePath
"")]
      lex1 FilePath
acc (Char
'$' : Char
'$' : FilePath
s) = FilePath -> ReadS PathComponent
lex1 FilePath
acc (Char
'$' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
s)
      lex1 FilePath
acc (Char
'$' : FilePath
s) = [(FilePath -> PathComponent
Ordinary (ShowS
forall a. [a] -> [a]
reverse FilePath
acc), Char
'$' Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
s)]
      lex1 FilePath
acc (Char
c : FilePath
s) = FilePath -> ReadS PathComponent
lex1 (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: FilePath
acc) FilePath
s
  readList :: ReadS [PathComponent]
readList [] = [([], FilePath
"")]
  readList FilePath
s =
    [ (PathComponent
component PathComponent -> [PathComponent] -> [PathComponent]
forall a. a -> [a] -> [a]
: [PathComponent]
components, FilePath
s'')
    | (PathComponent
component, FilePath
s') <- ReadS PathComponent
forall a. Read a => ReadS a
reads FilePath
s
    , ([PathComponent]
components, FilePath
s'') <- ReadS [PathComponent]
forall a. Read a => ReadS [a]
readList FilePath
s'
    ]