winery-1.1.3: A compact, well-typed seralisation format for Haskell values

Copyright(c) Fumiaki Kinoshita 2019
LicenseBSD3
StabilityProvisional
Safe HaskellNone
LanguageHaskell2010

Codec.Winery

Contents

Description

Maintainer : Fumiaki Kinoshita fumiexcel@gmail.com

Synopsis

Documentation

type Schema = SchemaP Int Source #

A schema preserves structure of a datatype, allowing users to inspect the data regardless of the current implementation.

"Yeah, it’s just a memento. Just, you know, from the first time we met."

data SchemaP a Source #

The basic schema datatype

Constructors

SFix !(SchemaP a)

binds a fixpoint

SVar !a

SVar n refers to the n-th innermost fixpoint

SVector !(SchemaP a) 
SProduct !(Vector (SchemaP a)) 
SRecord !(Vector (Text, SchemaP a)) 
SVariant !(Vector (Text, SchemaP a)) 
SBool 
SChar 
SWord8 
SWord16 
SWord32 
SWord64 
SInt8 
SInt16 
SInt32 
SInt64 
SInteger 
SFloat 
SDouble 
SBytes 
SText 
SUTCTime

nanoseconds from POSIX epoch

STag !Tag !(SchemaP a) 
SLet !(SchemaP a) !(SchemaP a) 
Instances
Functor SchemaP Source # 
Instance details

Defined in Codec.Winery.Base

Methods

fmap :: (a -> b) -> SchemaP a -> SchemaP b #

(<$) :: a -> SchemaP b -> SchemaP a #

Foldable SchemaP Source # 
Instance details

Defined in Codec.Winery.Base

Methods

fold :: Monoid m => SchemaP m -> m #

foldMap :: Monoid m => (a -> m) -> SchemaP a -> m #

foldr :: (a -> b -> b) -> b -> SchemaP a -> b #

foldr' :: (a -> b -> b) -> b -> SchemaP a -> b #

foldl :: (b -> a -> b) -> b -> SchemaP a -> b #

foldl' :: (b -> a -> b) -> b -> SchemaP a -> b #

foldr1 :: (a -> a -> a) -> SchemaP a -> a #

foldl1 :: (a -> a -> a) -> SchemaP a -> a #

toList :: SchemaP a -> [a] #

null :: SchemaP a -> Bool #

length :: SchemaP a -> Int #

elem :: Eq a => a -> SchemaP a -> Bool #

maximum :: Ord a => SchemaP a -> a #

minimum :: Ord a => SchemaP a -> a #

sum :: Num a => SchemaP a -> a #

product :: Num a => SchemaP a -> a #

Traversable SchemaP Source # 
Instance details

Defined in Codec.Winery.Base

Methods

traverse :: Applicative f => (a -> f b) -> SchemaP a -> f (SchemaP b) #

sequenceA :: Applicative f => SchemaP (f a) -> f (SchemaP a) #

mapM :: Monad m => (a -> m b) -> SchemaP a -> m (SchemaP b) #

sequence :: Monad m => SchemaP (m a) -> m (SchemaP a) #

Serialise Schema Source # 
Instance details

Defined in Codec.Winery.Class

Eq a => Eq (SchemaP a) Source # 
Instance details

Defined in Codec.Winery.Base

Methods

(==) :: SchemaP a -> SchemaP a -> Bool #

(/=) :: SchemaP a -> SchemaP a -> Bool #

Read a => Read (SchemaP a) Source # 
Instance details

Defined in Codec.Winery.Base

Show a => Show (SchemaP a) Source # 
Instance details

Defined in Codec.Winery.Base

Methods

showsPrec :: Int -> SchemaP a -> ShowS #

show :: SchemaP a -> String #

showList :: [SchemaP a] -> ShowS #

Generic (SchemaP a) Source # 
Instance details

Defined in Codec.Winery.Base

Associated Types

type Rep (SchemaP a) :: Type -> Type #

Methods

from :: SchemaP a -> Rep (SchemaP a) x #

to :: Rep (SchemaP a) x -> SchemaP a #

Pretty a => Pretty (SchemaP a) Source # 
Instance details

Defined in Codec.Winery.Base

Methods

pretty :: SchemaP a -> Doc ann #

prettyList :: [SchemaP a] -> Doc ann #

type Rep (SchemaP a) Source # 
Instance details

Defined in Codec.Winery.Base

