Skip to content

Commit

Permalink
Fix GHC 7.8 build
Browse files Browse the repository at this point in the history
  • Loading branch information
fizruk committed Jan 20, 2016
1 parent 11e8726 commit 276dfd8
Show file tree
Hide file tree
Showing 6 changed files with 26 additions and 22 deletions.
3 changes: 2 additions & 1 deletion servant-cassava/servant-cassava.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,8 @@ library
build-depends: base >=4.6 && <5
, cassava >0.4 && <0.5
, servant ==0.5.*
, mtl >= 2 && < 3
, transformers
, transformers-compat
, http-media
, vector
hs-source-dirs: src
Expand Down
10 changes: 5 additions & 5 deletions servant-cassava/src/Servant/CSV/Cassava.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ module Servant.CSV.Cassava where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad.Except (ExceptT, MonadError(..))
import Control.Monad.Trans.Except (ExceptT, throwE)
import Data.Csv
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable)
Expand Down Expand Up @@ -85,26 +85,26 @@ instance EncodeOpts DefaultEncodeOpts where
-- | Decode with 'decodeByNameWith'
instance ( FromNamedRecord a, DecodeOpts opt
) => MimeUnrender (CSV', opt) (Header, [a]) where
mimeUnrender _ bs = either throwError return $
mimeUnrender _ bs = either throwE return $
fmap toList <$> decodeByNameWith (decodeOpts p) bs
where p = Proxy :: Proxy opt

-- | Decode with 'decodeWith'. Assumes data has headers, which are stripped.
instance ( FromRecord a, DecodeOpts opt
) => MimeUnrender (CSV', opt) [a] where
mimeUnrender _ bs = either throwError return $
mimeUnrender _ bs = either throwE return $
toList <$> decodeWith (decodeOpts p) HasHeader bs
where p = Proxy :: Proxy opt

instance ( FromNamedRecord a, DecodeOpts opt
) => MimeUnrender (CSV', opt) (Header, Vector a) where
mimeUnrender _ = either throwError return . decodeByNameWith (decodeOpts p)
mimeUnrender _ = either throwE return . decodeByNameWith (decodeOpts p)
where p = Proxy :: Proxy opt

-- | Decode with 'decodeWith'. Assumes data has headers, which are stripped.
instance ( FromRecord a, DecodeOpts opt
) => MimeUnrender (CSV', opt) (Vector a) where
mimeUnrender _ = either throwError return . decodeWith (decodeOpts p) HasHeader
mimeUnrender _ = either throwE return . decodeWith (decodeOpts p) HasHeader
where p = Proxy :: Proxy opt

-- ** Decode Options
Expand Down
1 change: 1 addition & 0 deletions servant-server/src/Servant/Server/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ module Servant.Server.Internal

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
import Data.Traversable (traverse)
#endif
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Control.Monad.Trans (liftIO)
Expand Down
6 changes: 4 additions & 2 deletions servant/servant.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -52,8 +52,9 @@ library
, http-api-data >= 0.1 && < 0.3
, http-media >= 0.4 && < 0.7
, http-types >= 0.8 && < 0.10
, mtl >= 2 && < 3
, text >= 1 && < 2
, transformers
, transformers-compat
, string-conversions >= 0.3 && < 0.5
, network-uri >= 2.6
, vault >= 0.3 && <0.4
Expand Down Expand Up @@ -99,12 +100,13 @@ test-suite spec
, attoparsec
, bytestring
, hspec == 2.*
, mtl >= 2 && < 3
, QuickCheck
, quickcheck-instances
, servant
, string-conversions
, text
, transformers
, transformers-compat
, url

test-suite doctests
Expand Down
22 changes: 11 additions & 11 deletions servant/src/Servant/API/ContentTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,7 @@ import Control.Applicative ((*>), (<*))
#endif
import Control.Arrow (left)
import Control.Monad
import Control.Monad.Except (ExceptT, MonadError(..))
import Control.Monad.Trans.Except (ExceptT, throwE)
import Data.Aeson (FromJSON(..), ToJSON(..), encode)
import Data.Aeson.Parser (value)
import Data.Aeson.Types (parseEither)
Expand Down Expand Up @@ -185,7 +185,7 @@ instance OVERLAPPABLE_
--
-- >>> import Network.HTTP.Media hiding (Accept)
-- >>> import qualified Data.ByteString.Lazy.Char8 as BSC
-- >>> import Control.Monad.Except
-- >>> import Control.Monad.Trans.Except
-- >>> data MyContentType = MyContentType String
--
-- >>> :{
Expand All @@ -197,7 +197,7 @@ instance OVERLAPPABLE_
--instance Read a => MimeUnrender MyContentType a where
-- mimeUnrender _ bs = case BSC.take 12 bs of
-- "MyContentType" -> return . read . BSC.unpack $ BSC.drop 12 bs
-- _ -> throwError "didn't start with the magic incantation"
-- _ -> throwE "didn't start with the magic incantation"
-- :}
--
-- >>> type MyAPI = "path" :> ReqBody '[MyContentType] Int :> Get '[JSON] Int
Expand Down Expand Up @@ -347,23 +347,23 @@ eitherDecodeLenient input =
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")

-- | @either throwError return . eitherDecodeLenient@
-- | @either throwE return . eitherDecodeLenient@
instance FromJSON a => MimeUnrender JSON a where
mimeUnrender _ = either throwError return . eitherDecodeLenient
mimeUnrender _ = either throwE return . eitherDecodeLenient

-- | @either throwError return . (decodeFormUrlEncoded >=> fromFormUrlEncoded)@
-- | @either throwE return . (decodeFormUrlEncoded >=> fromFormUrlEncoded)@
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
-- holds if every element of x is non-null (i.e., not @("", "")@)
instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where
mimeUnrender _ = either throwError return . (decodeFormUrlEncoded >=> fromFormUrlEncoded)
mimeUnrender _ = either throwE return . (decodeFormUrlEncoded >=> fromFormUrlEncoded)

-- | @either throwError return . left show . TextL.decodeUtf8'@
-- | @either throwE return . left show . TextL.decodeUtf8'@
instance MimeUnrender PlainText TextL.Text where
mimeUnrender _ = either throwError return . left show . TextL.decodeUtf8'
mimeUnrender _ = either throwE return . left show . TextL.decodeUtf8'

-- | @either throwError return . left show . TextS.decodeUtf8' . toStrict@
-- | @either throwE return . left show . TextS.decodeUtf8' . toStrict@
instance MimeUnrender PlainText TextS.Text where
mimeUnrender _ = either throwError return . left show . TextS.decodeUtf8' . toStrict
mimeUnrender _ = either throwE return . left show . TextS.decodeUtf8' . toStrict

-- | @return . BC.unpack@
instance MimeUnrender PlainText String where
Expand Down
6 changes: 3 additions & 3 deletions servant/test/Servant/API/ContentTypesSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,9 @@ import Data.Monoid
import Data.Traversable
#endif
import Control.Arrow
import Control.Monad (when)
import Control.Monad.Except (runExceptT)
import Control.Monad.Trans (liftIO)
import Control.Monad (when)
import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson
import Data.ByteString.Char8 (ByteString, append, pack)
import qualified Data.ByteString.Lazy as BSL
Expand Down

0 comments on commit 276dfd8

Please sign in to comment.