servant-0.15: A family of combinators for defining webservices APIs

Safe HaskellSafe
LanguageHaskell2010

Servant.Types.SourceT

Synopsis

Documentation

>>> :set -XOverloadedStrings
>>> import Control.Monad.Except (runExcept)
>>> import Data.Foldable (toList)
>>> import qualified Data.Attoparsec.ByteString.Char8 as A8

newtype SourceT m a Source #

This is CPSised ListT.

Since: 0.15

Constructors

SourceT 

Fields

Instances
MonadIO m => FromSourceIO a (SourceT m a) Source # 
Instance details

Defined in Servant.API.Stream

Methods

fromSourceIO :: SourceIO a -> SourceT m a Source #

SourceToSourceIO m => ToSourceIO chunk (SourceT m chunk) Source #

Relax to use auxiliary class, have m

Instance details

Defined in Servant.API.Stream

Methods

toSourceIO :: SourceT m chunk -> SourceIO chunk Source #

Functor m => Functor (SourceT m) Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

fmap :: (a -> b) -> SourceT m a -> SourceT m b #

(<$) :: a -> SourceT m b -> SourceT m a #

Identity ~ m => Foldable (SourceT m) Source #
>>> toList (source [1..10])
[1,2,3,4,5,6,7,8,9,10]
Instance details

Defined in Servant.Types.SourceT

Methods

fold :: Monoid m0 => SourceT m m0 -> m0 #

foldMap :: Monoid m0 => (a -> m0) -> SourceT m a -> m0 #

foldr :: (a -> b -> b) -> b -> SourceT m a -> b #

foldr' :: (a -> b -> b) -> b -> SourceT m a -> b #

foldl :: (b -> a -> b) -> b -> SourceT m a -> b #

foldl' :: (b -> a -> b) -> b -> SourceT m a -> b #

foldr1 :: (a -> a -> a) -> SourceT m a -> a #

foldl1 :: (a -> a -> a) -> SourceT m a -> a #

toList :: SourceT m a -> [a] #

null :: SourceT m a -> Bool #

length :: SourceT m a -> Int #

elem :: Eq a => a -> SourceT m a -> Bool #

maximum :: Ord a => SourceT m a -> a #

minimum :: Ord a => SourceT m a -> a #

sum :: Num a => SourceT m a -> a #

product :: Num a => SourceT m a -> a #

(Applicative m, Show1 m) => Show1 (SourceT m) Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SourceT m a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [SourceT m a] -> ShowS #

MFunctor SourceT Source #
>>> hoist (Just . runIdentity) (source [1..3]) :: SourceT Maybe Int
fromStepT (Effect (Just (Yield 1 (Yield 2 (Yield 3 Stop)))))
Instance details

Defined in Servant.Types.SourceT

Methods

hoist :: Monad m => (forall a. m a -> n a) -> SourceT m b -> SourceT n b #

(Applicative m, Show1 m, Show a) => Show (SourceT m a) Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

showsPrec :: Int -> SourceT m a -> ShowS #

show :: SourceT m a -> String #

showList :: [SourceT m a] -> ShowS #

(Arbitrary a, Monad m) => Arbitrary (SourceT m a) Source #

Doesn't generate Error constructors. SourceT doesn't shrink.

Instance details

Defined in Servant.Types.SourceT

Methods

arbitrary :: Gen (SourceT m a) #

shrink :: SourceT m a -> [SourceT m a] #

mapStepT :: (StepT m a -> StepT m b) -> SourceT m a -> SourceT m b Source #

data StepT m a Source #

ListT with additional constructors.

Since: 0.15

Constructors

Stop 
Error String 
Skip (StepT m a) 
Yield a (StepT m a) 
Effect (m (StepT m a)) 
Instances
MonadTrans StepT Source #
>>> lift [1,2,3] :: StepT [] Int
Effect [Yield 1 Stop,Yield 2 Stop,Yield 3 Stop]
Instance details

Defined in Servant.Types.SourceT

Methods

lift :: Monad m => m a -> StepT m a #

Functor m => Functor (StepT m) Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

fmap :: (a -> b) -> StepT m a -> StepT m b #

(<$) :: a -> StepT m b -> StepT m a #

Identity ~ m => Foldable (StepT m) Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

fold :: Monoid m0 => StepT m m0 -> m0 #

foldMap :: Monoid m0 => (a -> m0) -> StepT m a -> m0 #

foldr :: (a -> b -> b) -> b -> StepT m a -> b #

foldr' :: (a -> b -> b) -> b -> StepT m a -> b #

