Skip to content

Commit

Permalink
Use tree-diff for config roundtrip tests.
Browse files Browse the repository at this point in the history
  • Loading branch information
23Skidoo committed May 3, 2019
1 parent 7781853 commit c7fe8de
Show file tree
Hide file tree
Showing 11 changed files with 286 additions and 139 deletions.
2 changes: 2 additions & 0 deletions Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -353,6 +353,7 @@ library
Distribution.Simple.Hpc
Distribution.Simple.Install
Distribution.Simple.InstallDirs
Distribution.Simple.InstallDirs.Internal
Distribution.Simple.LocalBuildInfo
Distribution.Simple.PackageIndex
Distribution.Simple.PreProcess
Expand Down Expand Up @@ -457,6 +458,7 @@ library
Distribution.Utils.ShortText
Distribution.Utils.Progress
Distribution.Verbosity
Distribution.Verbosity.Internal
Distribution.Version
Language.Haskell.Extension
Distribution.Compat.Binary
Expand Down
116 changes: 1 addition & 115 deletions Cabal/Distribution/Simple/InstallDirs.hs
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@ import Distribution.Pretty
import Distribution.Package
import Distribution.System
import Distribution.Compiler
import Distribution.Simple.InstallDirs.Internal

import System.Directory (getAppUserDataDirectory)
import System.FilePath
Expand Down Expand Up @@ -355,41 +356,6 @@ newtype PathTemplate = PathTemplate [PathComponent]

instance Binary PathTemplate

data PathComponent =
Ordinary FilePath
| Variable PathTemplateVariable
deriving (Eq, Ord, Generic)

instance Binary PathComponent

data PathTemplateVariable =
PrefixVar -- ^ The @$prefix@ path variable
| BindirVar -- ^ The @$bindir@ path variable
| LibdirVar -- ^ The @$libdir@ path variable
| LibsubdirVar -- ^ The @$libsubdir@ path variable
| DynlibdirVar -- ^ The @$dynlibdir@ path variable
| DatadirVar -- ^ The @$datadir@ path variable
| DatasubdirVar -- ^ The @$datasubdir@ path variable
| DocdirVar -- ^ The @$docdir@ path variable
| HtmldirVar -- ^ The @$htmldir@ path variable
| PkgNameVar -- ^ The @$pkg@ package name path variable
| PkgVerVar -- ^ The @$version@ package version path variable
| PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@
| LibNameVar -- ^ The @$libname@ path variable
| CompilerVar -- ^ The compiler name and version, eg @ghc-6.6.1@
| OSVar -- ^ The operating system name, eg @windows@ or @linux@
| ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@
| AbiVar -- ^ The Compiler's ABI identifier, $arch-$os-$compiler-$abitag
| AbiTagVar -- ^ The optional ABI tag for the compiler
| ExecutableNameVar -- ^ The executable name; used in shell wrappers
| TestSuiteNameVar -- ^ The name of the test suite being run
| TestSuiteResultVar -- ^ The result of the test suite being run, eg
-- @pass@, @fail@, or @error@.
| BenchmarkNameVar -- ^ The name of the benchmark being run
deriving (Eq, Ord, Generic)

instance Binary PathTemplateVariable

type PathTemplateEnv = [(PathTemplateVariable, PathTemplate)]