type Rep (SchemaP a) = D1 (MetaData "SchemaP" "Codec.Winery.Base" "winery-1.1.3-1nbpufM5bHiLQUUGyeG9nl" False) ((((C1 (MetaCons "SFix" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (SchemaP a))) :+: (C1 (MetaCons "SVar" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 a)) :+: C1 (MetaCons "SVector" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (SchemaP a))))) :+: (C1 (MetaCons "SProduct" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Vector (SchemaP a)))) :+: (C1 (MetaCons "SRecord" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Vector (Text, SchemaP a)))) :+: C1 (MetaCons "SVariant" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Vector (Text, SchemaP a))))))) :+: ((C1 (MetaCons "SBool" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "SChar" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "SWord8" PrefixI False) (U1 :: Type -> Type))) :+: (C1 (MetaCons "SWord16" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "SWord32" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "SWord64" PrefixI False) (U1 :: Type -> Type))))) :+: (((C1 (MetaCons "SInt8" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "SInt16" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "SInt32" PrefixI False) (U1 :: Type -> Type))) :+: (C1 (MetaCons "SInt64" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "SInteger" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "SFloat" PrefixI False) (U1 :: Type -> Type)))) :+: ((C1 (MetaCons "SDouble" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "SBytes" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "SText" PrefixI False) (U1 :: Type -> Type))) :+: (C1 (MetaCons "SUTCTime" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "STag" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Tag) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (SchemaP a))) :+: C1 (MetaCons "SLet" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (SchemaP a)) :*: S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (SchemaP a))))))))

data Tag Source #

Tag is an extra value that can be attached to a schema.

Constructors

TagInt !Int 
TagStr !Text 
TagList ![Tag] 
Instances
IsList Tag Source # 
Instance details

Defined in Codec.Winery.Base

Associated Types

type Item Tag :: Type #

Methods

fromList :: [Item Tag] -> Tag #

fromListN :: Int -> [Item Tag] -> Tag #

toList :: Tag -> [Item Tag] #

Eq Tag Source # 
Instance details

Defined in Codec.Winery.Base

Methods

(==) :: Tag -> Tag -> Bool #

(/=) :: Tag -> Tag -> Bool #

Read Tag Source # 
Instance details

Defined in Codec.Winery.Base

Show Tag Source # 
Instance details

Defined in Codec.Winery.Base

Methods

showsPrec :: Int -> Tag -> ShowS #

show :: Tag -> String #

showList :: [Tag] -> ShowS #

IsString Tag Source # 
Instance details

Defined in Codec.Winery.Base

Methods

fromString :: String -> Tag #

Generic Tag Source # 
Instance details

Defined in Codec.Winery.Base

Associated Types

type Rep Tag :: Type -> Type #

Methods

from :: Tag -> Rep Tag x #

to :: Rep Tag x -> Tag #

Pretty Tag Source # 
Instance details

Defined in Codec.Winery.Base

Methods

pretty :: Tag -> Doc ann #

prettyList :: [Tag] -> Doc ann #

Serialise Tag Source # 
Instance details

Defined in Codec.Winery.Class

type Rep Tag Source # 
Instance details

Defined in Codec.Winery.Base

type Item Tag Source # 
Instance details

Defined in Codec.Winery.Base

type Item Tag = Tag

class Typeable a => Serialise a where Source #

Serialisable datatype

Methods

schemaGen :: Proxy a -> SchemaGen Schema Source #

Obtain the schema of the datatype.

toBuilder :: a -> Builder Source #

Serialise a value.

extractor :: Extractor a Source #

A value of 'Extractor a' interprets a schema and builds a function from Term to a. This must be equivalent to decodeCurrent when the schema is the current one.

If extractor s returns a function, the function must return a non-bottom for any Term decodeTerm s returns.

It must not return a function if an unsupported schema is supplied.

getDecoderBy extractor (schema (Proxy a)) must be Right d where d@ is equivalent to decodeCurrent.

decodeCurrent :: Decoder a Source #

Decode a value with the current schema.

decodeCurrent evalDecoder toBuilder x ≡ x

bundleSerialise :: BundleSerialise a Source #

Instead of the four methods above, you can supply a bundle.

Instances
Serialise Bool Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Char Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Double Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Float Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Int Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Int8 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Int16 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Int32 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Int64 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Integer Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Natural Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Ordering Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Word Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Word8 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Word16 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Word32 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Word64 Source # 
Instance details

Defined in Codec.Winery.Class

Serialise () Source # 
Instance details

Defined in Codec.Winery.Class

Serialise ByteString Source # 
Instance details

Defined in Codec.Winery.Class

