construct-0.3.2: Haskell version of the Construct library for easy specification of file formats
Safe HaskellNone
LanguageHaskell2010

Construct

Description

Declarative and symmetrical specification of binary and textual data formats.

Synopsis

The type

data Format (m :: Type -> Type) (n :: Type -> Type) s a Source #

The central type. The four type parameters are:

  • m, type of the parser for the format
  • n, container type for the serialized form of the value, typically Identity unless something Alternative is called for.
  • s, type of the serialized value, typically ByteString
  • a, type of the parsed value in memory

The parse and serialize fields can be used to perform the two sides of the conversion between the in-memory and serialized form of the value.

parse :: Format m n s a -> m a Source #

serialize :: Format m n s a -> a -> n s Source #

Combinators

(<$) :: forall a (m :: Type -> Type) (n :: Type -> Type) s. (Eq a, Show a, Functor m, AlternativeFail n) => a -> Format m n s () -> Format m n s a infixl 4 Source #

Same as the usual <$ except a Format is no Functor.

(*>) :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Applicative m, Applicative n, Semigroup s) => Format m n s () -> Format m n s a -> Format m n s a infixl 4 Source #

Same as the usual *> except a Format is no Functor, let alone Applicative.

(<*) :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Applicative m, Applicative n, Semigroup s) => Format m n s a -> Format m n s () -> Format m n s a infixl 4 Source #

Same as the usual <* except a Format is no Functor, let alone Applicative.

(<|>) :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, Alternative n) => Format m n s a -> Format m n s a -> Format m n s a infixl 3 Source #

Same as the usual <|> except a Format is no Functor, let alone Alternative.

(<+>) :: forall (m :: Type -> Type) (n :: Type -> Type) s a b. Alternative m => Format m n s a -> Format m n s b -> Format m n s (Either a b) Source #

A discriminated or tagged choice between two formats.

(<?>) :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Parsing m, AlternativeFail n) => Format m n s a -> String -> Format m n s a infixr 0 Source #

Name a format to improve error messages.

>>> testParse (takeCharsWhile1 isDigit <?> "a number") "abc"
Left "expected a number, encountered 'a'"
>>> testSerialize (takeCharsWhile1 isDigit <?> "a number") "abc"
Left "expected a number, encountered \"abc\""

empty :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, Alternative n) => Format m n s a Source #

Same as the usual empty except a Format is no Functor, let alone Alternative.

optional :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, Alternative n, Monoid s) => Format m n s a -> Format m n s (Maybe a) Source #

Same as the usual optional except a Format is no Functor, let alone Alternative.

optionWithDefault :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, Alternative n) => Format m n s () -> Format m n s a -> Format m n s (Maybe a) Source #

Like optional except with arbitrary default serialization for the Nothing value.

optional = optionWithDefault (literal mempty)

pair :: forall (m :: Type -> Type) (n :: Type -> Type) s a b. (Applicative m, Applicative n, Semigroup s) => Format m n s a -> Format m n s b -> Format m n s (a, b) Source #

Combines two formats into a format for the pair of their values.

>>> testParse (pair char char) "abc"
Right [(('a','b'),"c")]

deppair :: forall (m :: Type -> Type) (n :: Type -> Type) s a b. (Monad m, Applicative n, Semigroup s) => Format m n s a -> (a -> Format m n s b) -> Format m n s (a, b) Source #

Combines two formats, where the second format depends on the first value, into a format for the pair of their values. Similar to >>= except Format is no Functor let alone Monad.

>>> testParse (deppair char (\c-> satisfy (==c) char)) "abc"
Left "encountered 'b'"
>>> testParse (deppair char (\c-> satisfy (==c) char)) "aac"
Right [(('a','a'),"c")]

many :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, Applicative n, Monoid s) => Format m n s a -> Format m n s [a] Source #

Same as the usual many except a Format is no Functor, let alone Alternative.

some :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, AlternativeFail n, Semigroup s) => Format m n s a -> Format m n s [a] Source #

