git.iko.soy/servant
on master help sign in
Add default ToSample implementation for Generics

- introduce an internal `GToSample` class - introduce internal functions `defaultSample` and `defaultSamples` - add default signature for `toSamples` to use Generics - set default `toSamples` implementation to `defaultSamples` - remove the `MINIMAL` pragma to avoid warnings for empty instances

commit80f235b986d8f0d9fae53ce8ba9840e5664eeca7 authorNickolay Kudasov <nickolay.kudasov@gmail.com> dateSat 19 Sep 2015, 01:15 (11 years ago) parent019fad9
1 file changed+47−6
compare with master
unifiedsplit
servant-docs/src/Servant/Docs/Internal.hs+47−6
servant-docs/src/Servant/Docs/Internal.hs+47−6
@@ -1,6 +1,7 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE ConstraintKinds #-}
33{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE DefaultSignatures #-}
45{-# LANGUAGE DeriveGeneric #-}
56{-# LANGUAGE FlexibleContexts #-}
67{-# LANGUAGE FlexibleInstances #-}
@@ -19,10 +20,9 @@
1920#endif
2021module Servant.Docs.Internal where
2122
22−#if !MIN_VERSION_base(4,8,0)
2323import Control.Applicative
24−#endif
25−import Control.Lens hiding (List)
24+import Control.Arrow (second)
25+import Control.Lens hiding (List, to, from)
2626import Data.ByteString.Conversion (ToByteString, toByteString)
2727import Data.ByteString.Lazy.Char8 (ByteString)
2828import qualified Data.CaseInsensitive as CI
@@ -382,14 +382,55 @@ class HasDocs layout where
382382-- some context (as 'Text') that explains when you're supposed to
383383-- get the corresponding response.
384384class ToSample a b | a -> b where
385− {-# MINIMAL (toSample | toSamples) #-}
386385 toSample :: Proxy a -> Maybe b
387386 toSample _ = snd <$> listToMaybe samples
388387 where samples = toSamples (Proxy :: Proxy a)
389388
390389 toSamples :: Proxy a -> [(Text, b)]
391− toSamples _ = maybe [] (return . ("",)) s
392− where s = toSample (Proxy :: Proxy a)
390+ default toSamples :: (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
391+ toSamples = defaultSamples
392+
393+defaultSample :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> Maybe b
394+defaultSample _ = to <$> gtoSample (Proxy :: Proxy (Rep a))
395+
396+defaultSamples :: forall a b. (Generic a, Generic b, GToSample (Rep a) (Rep b)) => Proxy a -> [(Text, b)]
397+defaultSamples _ = second to <$> gtoSamples (Proxy :: Proxy (Rep a))
398+
399+class GToSample t s where
400+ gtoSample :: proxy t -> Maybe (s x)
401+ gtoSample _ = snd <$> listToMaybe (gtoSamples (Proxy :: Proxy t))
402+ gtoSamples :: proxy t -> [(Text, s x)]
403+ gtoSamples _ = maybe empty (pure . ("",)) (gtoSample (Proxy :: Proxy t))
404+
405+instance GToSample U1 U1 where
406+ gtoSample _ = Just U1
407+
408+instance GToSample V1 V1 where
409+ gtoSample _ = Nothing
410+
411+instance (GToSample p p', GToSample q q') => GToSample (p :*: q) (p' :*: q') where
412+ gtoSample _ = (:*:) <$> gtoSample (Proxy :: Proxy p) <*> gtoSample (Proxy :: Proxy q)
413+ gtoSamples _ = render <$> ps <*> qs
414+ where
415+ ps = gtoSamples (Proxy :: Proxy p)
416+ qs = gtoSamples (Proxy :: Proxy q)
417+ render (ta, a) (tb, b)
418+ | T.null ta || T.null tb = (ta <> tb, a :*: b)
419+ | otherwise = (ta <> ", " <> tb, a :*: b)
420+
421+instance (GToSample p p', GToSample q q') => GToSample (p :+: q) (p' :+: q') where
422+ gtoSamples _ = lefts <|> rights
423+ where
424+ lefts = second L1 <$> gtoSamples (Proxy :: Proxy p)
425+ rights = second R1 <$> gtoSamples (Proxy :: Proxy q)
426+
427+instance ToSample a b => GToSample (K1 i a) (K1 i b) where
428+ gtoSample _ = K1 <$> toSample (Proxy :: Proxy a)
429+ gtoSamples _ = second K1 <$> toSamples (Proxy :: Proxy a)
430+
431+instance (GToSample f g) => GToSample (M1 i a f) (M1 i a g) where
432+ gtoSample _ = M1 <$> gtoSample (Proxy :: Proxy f)
433+ gtoSamples _ = second M1 <$> gtoSamples (Proxy :: Proxy f)
393434
394435instance ToSample a b => ToSample (Headers ls a) b where
395436 toSample _ = toSample (Proxy :: Proxy a)