pa-field-parser-0.3.0.0: “Vertical” parsing of values
Safe HaskellSafe-Inferred
LanguageGHC2021

FieldParser

Synopsis

Documentation

newtype FieldParser' err from to Source #

Parser for a field. TODO: define what a field is

If you want to build more complex parsers, use the attoparsecText and attoparsecBytes functions to build a parser from a bytestring.

If you want to nest parsers, e.g. first want to decode to Text via utf-8 and then parse the Text, use the Semigroupoid/Category instances to chain parsers.

As a general rule, when you create an error message, try to include the value (or a shortened version of the value) that was not accepted. Otherwise the error will be hard to debug.

Constructors

FieldParser (from -> Either err to) 

Instances

Instances details
Category (FieldParser' err :: Type -> Type -> TYPE LiftedRep) Source #

id is the parser that always succeeds.

Instance details

Defined in FieldParser

Methods

id :: forall (a :: k). FieldParser' err a a #

(.) :: forall (b :: k) (c :: k) (a :: k). FieldParser' err b c -> FieldParser' err a b -> FieldParser' err a c #

Semigroupoid (FieldParser' err :: Type -> Type -> TYPE LiftedRep) Source #

If the right parser fails, return its error, otherwise run the left parser.

Instance details

Defined in FieldParser

Methods

o :: forall (j :: k) (k1 :: k) (i :: k). FieldParser' err j k1 -> FieldParser' err i j -> FieldParser' err i k1 #

Profunctor (FieldParser' err) Source #

You can map over both sides of a parser to change the types in a

Instance details

Defined in FieldParser

Methods

dimap :: (a -> b) -> (c -> d) -> FieldParser' err b c -> FieldParser' err a d #

lmap :: (a -> b) -> FieldParser' err b c -> FieldParser' err a c #

rmap :: (b -> c) -> FieldParser' err a b -> FieldParser' err a c #

(#.) :: forall a b c q. Coercible c b => q b c -> FieldParser' err a b -> FieldParser' err a c #

(.#) :: forall a b c q. Coercible b a => FieldParser' err b c -> q a b -> FieldParser' err a c #

Functor (FieldParser' err from) Source # 
Instance details

Defined in FieldParser

Methods

fmap :: (a -> b) -> FieldParser' err from a -> FieldParser' err from b #

(<$) :: a -> FieldParser' err from b -> FieldParser' err from a #

type FieldParser from to = FieldParser' Error from to Source #

An alias for FieldParser' for the common case where err = Error.

runFieldParser :: FieldParser' err from to -> from -> Either err to Source #

Execute the field parser.

mapError :: (err1 -> err2) -> FieldParser' err1 from to -> FieldParser' err2 from to Source #

Change the type of the err in a field Parser.`

toParseJSON :: FieldParser Value a -> Value -> Parser a Source #

Turn a FieldParser Value directly into a valid parseJSON implementation.

If you want to parse any objects or lists, it’s better to use toAesonParser with jsonParser instead, but for simple json scalars this one is better.

toParseJSONErrorTree :: FieldParser' ErrorTree Value a -> Value -> Parser a Source #

Turn a FieldParser' ErrorTree Value directly into a valid parseJSON implementation.

If you want to parse any objects or lists, it’s better to use toAesonParser with jsonParser instead, but for simple json scalars this one is better.

toReadPrec Source #

Arguments

:: ReadPrec from

ReadPrec to base this parser on (e.g. use readPrec @Text@ to parse the same as Text)

-> FieldParser from to 
-> ReadPrec to 

toJsonParser :: Monad m => FieldParser' err Value to -> ParseT err m to Source #

Turn a FieldParser Value into an ParseT which parses this value.

jsonBool :: FieldParser Value Bool Source #

parse a json boolean from a Value

jsonNull :: FieldParser Value () Source #

parse a json null from a Value

jsonNumber :: FieldParser Value Scientific Source #

parse a json number from a Value

jsonString :: FieldParser Value Text Source #

parse a json string from a Value

Field parsers

notEmptyStringP :: FieldParser Text Text Source #

Assert that the string is not empty

signedDecimal :: FieldParser Text Integer Source #

A decimal number with an optional + or - sign character.

decimalNatural :: FieldParser Text Natural Source #

A decimal natural number; does not allow for a +-sign.

signedDecimalNatural :: FieldParser Text Natural Source #

A signed, decimal, natural number.

e.g. 12345, 0, or +12, but not -12.

integralToNatural :: Integral i => FieldParser i Natural Source #

Parse any integral into a natural number, fails if the integral is negative.

integralToInteger :: Integral i => FieldParser' err i Integer Source #

Parse any integral to an Integer. This can never fail, but is here to mirror integralToNatural.

scientific :: FieldParser Text Scientific Source #

An arbitrary-precision number in scientific notation.

boundedScientificIntegral :: forall i. (Integral i, Bounded i) => Error -> FieldParser Scientific i Source #

Parse a scientific into a bounded integral type.

Scientific can be *very* big, (think 1e10000) so this function makes sure we * don’t wrap around the bound * don’t fill up all our memory by e.g. parsing into Integer or Natural.

So if you want to go to Natural, you have to first set an intermediate type with a bound you want to accept (e.g. 64 bits via Int) and then go from that to the unbounded type (e.g. via integralToNatural).

err is added as context around the bounded error.

boundedScientificRealFloat :: RealFloat d => FieldParser Scientific d Source #

Parse a scientific into a bounded floating point type.

Scientific can be *very* big, (think 1e10000) so this function makes sure we * don’t wrap around the bound * don’t fill up all our memory * Fit into the available floating point representation space

bounded :: forall i. (Integral i, Bounded i) => Text -> FieldParser Integer i Source #

Parse an integer into a bounded integral type.

err is added as context around the bounded error.

utcTime :: FieldParser Text UTCTime Source #

Parse a timestamp into a UTC time, accepting only UTC timestamps like yyyy-mm-ddThh:mm:ss[.sss]Z (ISO 8601:2004(E) sec. 4.3.2 extended format)

utcTimeLenient :: FieldParser Text UTCTime Source #

Parse a timestamp into a UTC time, accepting multiple timezone formats. Do not use this if you can force the input to use the Z UTC notation (e.g. in a CSV), use utcTime instead.

Accepts

  • UTC timestamps: yyyy-mm-ddThh:mm:ss[.sss]Z
  • timestamps with time zone: yyyy-mm-ddThh:mm:ss[.sss]±hh:mm

( both ISO 8601:2004(E) sec. 4.3.2 extended format)

The time zone of the second kind of timestamp is taken into account, but normalized to UTC (it’s not preserved what the original time zone was)

clamped Source #

Arguments

:: (Ord a, Show a) 
=> a

lower boundary (inclusive)

-> a

upper boundary (exclusive)

-> FieldParser a a 

Example of how to create a more “complicated” parser that checks whether a value is between two other values.

oneOf :: Ord from => (from -> Text) -> [(from, to)] -> FieldParser from to Source #

oneOf prettyFrom oneOfMap

Takes a oneOf, which is a list of possibilities that this parser accepts. The comparison is done with (==), and then the according to value is returned.

In case of an error prettyFrom is used to pretty-print the available choices and actual input.

If you want to match on an Enum-like type, you should probably use invertPretty or invertPrettyCaseInsensitive instead, which allows for exhaustiveness checks.

oneOfMap :: Ord from => (from -> Text) -> Map from to -> FieldParser from to Source #

oneOf, but takes a map directly.

| oneOfMap prettyFrom oneOfMap

Takes a oneOfMap, which is a map of possibilities that this parser accepts.

In case of an error prettyFrom is used to pretty-print the available choices and actual input.

textEnum :: (Bounded to, Enum to) => (to -> Text) -> FieldParser Text to Source #

Parse into an enum from a textual description of the fields.

The given function is inverted with inverseMap and then used as the parsing function.

either :: FieldParser from to1 -> FieldParser from to2 -> FieldParser' ErrorTree from (Either to1 to2) Source #

Try to run the first parser, or if it fails run the second one; return an Either.

or :: NonEmpty (FieldParser from to) -> FieldParser' ErrorTree from to Source #

Try to run the first parser, or if it fails run the next one; They have to return the same value.

emptyOr :: forall s a. (Eq s, Show s, Monoid s) => FieldParser s a -> FieldParser' Error s (Maybe a) Source #

Parse into Nothing if the Monoid (e.g. Text, Map etc.) was empty

invertPretty :: (Bounded to, Enum to) => (to -> Text) -> FieldParser Text to Source #

Given a pretty printing function, it will create a parser that uses the inverse function to parse the field.

The pretty printing function must create a different output for different inputs! Otherwise which value is returned is undefined.

invertPrettyCaseInsensitive :: (Bounded to, Enum to) => (to -> Text) -> FieldParser Text to Source #

Given a pretty printing function, it will create a parser that uses the inverse function to parse the field. The parsed text is compared case-insensitively.

The pretty printing function must create a different output for different inputs! This also means two outputs should not match if compared case-insensitively. Otherwise which value is returned is undefined.

exactly :: Eq from => (from -> Text) -> from -> FieldParser from from Source #

oneOf but only one value possible

multiple Source #

Arguments

:: Text 
-> (Natural -> from -> Text)

For each sub-parser that failed, displayValOnErr is prefixed to its error. It receives the index (starting from 1) of the element that failed, so you can display it in the element’s error message. You can decide yourself whether you want to print the full value, part of the value, or only the index.

-> FieldParser from to

Parser for each element

-> FieldParser' ErrorTree [from] [to] 

Takes a parser and lifts it to parse every element in a list.

nonEmpty :: err -> FieldParser' err [from] (NonEmpty from) Source #

data FieldParserDesc' err from to Source #

Wrap a FieldParser with some descriptions for generating better error messages.

Constructors

FieldParserDesc 

Fields

separatedBy Source #

Arguments

:: Text

Separator

-> (Natural -> Text -> Text)

For each sub-parser that failed, displayValOnErr is prefixed to its error. It receives the index (starting from 1) of the element that failed, so you can display it in the element’s error message. You can decide yourself whether you want to print the full value, part of the value, or only the index.

-> FieldParserDesc Text to 
-> FieldParser' ErrorTree Text [to] 

Splits the input string into multiple elements based on the given separator string.

Each element is then passed to the provided innerParser.

This returns a descriptive tree of errors containing the errors of each sub-parser that failed.

ignoreSurroundingWhitespace :: FieldParser Text a -> FieldParser Text a Source #

Ignore whitespace around a text.

Shows how to use the profunctor instance to do pure transformations (that cannot throw any errors).

Alternatively this could be implemented in the FieldParser pipeline like ignore = FieldParser $ t -> Right (Text.strip t)

attoparsecText Source #

Arguments

:: (Text -> Error)

Error message to use if the parser fails (the attoparsec message is discarded)

-> Parser a

Parser to use. Should not check for endOfInput itself.

-> FieldParser Text a 

Given an error message and an attoparsec parser, “clamp” the parser that it expects to match until the end of the string, then run the parser and put the given error message on error.

This function works on Data.Attoparsec.Text parsers.

attoparsecBytes Source #

Arguments

:: Error

Error message to use if the parser fails (the attoparsec message is discarded)

-> Parser a

Parser to use. Should not check for endOfInput itself.

-> FieldParser ByteString a 

Given an error message and an attoparsec parser, “clamp” the parser that it expects to match until the end of the string, then run the parser and put the given error message on error.

This function works on Data.Attoparsec.ByteString parsers.

literal :: forall from to. Lift to => FieldParser from to -> from -> Code Q to Source #

Parse a literal value at compile time. This is used with Template Haskell, like so:

$$("2023-07-27" & literal hyphenatedDay) :: Time.Day

You need the double $$!

ATTN: This needs an instance of the Lift class for the output type. Many library types don’t yet implement this class, so we have to provide the instances ourselves. See NOTE: Lift for library types

Orphan instances

Lift Pico Source # 
Instance details

Methods

lift :: Quote m => Pico -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Pico -> Code m Pico #

Lift Day Source # 
Instance details

Methods

lift :: Quote m => Day -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Day -> Code m Day #

Lift TimeOfDay Source # 
Instance details

Methods

lift :: Quote m => TimeOfDay -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => TimeOfDay -> Code m TimeOfDay #