Serialise ByteString Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Scientific Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Text Source # 
Instance details

Defined in Codec.Winery.Class

Serialise UTCTime Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Void Source # 
Instance details

Defined in Codec.Winery.Class

Serialise All Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Any Source # 
Instance details

Defined in Codec.Winery.Class

Serialise IntSet Source # 
Instance details

Defined in Codec.Winery.Class

Serialise NominalDiffTime Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Schema Source # 
Instance details

Defined in Codec.Winery.Class

Serialise Tag Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise [a] Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Maybe a) Source # 
Instance details

Defined in Codec.Winery.Class

(Integral a, Serialise a) => Serialise (Ratio a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Complex a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Min a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Max a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (First a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Last a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Option a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (ZipList a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Identity a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (First a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Last a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Dual a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Sum a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Product a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Down a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise v => Serialise (IntMap v) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Seq a) Source # 
Instance details

Defined in Codec.Winery.Class

(Ord a, Serialise a) => Serialise (Set a) Source # 
Instance details

Defined in Codec.Winery.Class

(Unbox a, Serialise a) => Serialise (Vector a) Source # 
Instance details

Defined in Codec.Winery.Class

(Storable a, Serialise a) => Serialise (Vector a) Source # 
Instance details

Defined in Codec.Winery.Class

Serialise a => Serialise (Vector a) Source # 
Instance details

Defined in Codec.Winery.Class

(Typeable a, Bits a, Integral a) => Serialise (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

(GConstructorCount (Rep a), GSerialiseVariant (Rep a), GEncodeVariant (Rep a), GDecodeVariant (Rep a), Generic a, Typeable a) => Serialise (WineryVariant a) Source # 
Instance details

Defined in Codec.Winery

(GEncodeProduct (Rep a), GSerialiseProduct (Rep a), GDecodeProduct (Rep a), Generic a, Typeable a) => Serialise (WineryProduct a) Source # 
Instance details

Defined in Codec.Winery

(GEncodeProduct (Rep a), GSerialiseRecord (Rep a), GDecodeProduct (Rep a), Generic a, Typeable a) => Serialise (WineryRecord a) Source # 
Instance details

Defined in Codec.Winery

(Serialise a, Serialise b) => Serialise (Either a b) Source # 
Instance details

Defined in Codec.Winery.Class

(Serialise a, Serialise b) => Serialise (a, b) Source # 
Instance details

Defined in Codec.Winery.Class

(Eq k, Hashable k, Serialise k, Serialise v) => Serialise (HashMap k v) Source # 
Instance details

Defined in Codec.Winery.Class

(Ord k, Serialise k, Serialise v) => Serialise (Map k v) Source # 
Instance details

Defined in Codec.Winery.Class

(Serialise a, Serialise b) => Serialise (Arg a b) Source # 
Instance details

Defined in Codec.Winery.Class

(Serialise a, Serialise b, Serialise c) => Serialise (a, b, c) Source # 
Instance details

Defined in Codec.Winery.Class

(Serialise a, Typeable b, Typeable k) => Serialise (Const a b) Source # 
Instance details

Defined in Codec.Winery.Class

(Typeable k, Typeable f, Typeable a, Serialise (f a)) => Serialise (Ap f a) Source # 
Instance details

Defined in Codec.Winery.Class

(Typeable k, Typeable f, Typeable a, Serialise (f a)) => Serialise (Alt f a) Source # 
Instance details

Defined in Codec.Winery.Class

(Typeable k, Typeable a, Typeable b, a ~ b) => Serialise (a :~: b) Source # 
Instance details

Defined in Codec.Winery.Class

(Serialise a, Serialise b, Serialise c, Serialise d) => Serialise (a, b, c, d) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

schemaGen :: Proxy (a, b, c, d) -> SchemaGen Schema Source #

toBuilder :: (a, b, c, d) -> Builder Source #

extractor :: Extractor (a, b, c, d) Source #

decodeCurrent :: Decoder (a, b, c, d) Source #

bundleSerialise :: BundleSerialise (a, b, c, d) Source #

(Serialise a, Serialise b, Serialise c, Serialise d, Serialise e) => Serialise (a, b, c, d, e) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

schemaGen :: Proxy (a, b, c, d, e) -> SchemaGen Schema Source #

toBuilder :: (a, b, c, d, e) -> Builder Source #

extractor :: Extractor (a, b, c, d, e) Source #

decodeCurrent :: Decoder (a, b, c, d, e) Source #

bundleSerialise :: BundleSerialise (a, b, c, d, e) Source #

(Typeable j, Typeable k, Typeable f, Typeable g, Typeable a, Serialise (f (g a))) => Serialise (Compose f g a) Source # 
Instance details

Defined in Codec.Winery.Class

(Serialise a, Serialise b, Serialise c, Serialise d, Serialise e, Serialise f) => Serialise (a, b, c, d, e, f) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

schemaGen :: Proxy (a, b, c, d, e, f) -> SchemaGen Schema Source #

toBuilder :: (a, b, c, d, e, f) -> Builder Source #

extractor :: Extractor (a, b, c, d, e, f) Source #

decodeCurrent :: Decoder (a, b, c, d, e, f) Source #

bundleSerialise :: BundleSerialise (a, b, c, d, e, f) Source #

testSerialise :: forall a. (Eq a, Show a, Serialise a) => a -> Property Source #

Check the integrity of a Serialise instance.

"No tears in the writer, no tears in the reader. No surprise in the writer, no surprise in the reader."

schema :: forall proxy a. Serialise a => proxy a -> Schema Source #

Obtain the schema of the datatype.

"Tell me what you drink, and I will tell you what you are."

Standalone serialisation

toBuilderWithSchema :: forall a. Serialise a => a -> Builder Source #

Serialise a value with the schema.

serialise :: Serialise a => a -> ByteString Source #

Serialise a value along with its schema.

"Write the vision, and make it plain upon tables, that he may run that readeth it."

deserialise :: Serialise a => ByteString -> Either WineryException a Source #

Deserialise a serialised Bytestring.

"Old wood to burn! Old wine to drink! Old friends to trust! Old authors to read!"

writeFileSerialise :: Serialise a => FilePath -> a -> IO () Source #

serialise then write it to a file.

readFileDeserialise :: Serialise a => FilePath -> IO a Source #

Deserialise a file. Throws WineryException

Separate serialisation

serialiseSchema :: Schema -> ByteString Source #

Serialise a schema (prefix with the version number only).

newtype Extractor a Source #

Extractor is a Plan that creates a function to extract a value from Term.

The Applicative instance can be used to build a user-defined extractor. This is also Alternative, meaning that fallback plans may be added.

"Don't get set into one form, adapt it and build your own, and let it grow, be like water."

Constructors

Extractor 

Fields

Instances
Functor Extractor Source # 
Instance details

Defined in Codec.Winery.Base

Methods

fmap :: (a -> b) -> Extractor a -> Extractor b #

(<$) :: a -> Extractor b -> Extractor a #

Applicative Extractor Source # 
Instance details

Defined in Codec.Winery.Base

Methods

pure :: a -> Extractor a #

(<*>) :: Extractor (a -> b) -> Extractor a -> Extractor b #

liftA2 :: (a -> b -> c) -> Extractor a -> Extractor b -> Extractor c #

(*>) :: Extractor a -> Extractor b -> Extractor b #

(<*) :: Extractor a -> Extractor b -> Extractor a #

Alternative Extractor Source # 
Instance details

Defined in Codec.Winery.Base

Methods

empty :: Extractor a #

(<|>) :: Extractor a -> Extractor a -> Extractor a #

some :: Extractor a -> Extractor [a] #

many :: Extractor a -> Extractor [a] #

data Decoder a Source #

The Decoder monad

Instances
Monad Decoder Source # 
Instance details

Defined in Codec.Winery.Internal

Methods

(>>=) :: Decoder a -> (a -> Decoder b) -> Decoder b #

(>>) :: Decoder a -> Decoder b -> Decoder b #

return :: a -> Decoder a #

fail :: String -> Decoder a #

Functor Decoder Source # 
Instance details

Defined in Codec.Winery.Internal

Methods

fmap :: (a -> b) -> Decoder a -> Decoder b #

(<$) :: a -> Decoder b -> Decoder a #

Applicative Decoder Source # 
Instance details

Defined in Codec.Winery.Internal

Methods

pure :: a -> Decoder a #

(<*>) :: Decoder (a -> b) -> Decoder a -> Decoder b #

liftA2 :: (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c #

(*>) :: Decoder a -> Decoder b -> Decoder b #

(<*) :: Decoder a -> Decoder b -> Decoder a #

serialiseOnly :: Serialise a => a -> ByteString Source #

Serialise a value without its schema.

"Any unsaved progress will be lost."

getDecoder :: forall a. Serialise a => Schema -> Either WineryException (Decoder a) Source #

Obtain a decoder from a schema.

"A reader lives a thousand lives before he dies... The man who never reads lives only one."

getDecoderBy :: Extractor a -> Schema -> Either WineryException (Decoder a) Source #

Get a decoder from a Extractor and a schema.

Decoding combinators

data Term Source #

Common representation for any winery data. Handy for prettyprinting winery-serialised data.

Instances
Show Term Source # 
Instance details

Defined in Codec.Winery.Base

Methods

showsPrec :: Int -> Term -> ShowS #

show :: Term -> String #

showList :: [Term] -> ShowS #

ToJSON Term Source # 
Instance details

Defined in Codec.Winery.Base

Pretty Term Source # 
Instance details

Defined in Codec.Winery.Base

Methods

pretty :: Term -> Doc ann #

prettyList :: [Term] -> Doc ann #

newtype Subextractor a Source #

An extractor for individual fields. This distinction is required for handling recursions correctly.

Recommended extension: ApplicativeDo

Constructors

Subextractor 
Instances
Functor Subextractor Source # 
Instance details

Defined in Codec.Winery

Methods

fmap :: (a -> b) -> Subextractor a -> Subextractor b #

(<$) :: a -> Subextractor b -> Subextractor a #

Applicative Subextractor Source # 
Instance details

Defined in Codec.Winery

Alternative Subextractor Source # 
Instance details

Defined in Codec.Winery

buildExtractor :: Typeable a => Subextractor a -> Extractor a Source #

Build an extractor from a Subextractor.

extractListBy :: Typeable a => Extractor a -> Extractor (Vector a) Source #

Extract a list or an array of values.

extractField :: Serialise a => Text -> Subextractor a Source #

Extract a field of a record.

extractFieldBy :: Extractor a -> Text -> Subextractor a Source #

Extract a field using the supplied Extractor.

extractConstructor :: Serialise a => (Text, a -> r) -> Subextractor r -> Subextractor r infixr 1 Source #

Tries to match on a constructor. If it doesn't match (or constructor doesn't exist at all), leave it to the successor.

extractor = (Just, Just) extractConstructor (Nothing, () -> Nothing) extractConstructor extractVoid

extractConstructorBy :: Typeable a => (Extractor a, Text, a -> r) -> Subextractor r -> Subextractor r infixr 1 Source #

Tries to extract a specific constructor of a variant. Useful for implementing backward-compatible extractors.

extractVoid :: Typeable r => Subextractor r Source #

No constructors remaining.

Variable-length quantity

newtype VarInt a Source #

Encoded in variable-length quantity.

Constructors

VarInt 

Fields

Instances
Bounded a => Bounded (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

minBound :: VarInt a #

maxBound :: VarInt a #

Enum a => Enum (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

succ :: VarInt a -> VarInt a #

pred :: VarInt a -> VarInt a #

toEnum :: Int -> VarInt a #

fromEnum :: VarInt a -> Int #

enumFrom :: VarInt a -> [VarInt a] #

enumFromThen :: VarInt a -> VarInt a -> [VarInt a] #

enumFromTo :: VarInt a -> VarInt a -> [VarInt a] #

enumFromThenTo :: VarInt a -> VarInt a -> VarInt a -> [VarInt a] #

Eq a => Eq (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

(==) :: VarInt a -> VarInt a -> Bool #

(/=) :: VarInt a -> VarInt a -> Bool #

Integral a => Integral (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

quot :: VarInt a -> VarInt a -> VarInt a #

rem :: VarInt a -> VarInt a -> VarInt a #

div :: VarInt a -> VarInt a -> VarInt a #

mod :: VarInt a -> VarInt a -> VarInt a #

quotRem :: VarInt a -> VarInt a -> (VarInt a, VarInt a) #

divMod :: VarInt a -> VarInt a -> (VarInt a, VarInt a) #

toInteger :: VarInt a -> Integer #

Num a => Num (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

(+) :: VarInt a -> VarInt a -> VarInt a #

(-) :: VarInt a -> VarInt a -> VarInt a #

(*) :: VarInt a -> VarInt a -> VarInt a #

negate :: VarInt a -> VarInt a #

abs :: VarInt a -> VarInt a #

signum :: VarInt a -> VarInt a #

fromInteger :: Integer -> VarInt a #

Ord a => Ord (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

compare :: VarInt a -> VarInt a -> Ordering #

(<) :: VarInt a -> VarInt a -> Bool #

(<=) :: VarInt a -> VarInt a -> Bool #

(>) :: VarInt a -> VarInt a -> Bool #

(>=) :: VarInt a -> VarInt a -> Bool #

max :: VarInt a -> VarInt a -> VarInt a #

min :: VarInt a -> VarInt a -> VarInt a #

Read a => Read (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Real a => Real (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

toRational :: VarInt a -> Rational #

Show a => Show (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

showsPrec :: Int -> VarInt a -> ShowS #

show :: VarInt a -> String #

showList :: [VarInt a] -> ShowS #

Bits a => Bits (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

(.&.) :: VarInt a -> VarInt a -> VarInt a #

(.|.) :: VarInt a -> VarInt a -> VarInt a #

xor :: VarInt a -> VarInt a -> VarInt a #

complement :: VarInt a -> VarInt a #

shift :: VarInt a -> Int -> VarInt a #

rotate :: VarInt a -> Int -> VarInt a #

zeroBits :: VarInt a #

bit :: Int -> VarInt a #

setBit :: VarInt a -> Int -> VarInt a #

clearBit :: VarInt a -> Int -> VarInt a #

complementBit :: VarInt a -> Int -> VarInt a #

testBit :: VarInt a -> Int -> Bool #

bitSizeMaybe :: VarInt a -> Maybe Int #

bitSize :: VarInt a -> Int #

isSigned :: VarInt a -> Bool #

shiftL :: VarInt a -> Int -> VarInt a #

unsafeShiftL :: VarInt a -> Int -> VarInt a #

shiftR :: VarInt a -> Int -> VarInt a #

unsafeShiftR :: VarInt a -> Int -> VarInt a #

rotateL :: VarInt a -> Int -> VarInt a #

rotateR :: VarInt a -> Int -> VarInt a #

popCount :: VarInt a -> Int #

(Typeable a, Bits a, Integral a) => Serialise (VarInt a) Source # 
Instance details

Defined in Codec.Winery.Class

Internal

data SchemaGen a Source #

Schema generator

Instances
Functor SchemaGen Source # 
Instance details

Defined in Codec.Winery.Base

Methods

fmap :: (a -> b) -> SchemaGen a -> SchemaGen b #

(<$) :: a -> SchemaGen b -> SchemaGen a #

Applicative SchemaGen Source # 
Instance details

Defined in Codec.Winery.Base

Methods

pure :: a -> SchemaGen a #

(<*>) :: SchemaGen (a -> b) -> SchemaGen a -> SchemaGen b #

liftA2 :: (a -> b -> c) -> SchemaGen a -> SchemaGen b -> SchemaGen c #

(*>) :: SchemaGen a -> SchemaGen b -> SchemaGen b #

(<*) :: SchemaGen a -> SchemaGen b -> SchemaGen a #

getSchema :: forall proxy a. Serialise a => proxy a -> SchemaGen Schema Source #

Obtain a schema on SchemaGen, binding a fixpoint when necessary. If you are hand-rolling a definition of schemaGen, you should call this instead of schemaGen.

newtype Plan a Source #

Plan is a monad for computations which interpret Schema.

Constructors

Plan 

Fields

Instances
Monad Plan Source # 
Instance details

Defined in Codec.Winery.Base

Methods

(>>=) :: Plan a -> (a -> Plan b) -> Plan b #

(>>) :: Plan a -> Plan b -> Plan b #

return :: a -> Plan a #

fail :: String -> Plan a #

Functor Plan Source # 
Instance details

Defined in Codec.Winery.Base

Methods

fmap :: (a -> b) -> Plan a -> Plan b #

(<$) :: a -> Plan b -> Plan a #

Applicative Plan Source # 
Instance details

Defined in Codec.Winery.Base

Methods

pure :: a -> Plan a #

(<*>) :: Plan (a -> b) -> Plan a -> Plan b #

liftA2 :: (a -> b -> c) -> Plan a -> Plan b -> Plan c #

(*>) :: Plan a -> Plan b -> Plan b #

(<*) :: Plan a -> Plan b -> Plan a #

Alternative Plan Source # 
Instance details

Defined in Codec.Winery.Base

Methods

empty :: Plan a #

(<|>) :: Plan a -> Plan a -> Plan a #

some :: Plan a -> Plan [a] #

many :: Plan a -> Plan [a] #

mkPlan :: forall a. Typeable a => (Schema -> Strategy' (Term -> a)) -> Plan (Term -> a) Source #

Construct a plan, expanding fixpoints and let bindings.

DerivingVia

newtype WineryRecord a Source #

The Serialise instance is generically defined for records.

"Remember thee! Yea, from the table of my memory I'll wipe away all trivial fond records."

Constructors

WineryRecord 

Fields

newtype WineryVariant a Source #

The Serialise instance is generically defined for variants.

"The one so like the other as could not be distinguish'd but by names."

Constructors

WineryVariant 

Fields

newtype WineryProduct a Source #

Serialise a value as a product (omits field names).

"I get ideas about what's essential when packing my suitcase."

Constructors

WineryProduct 

Fields

Generic implementations (for old GHC / custom instances)

class GSerialiseRecord f Source #

Minimal complete definition

recordSchema, recordExtractor

Instances
GSerialiseRecord f => GSerialiseRecord (D1 c f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

recordSchema :: proxy (D1 c f) -> SchemaGen [(Text, Schema)] Source #

recordExtractor :: Maybe (D1 c f x) -> TransFusion (FieldDecoder Text) ((->) Term) (Term -> D1 c f x) Source #

GSerialiseRecord f => GSerialiseRecord (C1 c f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

recordSchema :: proxy (C1 c f) -> SchemaGen [(Text, Schema)] Source #

recordExtractor :: Maybe (C1 c f x) -> TransFusion (FieldDecoder Text) ((->) Term) (Term -> C1 c f x) Source #

(Serialise a, Selector c) => GSerialiseRecord (S1 c (K1 i a :: k -> Type) :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

recordSchema :: proxy (S1 c (K1 i a)) -> SchemaGen [(Text, Schema)] Source #

recordExtractor :: Maybe (S1 c (K1 i a) x) -> TransFusion (FieldDecoder Text) ((->) Term) (Term -> S1 c (K1 i a) x) Source #

(GSerialiseRecord f, GSerialiseRecord g) => GSerialiseRecord (f :*: g :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

recordSchema :: proxy (f :*: g) -> SchemaGen [(Text, Schema)] Source #

recordExtractor :: Maybe ((f :*: g) x) -> TransFusion (FieldDecoder Text) ((->) Term) (Term -> (f :*: g) x) Source #

gschemaGenRecord :: forall proxy a. (GSerialiseRecord (Rep a), Generic a, Typeable a) => proxy a -> SchemaGen Schema Source #

Generic implementation of schemaGen for a record.

gtoBuilderRecord :: (GEncodeProduct (Rep a), Generic a) => a -> Builder Source #

Generic implementation of toBuilder for a record.

gextractorRecord Source #

Arguments

:: (GSerialiseRecord (Rep a), Generic a, Typeable a) 
=> Maybe a

default value (optional)

-> Extractor a 

Generic implementation of extractor for a record.

class GSerialiseVariant f Source #

Minimal complete definition

variantSchema, variantExtractor

Instances
GSerialiseVariant f => GSerialiseVariant (D1 c f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantSchema :: proxy (D1 c f) -> SchemaGen [(Text, Schema)] Source #

variantExtractor :: [(Text, Schema -> Strategy' (Term -> D1 c f x))] Source #

(GSerialiseRecord f, KnownSymbol name) => GSerialiseVariant (C1 (MetaCons name fixity True) f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantSchema :: proxy (C1 (MetaCons name fixity True) f) -> SchemaGen [(Text, Schema)] Source #

variantExtractor :: [(Text, Schema -> Strategy' (Term -> C1 (MetaCons name fixity True) f x))] Source #

(GSerialiseProduct f, KnownSymbol name) => GSerialiseVariant (C1 (MetaCons name fixity False) f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantSchema :: proxy (C1 (MetaCons name fixity False) f) -> SchemaGen [(Text, Schema)] Source #

variantExtractor :: [(Text, Schema -> Strategy' (Term -> C1 (MetaCons name fixity False) f x))] Source #

(GSerialiseVariant f, GSerialiseVariant g) => GSerialiseVariant (f :+: g :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantSchema :: proxy (f :+: g) -> SchemaGen [(Text, Schema)] Source #

variantExtractor :: [(Text, Schema -> Strategy' (Term -> (f :+: g) x))] Source #

class GConstructorCount f Source #

Minimal complete definition

variantCount

Instances
GConstructorCount f => GConstructorCount (D1 i f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantCount :: proxy (D1 i f) -> Int Source #

GConstructorCount (C1 i f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantCount :: proxy (C1 i f) -> Int Source #

(GConstructorCount f, GConstructorCount g) => GConstructorCount (f :+: g :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantCount :: proxy (f :+: g) -> Int Source #

class GEncodeVariant f Source #

Minimal complete definition

variantEncoder

Instances
GEncodeVariant f => GEncodeVariant (D1 i f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantEncoder :: Int -> Int -> D1 i f x -> Builder Source #

GEncodeProduct f => GEncodeVariant (C1 i f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantEncoder :: Int -> Int -> C1 i f x -> Builder Source #

(GEncodeVariant f, GEncodeVariant g) => GEncodeVariant (f :+: g :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantEncoder :: Int -> Int -> (f :+: g) x -> Builder Source #

class GDecodeVariant f Source #

Minimal complete definition

variantDecoder

Instances
GDecodeVariant f => GDecodeVariant (D1 i f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantDecoder :: Int -> Int -> Decoder (D1 i f x) Source #

GDecodeProduct f => GDecodeVariant (C1 i f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantDecoder :: Int -> Int -> Decoder (C1 i f x) Source #

(GDecodeVariant f, GDecodeVariant g) => GDecodeVariant (f :+: g :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

variantDecoder :: Int -> Int -> Decoder ((f :+: g) x) Source #

gschemaGenVariant :: forall proxy a. (GSerialiseVariant (Rep a), Typeable a, Generic a) => proxy a -> SchemaGen Schema Source #

Generic implementation of schemaGen for an ADT.

gtoBuilderVariant :: forall a. (GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) => a -> Builder Source #

Generic implementation of toBuilder for an ADT.

gextractorVariant :: forall a. (GSerialiseVariant (Rep a), Generic a, Typeable a) => Extractor a Source #

Generic implementation of extractor for an ADT.

class GEncodeProduct f Source #

Encode all the fields

Minimal complete definition

productEncoder

Instances
GEncodeProduct (U1 :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

GEncodeProduct f => GEncodeProduct (D1 c f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

productEncoder :: D1 c f x -> Builder Source #

GEncodeProduct f => GEncodeProduct (C1 c f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

productEncoder :: C1 c f x -> Builder Source #

Serialise a => GEncodeProduct (S1 c (K1 i a :: k -> Type) :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

productEncoder :: S1 c (K1 i a) x -> Builder Source #

(GEncodeProduct f, GEncodeProduct g) => GEncodeProduct (f :*: g :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

productEncoder :: (f :*: g) x -> Builder Source #

class GDecodeProduct f Source #

Minimal complete definition

productDecoder

Instances
GDecodeProduct (U1 :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

(GDecodeProduct f, GDecodeProduct g) => GDecodeProduct (f :*: g :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

productDecoder :: Decoder ((f :*: g) x) Source #

Serialise a => GDecodeProduct (K1 i a :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

productDecoder :: Decoder (K1 i a x) Source #

GDecodeProduct f => GDecodeProduct (M1 i c f :: k -> Type) Source # 
Instance details

Defined in Codec.Winery.Class

Methods

productDecoder :: Decoder (M1 i c f x) Source #

gschemaGenProduct :: forall proxy a. (Generic a, GSerialiseProduct (Rep a)) => proxy a -> SchemaGen Schema Source #

gextractorProduct :: forall a. (GSerialiseProduct (Rep a), Generic a, Typeable a) => Extractor a Source #

Generic implementation of extractor for a record.

gdecodeCurrentProduct :: forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a Source #

Generic implementation of extractor for a record.

decodeCurrentDefault :: forall a. Serialise a => Decoder a Source #

decodeCurrent in terms of extractor; note that it's very slow.

Bundles

bundleRecord :: (GEncodeProduct (Rep a), GSerialiseRecord (Rep a), GDecodeProduct (Rep a), Generic a, Typeable a) => (Extractor a -> Extractor a) -> BundleSerialise a Source #

A bundle of generic implementations for records

bundleRecordDefault :: (GEncodeProduct (Rep a), GSerialiseRecord (Rep a), GDecodeProduct (Rep a), Generic a, Typeable a) => a -> (Extractor a -> Extractor a) -> BundleSerialise a Source #

A bundle of generic implementations for records, with a default value

bundleVariant :: (GSerialiseVariant (Rep a), GConstructorCount (Rep a), GEncodeVariant (Rep a), GDecodeVariant (Rep a), Generic a, Typeable a) => (Extractor a -> Extractor a) -> BundleSerialise a Source #

A bundle of generic implementations for variants

Preset schema

bootstrapSchema :: Word8 -> Either WineryException Schema Source #

Obtain the schema of the schema corresponding to the specified version.