Same as the usual some except a Format is no Functor, let alone Alternative.

manyTill :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, Applicative n, Monoid s) => Format m n s a -> Format m n s () -> Format m n s [a] Source #

In the parsing direction, the same as the regular manyTill: parses the item zero or more times until the terminator succeeds. When serializing, makes sure to append the terminator. Beware, for performance reasons the function does not verify that no item's serialization can be parsed via the terminator.

sepBy :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Alternative m, Applicative n, Monoid s) => Format m n s a -> Format m n s () -> Format m n s [a] Source #

Represents any number of values formatted using the first argument, separated by the second format argumewnt in serialized form. Similar to the usual sepBy combinator.

>>> testParse (takeCharsWhile isLetter `sepBy` literal ",") "foo,bar,baz"
Right [([],"foo,bar,baz"),(["foo"],",bar,baz"),(["foo","bar"],",baz"),(["foo","bar","baz"],"")]

sequence :: forall (m :: Type -> Type) (n :: Type -> Type) s a. (Monad m, AlternativeFail n, Monoid s, Eq a, Show a) => [Format m n s a] -> Format m n s [a] Source #

Sequence a list of formats into a list format.

count :: forall (m :: Type -> Type) (n :: Type -> Type) a s. (Applicative m, AlternativeFail n, Show a, Monoid s) => Int -> Format m n s a -> Format m n s [a] Source #

Repeats the argument format the given number of times.

The property count n f == Construct.sequence (replicate n f) holds.

>>> testParse (count 4 byte) (ByteString.pack [1,2,3,4,5])
Right [([1,2,3,4],"\ENQ")]
>>> testSerialize (count 4 byte) [1,2,3,4,5]
Left "expected a list of length 4, encountered [1,2,3,4,5]"
>>> testSerialize (count 4 byte) [1,2,3,4]
Right "\SOH\STX\ETX\EOT"

Self-referential record support

mfix :: forall (m :: Type -> Type) a (n :: Type -> Type) s. MonadFix m => (a -> Format m n s a) -> Format m n s a Source #

Same as the usual mfix except a Format is no Functor, let alone Monad.

record :: forall g (m :: Type -> Type) (n :: Type -> Type) s. (Apply g, Traversable g, FixTraversable m, Applicative n, Monoid s) => g (Format m n s) -> Format m n s (g Identity) Source #

Converts a record of field formats into a single format of the whole record.

recordWith :: forall g (m :: Type -> Type) n o s. (Apply g, Traversable g, FixTraversable m, Applicative n, Monoid s, Applicative o) => (forall a. o (n a) -> n a) -> g (Format m n s) -> Format m n s (g o) Source #

Converts a record of field formats into a single format of the whole record, a generalized form of record.

Mapping over a Format

mapSerialized :: forall s t (m :: Type -> Type -> Type) (n :: Type -> Type) a. (Monoid s, Monoid t, InputParsing (m s), InputParsing (m t), s ~ ParserInput (m s), t ~ ParserInput (m t), InputMappableParsing m, Functor n) => (s -> t) -> (t -> s) -> Format (m s) n s a -> Format (m t) n t a Source #

Converts a format for serialized streams of type s so it works for streams of type t instead

>>> testParse (mapSerialized ByteString.unpack ByteString.pack byte) [1,2,3]
Right [(1,[2,3])]

mapMaybeSerialized :: forall s t (m :: Type -> Type -> Type) (n :: Type -> Type) a. (Monoid s, Monoid t, InputParsing (m s), InputParsing (m t), s ~ ParserInput (m s), t ~ ParserInput (m t), InputMappableParsing m, Functor n) => (s -> Maybe t) -> (t -> Maybe s) -> Format (m s) n s a -> Format (m t) n t a Source #

Converts a format for serialized streams of type s so it works for streams of type t instead. The argument functions may return Nothing to indicate they have insuficient input to perform the conversion.

mapValue :: forall (m :: Type -> Type) a b (n :: Type -> Type) s. Functor m => (a -> b) -> (b -> a) -> Format m n s a -> Format m n s b Source #

Converts a format for in-memory values of type a so it works for values of type b instead.

>>> testParse (mapValue (read @Int) show $ takeCharsWhile1 isDigit) "012 34"
Right [(12," 34")]
>>> testSerialize (mapValue read show $ takeCharsWhile1 isDigit) 12
Right "12"

mapMaybeValue :: forall (m :: Type -> Type) a b (n :: Type -> Type) s. (Monad m, Parsing m, Show a, Show b, AlternativeFail n) => (a -> Maybe b) -> (b -> Maybe a) -> Format m n s a -> Format m n s b Source #

Converts a format for in-memory values of type a so it works for values of type b instead. The argument functions may signal conversion failure by returning Nothing.

Constraining a Format

satisfy :: forall (m :: Type -> Type) (n :: Type -> Type) a s. (Parsing m, Monad m, AlternativeFail n, Show a) => (a -> Bool) -> Format m n s a -> Format m n s a Source #

Filter the argument format so it only succeeds for values that pass the predicate.

>>> testParse (satisfy isDigit char) "abc"
Left "encountered 'a'"
>>> testParse (satisfy isLetter char) "abc"
Right [('a',"bc")]

value :: forall a (m :: Type -> Type) (n :: Type -> Type) s. (Eq a, Show a, Parsing m, Monad m, Alternative n) => Format m n s a -> a -> Format m n s () Source #

A fixed expected value serialized through the argument format

>>> testParse (value char 'a') "bcd"
Left "encountered 'b'"
>>> testParse (value char 'a') "abc"
Right [((),"bc")]

padded :: forall (m :: Type -> Type) (n :: Type -> Type) s. (Monad m, Functor n, InputParsing m, ParserInput m ~ s, FactorialMonoid s) => s -> Format m n s s -> Format m n s s Source #

Modifies the serialized form of the given format by padding it with the given template if it's any shorter

>>> testParse (padded "----" $ takeCharsWhile isDigit) "12--3---"
Right [("12","3---")]
>>> testSerialize (padded "----" $ takeCharsWhile isDigit) "12"
Right "12--"

padded1 :: forall (m :: Type -> Type) (n :: Type -> Type) s. (Monad m, Monad n, InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) => s -> Format m n s s -> Format m n s s Source #

Modifies the serialized form of the given format by padding it with the given template. The serialized form has to be shorter than the template before padding.

Primitives

literal :: forall (m :: Type -> Type) (n :: Type -> Type) s. (Functor m, InputParsing m, Applicative n, ParserInput m ~ s) => s -> Format m n s () Source #

A literal serialized form, such as a magic constant, corresponding to no value

>>> testParse (literal "Hi") "Hi there"
Right [(()," there")]

byte :: forall (m :: Type -> Type) (n :: Type -> Type). (InputParsing m, ParserInput m ~ ByteString, Applicative n) => Format m n ByteString Word8 Source #

A trivial format for a single byte in a ByteString

>>> testParse byte (ByteString.pack [1,2,3])
Right [(1,"\STX\ETX")]

char :: forall (m :: Type -> Type) s (n :: Type -> Type). (CharParsing m, ParserInput m ~ s, IsString s, Applicative n) => Format m n s Char Source #

A trivial format for a single character

>>> testParse char "abc"
Right [('a',"bc")]

cereal :: forall a (m :: Type -> Type) (n :: Type -> Type). (Serialize a, Monad m, InputParsing m, ParserInput m ~ ByteString, Applicative n) => Format m n ByteString a Source #

A quick way to format a value that already has an appropriate Serialize instance

>>> testParse (cereal @Word16) (ByteString.pack [1,2,3])
Right [(258,"\ETX")]
>>> testSerialize cereal (1025 :: Word16)
Right "\EOT\SOH"

cereal' :: forall (m :: Type -> Type) (n :: Type -> Type) a. (Monad m, InputParsing m, ParserInput m ~ ByteString, Applicative n) => Get a -> Putter a -> Format m n ByteString a Source #

