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
binary
Commits
6892225e
Commit
6892225e
authored
Jun 07, 2015
by
Lennart Kolmodin
Browse files
Merge pull request #77 from mboes/ghc710-warnings
Fix AMP and Safe Haskell related warnings in GHC 7.10.
parents
8debedd3
57143851
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/Data/Binary/Builder/Base.hs
View file @
6892225e
...
...
@@ -87,6 +87,7 @@ import GHC.Word (Word32(..),Word16(..),Word64(..))
import
GHC.Word
(
uncheckedShiftRL64
#
)
#
endif
#
endif
import
Prelude
-- Silence AMP warning.
------------------------------------------------------------------------
...
...
src/Data/Binary/Builder/Internal.hs
View file @
6892225e
{-# LANGUAGE CPP #-}
#
if
__GLASGOW_HASKELL__
>=
701
{-# LANGUAGE
Trustworthy
#-}
{-# LANGUAGE
Safe
#-}
#
endif
-----------------------------------------------------------------------------
-- |
-- Module : Data.Binary.Builder.Internal
-- Copyright : Lennart Kolmodin, Ross Paterson
-- License : BSD3-style (see LICENSE)
--
--
-- Maintainer : Lennart Kolmodin <kolmodin@gmail.com>
-- Stability : experimental
-- Portability : portable to Hugs and GHC
...
...
src/Data/Binary/Class.hs
View file @
6892225e
{-# LANGUAGE CPP, FlexibleContexts #-}
#
if
__GLASGOW_HASKELL__
>=
701
{-# LANGUAGE
Trustworthy
#-}
{-# LANGUAGE
Safe
#-}
#
endif
#
ifdef
GENERICS
{-# LANGUAGE DefaultSignatures #-}
...
...
@@ -41,12 +41,13 @@ module Data.Binary.Class (
)
where
import
Data.Word
import
Data.Bits
import
Data.Int
import
Data.Binary.Put
import
Data.Binary.Get
import
Control.Monad
import
Foreign
import
Data.ByteString.Lazy
(
ByteString
)
import
qualified
Data.ByteString.Lazy
as
L
...
...
src/Data/Binary/Generic.hs
View file @
6892225e
{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, KindSignatures,
ScopedTypeVariables,
Trustworthy
, TypeOperators, TypeSynonymInstances #-}
ScopedTypeVariables,
Safe
, TypeOperators, TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
...
...
@@ -26,6 +26,7 @@ import Data.Binary.Put
import
Data.Bits
import
Data.Word
import
GHC.Generics
import
Prelude
-- Silence AMP warning.
-- Type without constructors
instance
GBinary
V1
where
...
...
src/Data/Binary/Get.hs
View file @
6892225e
...
...
@@ -203,8 +203,6 @@ import qualified Data.ByteString.Unsafe as B
import
qualified
Data.ByteString.Lazy
as
L
import
qualified
Data.ByteString.Lazy.Internal
as
L
import
Control.Applicative
import
Data.Binary.Get.Internal
hiding
(
Decoder
(
..
),
runGetIncremental
)
import
qualified
Data.Binary.Get.Internal
as
I
...
...
src/Data/Binary/Put.hs
View file @
6892225e
{-# LANGUAGE CPP #-}
#
if
__GLASGOW_HASKELL__
>=
701
{-# LANGUAGE
Trustworthy
#-}
{-# LANGUAGE
Safe
#-}
#
endif
-----------------------------------------------------------------------------
...
...
@@ -8,7 +8,7 @@
-- Module : Data.Binary.Put
-- Copyright : Lennart Kolmodin
-- License : BSD3-style (see LICENSE)
--
--
-- Maintainer : Lennart Kolmodin <kolmodin@gmail.com>
-- Stability : stable
-- Portability : Portable to Hugs and GHC. Requires MPTCs
...
...
@@ -62,11 +62,12 @@ import qualified Data.ByteString as S
import
qualified
Data.ByteString.Lazy
as
L
import
Control.Applicative
import
Prelude
-- Silence AMP warning.
------------------------------------------------------------------------
-- XXX Strict in buffer only.
-- XXX Strict in buffer only.
data
PairS
a
=
PairS
a
!
Builder
sndS
::
PairS
a
->
Builder
...
...
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