Skip to content

Commit 3a90c48

Browse files
ersran9ersran9
committed
GHC 8 support
1 parent 1e00ec6 commit 3a90c48

File tree

9 files changed

+98
-66
lines changed

9 files changed

+98
-66
lines changed

‎ChangeLog.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
11
# Changelog
22

3+
## 0.2.2
4+
* Added support for GHC 8
5+
36
## 0.2.1
47

58
* Added `RequestBody` to the `Request` type. This allows user to have content in request's body with the desired `Content-Type`.

‎src/WebApi/Client.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -91,7 +91,7 @@ fromClientResponse hcResp = do
9191
<*> respHdr
9292
<*> pure () of
9393
Validation (Right success) -> success
94-
Validation (Left errs) ->
94+
Validation (Left _errs) ->
9595
case ApiError
9696
<$> pure status
9797
<*> (Validation $ toParamErr $ decode' (Route' :: Route' m r) respBodyBS)

‎src/WebApi/ContentTypes.hs

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ License : BSD3
44
Stability : experimental
55
-}
66

7+
{-# LANGUAGE CPP #-}
78
{-# LANGUAGE ConstraintKinds #-}
89
{-# LANGUAGE DataKinds #-}
910
{-# LANGUAGE FlexibleInstances #-}
@@ -14,6 +15,7 @@ Stability : experimental
1415
{-# LANGUAGE TypeOperators #-}
1516
{-# LANGUAGE UndecidableInstances #-}
1617
{-# LANGUAGE TupleSections #-}
18+
1719
module WebApi.ContentTypes
1820
(
1921
-- * Predefined Content Types.
@@ -45,7 +47,11 @@ module WebApi.ContentTypes
4547
import Blaze.ByteString.Builder (Builder)
4648
import qualified Blaze.ByteString.Builder.Char.Utf8 as Utf8 (fromText)
4749
import Data.Aeson (ToJSON (..), FromJSON (..), eitherDecodeStrict)
50+
#if MIN_VERSION_aeson(0,9,0)
51+
import Data.Aeson.Encode (encodeToBuilder)
52+
#else
4853
import Data.Aeson.Encode (encodeToByteStringBuilder)
54+
#endif
4955
import Data.ByteString (ByteString)
5056
import Data.Maybe (fromMaybe)
5157
import Data.Proxy
@@ -127,7 +133,11 @@ class (Accept a) => Encode a c where
127133
encode :: Proxy a -> c -> Builder
128134

129135
instance (ToJSON c) => Encode JSON c where
136+
#if MIN_VERSION_aeson(0,9,0)
137+
encode _ = encodeToBuilder . toJSON
138+
#else
130139
encode _ = encodeToByteStringBuilder . toJSON
140+
#endif
131141

132142
instance (ToText a) => Encode PlainText a where
133143
encode _ = Utf8.fromText . toText

‎src/WebApi/Contract.hs

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ Provides the contract for the web api. The contract consists of 'WebApi' and 'Ap
1515
1616
-}
1717

18+
{-# LANGUAGE CPP #-}
1819
{-# LANGUAGE DataKinds #-}
1920
{-# LANGUAGE FlexibleContexts #-}
2021
{-# LANGUAGE KindSignatures #-}
@@ -23,6 +24,11 @@ Provides the contract for the web api. The contract consists of 'WebApi' and 'Ap
2324
{-# LANGUAGE TypeFamilies #-}
2425
{-# LANGUAGE UndecidableInstances #-}
2526
{-# LANGUAGE PatternSynonyms #-}
27+
28+
#if __GLASGOW_HASKELL__ >= 800
29+
{-# LANGUAGE UndecidableSuperClasses #-}
30+
#endif
31+
2632
module WebApi.Contract
2733
(-- * API Contract
2834
WebApi (..)
@@ -182,7 +188,11 @@ data ApiError m r = ApiError
182188
data OtherError = OtherError { exception :: SomeException }
183189

184190
-- | Used for constructing 'Request'
191+
#if __GLASGOW_HASKELL__ >= 800
192+
pattern Request :: (SingMethod m)
193+
#else
185194
pattern Request :: () => (SingMethod m)
195+
#endif
186196
=> PathParam m r
187197
-> QueryParam m r
188198
-> FormParam m r
@@ -199,7 +209,11 @@ pattern Request pp qp fp fip hi ci rb <- Req' pp qp fp fip hi ci rb _ where
199209

200210
-- | Exists only for compatability reasons. This will be removed in the next version.
201211
-- Use 'Request' pattern instead
212+
#if __GLASGOW_HASKELL__ >= 800
213+
pattern Req :: (SingMethod m, HListToTuple (StripContents (RequestBody m r)) ~ ())
214+
#else
202215
pattern Req :: () => (SingMethod m, HListToTuple (StripContents (RequestBody m r)) ~ ())
216+
#endif
203217
=> PathParam m r
204218
-> QueryParam m r
205219
-> FormParam m r

‎src/WebApi/Internal.hs

Lines changed: 16 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,18 @@
1-
{-# LANGUAGE ConstraintKinds #-}
2-
{-# LANGUAGE DataKinds #-}
3-
{-# LANGUAGE DefaultSignatures #-}
4-
{-# LANGUAGE FlexibleContexts #-}
5-
{-# LANGUAGE KindSignatures #-}
6-
{-# LANGUAGE MultiParamTypeClasses #-}
7-
{-# LANGUAGE OverloadedStrings #-}
8-
{-# LANGUAGE ScopedTypeVariables #-}
9-
{-# LANGUAGE TypeFamilies #-}
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE ConstraintKinds #-}
3+
{-# LANGUAGE DataKinds #-}
4+
{-# LANGUAGE DefaultSignatures #-}
5+
{-# LANGUAGE FlexibleContexts #-}
6+
{-# LANGUAGE KindSignatures #-}
7+
{-# LANGUAGE MultiParamTypeClasses #-}
8+
{-# LANGUAGE OverloadedStrings #-}
9+
{-# LANGUAGE ScopedTypeVariables #-}
10+
{-# LANGUAGE TypeFamilies #-}
11+
12+
#if __GLASGOW_HASKELL__ >= 800
13+
{-# LANGUAGE UndecidableSuperClasses #-}
14+
#endif
15+
1016
module WebApi.Internal where
1117

1218
import Blaze.ByteString.Builder (Builder, toByteString)
@@ -161,7 +167,7 @@ renderPaths p r = toByteString
161167
fillHoles Hole (segs, dynV: xs) = (decodeUtf8 dynV : segs, xs)
162168
fillHoles Hole (_segs, []) = error "Panic: fewer pathparams than holes"
163169

164-
toRoute :: (MkPathFormatString r) => route m r -> Proxy r
170+
toRoute :: route m r -> Proxy r
165171
toRoute = const Proxy
166172

167173
-- | Describes the implementation of a single API end point corresponding to @ApiContract (ApiInterface p) m r@

‎src/WebApi/Param.hs

Lines changed: 20 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -447,11 +447,11 @@ newtype NonNested a = NonNested { getNonNestedParam :: a }
447447
deriving (Show, Eq, Read)
448448

449449
-- | Serialize a type without nesting.
450-
toNonNestedParam :: (ToParam (NonNested a) parK, EncodeParam a) => Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK]
450+
toNonNestedParam :: (ToParam (NonNested a) parK) => Proxy (parK :: ParamK) -> ByteString -> a -> [SerializedData parK]
451451
toNonNestedParam par pfx a = toParam par pfx (NonNested a)
452452

453453
-- | (Try to) Deserialize a type without nesting.
454-
fromNonNestedParam :: (FromParam (NonNested a) parK, DecodeParam a) => Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a
454+
fromNonNestedParam :: (FromParam (NonNested a) parK) => Proxy (parK :: ParamK) -> ByteString -> Trie (DeSerializedData parK) -> Validation [ParamErr] a
455455
fromNonNestedParam par pfx kvs = getNonNestedParam <$> fromParam par pfx kvs
456456

457457
instance (EncodeParam a) => ToParam (NonNested a) 'QueryParam where
@@ -682,13 +682,13 @@ instance (EncodeParam a) => ToParam (OptValue a) 'Cookie where
682682
toParam _ pfx (OptValue (Just val)) = [(pfx, encodeParam val)]
683683
toParam _ _ (OptValue Nothing) = []
684684

685-
instance (ToJSON a, FromJSON a) => ToParam (JsonOf a) 'QueryParam where
685+
instance (ToJSON a) => ToParam (JsonOf a) 'QueryParam where
686686
toParam _ pfx val = [(pfx, Just $ encodeParam val)]
687687

688-
instance (ToJSON a, FromJSON a) => ToParam (JsonOf a) 'FormParam where
688+
instance (ToJSON a) => ToParam (JsonOf a) 'FormParam where
689689
toParam _ pfx val = [(pfx, encodeParam val)]
690690

691-
instance (ToJSON a, FromJSON a) => ToParam (JsonOf a) 'Cookie where
691+
instance (ToJSON a) => ToParam (JsonOf a) 'Cookie where
692692
toParam _ pfx val = [(pfx, encodeParam val)]
693693

694694
instance ToParam a par => ToParam (Maybe a) par where
@@ -1150,7 +1150,7 @@ instance FromParam Day 'Cookie where
11501150
_ -> Validation $ Left [ParseErr key "Unable to cast to Day"]
11511151
_ -> Validation $ Left [NotFound key]
11521152

1153-
instance (Show (DeSerializedData par), FromParam a par) => FromParam [a] par where
1153+
instance (FromParam a par) => FromParam [a] par where
11541154
fromParam pt key kvs = case Trie.null kvs' of
11551155
True -> Validation $ Right []
11561156
False ->
@@ -1166,7 +1166,7 @@ instance (Show (DeSerializedData par), FromParam a par) => FromParam [a] par whe
11661166
(Validation (Right _), Validation (Left es)) -> Validation $ Left es
11671167
(Validation (Left as), Validation (Left es)) -> Validation $ Left (es ++ as)
11681168

1169-
instance (Show (DeSerializedData par), FromParam a par) => FromParam (Vector a) par where
1169+
instance (FromParam a par) => FromParam (Vector a) par where
11701170
fromParam pt key kvs = case fromParam pt key kvs of
11711171
Validation (Right v) -> Validation $ Right (V.fromList v)
11721172
Validation (Left err) -> Validation (Left err)
@@ -1441,18 +1441,18 @@ instance (ToParam a parK) => ToParam (Field s a) parK where
14411441
instance (FromParam a parK) => FromParam (Field s a) parK where
14421442
fromParam pt key kvs = Field <$> fromParam pt key kvs
14431443

1444-
type family IsMeta a where
1445-
IsMeta (Field s a) = 'True
1446-
IsMeta a = 'False
1444+
type family IsField a where
1445+
IsField (Field s a) = 'True
1446+
IsField a = 'False
14471447

1448-
class Meta a (b :: Bool) where
1449-
meta :: Proxy a -> Proxy b -> (ByteString -> ByteString)
1448+
class FieldModifier a (b :: Bool) where
1449+
fieldMod :: Proxy a -> Proxy b -> (ByteString -> ByteString)
14501450

1451-
instance (KnownSymbol s) => Meta (Field s a) 'True where
1452-
meta _ _ = const $ ASCII.pack (symbolVal (Proxy :: Proxy s))
1451+
instance (KnownSymbol s) => FieldModifier (Field s a) 'True where
1452+
fieldMod _ _ = const $ ASCII.pack (symbolVal (Proxy :: Proxy s))
14531453

1454-
instance Meta a 'False where
1455-
meta _ _ = id
1454+
instance FieldModifier a 'False where
1455+
fieldMod _ _ = id
14561456

14571457
-- | Serialize a type to the header params
14581458
class ToHeader a where
@@ -1576,9 +1576,9 @@ instance (GFromParam f parK, Datatype t) => GFromParam (M1 D t f) parK where
15761576

15771577
where dtN = T.pack $ datatypeName (undefined :: (M1 D t f) a)
15781578

1579-
instance (GFromParam f parK, Selector t, f ~ (K1 i c), Meta c (IsMeta c)) => GFromParam (M1 S t f) parK where
1579+
instance (GFromParam f parK, Selector t, f ~ (K1 i c), FieldModifier c (IsField c)) => GFromParam (M1 S t f) parK where
15801580
gfromParam pt pfx pa psett kvs = let fldN = (ASCII.pack $ (selName (undefined :: (M1 S t f) a)))
1581-
modSelName = meta (Proxy :: Proxy c) (Proxy :: Proxy (IsMeta c))
1581+
modSelName = fieldMod (Proxy :: Proxy c) (Proxy :: Proxy (IsField c))
15821582
in case fldN of
15831583
"" -> M1 <$> gfromParam pt (pfx `nest` numberedFld pa) pa psett (submap pfx kvs)
15841584
_ -> M1 <$> gfromParam pt (pfx `nest` (modSelName fldN)) pa psett (submap pfx kvs)
@@ -1610,9 +1610,9 @@ instance (GToParam f parK, Constructor t) => GToParam (M1 C t f) parK where
16101610
instance (GToParam f parK) => GToParam (M1 D t f) parK where
16111611
gtoParam pt pfx pa psett (M1 x) = gtoParam pt pfx pa psett x
16121612

1613-
instance (GToParam f parK, Selector t, f ~ (K1 i c), Meta c (IsMeta c)) => GToParam (M1 S t f) parK where
1613+
instance (GToParam f parK, Selector t, f ~ (K1 i c), FieldModifier c (IsField c)) => GToParam (M1 S t f) parK where
16141614
gtoParam pt pfx pa psett m@(M1 x) = let fldN = ASCII.pack (selName m)
1615-
modSelName = meta (Proxy :: Proxy c) (Proxy :: Proxy (IsMeta c))
1615+
modSelName = fieldMod (Proxy :: Proxy c) (Proxy :: Proxy (IsField c))
16161616
in case fldN of
16171617
"" -> gtoParam pt (pfx `nest` numberedFld pa) pa psett x
16181618
_ -> gtoParam pt (pfx `nest` (modSelName fldN)) pa psett x

‎src/WebApi/Server.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -74,8 +74,7 @@ raise :: ( MonadThrow handM
7474
raise status errs = raiseWith' (ApiError status errs Nothing Nothing)
7575

7676
-- | This function short circuits returning an `ApiError`.
77-
raiseWith :: ( Monad handM
78-
, MonadThrow handM
77+
raiseWith :: ( MonadThrow handM
7978
, Typeable m
8079
, Typeable r
8180
) => Status

‎stack.yaml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
11
packages:
22
- '.'
3-
resolver: lts-3.5
3+
resolver: lts-5.13
44

‎webapi.cabal

Lines changed: 32 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
-- documentation, see http://haskell.org/cabal/users-guide/
33

44
name: webapi
5-
version: 0.2.1.0
5+
version: 0.2.2.0
66
synopsis: WAI based library for web api
77
description: WAI based library for web api
88
homepage: http://byteally.github.io/webapi/
@@ -36,29 +36,29 @@ library
3636

3737
other-modules: WebApi.Util
3838
-- other-extensions:
39-
build-depends: base >=4.7 && <4.9
40-
, text >=1.2 && <1.3
41-
, containers >=0.5 && <0.6
42-
, binary >=0.7 && <0.8
43-
, bytestring >=0.10 && <0.11
44-
, vector >=0.10 && < 0.12
45-
, aeson >=0.8 && <0.10
46-
, http-types == 0.8.*
47-
, blaze-builder == 0.4.*
39+
build-depends: base >= 4.7 && < 5
40+
, text >= 1.2 && < 1.3
41+
, containers >= 0.5 && < 0.6
42+
, binary >= 0.7 && < 0.9
43+
, bytestring >= 0.10 && < 0.11
44+
, vector >= 0.10 && < 0.12
45+
, aeson >= 0.8 && < 0.12
46+
, http-types >= 0.8 && < 0.10
47+
, blaze-builder >= 0.4 && < 0.5
4848
, bytestring-trie == 0.2.*
4949
, bytestring-lexing == 0.5.*
50-
, wai == 3.0.*
51-
, wai-extra == 3.0.*
50+
, wai >= 3.0 && < 3.3
51+
, wai-extra >= 3.0 && < 3.3
5252
, case-insensitive == 1.2.*
5353
, http-client == 0.4.*
5454
, http-client-tls == 0.2.*
55-
, network-uri == 2.6.*
56-
, time == 1.5.*
57-
, http-media == 0.6.*
58-
, resourcet == 1.1.*
59-
, exceptions == 0.8.*
60-
, transformers == 0.4.*
61-
, cookie == 0.4.*
55+
, network-uri >= 2.6 && < 2.7
56+
, time >= 1.5 && < 1.7
57+
, http-media >= 0.6 && < 0.7
58+
, resourcet >= 1.1 && < 1.2
59+
, exceptions >= 0.8 && < 1
60+
, transformers >= 0.4 && < 0.6
61+
, cookie >= 0.4 && < 0.5
6262
, QuickCheck == 2.8.*
6363

6464
hs-source-dirs: src
@@ -77,20 +77,20 @@ test-suite unit-tests
7777
hs-source-dirs: tests
7878
default-language: Haskell2010
7979
cpp-options: -DTEST
80-
-- ghc-options: -Wall
81-
build-depends: base >=4.7 && <4.9
82-
, aeson >=0.8 && <0.9
80+
ghc-options: -Wall
81+
build-depends: base >= 4.7 && < 5
82+
, aeson >= 0.8 && < 0.12
8383
, case-insensitive == 1.2.*
84-
, wai == 3.0.*
85-
, wai-extra == 3.0.*
86-
, warp == 3.1.*
87-
, http-media == 0.6.*
88-
, http-types == 0.8.*
89-
, hspec == 2.1.*
84+
, wai >= 3.0 && < 3.3
85+
, wai-extra >= 3.0 && < 3.3
86+
, warp
87+
, http-media >= 0.6 && < 0.7
88+
, http-types >= 0.8 && < 0.10
89+
, hspec >= 2.1 && < 2.3
9090
, hspec-wai == 0.6.*
91-
, text == 1.2.*
92-
, bytestring == 0.10.*
93-
, time == 1.5.*
94-
, vector == 0.10.*
91+
, text >= 1.2 && < 1.3
92+
, bytestring >= 0.10 && < 0.11
93+
, vector >= 0.10 && < 0.12
94+
, time >= 1.5 && < 1.7
9595
, QuickCheck == 2.8.*
9696
, webapi

0 commit comments

Comments
 (0)