Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Synopsis
- newtype FieldParser' err from to = FieldParser (from -> Either err to)
- type FieldParser from to = FieldParser' Error from to
- runFieldParser :: FieldParser' err from to -> from -> Either err to
- mapError :: (err1 -> err2) -> FieldParser' err1 from to -> FieldParser' err2 from to
- toParseJSON :: FieldParser Value a -> Value -> Parser a
- toParseJSONErrorTree :: FieldParser' ErrorTree Value a -> Value -> Parser a
- toReadPrec :: ReadPrec from -> FieldParser from to -> ReadPrec to
- jsonParser :: Monad m => FieldParser' err Value to -> ParseT err m to
- jsonBool :: FieldParser Value Bool
- jsonNull :: FieldParser Value ()
- jsonNumber :: FieldParser Value Scientific
- jsonString :: FieldParser Value Text
- utf8 :: FieldParser ByteString Text
- signedDecimal :: FieldParser Text Integer
- decimalNatural :: FieldParser Text Natural
- signedDecimalNatural :: FieldParser Text Natural
- integralToNatural :: Integral i => FieldParser i Natural
- integralToInteger :: Integral i => FieldParser' err i Integer
- scientific :: FieldParser Text Scientific
- boundedScientificIntegral :: forall i. (Integral i, Bounded i) => Error -> FieldParser Scientific i
- boundedScientificRealFloat :: RealFloat d => FieldParser Scientific d
- bounded :: forall i. (Integral i, Bounded i) => Text -> FieldParser Integer i
- clamped :: (Ord a, Show a) => a -> a -> FieldParser a a
- oneOf :: Ord from => (from -> Text) -> [(from, to)] -> FieldParser from to
- oneOfMap :: Ord from => (from -> Text) -> Map from to -> FieldParser from to
- textEnum :: (Bounded to, Enum to) => (to -> Text) -> FieldParser Text to
- either :: FieldParser from to1 -> FieldParser from to2 -> FieldParser' ErrorTree from (Either to1 to2)
- or :: NonEmpty (FieldParser from to) -> FieldParser' ErrorTree from to
- invertPretty :: (Bounded to, Enum to) => (to -> Text) -> FieldParser Text to
- invertPrettyCaseInsensitive :: (Bounded to, Enum to) => (to -> Text) -> FieldParser Text to
- exactly :: Eq from => (from -> Text) -> from -> FieldParser from from
- multiple :: Text -> (Natural -> from -> Text) -> FieldParser from to -> FieldParser' ErrorTree [from] [to]
- nonEmpty :: err -> FieldParser' err [from] (NonEmpty from)
- data FieldParserDesc' err from to = FieldParserDesc {
- symbolicDesc :: Text
- fieldParser :: FieldParser' err from to
- type FieldParserDesc from to = FieldParserDesc' Error from to
- separatedBy :: Text -> (Natural -> Text -> Text) -> FieldParserDesc Text to -> FieldParser' ErrorTree Text [to]
- ignoreSurroundingWhitespace :: FieldParser Text a -> FieldParser Text a
- attoparsecText :: (Text -> Error) -> Parser a -> FieldParser Text a
- attoparsecBytes :: Error -> Parser a -> FieldParser ByteString a
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.
FieldParser (from -> Either err to) |
Instances
Category (FieldParser' err :: Type -> Type -> TYPE LiftedRep) Source # |
|
Defined in FieldParser 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. |
Defined in FieldParser 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 |
Defined in FieldParser 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 # | |
Defined in FieldParser 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.
:: ReadPrec from | ReadPrec to base this parser on (e.g. use |
-> FieldParser from to | |
-> ReadPrec to |
jsonParser :: Monad m => FieldParser' err Value to -> ParseT err m to Source #
Turn a FieldParser Value
into an ParseT
which parses this 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
utf8 :: FieldParser ByteString Text Source #
Parse field as Text
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.
:: (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.
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
:: Text | |
-> (Natural -> from -> Text) | For each sub-parser that failed, |
-> 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.
FieldParserDesc | |
|
type FieldParserDesc from to = FieldParserDesc' Error from to Source #
:: Text | Separator |
-> (Natural -> Text -> Text) | For each sub-parser that failed, |
-> 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)
:: (Text -> Error) | Error message to use if the parser fails (the attoparsec message is discarded) |
-> Parser a | Parser to use. Should not check for |
-> 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.
:: Error | Error message to use if the parser fails (the attoparsec message is discarded) |
-> Parser a | Parser to use. Should not check for |
-> 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.