Remove applicative import warnings in GHC 7.10.1.
This commit is contained in:
parent
78c0619e02
commit
f69440d7fa
5 changed files with 16 additions and 4 deletions
|
@ -1,6 +1,6 @@
|
|||
-- | Database administrative functions
|
||||
|
||||
{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-}
|
||||
{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards #-}
|
||||
|
||||
module Database.MongoDB.Admin (
|
||||
-- * Admin
|
||||
|
@ -28,7 +28,9 @@ module Database.MongoDB.Admin (
|
|||
) where
|
||||
|
||||
import Prelude hiding (lookup)
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Monad (forever, unless, liftM)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
|
|
|
@ -18,7 +18,11 @@ module Database.MongoDB.Connection (
|
|||
import Prelude hiding (lookup)
|
||||
import Data.IORef (IORef, newIORef, readIORef)
|
||||
import Data.List (intersect, partition, (\\), delete)
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
|
||||
import Control.Monad (forM_)
|
||||
import Network (HostName, PortID(..), connectTo)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
-- "Database.MongoDB.Query" and "Database.MongoDB.Connection" instead.
|
||||
|
||||
{-# LANGUAGE RecordWildCards, StandaloneDeriving, OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts, TupleSections, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE CPP, FlexibleContexts, TupleSections, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
|
||||
|
||||
module Database.MongoDB.Internal.Protocol (
|
||||
|
@ -22,7 +22,9 @@ module Database.MongoDB.Internal.Protocol (
|
|||
Username, Password, Nonce, pwHash, pwKey
|
||||
) where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
import Control.Arrow ((***))
|
||||
import Control.Monad (forM_, replicateM, unless)
|
||||
import Data.Binary.Get (Get, runGet)
|
||||
|
|
|
@ -7,7 +7,9 @@
|
|||
|
||||
module Database.MongoDB.Internal.Util where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
import Control.Exception (handle, throwIO, Exception)
|
||||
import Control.Monad (liftM, liftM2)
|
||||
import Data.Bits (Bits, (.|.))
|
||||
|
|
|
@ -51,7 +51,9 @@ import Control.Monad (unless, replicateM, liftM)
|
|||
import Data.Int (Int32)
|
||||
import Data.Maybe (listToMaybe, catMaybes)
|
||||
import Data.Word (Word32)
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Data.Monoid (mappend)
|
||||
#endif
|
||||
import Data.Typeable (Typeable)
|
||||
|
||||
#if MIN_VERSION_base(4,6,0)
|
||||
|
@ -235,8 +237,8 @@ whereJS :: Selector -> Javascript -> Selector
|
|||
whereJS sel js = ("$where" =: js) : sel
|
||||
|
||||
class Select aQueryOrSelection where
|
||||
select :: Selector -> Collection -> aQueryOrSelection
|
||||
-- ^ 'Query' or 'Selection' that selects documents in collection that match selector. The choice of type depends on use, for example, in @'find' (select sel col)@ it is a Query, and in @'delete' (select sel col)@ it is a Selection.
|
||||
select :: Selector -> Collection -> aQueryOrSelection
|
||||
-- ^ 'Query' or 'Selection' that selects documents in collection that match selector. The choice of type depends on use, for example, in @'find' (select sel col)@ it is a Query, and in @'delete' (select sel col)@ it is a Selection.
|
||||
|
||||
instance Select Selection where
|
||||
select = Select
|
||||
|
|
Loading…
Reference in a new issue