Commit bea19f65 authored by Oleg Grenrus's avatar Oleg Grenrus

Use Distribution.Compat.Prelude across Cabal

parent 37d6e068
......@@ -17,6 +17,10 @@ module Distribution.Compat.Binary
#endif
) where
#if __GLASGOW_HASKELL__ < 706
import Prelude hiding (catch)
#endif
import Control.Exception (catch, evaluate)
#if __GLASGOW_HASKELL__ >= 711
import Control.Exception (pattern ErrorCall)
......@@ -25,10 +29,6 @@ import Control.Exception (ErrorCall(..))
#endif
import Data.ByteString.Lazy (ByteString)
#if __GLASGOW_HASKELL__ < 706
import Prelude hiding (catch)
#endif
#if __GLASGOW_HASKELL__ >= 708 || MIN_VERSION_binary(0,7,0)
import Data.Binary
......
......@@ -11,11 +11,12 @@ module Distribution.Compat.CopyFile (
setDirOrdinary,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Compat.Exception
import Distribution.Compat.Internal.TempFile
import Control.Monad
( when, unless )
import Control.Exception
( bracketOnError, throwIO )
import qualified Data.ByteString.Lazy as BSL
......
......@@ -3,6 +3,9 @@ module Distribution.Compat.CreatePipe (createPipe) where
import System.IO (Handle, hSetEncoding, localeEncoding)
import Prelude ()
import Distribution.Compat.Prelude
-- The mingw32_HOST_OS CPP macro is GHC-specific
#if mingw32_HOST_OS
import Control.Exception (onException)
......
......@@ -6,6 +6,9 @@ module Distribution.Compat.Environment
( getEnvironment, lookupEnv, setEnv )
where
import Prelude ()
import Distribution.Compat.Prelude
import qualified System.Environment as System
#if __GLASGOW_HASKELL__ >= 706
import System.Environment (lookupEnv)
......@@ -14,8 +17,6 @@ import Distribution.Compat.Exception (catchIO)
#endif
#ifdef mingw32_HOST_OS
import Control.Monad
import qualified Data.Char as Char (toUpper)
import Foreign.C
import GHC.Windows
#else
......@@ -33,7 +34,7 @@ getEnvironment :: IO [(String, String)]
getEnvironment = fmap upcaseVars System.getEnvironment
where
upcaseVars = map upcaseVar
upcaseVar (var, val) = (map Char.toUpper var, val)
upcaseVar (var, val) = (map toUpper var, val)
#else
getEnvironment = System.getEnvironment
#endif
......
......@@ -12,8 +12,10 @@
module Distribution.Compat.GetShortPathName ( getShortPathName )
where
import Prelude ()
import Distribution.Compat.Prelude
#ifdef mingw32_HOST_OS
import Control.Monad (void)
import qualified System.Win32 as Win32
import System.Win32 (LPCTSTR, LPTSTR, DWORD)
......
......@@ -9,7 +9,7 @@ import Control.Monad.Fail (MonadFail(fail))
-- the following code corresponds to
-- http://hackage.haskell.org/package/fail-4.9.0.0
import qualified Prelude as P
import Prelude hiding (fail)
import Distribution.Compat.Prelude hiding (fail)
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec
......
......@@ -69,11 +69,12 @@ module Distribution.Compat.ReadP
)
where
import Prelude ()
import Distribution.Compat.Prelude hiding (many, get)
import qualified Distribution.Compat.MonadFail as Fail
import Control.Monad( MonadPlus(..), liftM, liftM2, replicateM, ap, (>=>) )
import Data.Char (isSpace)
import Control.Applicative as AP (Applicative(..), Alternative(empty, (<|>)))
import Control.Monad( replicateM, (>=>) )
infixr 5 +++, <++
......@@ -98,7 +99,7 @@ instance Applicative (P s) where
(<*>) = ap
instance Monad (P s) where
return = AP.pure
return = pure
(Get f) >>= k = Get (f >=> k)
(Look f) >>= k = Look (f >=> k)
......@@ -160,7 +161,7 @@ instance Applicative (Parser r s) where
(<*>) = ap
instance Monad (Parser r s) where
return = AP.pure
return = pure
fail = Fail.fail
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
......
......@@ -6,17 +6,17 @@ module Distribution.Compat.Time
, calibrateMtimeChangeDelay )
where
import Control.Arrow ( first )
import Prelude ()
import Distribution.Compat.Prelude
import Data.Int ( Int64 )
import Data.Word ( Word64 )
import System.Directory ( getModificationTime )
import Distribution.Compat.Binary ( Binary )
import Distribution.Simple.Utils ( withTempDirectory )
import Distribution.Verbosity ( silent )
import System.FilePath
import Control.Monad
import Data.Time.Clock.POSIX ( POSIXTime, getPOSIXTime )
import Data.Time ( diffUTCTime, getCurrentTime )
......@@ -179,10 +179,10 @@ getCurTime = posixTimeToModTime `fmap` getPOSIXTime -- Uses 'gettimeofday'.
-- The returned delay is never smaller
-- than 10 ms, but never larger than 1 second.
calibrateMtimeChangeDelay :: IO (Int, Int)
calibrateMtimeChangeDelay = do
calibrateMtimeChangeDelay =
withTempDirectory silent "." "calibration-" $ \dir -> do
let fileName = dir </> "probe"
mtimes <- forM [1..25] $ \(i::Int) -> time $ do
mtimes <- for [1..25] $ \(i::Int) -> time $ do
writeFile fileName $ show i
t0 <- getModTime fileName
let spin j = do
......
......@@ -42,23 +42,17 @@ module Distribution.Compiler (
AbiTag(..), abiTagString
) where
import Distribution.Compat.Binary
import Prelude ()
import Distribution.Compat.Prelude
import Language.Haskell.Extension
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Maybe (fromMaybe)
import Distribution.Version (Version(..))
import GHC.Generics (Generic)
import qualified System.Info (compilerName, compilerVersion)
import Distribution.Text (Text(..), display)
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>))
import qualified Data.Char as Char (toLower, isDigit, isAlphaNum)
import Control.Monad (when)
data CompilerFlavor = GHC | GHCJS | NHC | YHC | Hugs | HBC | Helium | JHC | LHC | UHC
| HaskellSuite String -- string is the id of the actual compiler
......@@ -77,8 +71,8 @@ instance Text CompilerFlavor where
disp other = Disp.text (lowercase (show other))
parse = do
comp <- Parse.munch1 Char.isAlphaNum
when (all Char.isDigit comp) Parse.pfail
comp <- Parse.munch1 isAlphaNum
when (all isDigit comp) Parse.pfail
return (classifyCompilerFlavor comp)
classifyCompilerFlavor :: String -> CompilerFlavor
......@@ -103,8 +97,8 @@ classifyCompilerFlavor s =
--
parseCompilerFlavorCompat :: Parse.ReadP r CompilerFlavor
parseCompilerFlavorCompat = do
comp <- Parse.munch1 Char.isAlphaNum
when (all Char.isDigit comp) Parse.pfail
comp <- Parse.munch1 isAlphaNum
when (all isDigit comp) Parse.pfail
case lookup comp compilerMap of
Just compiler -> return compiler
Nothing -> return (OtherCompiler comp)
......@@ -144,7 +138,7 @@ instance Binary CompilerId
instance Text CompilerId where
disp (CompilerId f (Version [] _)) = disp f
disp (CompilerId f v) = disp f <> Disp.char '-' <> disp v
disp (CompilerId f v) = disp f <<>> Disp.char '-' <<>> disp v
parse = do
flavour <- parse
......@@ -152,7 +146,7 @@ instance Text CompilerId where
return (CompilerId flavour version)
lowercase :: String -> String
lowercase = map Char.toLower
lowercase = map toLower
-- ------------------------------------------------------------
-- * Compiler Info
......@@ -189,7 +183,7 @@ instance Text AbiTag where
disp (AbiTag tag) = Disp.text tag
parse = do
tag <- Parse.munch (\c -> Char.isAlphaNum c || c == '_')
tag <- Parse.munch (\c -> isAlphaNum c || c == '_')
if null tag then return NoAbiTag else return (AbiTag tag)
abiTagString :: AbiTag -> String
......
......@@ -50,8 +50,8 @@ module Distribution.GetOpt (
-- $example
) where
import Data.List ( isPrefixOf, intercalate, find )
import Data.Maybe ( isJust )
import Prelude ()
import Distribution.Compat.Prelude
-- |What to do with options following non-options
data ArgOrder a
......
......@@ -41,6 +41,9 @@ module Distribution.InstalledPackageInfo (
fieldsInstalledPackageInfo,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.ParseUtils
import Distribution.License
import Distribution.Package hiding (installedUnitId, installedPackageId)
......@@ -49,12 +52,9 @@ import Distribution.ModuleName
import Distribution.Version
import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.Binary
import Distribution.Compat.Graph
import Text.PrettyPrint as Disp
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
-- -----------------------------------------------------------------------------
-- The InstalledPackageInfo type
......
......@@ -13,8 +13,8 @@ module Distribution.Lex (
tokenizeQuotedWords
) where
import Data.Char (isSpace)
import Distribution.Compat.Semigroup as Semi
import Prelude ()
import Distribution.Compat.Prelude
newtype DList a = DList ([a] -> [a])
......@@ -26,7 +26,7 @@ singleton a = DList (a:)
instance Monoid (DList a) where
mempty = DList id
mappend = (Semi.<>)
mappend = (<>)
instance Semigroup (DList a) where
DList a <> DList b = DList (a . b)
......
......@@ -47,17 +47,13 @@ module Distribution.License (
knownLicenses,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Version
import Distribution.Text
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.Binary
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>))
import qualified Data.Char as Char (isAlphaNum)
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
-- | Indicates the license under which a package's source code is released.
-- Versions of the licenses not listed here will be rejected by Hackage and
......@@ -141,16 +137,16 @@ knownLicenses = [ GPL unversioned, GPL (version [2]), GPL (version [3])
version v = Just (Version v [])
instance Text License where
disp (GPL version) = Disp.text "GPL" <> dispOptVersion version
disp (LGPL version) = Disp.text "LGPL" <> dispOptVersion version
disp (AGPL version) = Disp.text "AGPL" <> dispOptVersion version
disp (MPL version) = Disp.text "MPL" <> dispVersion version
disp (Apache version) = Disp.text "Apache" <> dispOptVersion version
disp (GPL version) = Disp.text "GPL" <<>> dispOptVersion version
disp (LGPL version) = Disp.text "LGPL" <<>> dispOptVersion version
disp (AGPL version) = Disp.text "AGPL" <<>> dispOptVersion version
disp (MPL version) = Disp.text "MPL" <<>> dispVersion version
disp (Apache version) = Disp.text "Apache" <<>> dispOptVersion version
disp (UnknownLicense other) = Disp.text other
disp other = Disp.text (show other)
parse = do
name <- Parse.munch1 (\c -> Char.isAlphaNum c && c /= '-')
name <- Parse.munch1 (\c -> isAlphaNum c && c /= '-')
version <- Parse.option Nothing (Parse.char '-' >> fmap Just parse)
return $! case (name, version :: Maybe Version) of
("GPL", _ ) -> GPL version
......@@ -174,4 +170,4 @@ dispOptVersion Nothing = Disp.empty
dispOptVersion (Just v) = dispVersion v
dispVersion :: Version -> Disp.Doc
dispVersion v = Disp.char '-' <> disp v
dispVersion v = Disp.char '-' <<>> disp v
......@@ -60,6 +60,9 @@ module Distribution.Make (
defaultMain, defaultMainArgs, defaultMainNoRead
) where
import Prelude ()
import Distribution.Compat.Prelude
-- local
import Distribution.Compat.Exception
import Distribution.Package
......
......@@ -21,21 +21,14 @@ module Distribution.ModuleName (
simple,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Text
import Distribution.Compat.Binary
import qualified Distribution.Compat.ReadP as Parse
import qualified Data.Char as Char
( isAlphaNum, isUpper )
import Control.DeepSeq
import Data.Data (Data)
import Data.Typeable (Typeable)
import qualified Text.PrettyPrint as Disp
import Data.List
( intercalate, intersperse )
import GHC.Generics (Generic)
import System.FilePath
( pathSeparator )
import System.FilePath ( pathSeparator )
-- | A valid Haskell module name.
--
......@@ -57,16 +50,16 @@ instance Text ModuleName where
where
component = do
c <- Parse.satisfy Char.isUpper
c <- Parse.satisfy isUpper
cs <- Parse.munch validModuleChar
return (c:cs)
validModuleChar :: Char -> Bool
validModuleChar c = Char.isAlphaNum c || c == '_' || c == '\''
validModuleChar c = isAlphaNum c || c == '_' || c == '\''
validModuleComponent :: String -> Bool
validModuleComponent [] = False
validModuleComponent (c:cs) = Char.isUpper c
validModuleComponent (c:cs) = isUpper c
&& all validModuleChar cs
{-# DEPRECATED simple "use ModuleName.fromString instead" #-}
......
......@@ -49,6 +49,9 @@ module Distribution.Package (
PackageInstalled(..),
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Version
( Version(..), VersionRange, anyVersion, thisVersion
, notThisVersion, simplifyVersionRange )
......@@ -56,18 +59,10 @@ import Distribution.Version
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Distribution.Compat.ReadP
import Distribution.Compat.Binary
import Distribution.Text
import Distribution.ModuleName
import Control.DeepSeq (NFData(..))
import qualified Data.Char as Char
( isDigit, isAlphaNum, )
import Data.Data ( Data )
import Data.List ( intercalate )
import Data.Typeable ( Typeable )
import GHC.Generics (Generic)
import Text.PrettyPrint ((<>), (<+>), text)
import Text.PrettyPrint ((<+>), text)
newtype PackageName = PackageName { unPackageName :: String }
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
......@@ -81,8 +76,8 @@ instance Text PackageName where
return (PackageName (intercalate "-" ns))
where
component = do
cs <- Parse.munch1 Char.isAlphaNum
if all Char.isDigit cs then Parse.pfail else return cs
cs <- Parse.munch1 isAlphaNum
if all isDigit cs then Parse.pfail else return cs
-- each component must contain an alphabetic character, to avoid
-- ambiguity in identifiers like foo-1 (the 1 is the version number).
......@@ -105,7 +100,7 @@ instance Binary PackageIdentifier
instance Text PackageIdentifier where
disp (PackageIdentifier n v) = case v of
Version [] _ -> disp n -- if no version, don't show version.
_ -> disp n <> Disp.char '-' <> disp v
_ -> disp n <<>> Disp.char '-' <<>> disp v
parse = do
n <- parse
......@@ -132,7 +127,7 @@ instance Binary Module
instance Text Module where
disp (Module uid mod_name) =
disp uid <> Disp.text ":" <> disp mod_name
disp uid <<>> Disp.text ":" <<>> disp mod_name
parse = do
uid <- parse
_ <- Parse.char ':'
......@@ -159,7 +154,7 @@ instance Text ComponentId where
disp (ComponentId str) = text str
parse = ComponentId `fmap` Parse.munch1 abi_char
where abi_char c = Char.isAlphaNum c || c `elem` "-_."
where abi_char c = isAlphaNum c || c `elem` "-_."
instance NFData ComponentId where
rnf (ComponentId pk) = rnf pk
......@@ -266,4 +261,4 @@ instance Binary AbiHash
instance Text AbiHash where
disp (AbiHash abi) = Disp.text abi
parse = fmap AbiHash (Parse.munch Char.isAlphaNum)
parse = fmap AbiHash (Parse.munch isAlphaNum)
......@@ -100,6 +100,9 @@ module Distribution.PackageDescription (
SetupBuildInfo(..),
) where
import Prelude ()
--import Distribution.Compat.Prelude
import Distribution.Types.Library
import Distribution.Types.TestSuite
import Distribution.Types.Executable
......
......@@ -33,6 +33,9 @@ module Distribution.PackageDescription.Check (
checkPackageFileNames,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.Compiler
......@@ -46,17 +49,13 @@ import Distribution.Text
import Distribution.Simple.LocalBuildInfo hiding (compiler)
import Language.Haskell.Extension
import Data.Maybe
( isNothing, isJust, catMaybes, mapMaybe, fromMaybe, maybeToList )
import Data.List (sort, group, isPrefixOf, nub, find)
import Control.Monad
( filterM, liftM )
import Data.List (group)
import qualified System.Directory as System
( doesFileExist, doesDirectoryExist )
import qualified Data.Map as Map
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<>), (<+>))
import Text.PrettyPrint ((<+>))
import qualified System.Directory (getDirectoryContents)
import System.IO (openBinaryFile, IOMode(ReadMode), hGetContents)
......@@ -66,6 +65,7 @@ import System.FilePath
import System.FilePath.Windows as FilePath.Windows
( isValid )
-- | Results of some kind of failed package check.
--
-- There are a range of severities, from merely dubious to totally insane.
......@@ -1254,12 +1254,12 @@ displayRawVersionRange =
. foldVersionRange' -- precedence:
-- All the same as the usual pretty printer, except for the parens
( Disp.text "-any" , 0 :: Int)
(\v -> (Disp.text "==" <> disp v , 0))
(\v -> (Disp.char '>' <> disp v , 0))
(\v -> (Disp.char '<' <> disp v , 0))
(\v -> (Disp.text ">=" <> disp v , 0))
(\v -> (Disp.text "<=" <> disp v , 0))
(\v _ -> (Disp.text "==" <> dispWild v , 0))
(\v -> (Disp.text "==" <<>> disp v , 0))
(\v -> (Disp.char '>' <<>> disp v , 0))
(\v -> (Disp.char '<' <<>> disp v , 0))
(\v -> (Disp.text ">=" <<>> disp v , 0))
(\v -> (Disp.text "<=" <<>> disp v , 0))
(\v _ -> (Disp.text "==" <<>> dispWild v , 0))
(\(r1, p1) (r2, p2) ->
(punct 2 p1 r1 <+> Disp.text "||" <+> punct 2 p2 r2 , 2))
(\(r1, p1) (r2, p2) ->
......@@ -1269,7 +1269,7 @@ displayRawVersionRange =
where
dispWild (Version b _) =
Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int b))
<> Disp.text ".*"
<<>> Disp.text ".*"
punct p p' | p < p' = Disp.parens
| otherwise = id
......@@ -1734,13 +1734,13 @@ checkTarPath path
| otherwise = case pack nameMax (reverse (splitPath path)) of
Left err -> Just err
Right [] -> Nothing
Right (first:rest) -> case pack prefixMax remainder of
Right (h:rest) -> case pack prefixMax remainder of
Left err -> Just err
Right [] -> Nothing
Right (_:_) -> Just noSplit
where
-- drop the '/' between the name and prefix:
remainder = init first : rest
remainder = init h : rest
where
nameMax, prefixMax :: Int
......
......@@ -35,8 +35,8 @@ module Distribution.PackageDescription.Configuration (
transformAllBuildDepends,
) where
import Control.Applicative -- 7.10 -Werror workaround.