Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
1aee4142
Commit
1aee4142
authored
Mar 06, 2015
by
Mikhail Glushenkov
Browse files
-Wall police (GHC 7.10 edition).
parent
af77559c
Changes
41
Hide whitespace changes
Inline
Side-by-side
Cabal/Distribution/Compat/ReadP.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Compat.ReadP
...
...
@@ -71,7 +72,10 @@ module Distribution.Compat.ReadP
import
Control.Monad
(
MonadPlus
(
..
),
liftM
,
liftM2
,
ap
)
import
Data.Char
(
isSpace
)
import
Control.Applicative
(
Applicative
(
..
),
Alternative
(
empty
,
(
<|>
)))
#
if
__GLASGOW_HASKELL__
<
710
import
Control.Applicative
(
Applicative
(
..
))
#
endif
import
Control.Applicative
(
Alternative
(
empty
,
(
<|>
)))
infixr
5
+++
,
<++
...
...
Cabal/Distribution/PackageDescription.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
...
...
@@ -109,7 +110,9 @@ import Distribution.Compat.Binary (Binary)
import
Data.Data
(
Data
)
import
Data.List
(
nub
,
intercalate
)
import
Data.Maybe
(
fromMaybe
,
maybeToList
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
mempty
,
mappend
))
#
endif
import
Data.Typeable
(
Typeable
)
import
Control.Monad
(
MonadPlus
(
mplus
))
import
GHC.Generics
(
Generic
)
...
...
Cabal/Distribution/PackageDescription/Parse.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
...
...
@@ -42,10 +43,12 @@ module Distribution.PackageDescription.Parse (
import
Data.Char
(
isSpace
)
import
Data.Maybe
(
listToMaybe
,
isJust
)
import
Data.Monoid
(
Monoid
(
..
)
)
import
Data.List
(
nub
,
unfoldr
,
partition
,
(
\\
))
import
Control.Monad
(
liftM
,
foldM
,
when
,
unless
,
ap
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
import
Control.Applicative
(
Applicative
(
..
))
#
endif
import
Control.Arrow
(
first
)
import
System.Directory
(
doesFileExist
)
import
qualified
Data.ByteString.Lazy.Char8
as
BS.Char8
...
...
@@ -622,10 +625,15 @@ newtype StT s m a = StT { runStT :: s -> m (a,s) }
instance
Functor
f
=>
Functor
(
StT
s
f
)
where
fmap
g
(
StT
f
)
=
StT
$
fmap
(
first
g
)
.
f
#
if
__GLASGOW_HASKELL__
>=
710
instance
(
Monad
m
)
=>
Applicative
(
StT
s
m
)
where
#
else
instance
(
Monad
m
,
Functor
m
)
=>
Applicative
(
StT
s
m
)
where
#
endif
pure
=
return
(
<*>
)
=
ap
instance
Monad
m
=>
Monad
(
StT
s
m
)
where
return
a
=
StT
(
\
s
->
return
(
a
,
s
))
StT
f
>>=
g
=
StT
$
\
s
->
do
...
...
Cabal/Distribution/PackageDescription/PrettyPrint.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.PackageDescription.PrettyPrint
...
...
@@ -17,7 +18,9 @@ module Distribution.PackageDescription.PrettyPrint (
showGenericPackageDescription
,
)
where
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
mempty
))
#
endif
import
Distribution.PackageDescription
(
Benchmark
(
..
),
BenchmarkInterface
(
..
),
benchmarkType
,
TestSuite
(
..
),
TestSuiteInterface
(
..
),
testType
...
...
Cabal/Distribution/ParseUtils.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.ParseUtils
...
...
@@ -61,7 +62,9 @@ import Data.Maybe (fromMaybe)
import
Data.Tree
as
Tree
(
Tree
(
..
),
flatten
)
import
qualified
Data.Map
as
Map
import
Control.Monad
(
foldM
,
ap
)
#
if
__GLASGOW_HASKELL__
<
710
import
Control.Applicative
(
Applicative
(
..
))
#
endif
import
System.FilePath
(
normalise
)
import
Data.List
(
sortBy
)
...
...
Cabal/Distribution/Simple/BuildTarget.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.BuildTargets
...
...
@@ -55,7 +56,10 @@ import Data.Either
(
partitionEithers
)
import
qualified
Data.Map
as
Map
import
Control.Monad
import
Control.Applicative
(
Applicative
(
..
),
Alternative
(
..
))
#
if
__GLASGOW_HASKELL__
<
710
import
Control.Applicative
(
Applicative
(
..
))
#
endif
import
Control.Applicative
(
Alternative
(
..
))
import
qualified
Distribution.Compat.ReadP
as
Parse
import
Distribution.Compat.ReadP
(
(
+++
),
(
<++
)
)
...
...
Cabal/Distribution/Simple/CCompiler.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.CCompiler
...
...
@@ -46,8 +47,10 @@ module Distribution.Simple.CCompiler (
filenameCDialect
)
where
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
#
endif
import
System.FilePath
(
takeExtension
)
...
...
Cabal/Distribution/Simple/Command.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Command
...
...
@@ -63,7 +64,9 @@ import Control.Monad
import
Data.Char
(
isAlpha
,
toLower
)
import
Data.List
(
sortBy
)
import
Data.Maybe
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
#
endif
import
qualified
Distribution.GetOpt
as
GetOpt
import
Distribution.Text
(
Text
(
disp
,
parse
)
)
...
...
@@ -175,7 +178,7 @@ optArg' ad mkflag showflag =
optArg
ad
(
succeedReadE
(
mkflag
.
Just
))
def
showflag
where
def
=
mkflag
Nothing
noArg
::
(
Eq
b
,
Monoid
b
)
=>
b
->
MkOptDescr
(
a
->
b
)
(
b
->
a
->
a
)
a
noArg
::
(
Eq
b
)
=>
b
->
MkOptDescr
(
a
->
b
)
(
b
->
a
->
a
)
a
noArg
flag
sf
lf
d
=
choiceOpt
[(
flag
,
(
sf
,
lf
),
d
)]
sf
lf
d
boolOpt
::
(
b
->
Maybe
Bool
)
->
(
Bool
->
b
)
->
SFlags
->
SFlags
...
...
Cabal/Distribution/Simple/Configure.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
...
...
@@ -135,8 +136,10 @@ import Data.Maybe
import
Data.Either
(
partitionEithers
)
import
qualified
Data.Set
as
Set
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
#
endif
import
qualified
Data.Map
as
Map
import
Data.Map
(
Map
)
import
Data.Traversable
...
...
Cabal/Distribution/Simple/GHC.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.GHC
...
...
@@ -107,7 +108,9 @@ import Data.Char ( isDigit, isSpace )
import
Data.List
import
qualified
Data.Map
as
M
(
fromList
)
import
Data.Maybe
(
catMaybes
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
#
endif
import
Data.Version
(
showVersion
)
import
System.Directory
(
doesFileExist
,
getAppUserDataDirectory
,
createDirectoryIfMissing
)
...
...
Cabal/Distribution/Simple/GHC/Internal.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.GHC.Internal
...
...
@@ -66,7 +67,9 @@ import qualified Data.Map as M
import
Data.Char
(
isSpace
)
import
Data.Maybe
(
fromMaybe
,
maybeToList
,
isJust
)
import
Control.Monad
(
unless
,
when
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
#
endif
import
System.Directory
(
getDirectoryContents
,
getTemporaryDirectory
)
import
System.Environment
(
getEnv
)
import
System.FilePath
(
(
</>
),
(
<.>
),
takeExtension
,
takeDirectory
)
...
...
Cabal/Distribution/Simple/GHCJS.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
module
Distribution.Simple.GHCJS
(
configure
,
getInstalledPackages
,
getPackageDBContents
,
buildLib
,
buildExe
,
...
...
@@ -71,7 +72,9 @@ import Language.Haskell.Extension ( Extension(..)
import
Control.Monad
(
unless
,
when
)
import
Data.Char
(
isSpace
)
import
qualified
Data.Map
as
M
(
fromList
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
#
endif
import
System.Directory
(
doesFileExist
)
import
System.FilePath
(
(
</>
),
(
<.>
),
takeExtension
,
takeDirectory
,
replaceExtension
,
...
...
Cabal/Distribution/Simple/InstallDirs.hs
View file @
1aee4142
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
...
...
@@ -47,7 +48,9 @@ module Distribution.Simple.InstallDirs (
import
Distribution.Compat.Binary
(
Binary
)
import
Data.List
(
isPrefixOf
)
import
Data.Maybe
(
fromMaybe
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
))
#
endif
import
GHC.Generics
(
Generic
)
import
System.Directory
(
getAppUserDataDirectory
)
import
System.FilePath
((
</>
),
isPathSeparator
,
pathSeparator
)
...
...
Cabal/Distribution/Simple/LHC.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.LHC
...
...
@@ -90,7 +91,9 @@ import Control.Monad ( unless, when )
import
Data.List
import
qualified
Data.Map
as
M
(
empty
)
import
Data.Maybe
(
catMaybes
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
#
endif
import
System.Directory
(
removeFile
,
renameFile
,
getDirectoryContents
,
doesFileExist
,
getTemporaryDirectory
)
...
...
Cabal/Distribution/Simple/PackageIndex.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
...
...
@@ -79,7 +80,9 @@ import qualified Data.Graph as Graph
import
Data.List
as
List
(
null
,
foldl'
,
sort
,
groupBy
,
sortBy
,
find
,
isInfixOf
,
nubBy
,
deleteBy
,
deleteFirstsBy
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
))
#
endif
import
Data.Map
(
Map
)
import
qualified
Data.Map
as
Map
import
Data.Maybe
(
isNothing
,
fromMaybe
)
...
...
@@ -379,7 +382,7 @@ allPackagesBySourcePackageId (PackageIndex _ pnames) =
-- Since multiple package DBs mask each other by 'InstalledPackageId',
-- then we get back at most one package.
--
lookupInstalledPackageId
::
PackageInstalled
a
=>
PackageIndex
a
->
InstalledPackageId
lookupInstalledPackageId
::
PackageIndex
a
->
InstalledPackageId
->
Maybe
a
lookupInstalledPackageId
(
PackageIndex
pids
_
)
pid
=
Map
.
lookup
pid
pids
...
...
@@ -390,7 +393,7 @@ lookupInstalledPackageId (PackageIndex pids _) pid = Map.lookup pid pids
-- but different 'InstalledPackageId'. They are returned in order of
-- preference, with the most preferred first.
--
lookupSourcePackageId
::
PackageInstalled
a
=>
PackageIndex
a
->
PackageId
->
[
a
]
lookupSourcePackageId
::
PackageIndex
a
->
PackageId
->
[
a
]
lookupSourcePackageId
(
PackageIndex
_
pnames
)
pkgid
=
case
Map
.
lookup
(
packageName
pkgid
)
pnames
of
Nothing
->
[]
...
...
@@ -408,7 +411,7 @@ lookupPackageId index pkgid = case lookupSourcePackageId index pkgid of
-- | Does a lookup by source package name.
--
lookupPackageName
::
PackageInstalled
a
=>
PackageIndex
a
->
PackageName
lookupPackageName
::
PackageIndex
a
->
PackageName
->
[(
Version
,
[
a
])]
lookupPackageName
(
PackageIndex
_
pnames
)
name
=
case
Map
.
lookup
name
pnames
of
...
...
@@ -421,7 +424,7 @@ lookupPackageName (PackageIndex _ pnames) name =
-- We get back any number of versions of the specified package name, all
-- satisfying the version range constraint.
--
lookupDependency
::
PackageInstalled
a
=>
PackageIndex
a
->
Dependency
lookupDependency
::
PackageIndex
a
->
Dependency
->
[(
Version
,
[
a
])]
lookupDependency
(
PackageIndex
_
pnames
)
(
Dependency
name
versionRange
)
=
case
Map
.
lookup
name
pnames
of
...
...
@@ -446,7 +449,7 @@ lookupDependency (PackageIndex _ pnames) (Dependency name versionRange) =
-- packages. The list of ambiguous results is split by exact package name. So
-- it is a non-empty list of non-empty lists.
--
searchByName
::
PackageInstalled
a
=>
PackageIndex
a
->
String
->
SearchResult
[
a
]
searchByName
::
PackageIndex
a
->
String
->
SearchResult
[
a
]
searchByName
(
PackageIndex
_
pnames
)
name
=
case
[
pkgs
|
pkgs
@
(
PackageName
name'
,
_
)
<-
Map
.
toList
pnames
,
lowercase
name'
==
lname
]
of
...
...
@@ -463,7 +466,7 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a]
--
-- That is, all packages that contain the given string in their name.
--
searchByNameSubstring
::
PackageInstalled
a
=>
PackageIndex
a
->
String
->
[
a
]
searchByNameSubstring
::
PackageIndex
a
->
String
->
[
a
]
searchByNameSubstring
(
PackageIndex
_
pnames
)
searchterm
=
[
pkg
|
(
PackageName
name
,
pvers
)
<-
Map
.
toList
pnames
...
...
Cabal/Distribution/Simple/Program/GHC.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
module
Distribution.Simple.Program.GHC
(
GhcOptions
(
..
),
GhcMode
(
..
),
...
...
@@ -26,7 +27,9 @@ import Distribution.Utils.NubList ( NubListR, fromNubListR )
import
Language.Haskell.Extension
(
Language
(
..
),
Extension
(
..
)
)
import
qualified
Data.Map
as
M
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
#
endif
import
Data.List
(
intercalate
)
-- | A structured set of GHC options/flags
...
...
Cabal/Distribution/Simple/Setup.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
-----------------------------------------------------------------------------
...
...
@@ -103,7 +104,9 @@ import Control.Monad (liftM)
import
Distribution.Compat.Binary
(
Binary
)
import
Data.List
(
sort
)
import
Data.Char
(
isSpace
,
isAlpha
)
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
(
Monoid
(
..
)
)
#
endif
import
GHC.Generics
(
Generic
)
-- FIXME Not sure where this should live
...
...
Cabal/Distribution/Utils/NubList.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
module
Distribution.Utils.NubList
(
NubList
-- opaque
,
toNubList
-- smart construtor
...
...
@@ -11,7 +12,9 @@ module Distribution.Utils.NubList
)
where
import
Distribution.Compat.Binary
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
#
endif
import
Distribution.Simple.Utils
(
ordNub
,
listUnion
,
ordNubRight
,
listUnionRight
)
...
...
@@ -60,7 +63,7 @@ instance (Ord a, Read a) => Read (NubList a) where
readPrec
=
readNubList
toNubList
-- | Helper used by NubList/NubListR's Read instances.
readNubList
::
(
Ord
a
,
Read
a
)
=>
([
a
]
->
l
a
)
->
R
.
ReadPrec
(
l
a
)
readNubList
::
(
Read
a
)
=>
([
a
]
->
l
a
)
->
R
.
ReadPrec
(
l
a
)
readNubList
toList
=
R
.
parens
.
R
.
prec
10
$
fmap
toList
R
.
readPrec
-- | Binary instance for 'NubList a' is the same as for '[a]'. For 'put', we
...
...
Cabal/tests/PackageTests/DeterministicAr/Check.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module
PackageTests.DeterministicAr.Check
where
...
...
@@ -7,7 +8,9 @@ import qualified Data.ByteString as BS
import
qualified
Data.ByteString.Char8
as
BS8
import
Data.Char
(
isSpace
)
import
Data.List
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Traversable
#
endif
import
PackageTests.PackageTester
import
System.Exit
import
System.FilePath
...
...
Cabal/tests/UnitTests/Distribution/Utils/NubList.hs
View file @
1aee4142
{-# LANGUAGE CPP #-}
module
UnitTests.Distribution.Utils.NubList
(
tests
)
where
#
if
__GLASGOW_HASKELL__
<
710
import
Data.Monoid
#
endif
import
Distribution.Utils.NubList
import
Test.Framework
import
Test.Framework.Providers.HUnit
(
testCase
)
...
...
Prev
1
2
3
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment