Cabal-syntax-3.16.0.0: A library for working with .cabal files
Copyright(c) 2019 Oleg Grenrus
Safe HaskellNone
LanguageHaskell2010

Distribution.Utils.Structured

Description

Structurally tag binary serialisation stream. Useful when most Binary instances are Generic derived.

Say you have a data type

data Record = Record
 { _recordFields :: HM.HashMap Text (Integer, ByteString)
 , _recordEnabled :: Bool
 }
 deriving (Eq, Show, Generic)
instance Binary Record
instance Structured  Record

then you can serialise and deserialise Record values with a structure tag by simply

structuredEncode  record :: ByteString 
structuredDecode  lbs :: IO Record

If structure of Record changes in between, deserialisation will fail early.

Technically, Structured is not related to Binary, and may be useful in other uses.

Encoding and decoding

These functions operate like binary's counterparts, but the serialised version has a structure hash in front.

structuredEncode :: (Binary a, Structured a) => a -> ByteString Source #

Structured encode . Encode a value to using binary serialisation to a lazy ByteString . Encoding starts with 16 byte large structure hash.

structuredEncodeFile :: (Binary a, Structured a) => FilePath -> a -> IO () Source #

Lazily serialise a value to a file

structuredDecode :: (Binary a, Structured a) => ByteString -> a Source #

Structured decode . Decode a value from a lazy ByteString , reconstructing the original structure. Throws pure exception on invalid inputs.

structuredDecodeOrFailIO :: (Binary a, Structured a) => ByteString -> IO (Either String a) Source #

structuredDecodeFileOrFail :: (Binary a, Structured a) => FilePath -> IO (Either String a) Source #

Lazily reconstruct a value previously written to a file.

Structured class

class Typeable a => Structured a where Source #

Class of types with a known Structure .

For regular data types Structured can be derived generically.

data Record = Record { a :: Int, b :: Bool, c :: [Char] } deriving (Generic )
instance Structured  Record

Since: 3.2.0.0

Minimal complete definition

Nothing

Methods

structure :: Proxy a -> Structure Source #

default structure :: (Generic a, GStructured (Rep a)) => Proxy a -> Structure Source #

Instances

Instances details
Instance details

Defined in Distribution.Backpack

Instance details

Defined in Distribution.Backpack

Instance details

Defined in Distribution.Compiler

Instance details

Defined in Distribution.Compiler

Instance details

Defined in Distribution.License

Instance details

Defined in Distribution.ModuleName

Instance details

Defined in Distribution.SPDX.License

Instance details

Defined in Distribution.System

Instance details

Defined in Distribution.System

Instance details

Defined in Distribution.System

Instance details

Defined in Distribution.Types.AbiHash

Instance details

Defined in Distribution.Types.ConfVar

Instance details

Defined in Distribution.Types.Flag

Instance details

Defined in Distribution.Types.Library

Instance details

Defined in Distribution.Types.Mixin

Instance details

Defined in Distribution.Types.Module

Instance details

Defined in Distribution.Types.TestType

Instance details

Defined in Distribution.Types.UnitId

Instance details

Defined in Distribution.Types.UnitId

Instance details

Defined in Distribution.Types.Version

Instance details

Defined in Language.Haskell.Extension

Instance details

Defined in Language.Haskell.Extension

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy () -> Structure Source #

structureHash' :: Tagged () MD5

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Compat.Graph

Methods

structure :: Proxy (Graph a) -> Structure Source #

structureHash' :: Tagged (Graph a) MD5

Instance details

Defined in Distribution.Compat.NonEmptySet

Instance details

Defined in Distribution.Compat.Semigroup

Methods

structure :: Proxy (Last' a) -> Structure Source #

structureHash' :: Tagged (Last' a) MD5

Instance details

Defined in Distribution.Compat.Semigroup

Instance details

Defined in Distribution.Compiler

Instance details

Defined in Distribution.Types.Condition

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (Last a) -> Structure Source #

structureHash' :: Tagged (Last a) MD5

Instance details

Defined in Distribution.Utils.Structured

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (Ratio a) -> Structure Source #

structureHash' :: Tagged (Ratio a) MD5

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (IntMap v) -> Structure Source #

structureHash' :: Tagged (IntMap v) MD5

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (Seq v) -> Structure Source #

structureHash' :: Tagged (Seq v) MD5

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (Set k) -> Structure Source #

structureHash' :: Tagged (Set k) MD5

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (Maybe a) -> Structure Source #

structureHash' :: Tagged (Maybe a) MD5

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy [a] -> Structure Source #

structureHash' :: Tagged [a] MD5

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (Either a b) -> Structure Source #

structureHash' :: Tagged (Either a b) MD5

Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (Map k v) -> Structure Source #

structureHash' :: Tagged (Map k v) MD5

(Structured a1, Structured a2) => Structured (a1, a2) Source #
Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (a1, a2) -> Structure Source #

structureHash' :: Tagged (a1, a2) MD5

Instance details

Defined in Distribution.Types.CondTree

Methods

structure :: Proxy (CondBranch v c a) -> Structure Source #

structureHash' :: Tagged (CondBranch v c a) MD5

Instance details

Defined in Distribution.Types.CondTree

Methods

structure :: Proxy (CondTree v c a) -> Structure Source #

structureHash' :: Tagged (CondTree v c a) MD5

(Typeable allowAbsolute, Typeable from, Typeable to) => Structured (SymbolicPathX allowAbsolute from to) Source #
Instance details

Defined in Distribution.Utils.Path

Methods