-- | Convert a 'FilePath' to a 'PathTemplate' including any template vars.
Expand Down Expand Up @@ -485,86 +451,6 @@ installDirsTemplateEnv dirs =
-- spans which are either strings or variables, eg:
-- PathTemplate [Variable PrefixVar, Ordinary "/bin" ]

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 ]
-- NB: order matters! Longer strings first
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) -- backwards compatibility
,("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
-- for some reason we collapse multiple $ symbols here
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' ]

instance Show PathTemplate where
show (PathTemplate template) = show (show template)

Expand Down
124 changes: 124 additions & 0 deletions Cabal/Distribution/Simple/InstallDirs/Internal.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,124 @@
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Simple.InstallDirs.Internal
( PathComponent(..)
, PathTemplateVariable(..)
) where

import Prelude ()
import Distribution.Compat.Prelude

data PathComponent =
Ordinary FilePath
| Variable PathTemplateVariable
deriving (Eq, Ord, Generic)

instance Binary PathComponent

data PathTemplateVariable =
PrefixVar -- ^ The @$prefix@ path variable
| BindirVar -- ^ The @$bindir@ path variable
| LibdirVar -- ^ The @$libdir@ path variable
| LibsubdirVar -- ^ The @$libsubdir@ path variable
| DynlibdirVar -- ^ The @$dynlibdir@ path variable
| DatadirVar -- ^ The @$datadir@ path variable
| DatasubdirVar -- ^ The @$datasubdir@ path variable
| DocdirVar -- ^ The @$docdir@ path variable
| HtmldirVar -- ^ The @$htmldir@ path variable
| PkgNameVar -- ^ The @$pkg@ package name path variable
| PkgVerVar -- ^ The @$version@ package version path variable
| PkgIdVar -- ^ The @$pkgid@ package Id path variable, eg @foo-1.0@
| LibNameVar -- ^ The @$libname@ path variable
| CompilerVar -- ^ The compiler name and version, eg @ghc-6.6.1@
| OSVar -- ^ The operating system name, eg @windows@ or @linux@
| ArchVar -- ^ The CPU architecture name, eg @i386@ or @x86_64@
| AbiVar -- ^ The compiler's ABI identifier,
--- $arch-$os-$compiler-$abitag
| AbiTagVar -- ^ The optional ABI tag for the compiler
| ExecutableNameVar -- ^ The executable name; used in shell wrappers
| TestSuiteNameVar -- ^ The name of the test suite being run
| TestSuiteResultVar -- ^ The result of the test suite being run, eg
-- @pass@, @fail@, or @error@.
| BenchmarkNameVar -- ^ The name of the benchmark being run
deriving (Eq, Ord, Generic)

instance Binary 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 ]
-- NB: order matters! Longer strings first
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) -- backwards compatibility
,("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
-- for some reason we collapse multiple $ symbols here
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' ]
3 changes: 2 additions & 1 deletion Cabal/Distribution/Utils/NubList.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Utils.NubList
( NubList -- opaque
, toNubList -- smart construtor
Expand All @@ -21,7 +22,7 @@ import qualified Text.Read as R
-- | NubList : A de-duplicated list that maintains the original order.
newtype NubList a =
NubList { fromNubList :: [a] }
deriving (Eq, Typeable)
deriving (Eq, Generic, Typeable)

-- NubList assumes that nub retains the list order while removing duplicate
-- elements (keeping the first occurence). Documentation for "Data.List.nub"
Expand Down
16 changes: 1 addition & 15 deletions Cabal/Distribution/Verbosity.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ import Distribution.ReadE
import Data.List (elemIndex)
import Data.Set (Set)
import Distribution.Parsec
import Distribution.Verbosity.Internal

import qualified Data.Set as Set
import qualified Distribution.Compat.CharParsing as P
Expand Down Expand Up @@ -86,11 +87,6 @@ instance Bounded Verbosity where

instance Binary Verbosity

data VerbosityLevel = Silent | Normal | Verbose | Deafening
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)

instance Binary VerbosityLevel

-- We shouldn't print /anything/ unless an error occurs in silent mode
silent :: Verbosity
silent = mkVerbosity Silent
Expand Down Expand Up @@ -221,16 +217,6 @@ showForGHC v = maybe (error "unknown verbosity") show $
elemIndex v [silent,normal,__,verbose,deafening]
where __ = silent -- this will be always ignored by elemIndex

data VerbosityFlag
= VCallStack
| VCallSite
| VNoWrap
| VMarkOutput
| VTimestamp
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)

instance Binary VerbosityFlag

-- | Turn on verbose call-site printing when we log.
verboseCallSite :: Verbosity -> Verbosity
verboseCallSite = verboseFlag VCallSite
Expand Down
23 changes: 23 additions & 0 deletions Cabal/Distribution/Verbosity/Internal.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,23 @@
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Verbosity.Internal
( VerbosityLevel(..)
, VerbosityFlag(..)
) where

import Prelude ()
import Distribution.Compat.Prelude

data VerbosityLevel = Silent | Normal | Verbose | Deafening
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)

instance Binary VerbosityLevel

data VerbosityFlag
= VCallStack
| VCallSite
| VNoWrap
| VMarkOutput
| VTimestamp
deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)

instance Binary VerbosityFlag
2 changes: 1 addition & 1 deletion cabal-install/Distribution/Client/IndexUtils/Timestamp.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ import GHC.Generics (Generic)

-- | UNIX timestamp (expressed in seconds since unix epoch, i.e. 1970).
newtype Timestamp = TS Int64 -- Tar.EpochTime
deriving (Eq,Ord,Enum,NFData,Show)
deriving (Eq,Ord,Enum,NFData,Show,Generic)

epochTimeToTimestamp :: Tar.EpochTime -> Maybe Timestamp
epochTimeToTimestamp et
Expand Down
Loading

0 comments on commit c7fe8de

Please sign in to comment.