winery-1.3.2: A compact, well-typed seralisation format for Haskell values
Copyright(c) Fumiaki Kinoshita 2019
LicenseBSD3
MaintainerFumiaki Kinoshita <fumiexcel@gmail.com>
StabilityProvisional
Safe HaskellNone
LanguageHaskell2010

Codec.Winery.Base

Description

Basic types

Synopsis

Documentation

data Tag Source #

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

Constructors

TagInt !Int 
TagStr !Text 
TagList ![Tag] 

Instances

Instances details
IsList Tag Source # 
Instance details

Defined in Codec.Winery.Base

Associated Types

type Item Tag #

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

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

Instances details
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 #

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.3.2-KhjWZ07kGaY74i3HCD3TU0" '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))))))))

newtype SchemaGen a Source #

Schema generator

Constructors

SchemaGen 

Fields

Instances

Instances details
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 #

currentSchemaVersion :: Word8 Source #

The current version of the schema

bootstrapSchema :: Word8 -> Either WineryException Schema Source #

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

data Term Source #

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

Instances

Instances details
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 #

data ExtractException Source #

This may be thrown if illegal Term is passed to an extractor.

Constructors

InvalidTerm !Term 

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

Instances details
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 StrategyBind Source #

Constructors

DynDecoder !Dynamic

A fixpoint of a decoder

BoundSchema !Int !Schema

schema bound by SLet. Int is a basis of the variables

unwrapExtractor :: Extractor a -> Schema -> Strategy' (Term -> a) Source #

Deprecated: Use runExtractor instead

Run an Extractor.