git.iko.soy/typeable/servant
on master help sign in
Merge pull request #238 from fizruk/simplify-ToSample-#211

Simplify ToSample (remove redundant second parameter)

commit1d248a573f771ff5c5aa9b0792ba39c5c21a8661 authorJulian Arni <jkarni@gmail.com> dateThu 24 Sep 2015, 15:03 (11 years ago) parentc4561b4f0c2284
6 files changed+62−64
servant-docs/CHANGELOG.md+1 servant-docs/example/greet.hs+2−2 servant-docs/src/Servant/Docs.hs+1−1 servant-docs/src/Servant/Docs/Internal.hs+47−50 servant-docs/test/Servant/DocsSpec.hs+7−7 servant-examples/tutorial/T10.hs+4−4
servant-docs/CHANGELOG.md+1
@@ -3,6 +3,7 @@ HEAD
33
44* Support for the `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators
55* Support maximum samples setting with new `DocOptions` type (used by `docsWithOptions` and `docsWith`)
6+* Remove redundant second parameter of ToSample
67* Add Generic-based default implementation for `ToSample` class
78* Add more `ToSamples` instances: `Bool`, `Ordering`, tuples (up to 7), `[]`, `Maybe`, `Either`, `Const`, `ZipList` and some monoids
89* Move `toSample` out of `ToSample` class
servant-docs/example/greet.hs+2−2
@@ -53,13 +53,13 @@ instance ToParam (MatrixParam "lang" String) where
5353 "Get the greeting message selected language. Default is en."
5454 Normal
5555
56−instance ToSample Greet Greet where
56+instance ToSample Greet where
5757 toSamples _ =
5858 [ ("If you use ?capital=true", Greet "HELLO, HASKELLER")
5959 , ("If you use ?capital=false", Greet "Hello, haskeller")
6060 ]
6161
62−instance ToSample Int Int where
62+instance ToSample Int where
6363 toSamples _ = singleSample 1729
6464
6565-- We define some introductory sections, these will appear at the top of the
servant-docs/src/Servant/Docs.hs+1−1
@@ -78,7 +78,7 @@
7878-- > "Get the greeting message selected language. Default is en."
7979-- > Normal
8080-- >
81−-- > instance ToSample Greet Greet where
81+-- > instance ToSample Greet where
8282-- > toSample _ = Just $ Greet "Hello, haskeller!"
8383-- >
8484-- > toSamples _ =
servant-docs/src/Servant/Docs/Internal.hs+47−50
@@ -394,7 +394,7 @@ class HasDocs layout where
394394-- > instance FromJSON Greet
395395-- > instance ToJSON Greet
396396-- >
397−-- > instance ToSample Greet Greet where
397+-- > instance ToSample Greet where
398398-- > toSamples _ = singleSample g
399399-- >
400400-- > where g = Greet "Hello, haskeller!"
@@ -403,13 +403,13 @@ class HasDocs layout where
403403-- 'toSample': it lets you specify different responses along with
404404-- some context (as 'Text') that explains when you're supposed to
405405-- get the corresponding response.
406−class ToSample a b | a -> b where
407− toSamples :: Proxy a -> [(Text, b)]
408− default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
406+class ToSample a where
407+ toSamples :: Proxy a -> [(Text, a)]
408+ default toSamples :: (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
409409 toSamples = defaultSamples
410410
411411-- | Sample input or output (if there is at least one).
412−toSample :: forall a b. ToSample a b => Proxy a -> Maybe b
412+toSample :: forall a. ToSample a => Proxy a -> Maybe a
413413toSample _ = snd <$> listToMaybe (toSamples (Proxy :: Proxy a))
414414
415415-- | No samples.
@@ -425,22 +425,22 @@ samples :: [a] -> [(Text, a)]
425425samples = map ("",)
426426
427427-- | Default sample Generic-based inputs/outputs.
428−defaultSamples :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
428+defaultSamples :: forall a. (Generic a, GToSample (Rep a)) => Proxy a -> [(Text, a)]
429429defaultSamples _ = Omega.runOmega $ second to <$> gtoSamples (Proxy :: Proxy (Rep a))
430430
431431-- | @'ToSample'@ for Generics.
432432--
433433-- The use of @'Omega'@ allows for more productive sample generation.
434−class GToSample t s where
435− gtoSamples :: proxy t -> Omega.Omega (Text, s x)
434+class GToSample t where
435+ gtoSamples :: proxy t -> Omega.Omega (Text, t x)
436436
437−instance GToSample U1 U1 where
437+instance GToSample U1 where
438438 gtoSamples _ = Omega.each (singleSample U1)
439439
440−instance GToSample V1 V1 where
440+instance GToSample V1 where
441441 gtoSamples _ = empty
442442
443−instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') where
443+instance (GToSample p, GToSample q) => GToSample (p :*: q) where
444444 gtoSamples _ = render <$> ps <*> qs
445445 where
446446 ps = gtoSamples (Proxy :: Proxy p)
@@ -449,21 +449,18 @@ instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') whe
449449 | T.null ta || T.null tb = (ta <> tb, a :*: b)
450450 | otherwise = (ta <> ", " <> tb, a :*: b)
451451
452−instance (GToSample p p', GToSample q q') => GToSample (p :+: q) (p' :+: q') where
452+instance (GToSample p, GToSample q) => GToSample (p :+: q) where
453453 gtoSamples _ = lefts <|> rights
454454 where
455455 lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
456456 rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
457457
458−instance ToSample a b => GToSample (K1 i a) (K1 i b) where
458+instance ToSample a => GToSample (K1 i a) where
459459 gtoSamples _ = second K1 <$> Omega.each (toSamples (Proxy :: Proxy a))
460460
461−instance (GToSample f g) => GToSample (M1 i a f) (M1 i a g) where
461+instance (GToSample f) => GToSample (M1 i a f) where
462462 gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
463463
464−instance ToSample a b => ToSample (Headers ls a) b where
465− toSamples _ = toSamples (Proxy :: Proxy a)
466−
467464
468465class AllHeaderSamples ls where
469466 allHeaderToSample :: Proxy ls -> [HTTP.Header]
@@ -471,7 +468,7 @@ class AllHeaderSamples ls where
471468instance AllHeaderSamples '[] where
472469 allHeaderToSample _ = []
473470
474−instance (ToByteString l, AllHeaderSamples ls, ToSample l l, KnownSymbol h)
471+instance (ToByteString l, AllHeaderSamples ls, ToSample l, KnownSymbol h)
475472 => AllHeaderSamples (Header h l ': ls) where
476473 allHeaderToSample _ = (mkHeader (toSample (Proxy :: Proxy l))) :
477474 allHeaderToSample (Proxy :: Proxy ls)
@@ -481,7 +478,7 @@ instance (ToByteString l, AllHeaderSamples ls, ToSample l l, KnownSymbol h)
481478
482479-- | Synthesise a sample value of a type, encoded in the specified media types.
483480sampleByteString
484− :: forall ctypes a b. (ToSample a b, IsNonEmpty ctypes, AllMimeRender ctypes b)
481+ :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
485482 => Proxy ctypes
486483 -> Proxy a
487484 -> [(M.MediaType, ByteString)]
@@ -491,7 +488,7 @@ sampleByteString ctypes@Proxy Proxy =
491488-- | Synthesise a list of sample values of a particular type, encoded in the
492489-- specified media types.
493490sampleByteStrings
494− :: forall ctypes a b. (ToSample a b, IsNonEmpty ctypes, AllMimeRender ctypes b)
491+ :: forall ctypes a. (ToSample a, IsNonEmpty ctypes, AllMimeRender ctypes a)
495492 => Proxy ctypes
496493 -> Proxy a
497494 -> [(Text, M.MediaType, ByteString)]
@@ -728,7 +725,7 @@ instance
728725#if MIN_VERSION_base(4,8,0)
729726 {-# OVERLAPPABLe #-}
730727#endif
731− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
728+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
732729 => HasDocs (Delete cts a) where
733730 docsFor Proxy (endpoint, action) DocOptions{..} =
734731 single endpoint' action'
@@ -743,7 +740,7 @@ instance
743740#if MIN_VERSION_base(4,8,0)
744741 {-# OVERLAPPING #-}
745742#endif
746− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
743+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts
747744 , AllHeaderSamples ls , GetHeaders (HList ls) )
748745 => HasDocs (Delete cts (Headers ls a)) where
749746 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -761,7 +758,7 @@ instance
761758#if MIN_VERSION_base(4,8,0)
762759 {-# OVERLAPPABLe #-}
763760#endif
764− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
761+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
765762 => HasDocs (Get cts a) where
766763 docsFor Proxy (endpoint, action) DocOptions{..} =
767764 single endpoint' action'
@@ -776,7 +773,7 @@ instance
776773#if MIN_VERSION_base(4,8,0)
777774 {-# OVERLAPPING #-}
778775#endif
779− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
776+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts
780777 , AllHeaderSamples ls , GetHeaders (HList ls) )
781778 => HasDocs (Get cts (Headers ls a)) where
782779 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -803,7 +800,7 @@ instance
803800#if MIN_VERSION_base(4,8,0)
804801 {-# OVERLAPPABLE #-}
805802#endif
806− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
803+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
807804 => HasDocs (Post cts a) where
808805 docsFor Proxy (endpoint, action) DocOptions{..} =
809806 single endpoint' action'
@@ -819,7 +816,7 @@ instance
819816#if MIN_VERSION_base(4,8,0)
820817 {-# OVERLAPPING #-}
821818#endif
822− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
819+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts
823820 , AllHeaderSamples ls , GetHeaders (HList ls) )
824821 => HasDocs (Post cts (Headers ls a)) where
825822 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -838,7 +835,7 @@ instance
838835#if MIN_VERSION_base(4,8,0)
839836 {-# OVERLAPPABLE #-}
840837#endif
841− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts)
838+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts)
842839 => HasDocs (Put cts a) where
843840 docsFor Proxy (endpoint, action) DocOptions{..} =
844841 single endpoint' action'
@@ -854,7 +851,7 @@ instance
854851#if MIN_VERSION_base(4,8,0)
855852 {-# OVERLAPPING #-}
856853#endif
857− (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts
854+ (ToSample a, IsNonEmpty cts, AllMimeRender cts a, SupportedTypes cts
858855 , AllHeaderSamples ls , GetHeaders (HList ls) )
859856 => HasDocs (Put cts (Headers ls a)) where
860857 docsFor Proxy (endpoint, action) DocOptions{..} =
@@ -951,7 +948,7 @@ instance HasDocs Raw where
951948-- example data. However, there's no reason to believe that the instances of
952949-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
953950-- both are even defined) for any particular type.
954−instance (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, HasDocs sublayout
951+instance (ToSample a, IsNonEmpty cts, AllMimeRender cts a, HasDocs sublayout
955952 , SupportedTypes cts)
956953 => HasDocs (ReqBody cts a :> sublayout) where
957954
@@ -990,32 +987,32 @@ instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
990987 docsFor (Proxy :: Proxy sublayout) ep
991988
992989-- ToSample instances for simple types
993−instance ToSample () ()
994−instance ToSample Bool Bool
995−instance ToSample Ordering Ordering
990+instance ToSample ()
991+instance ToSample Bool
992+instance ToSample Ordering
996993
997994-- polymorphic ToSample instances
998−instance (ToSample a a, ToSample b b) => ToSample (a, b) (a, b)
999−instance (ToSample a a, ToSample b b, ToSample c c) => ToSample (a, b, c) (a, b, c)
1000−instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d) => ToSample (a, b, c, d) (a, b, c, d)
1001−instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e) => ToSample (a, b, c, d, e) (a, b, c, d, e)
1002−instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e, ToSample f f) => ToSample (a, b, c, d, e, f) (a, b, c, d, e, f)
1003−instance (ToSample a a, ToSample b b, ToSample c c, ToSample d d, ToSample e e, ToSample f f, ToSample g g) => ToSample (a, b, c, d, e, f, g) (a, b, c, d, e, f, g)
995+instance (ToSample a, ToSample b) => ToSample (a, b)
996+instance (ToSample a, ToSample b, ToSample c) => ToSample (a, b, c)
997+instance (ToSample a, ToSample b, ToSample c, ToSample d) => ToSample (a, b, c, d)
998+instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e) => ToSample (a, b, c, d, e)
999+instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f) => ToSample (a, b, c, d, e, f)
1000+instance (ToSample a, ToSample b, ToSample c, ToSample d, ToSample e, ToSample f, ToSample g) => ToSample (a, b, c, d, e, f, g)
10041001
1005−instance ToSample a a => ToSample (Maybe a) (Maybe a)
1006−instance (ToSample a a, ToSample b b) => ToSample (Either a b) (Either a b)
1007−instance ToSample a a => ToSample [a] [a]
1002+instance ToSample a => ToSample (Maybe a)
1003+instance (ToSample a, ToSample b) => ToSample (Either a b)
1004+instance ToSample a => ToSample [a]
10081005
10091006-- ToSample instances for Control.Applicative types
1010−instance ToSample a a => ToSample (Const a b) (Const a b)
1011−instance ToSample a a => ToSample (ZipList a) (ZipList a)
1007+instance ToSample a => ToSample (Const a b)
1008+instance ToSample a => ToSample (ZipList a)
10121009
10131010-- ToSample instances for Data.Monoid newtypes
1014−instance ToSample All All
1015−instance ToSample Any Any
1016−instance ToSample a a => ToSample (Sum a) (Sum a)
1017−instance ToSample a a => ToSample (Product a) (Product a)
1018−instance ToSample a a => ToSample (First a) (First a)
1019−instance ToSample a a => ToSample (Last a) (Last a)
1020−instance ToSample a a => ToSample (Dual a) (Dual a)
1011+instance ToSample All
1012+instance ToSample Any
1013+instance ToSample a => ToSample (Sum a)
1014+instance ToSample a => ToSample (Product a)
1015+instance ToSample a => ToSample (First a)
1016+instance ToSample a => ToSample (Last a)
1017+instance ToSample a => ToSample (Dual a)
10211018
servant-docs/test/Servant/DocsSpec.hs+7−7
@@ -30,7 +30,7 @@ spec = describe "Servant.Docs" $ do
3030 describe "markdown with extra info" $ do
3131 let
3232 extra = extraInfo
33− (Proxy :: Proxy (Get '[JSON, PlainText] Int))
33+ (Proxy :: Proxy (Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)))
3434 (defAction & notes <>~ [DocNote "Get an Integer" ["get an integer in Json or plain text"]])
3535 <>
3636 extraInfo
@@ -90,26 +90,26 @@ data Datatype1 = Datatype1 { dt1field1 :: String
9090
9191instance ToJSON Datatype1
9292
93−instance ToSample Datatype1 Datatype1 where
93+instance ToSample Datatype1 where
9494 toSamples _ = singleSample $ Datatype1 "field 1" 13
9595
96−instance ToSample Char Char where
96+instance ToSample Char where
9797 toSamples _ = samples ['a'..'z']
9898
99−instance ToSample Int Int where
99+instance ToSample Int where
100100 toSamples _ = singleSample 17
101101
102102instance MimeRender PlainText Int where
103103 mimeRender _ = cs . show
104104
105−type TestApi1 = Get '[JSON, PlainText] Int
105+type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
106106 :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
107107
108108data TT = TT1 | TT2 deriving (Show, Eq)
109109data UT = UT1 | UT2 deriving (Show, Eq)
110110
111−instance ToSample TT TT where
111+instance ToSample TT where
112112 toSamples _ = [("eins", TT1), ("zwei", TT2)]
113113
114−instance ToSample UT UT where
114+instance ToSample UT where
115115 toSamples _ = [("yks", UT1), ("kaks", UT2)]
servant-examples/tutorial/T10.hs+4−4
@@ -23,7 +23,7 @@ instance ToCapture (Capture "x" Int) where
2323instance ToCapture (Capture "y" Int) where
2424 toCapture _ = DocCapture "y" "(integer) position on the y axis"
2525
26−instance ToSample T3.Position T3.Position where
26+instance ToSample T3.Position where
2727 toSamples _ = singleSample (T3.Position 3 14)
2828
2929instance ToParam (QueryParam "name" String) where
@@ -33,7 +33,7 @@ instance ToParam (QueryParam "name" String) where
3333 "Name of the person to say hello to."
3434 Normal
3535
36−instance ToSample T3.HelloMessage T3.HelloMessage where
36+instance ToSample T3.HelloMessage where
3737 toSamples _ =
3838 [ ("When a value is provided for 'name'", T3.HelloMessage "Hello, Alp")
3939 , ("When 'name' is not specified", T3.HelloMessage "Hello, anonymous coward")
@@ -42,10 +42,10 @@ instance ToSample T3.HelloMessage T3.HelloMessage where
4242ci :: T3.ClientInfo
4343ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
4444
45−instance ToSample T3.ClientInfo T3.ClientInfo where
45+instance ToSample T3.ClientInfo where
4646 toSamples _ = singleSample ci
4747
48−instance ToSample T3.Email T3.Email where
48+instance ToSample T3.Email where
4949 toSamples _ = singleSample (T3.emailForClient ci)
5050
5151api :: Proxy DocsAPI