Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data AsnEncoding a
- = EncSequence [Field a]
- | EncSequenceOf (a -> [b]) (AsnEncoding b)
- | EncChoice (Choice a)
- | EncRetag TagAndExplicitness (AsnEncoding a)
- | EncUniversalValue (UniversalValue a)
- data UniversalValue a
- = UniversalValueBoolean (a -> Bool) (Subtypes Bool)
- | UniversalValueInteger (a -> Integer) (Subtypes Integer)
- | UniversalValueNull
- | UniversalValueOctetString (a -> ByteString) (Subtypes ByteString)
- | UniversalValueTextualString StringType (a -> Text) (Subtypes Text) (Subtypes Char)
- | UniversalValueObjectIdentifier (a -> ObjectIdentifier) (Subtypes ObjectIdentifier)
- newtype Subtypes a = Subtypes {
- getSubtypes :: [Subtype a]
- newtype ObjectIdentifier = ObjectIdentifier {}
- newtype ObjectIdentifierSuffix = ObjectIdentifierSuffix {}
- data Subtype a
- = SubtypeSingleValue a
- | SubtypeValueRange a a
- data StringType
- data Explicitness
- data TagAndExplicitness = TagAndExplicitness Tag Explicitness
- data Choice a = Choice (a -> b) [b] (b -> ValueAndEncoding)
- data ValueAndEncoding = ValueAndEncoding Int OptionName b (AsnEncoding b)
- data Field a
- = FieldRequired FieldName (a -> b) (AsnEncoding b)
- | FieldOptional FieldName (a -> Maybe b) (AsnEncoding b)
- | FieldDefaulted FieldName (a -> b) b (b -> String) (b -> b -> Bool) (AsnEncoding b)
- data TaggedByteString = TaggedByteString !Construction !Tag !ByteString
- data TaggedStrictByteString = TaggedStrictByteString !Construction !Tag !ByteString
- data Construction
- newtype FieldName = FieldName {}
- newtype OptionName = OptionName {}
- data TagClass
- data Tag = Tag {}
- fromIntegerTagAndExplicitness :: Integer -> TagAndExplicitness
- fromIntegerTag :: Integer -> Tag
- data AsnDecoding a
- = AsnDecodingUniversal (UniverseDecoding a)
- | AsnDecodingSequenceOf ([b] -> a) (AsnDecoding b)
- | AsnDecodingConversion (AsnDecoding b) (b -> Either String a)
- | AsnDecodingRetag TagAndExplicitness (AsnDecoding a)
- | AsnDecodingSequence (FieldDecoding a)
- | AsnDecodingChoice [OptionDecoding a]
- data Ap f a where
- data OptionDecoding a = OptionDecoding OptionName (AsnDecoding a)
- newtype FieldDecoding a = FieldDecoding (Ap FieldDecodingPart a)
- data FieldDecodingPart a
- = FieldDecodingRequired FieldName (AsnDecoding a)
- | FieldDecodingDefault FieldName (AsnDecoding a) a (a -> String)
- | FieldDecodingOptional FieldName (AsnDecoding b) (Maybe b -> a)
- data UniverseDecoding a
- = UniverseDecodingInteger (Integer -> a) (Subtypes Integer)
- | UniverseDecodingTextualString StringType (Text -> a) (Subtypes Text) (Subtypes Char)
- | UniverseDecodingOctetString (ByteString -> a) (Subtypes ByteString)
- | UniverseDecodingObjectIdentifier (ObjectIdentifier -> a) (Subtypes ObjectIdentifier)
- | UniverseDecodingNull a
- newtype DecodePart a = DecodePart {
- getDecodePart :: ByteString -> Either String (a, ByteString)
- runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a
- liftAp :: f a -> Ap f a
- constructionBit :: Construction -> Word8
- tagClassBit :: TagClass -> Word8
- sequenceTag :: Tag
- tagNumStringType :: StringType -> Int
Documentation
data AsnEncoding a Source #
EncSequence [Field a] | |
EncSequenceOf (a -> [b]) (AsnEncoding b) | |
EncChoice (Choice a) | |
EncRetag TagAndExplicitness (AsnEncoding a) | |
EncUniversalValue (UniversalValue a) |
Instances
Contravariant AsnEncoding Source # | |
Defined in Language.Asn.Types.Internal contramap :: (a -> b) -> AsnEncoding b -> AsnEncoding a # (>$) :: b -> AsnEncoding b -> AsnEncoding a # |
data UniversalValue a Source #
Instances
Contravariant UniversalValue Source # | |
Defined in Language.Asn.Types.Internal contramap :: (a -> b) -> UniversalValue b -> UniversalValue a # (>$) :: b -> UniversalValue b -> UniversalValue a # |
Subtypes | |
|
newtype ObjectIdentifier Source #
Note: we deviate slightly from the actual definition of an object identifier. Technically, each number of an OID should be allowed to be an integer of unlimited size. However, we are intentionally unfaithful to this specification because in practice, there are no OIDs that use integers above a 32-bit word, so we just use the machine's native word size.
Instances
newtype ObjectIdentifierSuffix Source #
Instances
data StringType Source #
Choice (a -> b) [b] (b -> ValueAndEncoding) |
data ValueAndEncoding Source #
FieldRequired FieldName (a -> b) (AsnEncoding b) | |
FieldOptional FieldName (a -> Maybe b) (AsnEncoding b) | |
FieldDefaulted FieldName (a -> b) b (b -> String) (b -> b -> Bool) (AsnEncoding b) |
data Construction Source #
Instances
Eq Construction Source # | |
Defined in Language.Asn.Types.Internal (==) :: Construction -> Construction -> Bool # (/=) :: Construction -> Construction -> Bool # | |
Show Construction Source # | |
Defined in Language.Asn.Types.Internal showsPrec :: Int -> Construction -> ShowS # show :: Construction -> String # showList :: [Construction] -> ShowS # |
Instances
IsString FieldName Source # | |
Defined in Language.Asn.Types.Internal fromString :: String -> FieldName # |
newtype OptionName Source #
Instances
IsString OptionName Source # | |
Defined in Language.Asn.Types.Internal fromString :: String -> OptionName # |
fromIntegerTag :: Integer -> Tag Source #
data AsnDecoding a Source #
AsnDecodingUniversal (UniverseDecoding a) | |
AsnDecodingSequenceOf ([b] -> a) (AsnDecoding b) | |
AsnDecodingConversion (AsnDecoding b) (b -> Either String a) | |
AsnDecodingRetag TagAndExplicitness (AsnDecoding a) | |
AsnDecodingSequence (FieldDecoding a) | |
AsnDecodingChoice [OptionDecoding a] |
Instances
Functor AsnDecoding Source # | |
Defined in Language.Asn.Types.Internal fmap :: (a -> b) -> AsnDecoding a -> AsnDecoding b # (<$) :: a -> AsnDecoding b -> AsnDecoding a # |
data OptionDecoding a Source #
Instances
Functor OptionDecoding Source # | |
Defined in Language.Asn.Types.Internal fmap :: (a -> b) -> OptionDecoding a -> OptionDecoding b # (<$) :: a -> OptionDecoding b -> OptionDecoding a # |
newtype FieldDecoding a Source #
Instances
Functor FieldDecoding Source # | |
Defined in Language.Asn.Types.Internal fmap :: (a -> b) -> FieldDecoding a -> FieldDecoding b # (<$) :: a -> FieldDecoding b -> FieldDecoding a # | |
Applicative FieldDecoding Source # | |
Defined in Language.Asn.Types.Internal pure :: a -> FieldDecoding a # (<*>) :: FieldDecoding (a -> b) -> FieldDecoding a -> FieldDecoding b # liftA2 :: (a -> b -> c) -> FieldDecoding a -> FieldDecoding b -> FieldDecoding c # (*>) :: FieldDecoding a -> FieldDecoding b -> FieldDecoding b # (<*) :: FieldDecoding a -> FieldDecoding b -> FieldDecoding a # |
data FieldDecodingPart a Source #
FieldDecodingRequired FieldName (AsnDecoding a) | |
FieldDecodingDefault FieldName (AsnDecoding a) a (a -> String) | |
FieldDecodingOptional FieldName (AsnDecoding b) (Maybe b -> a) |
data UniverseDecoding a Source #
Instances
Functor UniverseDecoding Source # | |
Defined in Language.Asn.Types.Internal fmap :: (a -> b) -> UniverseDecoding a -> UniverseDecoding b # (<$) :: a -> UniverseDecoding b -> UniverseDecoding a # |
newtype DecodePart a Source #
DecodePart | |
|
Instances
Functor DecodePart Source # | |
Defined in Language.Asn.Types.Internal fmap :: (a -> b) -> DecodePart a -> DecodePart b # (<$) :: a -> DecodePart b -> DecodePart a # | |
Applicative DecodePart Source # | |
Defined in Language.Asn.Types.Internal pure :: a -> DecodePart a # (<*>) :: DecodePart (a -> b) -> DecodePart a -> DecodePart b # liftA2 :: (a -> b -> c) -> DecodePart a -> DecodePart b -> DecodePart c # (*>) :: DecodePart a -> DecodePart b -> DecodePart b # (<*) :: DecodePart a -> DecodePart b -> DecodePart a # |
runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a Source #
constructionBit :: Construction -> Word8 Source #
tagClassBit :: TagClass -> Word8 Source #
sequenceTag :: Tag Source #
tagNumStringType :: StringType -> Int Source #