structure :: Proxy (SymbolicPathX allowAbsolute from to) -> Structure Source #

structureHash' :: Tagged (SymbolicPathX allowAbsolute from to) MD5

(Structured a1, Structured a2, Structured a3) => Structured (a1, a2, a3) Source #
Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (a1, a2, a3) -> Structure Source #

structureHash' :: Tagged (a1, a2, a3) MD5

(Structured a1, Structured a2, Structured a3, Structured a4) => Structured (a1, a2, a3, a4) Source #
Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (a1, a2, a3, a4) -> Structure Source #

structureHash' :: Tagged (a1, a2, a3, a4) MD5

(Structured a1, Structured a2, Structured a3, Structured a4, Structured a5) => Structured (a1, a2, a3, a4, a5) Source #
Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (a1, a2, a3, a4, a5) -> Structure Source #

structureHash' :: Tagged (a1, a2, a3, a4, a5) MD5

(Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6) => Structured (a1, a2, a3, a4, a5, a6) Source #
Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (a1, a2, a3, a4, a5, a6) -> Structure Source #

structureHash' :: Tagged (a1, a2, a3, a4, a5, a6) MD5

(Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6, Structured a7) => Structured (a1, a2, a3, a4, a5, a6, a7) Source #
Instance details

Defined in Distribution.Utils.Structured

Methods

structure :: Proxy (a1, a2, a3, a4, a5, a6, a7) -> Structure Source #

structureHash' :: Tagged (a1, a2, a3, a4, a5, a6, a7) MD5

type MD5 = Fingerprint Source #

structureHash :: Structured a => Proxy a -> MD5 Source #

Semantically hashStructure . structure .

structureBuilder :: Structure -> Builder Source #

Flatten Structure into something we can calculate hash of.

As Structure can be potentially infinite. For mutually recursive types, we keep track of TypeRep s, and put just TypeRep name when it's occurred another time.

genericStructure :: (Typeable a, Generic a, GStructured (Rep a)) => Proxy a -> Structure Source #

Derive structure generically.

class GStructured (f :: Type -> Type) Source #

Used to implement genericStructure .

Minimal complete definition

gstructured

Instances

Instances details
(i ~ D, Datatype c, GStructuredSum f) => GStructured (M1 i c f) Source #
Instance details

Defined in Distribution.Utils.Structured

Methods

gstructured :: TypeRep -> Proxy (M1 i c f) -> TypeVersion -> Structure

nominalStructure :: forall {k} (a :: k). Typeable a => Proxy a -> Structure Source #

Use Typeable to infer name

containerStructure :: forall {k} (f :: Type -> k) a. (Typeable f, Structured a) => Proxy (f a) -> Structure Source #

Structure type

data Structure Source #

Structure of a datatype.

It can be infinite, as far as TypeRep s involved are finite. (e.g. polymorphic recursion might cause troubles).

Constructors

Nominal !TypeRep !TypeVersion TypeName [Structure]

nominal, yet can be parametrised by other structures.

Structure !TypeRep !TypeVersion TypeName SopStructure

sum-of-products structure

Instances

Instances details
Instance details

Defined in Distribution.Utils.Structured

Associated Types

type Rep Structure
Instance details

Defined in Distribution.Utils.Structured

type Rep Structure = D1 ('MetaData "Structure" "Distribution.Utils.Structured" "Cabal-syntax-3.16.0.0-813lolNablNGaeNilk6GeH" 'False) (C1 ('MetaCons "Nominal" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeRep) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeVersion)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Structure]))) :+: (C1 ('MetaCons "Newtype" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeRep) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeVersion)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Structure))) :+: C1 ('MetaCons "Structure" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeRep) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeVersion)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SopStructure)))))
Show Structure Source #
Instance details

Defined in Distribution.Utils.Structured

Eq Structure Source #
Instance details

Defined in Distribution.Utils.Structured

Ord Structure Source #
Instance details

Defined in Distribution.Utils.Structured

type Rep Structure Source #
Instance details

Defined in Distribution.Utils.Structured

type Rep Structure = D1 ('MetaData "Structure" "Distribution.Utils.Structured" "Cabal-syntax-3.16.0.0-813lolNablNGaeNilk6GeH" 'False) (C1 ('MetaCons "Nominal" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeRep) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeVersion)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Structure]))) :+: (C1 ('MetaCons "Newtype" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeRep) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeVersion)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Structure))) :+: C1 ('MetaCons "Structure" 'PrefixI 'False) ((S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeRep) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 TypeVersion)) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 TypeName) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SopStructure)))))

data Tag (a :: k) Source #

Constructors

Tag

Instances

Instances details
Instance details

Defined in Distribution.Utils.Structured

Methods

put :: Tag a -> Put #

get :: Get (Tag a) #

putList :: [Tag a] -> Put #

type TypeName = String Source #

type ConstructorName = String Source #

type TypeVersion = Word32 Source #

A semantic version of a data type. Usually 0.

type SopStructure = [(ConstructorName, [Structure])] Source #

hashStructure :: Structure -> MD5 Source #

A MD5 hash digest of Structure .

typeVersion :: Functor f => (TypeVersion -> f TypeVersion) -> Structure -> f Structure Source #

A van-Laarhoven lens into TypeVersion of Structure

typeVersion  :: Lens' Structure  TypeVersion 

typeName :: Functor f => (TypeName -> f TypeName) -> Structure -> f Structure Source #

A van-Laarhoven lens into TypeName of Structure

typeName  :: Lens' Structure  TypeName 

AltStyle によって変換されたページ (->オリジナル) /