diff options
Diffstat (limited to 'users/Profpatsch')
| -rw-r--r-- | users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs | 15 |
1 files changed, 14 insertions, 1 deletions
diff --git a/users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs b/users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs index 73cb52855d65..b1256fa4affe 100644 --- a/users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs +++ b/users/Profpatsch/jbovlaste-sqlite/JbovlasteSqlite.hs @@ -338,6 +338,8 @@ nodeElementMay = \case Xml.NodeElement el -> Just el _ -> Nothing +-- | A generic applicative “vertical” parser. +-- Similar to `FieldParser`, but made for parsing whole structures and collect all errors in an `ErrorTree`. newtype Parse from to = Parse ((Context, from) -> Validation (NonEmpty ErrorTree) (Context, to)) deriving (Functor, Applicative, Selective) @@ -349,6 +351,8 @@ newtype Parse from to = Parse ((Context, from) -> Validation (NonEmpty ErrorTree ((,) Context) ) +-- | Every parser can add to the context, like e.g. an element parser will add the name of the element it should be parsing. +-- This should be added to the error message of each parser, with `showContext`. newtype Context = Context (Maybe [Text]) deriving stock (Show) deriving (Semigroup, Monoid) via (First [Text]) @@ -413,16 +417,18 @@ attributeMay name = Parse $ \(ctx, el) -> Just a -> Success (ctx & addContext [fmt|{{attr:{name}}}|], Just a) Nothing -> Success (ctx, Nothing) --- | 'oneOf' but only one value possible +-- | Accept only exactly the given value exactly :: Eq from => (from -> Text) -> from -> Parse from from exactly errDisplay from = Parse $ \(ctx, from') -> if from == from' then Success (ctx, from') else Failure $ singleton [fmt|Field has to be exactly {errDisplay from}, was: {errDisplay from'} at {showContext ctx}|] +-- | Make a parser to parse the whole list multiple :: Parse a1 a2 -> Parse [a1] [a2] multiple inner = dimap nonEmpty (Prelude.maybe [] toList) (maybe $ multipleNE inner) +-- | Make a parser to parse the whole non-empty list multipleNE :: Parse from to -> Parse (NonEmpty from) (NonEmpty to) multipleNE inner = Parse $ \(ctx, from) -> from @@ -431,28 +437,33 @@ multipleNE inner = Parse $ \(ctx, from) -> -- we assume that, since the same parser is used everywhere, the context will be the same as well (TODO: correct?) & second (\((ctx', y) :| ys) -> (ctx', y :| (snd <$> ys))) +-- | Lift a parser into an optional value maybe :: Parse from to -> Parse (Maybe from) (Maybe to) maybe inner = Parse $ \(ctx, m) -> case m of Nothing -> Success (ctx, Nothing) Just a -> runParse' inner (ctx, a) & second (fmap Just) +-- | Assert that there is exactly one element in the list exactlyOne :: Parse [from] from exactlyOne = Parse $ \(ctx, xs) -> case xs of [] -> Failure $ singleton [fmt|Expected exactly 1 element, but got 0, at {ctx & showContext}|] [one] -> Success (ctx, one) _more -> Failure $ singleton [fmt|Expected exactly 1 element, but got 2, at {ctx & showContext}|] +-- | Assert that there is exactly zero or one element in the list zeroOrOne :: Parse [from] (Maybe from) zeroOrOne = Parse $ \(ctx, xs) -> case xs of [] -> Success (ctx, Nothing) [one] -> Success (ctx, Just one) _more -> Failure $ singleton [fmt|Expected exactly 1 element, but got 2, at {ctx & showContext}|] +-- | Find the first element on which the sub-parser succeeds; if there was no match, return all error messages. find :: Parse from to -> Parse [from] to find inner = Parse $ \(ctx, xs) -> case xs of [] -> failure [fmt|Wanted to get the first sub-parser that succeeds, but there were no elements in the list, at {ctx & showContext}|] (y : ys) -> runParse' (findNE' inner) (ctx, y :| ys) +-- | Find the first element on which the sub-parser succeeds; if there was no match, return all error messages. findNE' :: Parse from to -> Parse (NonEmpty from) to findNE' inner = Parse $ \(ctx, xs) -> xs @@ -472,6 +483,7 @@ findNE' inner = Parse $ \(ctx, xs) -> & singleton & Failure +-- | Find all elements on which the sub-parser succeeds; if there was no match, return an empty list findAll :: Parse from to -> Parse [from] [to] findAll inner = Parse $ \(ctx, xs) -> xs @@ -483,6 +495,7 @@ findAll inner = Parse $ \(ctx, xs) -> Success (ctx, []) (_miss, (hitCtx, hit) : hits) -> Success (hitCtx, hit : (hits <&> snd)) +-- | convert a 'FieldParser' into a 'Parse'. fieldParser :: FieldParser from to -> Parse from to fieldParser fp = Parse $ \(ctx, from) -> case Field.runFieldParser fp from of Right a -> Success (ctx, a) |