cuddle-0.5.0.0: CDDL Generator and test utilities
Safe HaskellNone
LanguageGHC2021

Codec.CBOR.Cuddle.CDDL.CTree

Synopsis

Resolved CDDL Tree

data CTree (f :: Type -> Type) Source #

CDDL Tree, parametrised over a functor

We principally use this functor to represent references - thus, every 'f a' may be either an a or a reference to another CTree.

Constructors

Literal Value 
Postlude PTerm 
Map [Node f] 
Array [Node f] 
Choice (NonEmpty (Node f)) 
Group [Node f] 
KV 

Fields

Occur 
Range 

Fields

Control 

Fields

Enum (Node f) 
Unwrap (Node f) 
Tag Word64 (Node f) 

Instances

Instances details
Generic (CTree f) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

Associated Types

type Rep (CTree f) 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

type Rep (CTree f) = D1 ('MetaData "CTree" "Codec.CBOR.Cuddle.CDDL.CTree" "cuddle-0.5.0.0-H0bbRBZdSvH43WSgb38tp7" 'False) (((C1 ('MetaCons "Literal" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Value)) :+: (C1 ('MetaCons "Postlude" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PTerm)) :+: C1 ('MetaCons "Map" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node f])))) :+: (C1 ('MetaCons "Array" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node f])) :+: (C1 ('MetaCons "Choice" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (Node f)))) :+: C1 ('MetaCons "Group" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node f]))))) :+: ((C1 ('MetaCons "KV" 'PrefixI 'True) (S1 ('MetaSel ('Just "key") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: (S1 ('MetaSel ('Just "value") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "cut") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool))) :+: (C1 ('MetaCons "Occur" 'PrefixI 'True) (S1 ('MetaSel ('Just "item") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "occurs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OccurrenceIndicator)) :+: C1 ('MetaCons "Range" 'PrefixI 'True) (S1 ('MetaSel ('Just "from") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: (S1 ('MetaSel ('Just "to") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "inclusive") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RangeBound))))) :+: ((C1 ('MetaCons "Control" 'PrefixI 'True) (S1 ('MetaSel ('Just "op") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CtlOp) :*: (S1 ('MetaSel ('Just "target") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "controller") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)))) :+: C1 ('MetaCons "Enum" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)))) :+: (C1 ('MetaCons "Unwrap" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f))) :+: C1 ('MetaCons "Tag" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word64) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)))))))

Methods

from :: CTree f -> Rep (CTree f) x #

to :: Rep (CTree f) x -> CTree f #

Show (CTree MonoRef) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.Resolve

type Rep (CTree f) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

type Rep (CTree f) = D1 ('MetaData "CTree" "Codec.CBOR.Cuddle.CDDL.CTree" "cuddle-0.5.0.0-H0bbRBZdSvH43WSgb38tp7" 'False) (((C1 ('MetaCons "Literal" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Value)) :+: (C1 ('MetaCons "Postlude" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PTerm)) :+: C1 ('MetaCons "Map" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node f])))) :+: (C1 ('MetaCons "Array" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node f])) :+: (C1 ('MetaCons "Choice" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (NonEmpty (Node f)))) :+: C1 ('MetaCons "Group" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node f]))))) :+: ((C1 ('MetaCons "KV" 'PrefixI 'True) (S1 ('MetaSel ('Just "key") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: (S1 ('MetaSel ('Just "value") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "cut") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Bool))) :+: (C1 ('MetaCons "Occur" 'PrefixI 'True) (S1 ('MetaSel ('Just "item") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "occurs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OccurrenceIndicator)) :+: C1 ('MetaCons "Range" 'PrefixI 'True) (S1 ('MetaSel ('Just "from") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: (S1 ('MetaSel ('Just "to") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "inclusive") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 RangeBound))))) :+: ((C1 ('MetaCons "Control" 'PrefixI 'True) (S1 ('MetaSel ('Just "op") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 CtlOp) :*: (S1 ('MetaSel ('Just "target") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)) :*: S1 ('MetaSel ('Just "controller") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)))) :+: C1 ('MetaCons "Enum" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)))) :+: (C1 ('MetaCons "Unwrap" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f))) :+: C1 ('MetaCons "Tag" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Word64) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Node f)))))))

traverseCTree :: Monad m => (Node f -> m (Node g)) -> CTree f -> m (CTree g) Source #

Traverse the CTree, carrying out the given operation at each node

type Node (f :: Type -> Type) = f (CTree f) Source #

newtype CTreeRoot' (poly :: Type -> Type) (f :: Type -> Type) Source #

Constructors

CTreeRoot (Map Name (poly (Node f))) 

Instances

Instances details
Generic (CTreeRoot' poly f) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

Associated Types

type Rep (CTreeRoot' poly f) 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

type Rep (CTreeRoot' poly f) = D1 ('MetaData "CTreeRoot'" "Codec.CBOR.Cuddle.CDDL.CTree" "cuddle-0.5.0.0-H0bbRBZdSvH43WSgb38tp7" 'True) (C1 ('MetaCons "CTreeRoot" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Name (poly (Node f))))))

Methods

from :: CTreeRoot' poly f -> Rep (CTreeRoot' poly f) x #

to :: Rep (CTreeRoot' poly f) x -> CTreeRoot' poly f #

Show (poly (Node MonoRef)) => Show (CTreeRoot' poly MonoRef) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.Resolve

type Rep (CTreeRoot' poly f) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

type Rep (CTreeRoot' poly f) = D1 ('MetaData "CTreeRoot'" "Codec.CBOR.Cuddle.CDDL.CTree" "cuddle-0.5.0.0-H0bbRBZdSvH43WSgb38tp7" 'True) (C1 ('MetaCons "CTreeRoot" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Map Name (poly (Node f))))))

data ParametrisedWith w a Source #

Constructors

Unparametrised 

Fields

Parametrised 

Fields

Instances

Instances details
Foldable (ParametrisedWith w) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

Methods

fold :: Monoid m => ParametrisedWith w m -> m #

foldMap :: Monoid m => (a -> m) -> ParametrisedWith w a -> m #

foldMap' :: Monoid m => (a -> m) -> ParametrisedWith w a -> m #

foldr :: (a -> b -> b) -> b -> ParametrisedWith w a -> b #

foldr' :: (a -> b -> b) -> b -> ParametrisedWith w a -> b #

foldl :: (b -> a -> b) -> b -> ParametrisedWith w a -> b #

foldl' :: (b -> a -> b) -> b -> ParametrisedWith w a -> b #

foldr1 :: (a -> a -> a) -> ParametrisedWith w a -> a #

foldl1 :: (a -> a -> a) -> ParametrisedWith w a -> a #

toList :: ParametrisedWith w a -> [a] #

null :: ParametrisedWith w a -> Bool #

length :: ParametrisedWith w a -> Int #

elem :: Eq a => a -> ParametrisedWith w a -> Bool #

maximum :: Ord a => ParametrisedWith w a -> a #

minimum :: Ord a => ParametrisedWith w a -> a #

sum :: Num a => ParametrisedWith w a -> a #

product :: Num a => ParametrisedWith w a -> a #

Traversable (ParametrisedWith w) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

Methods

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

sequenceA :: Applicative f => ParametrisedWith w (f a) -> f (ParametrisedWith w a) #

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

sequence :: Monad m => ParametrisedWith w (m a) -> m (ParametrisedWith w a) #

Functor (ParametrisedWith w) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

Methods

fmap :: (a -> b) -> ParametrisedWith w a -> ParametrisedWith w b #

(<$) :: a -> ParametrisedWith w b -> ParametrisedWith w a #

Generic (ParametrisedWith w a) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

Associated Types

type Rep (ParametrisedWith w a) 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

type Rep (ParametrisedWith w a) = D1 ('MetaData "ParametrisedWith" "Codec.CBOR.Cuddle.CDDL.CTree" "cuddle-0.5.0.0-H0bbRBZdSvH43WSgb38tp7" 'False) (C1 ('MetaCons "Unparametrised" 'PrefixI 'True) (S1 ('MetaSel ('Just "underlying") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "Parametrised" 'PrefixI 'True) (S1 ('MetaSel ('Just "underlying") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Just "params") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 w)))
(Show a, Show w) => Show (ParametrisedWith w a) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

(Eq a, Eq w) => Eq (ParametrisedWith w a) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

(Hashable w, Hashable a) => Hashable (ParametrisedWith w a) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

type Rep (ParametrisedWith w a) Source # 
Instance details

Defined in Codec.CBOR.Cuddle.CDDL.CTree

type Rep (ParametrisedWith w a) = D1 ('MetaData "ParametrisedWith" "Codec.CBOR.Cuddle.CDDL.CTree" "cuddle-0.5.0.0-H0bbRBZdSvH43WSgb38tp7" 'False) (C1 ('MetaCons "Unparametrised" 'PrefixI 'True) (S1 ('MetaSel ('Just "underlying") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a)) :+: C1 ('MetaCons "Parametrised" 'PrefixI 'True) (S1 ('MetaSel ('Just "underlying") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Just "params") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 w)))