Specifying a formatter explicitly using the cereal getter and putter

>>> testParse (cereal' getWord16le putWord16le) (ByteString.pack [1,2,3])
Right [(513,"\ETX")]

take :: forall (m :: Type -> Type) s (n :: Type -> Type). (InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) => Int -> Format m n s s Source #

Format whose in-memory value is a fixed-size prefix of the serialized value

>>> testParse (take 3) "12345"
Right [("123","45")]
>>> testSerialize (take 3) "123"
Right "123"
>>> testSerialize (take 3) "1234"
Left "expected a value of length 3, encountered \"1234\""

takeWhile :: forall (m :: Type -> Type) s (n :: Type -> Type). (InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) => (s -> Bool) -> Format m n s s Source #

Format whose in-memory value is the longest prefix of the serialized value smallest parts of which all satisfy the given predicate.

>>> testParse (takeWhile (> "b")) "abcd"
Right [("","abcd")]
>>> testParse (takeWhile (> "b")) "dcba"
Right [("dc","ba")]
>>> testSerialize (takeWhile (> "b")) "dcba"
Left "expected takeWhile, encountered \"dcba\""
>>> testSerialize (takeWhile (> "b")) "dc"
Right "dc"
>>> testSerialize (takeWhile (> "b")) ""
Right ""

takeWhile1 :: forall (m :: Type -> Type) s (n :: Type -> Type). (InputParsing m, ParserInput m ~ s, FactorialMonoid s, Show s, AlternativeFail n) => (s -> Bool) -> Format m n s s Source #

Format whose in-memory value is the longest non-empty prefix of the serialized value smallest parts of which all satisfy the given predicate.

>>> testParse (takeWhile1 (> "b")) "abcd"
Left "takeWhile1"
>>> testSerialize (takeWhile1 (> "b")) ""
Left "expected takeWhile1, encountered \"\""
>>> testSerialize (takeWhile1 (> "b")) "dc"
Right "dc"

takeCharsWhile :: forall (m :: Type -> Type) s (n :: Type -> Type). (InputCharParsing m, ParserInput m ~ s, TextualMonoid s, Show s, AlternativeFail n) => (Char -> Bool) -> Format m n s s Source #

Format whose in-memory value is the longest prefix of the serialized value that consists of characters which all satisfy the given predicate.

>>> testParse (takeCharsWhile isDigit) "a12"
Right [("","a12")]
>>> testParse (takeCharsWhile isDigit) "12a"
Right [("12","a")]
>>> testSerialize (takeCharsWhile isDigit) "12a"
Left "expected takeCharsWhile, encountered \"12a\""
>>> testSerialize (takeCharsWhile isDigit) "12"
Right "12"
>>> testSerialize (takeCharsWhile isDigit) ""
Right ""

takeCharsWhile1 :: forall (m :: Type -> Type) s (n :: Type -> Type). (InputCharParsing m, ParserInput m ~ s, TextualMonoid s, Show s, AlternativeFail n) => (Char -> Bool) -> Format m n s s Source #

Format whose in-memory value is the longest non-empty prefix of the serialized value that consists of characters which all satisfy the given predicate.

>>> testParse (takeCharsWhile1 isDigit) "a12"
Left "takeCharsWhile1 encountered 'a'"
>>> testParse (takeCharsWhile1 isDigit) "12a"
Right [("12","a")]
>>> testSerialize (takeCharsWhile1 isDigit) "12"
Right "12"
>>> testSerialize (takeCharsWhile1 isDigit) ""
Left "expected takeCharsWhile1, encountered \"\""

Test helpers

testParse :: Monoid s => Format (Parser Symmetric s) (Either Error) s a -> s -> Either String [(a, s)] Source #

Attempts to parse the given input with the format with a constrained type, returns either a failure message or a list of successes.

testSerialize :: Format (Parser Symmetric s) (Either Error) s a -> a -> Either String s Source #

A less polymorphic wrapper around serialize useful for testing