diff --git a/servant/servant.cabal b/servant/servant.cabal index 99b1f7f7..94e0ad1e 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -1,27 +1,31 @@ +cabal-version: >=1.10 name: servant version: 0.15 + synopsis: A family of combinators for defining webservices APIs +category: Servant, Web description: A family of combinators for defining webservices APIs and serving them . You can learn about the basics in the . . + homepage: http://haskell-servant.readthedocs.org/ -Bug-reports: http://github.com/haskell-servant/servant/issues +bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3 license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com -copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors -category: Servant, Web +copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors build-type: Custom -cabal-version: >=1.10 + tested-with: GHC==8.0.2 GHC==8.2.2 GHC==8.4.4 GHC==8.6.2 + extra-source-files: CHANGELOG.md @@ -103,6 +107,7 @@ library , http-types >= 0.12.2 && < 0.13 , mmorph >= 1.1.2 && < 1.2 , network-uri >= 2.6.1.0 && < 2.7 + , QuickCheck >= 2.12.6.1 && <2.13 , singleton-bool >= 0.1.4 && < 0.2 , string-conversions >= 0.4.0.1 && < 0.5 , tagged >= 0.8.6 && < 0.9 diff --git a/servant/src/Servant/Types/SourceT.hs b/servant/src/Servant/Types/SourceT.hs index 14e6642f..284be4bf 100644 --- a/servant/src/Servant/Types/SourceT.hs +++ b/servant/src/Servant/Types/SourceT.hs @@ -16,10 +16,12 @@ import Data.Functor.Classes (Show1 (..), showsBinaryWith, showsPrec1, showsUnaryWith) import Data.Functor.Identity (Identity (..)) -import Prelude hiding +import Prelude () +import Prelude.Compat hiding (readFile) import System.IO (Handle, IOMode (..), withFile) +import qualified Test.QuickCheck as QC -- $setup -- >>> :set -XOverloadedStrings @@ -28,6 +30,9 @@ import System.IO -- >>> import qualified Data.Attoparsec.ByteString.Char8 as A8 -- | This is CPSised ListT. +-- +-- @since 0.15 +-- newtype SourceT m a = SourceT { unSourceT :: forall b. (StepT m a -> m b) -> m b } @@ -37,6 +42,9 @@ mapStepT f (SourceT m) = SourceT $ \k -> m (k . f) {-# INLINE mapStepT #-} -- | @ListT@ with additional constructors. +-- +-- @since 0.15 +-- data StepT m a = Stop | Error String -- we can this argument configurable. @@ -81,6 +89,20 @@ instance MFunctor SourceT where hoist f (SourceT m) = SourceT $ \k -> k $ Effect $ f $ fmap (hoist f) $ m return +-- | Doesn't generate 'Error' constructors. 'SourceT' doesn't shrink. +instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (SourceT m a) where + arbitrary = fromStepT <$> QC.arbitrary + +-- An example of above instance. Not doctested because it's volatile. +-- +-- >>> import Test.QuickCheck as QC +-- >>> import Test.QuickCheck.Gen as QC +-- >>> import Test.QuickCheck.Random as QC +-- >>> let generate (QC.MkGen g) = g (QC.mkQCGen 44) 10 +-- +-- >>> generate (arbitrary :: QC.Gen (SourceT Identity Int)) +-- fromStepT (Effect (Identity (Yield (-10) (Yield 3 (Skip (Yield 1 Stop)))))) + ------------------------------------------------------------------------------- -- StepT instances ------------------------------------------------------------------------------- @@ -128,6 +150,27 @@ instance MFunctor StepT where go (Yield x s) = Yield x (go s) go (Effect ms) = Effect (f (fmap go ms)) +-- | Doesn't generate 'Error' constructors. +instance (QC.Arbitrary a, Monad m) => QC.Arbitrary (StepT m a) where + arbitrary = QC.sized arb where + arb n | n <= 0 = pure Stop + | otherwise = QC.frequency + [ (1, pure Stop) + , (1, Skip <$> arb') + , (1, Effect . return <$> arb') + , (8, Yield <$> QC.arbitrary <*> arb') + ] + where + arb' = arb (n - 1) + + shrink Stop = [] + shrink (Error _) = [Stop] + shrink (Skip s) = [s] + shrink (Effect _) = [] + shrink (Yield x s) = + [ Yield x' s | x' <- QC.shrink x ] ++ + [ Yield x s' | s' <- QC.shrink s ] + ------------------------------------------------------------------------------- -- Operations ------------------------------------------------------------------------------- @@ -244,6 +287,7 @@ fromActionStep stop action = loop where -- | Read file. -- -- >>> foreach fail BS.putStr (readFile "servant.cabal") +-- cabal-version: >=1.10 -- name: servant -- ... --