foldl :: (b -> a -> b) -> b -> StepT m a -> b #

foldl' :: (b -> a -> b) -> b -> StepT m a -> b #

foldr1 :: (a -> a -> a) -> StepT m a -> a #

foldl1 :: (a -> a -> a) -> StepT m a -> a #

toList :: StepT m a -> [a] #

null :: StepT m a -> Bool #

length :: StepT m a -> Int #

elem :: Eq a => a -> StepT m a -> Bool #

maximum :: Ord a => StepT m a -> a #

minimum :: Ord a => StepT m a -> a #

sum :: Num a => StepT m a -> a #

product :: Num a => StepT m a -> a #

(Applicative m, Show1 m) => Show1 (StepT m) Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> StepT m a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [StepT m a] -> ShowS #

MFunctor StepT Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

hoist :: Monad m => (forall a. m a -> n a) -> StepT m b -> StepT n b #

(Applicative m, Show1 m, Show a) => Show (StepT m a) Source # 
Instance details

Defined in Servant.Types.SourceT

Methods

showsPrec :: Int -> StepT m a -> ShowS #

show :: StepT m a -> String #

showList :: [StepT m a] -> ShowS #

(Arbitrary a, Monad m) => Arbitrary (StepT m a) Source #

Doesn't generate Error constructors.

Instance details

Defined in Servant.Types.SourceT

Methods

arbitrary :: Gen (StepT m a) #

shrink :: StepT m a -> [StepT m a] #

fromStepT :: StepT m a -> SourceT m a Source #

Create SourceT from Step.

Note: often enough you want to use SourceT directly.

source :: [a] -> SourceT m a Source #

Create pure SourceT.

>>> source "foo" :: SourceT Identity Char
fromStepT (Effect (Identity (Yield 'f' (Yield 'o' (Yield 'o' Stop)))))

runSourceT :: Monad m => SourceT m a -> ExceptT String m [a] Source #

Get the answers.

>>> runSourceT (source "foo" :: SourceT Identity Char)
ExceptT (Identity (Right "foo"))
>>> runSourceT (source "foo" :: SourceT [] Char)
ExceptT [Right "foo"]

runStepT :: Monad m => StepT m a -> ExceptT String m [a] Source #

mapMaybe :: Functor m => (a -> Maybe b) -> SourceT m a -> SourceT m b Source #

Filter values.

>>> toList $ mapMaybe (\x -> if odd x then Just x else Nothing) (source [0..10]) :: [Int]
[1,3,5,7,9]
>>> mapMaybe (\x -> if odd x then Just x else Nothing) (source [0..2]) :: SourceT Identity Int
fromStepT (Effect (Identity (Skip (Yield 1 (Skip Stop)))))

Illustrates why we need Skip.

mapMaybeStep :: Functor m => (a -> Maybe b) -> StepT m a -> StepT m b Source #

foreach Source #

Arguments

:: Monad m 
=> (String -> m ())

error handler

-> (a -> m ()) 
-> SourceT m a 
-> m () 

Run action for each value in the SourceT.

>>> foreach fail print (source "abc")
'a'
'b'
'c'

foreachStep Source #

Arguments

:: Monad m 
=> (String -> m ())

error handler

-> (a -> m ()) 
-> StepT m a 
-> m () 

See foreach.

fromAction :: Functor m => (a -> Bool) -> m a -> SourceT m a Source #

fromActionStep :: Functor m => (a -> Bool) -> m a -> StepT m a Source #

readFile :: FilePath -> SourceT IO ByteString Source #

Read file.

>>> foreach fail BS.putStr (readFile "servant.cabal")
cabal-version:       >=1.10
name:                servant
...

transformWithAtto :: Monad m => Parser a -> SourceT m ByteString -> SourceT m a Source #

Transform using attoparsec parser.

Note: parser should not accept empty input!

>>> let parser = A.skipWhile A8.isSpace_w8 >> A.takeWhile1 A8.isDigit_w8
>>> runExcept $ runSourceT $ transformWithAtto parser (source ["1 2 3"])
Right ["1","2","3"]
>>> runExcept $ runSourceT $ transformWithAtto parser (source ["1", "2", "3"])
Right ["123"]
>>> runExcept $ runSourceT $ transformWithAtto parser (source ["1", "2 3", "4"])
Right ["12","34"]
>>> runExcept $ runSourceT $ transformWithAtto parser (source ["foobar"])
Left "Failed reading: takeWhile1"

transformStepWithAtto :: forall a m. Monad m => Parser a -> StepT m ByteString -> StepT m a Source #