{-# LANGUAGE RankNTypes #-}
{-|
Module      : Toml.Schema.Matcher
Description : A type for building results while tracking scopes
Copyright   : (c) Eric Mertens, 2023
License     : ISC
Maintainer  : emertens@gmail.com

This type helps to build up computations that can validate a TOML
value and compute some application-specific representation.

It supports warning messages which can be used to deprecate old
configuration options and to detect unused table keys.

It supports tracking multiple error messages when you have more
than one decoding option and all of them have failed.

Use 'Toml.Pretty.prettyMatchMessage' for an easy way to make human
readable strings from matcher outputs.

-}
module Toml.Schema.Matcher (
    -- * Types
    Matcher,
    Result(..),
    MatchMessage(..),

    -- * Operations
    runMatcher,
    withScope,
    getScope,
    warn,
    warnAt,
    failAt,

    -- * Run helpers
    runMatcherIgnoreWarn,
    runMatcherFatalWarn,

    -- * Scope helpers
    Scope(..),
    inKey,
    inIndex,
    ) where

import Control.Applicative (Alternative(..))
import Control.Monad (MonadPlus, ap, liftM)
import Data.Monoid (Endo(..))
import Data.Text (Text)

-- | Computations that result in a 'Result' and which track a list
-- of nested contexts to assist in generating warnings and error
-- messages.
--
-- Use 'withScope' to run a 'Matcher' in a new, nested scope.
newtype Matcher l a = Matcher {
    forall l a.
Matcher l a
-> forall r.
   [Scope]
   -> DList (MatchMessage l)
   -> (DList (MatchMessage l) -> r)
   -> (DList (MatchMessage l) -> a -> r)
   -> r
unMatcher ::
        forall r.
        [Scope] ->
        DList (MatchMessage l) ->
        (DList (MatchMessage l) -> r) ->
        (DList (MatchMessage l) -> a -> r) ->
        r
    }

instance Functor (Matcher a) where
    fmap :: forall a b. (a -> b) -> Matcher a a -> Matcher a b
fmap = (a -> b) -> Matcher a a -> Matcher a b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (Matcher a) where
    pure :: forall a. a -> Matcher a a
pure a
x = (forall r.
 [Scope]
 -> DList (MatchMessage a)
 -> (DList (MatchMessage a) -> r)
 -> (DList (MatchMessage a) -> a -> r)
 -> r)
-> Matcher a a
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
_env DList (MatchMessage a)
ws DList (MatchMessage a) -> r
_err DList (MatchMessage a) -> a -> r
ok -> DList (MatchMessage a) -> a -> r
ok DList (MatchMessage a)
ws a
x)
    <*> :: forall a b. Matcher a (a -> b) -> Matcher a a -> Matcher a b
(<*>) = Matcher a (a -> b) -> Matcher a a -> Matcher a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Matcher a) where
    Matcher a a
m >>= :: forall a b. Matcher a a -> (a -> Matcher a b) -> Matcher a b
>>= a -> Matcher a b
f = (forall r.
 [Scope]
 -> DList (MatchMessage a)
 -> (DList (MatchMessage a) -> r)
 -> (DList (MatchMessage a) -> b -> r)
 -> r)
-> Matcher a b
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
env DList (MatchMessage a)
ws DList (MatchMessage a) -> r
err DList (MatchMessage a) -> b -> r
ok -> Matcher a a
-> forall r.
   [Scope]
   -> DList (MatchMessage a)
   -> (DList (MatchMessage a) -> r)
   -> (DList (MatchMessage a) -> a -> r)
   -> r
forall l a.
Matcher l a
-> forall r.
   [Scope]
   -> DList (MatchMessage l)
   -> (DList (MatchMessage l) -> r)
   -> (DList (MatchMessage l) -> a -> r)
   -> r
unMatcher Matcher a a
m [Scope]
env DList (MatchMessage a)
ws DList (MatchMessage a) -> r
err (\DList (MatchMessage a)
warn' a
x -> Matcher a b
-> forall r.
   [Scope]
   -> DList (MatchMessage a)
   -> (DList (MatchMessage a) -> r)
   -> (DList (MatchMessage a) -> b -> r)
   -> r
forall l a.
Matcher l a
-> forall r.
   [Scope]
   -> DList (MatchMessage l)
   -> (DList (MatchMessage l) -> r)
   -> (DList (MatchMessage l) -> a -> r)
   -> r
unMatcher (a -> Matcher a b
f a
x) [Scope]
env DList (MatchMessage a)
warn' DList (MatchMessage a) -> r
err DList (MatchMessage a) -> b -> r
ok))
    {-# INLINE (>>=) #-}

instance Alternative (Matcher a) where
    empty :: forall a. Matcher a a
empty = (forall r.
 [Scope]
 -> DList (MatchMessage a)
 -> (DList (MatchMessage a) -> r)
 -> (DList (MatchMessage a) -> a -> r)
 -> r)
-> Matcher a a
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
_env DList (MatchMessage a)
_warn DList (MatchMessage a) -> r
err DList (MatchMessage a) -> a -> r
_ok -> DList (MatchMessage a) -> r
err DList (MatchMessage a)
forall a. Monoid a => a
mempty)
    Matcher forall r.
[Scope]
-> DList (MatchMessage a)
-> (DList (MatchMessage a) -> r)
-> (DList (MatchMessage a) -> a -> r)
-> r
x <|> :: forall a. Matcher a a -> Matcher a a -> Matcher a a
<|> Matcher forall r.
[Scope]
-> DList (MatchMessage a)
-> (DList (MatchMessage a) -> r)
-> (DList (MatchMessage a) -> a -> r)
-> r
y = (forall r.
 [Scope]
 -> DList (MatchMessage a)
 -> (DList (MatchMessage a) -> r)
 -> (DList (MatchMessage a) -> a -> r)
 -> r)
-> Matcher a a
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
env DList (MatchMessage a)
ws DList (MatchMessage a) -> r
err DList (MatchMessage a) -> a -> r
ok -> [Scope]
-> DList (MatchMessage a)
-> (DList (MatchMessage a) -> r)
-> (DList (MatchMessage a) -> a -> r)
-> r
forall r.
[Scope]
-> DList (MatchMessage a)
-> (DList (MatchMessage a) -> r)
-> (DList (MatchMessage a) -> a -> r)
-> r
x [Scope]
env DList (MatchMessage a)
ws (\DList (MatchMessage a)
errs1 -> [Scope]
-> DList (MatchMessage a)
-> (DList (MatchMessage a) -> r)
-> (DList (MatchMessage a) -> a -> r)
-> r
forall r.
[Scope]
-> DList (MatchMessage a)
-> (DList (MatchMessage a) -> r)
-> (DList (MatchMessage a) -> a -> r)
-> r
y [Scope]
env DList (MatchMessage a)
ws (\DList (MatchMessage a)
errs2 -> DList (MatchMessage a) -> r
err (DList (MatchMessage a)
errs1 DList (MatchMessage a)
-> DList (MatchMessage a) -> DList (MatchMessage a)
forall a. Semigroup a => a -> a -> a
<> DList (MatchMessage a)
errs2)) DList (MatchMessage a) -> a -> r
ok) DList (MatchMessage a) -> a -> r
ok)

instance MonadPlus (Matcher a)

-- | Scopes for TOML message.
data Scope
    = ScopeIndex Int -- ^ zero-based array index
    | ScopeKey Text -- ^ key in a table
    deriving (
        ReadPrec [Scope]
ReadPrec Scope
Int -> ReadS Scope
ReadS [Scope]
(Int -> ReadS Scope)
-> ReadS [Scope]
-> ReadPrec Scope
-> ReadPrec [Scope]
-> Read Scope
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Scope
readsPrec :: Int -> ReadS Scope
$creadList :: ReadS [Scope]
readList :: ReadS [Scope]
$creadPrec :: ReadPrec Scope
readPrec :: ReadPrec Scope
$creadListPrec :: ReadPrec [Scope]
readListPrec :: ReadPrec [Scope]
Read {- ^ Default instance -},
        Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scope -> ShowS
showsPrec :: Int -> Scope -> ShowS
$cshow :: Scope -> String
show :: Scope -> String
$cshowList :: [Scope] -> ShowS
showList :: [Scope] -> ShowS
Show {- ^ Default instance -},
        Scope -> Scope -> Bool
(Scope -> Scope -> Bool) -> (Scope -> Scope -> Bool) -> Eq Scope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
/= :: Scope -> Scope -> Bool
Eq   {- ^ Default instance -},
        Eq Scope
Eq Scope =>
(Scope -> Scope -> Ordering)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Bool)
-> (Scope -> Scope -> Scope)
-> (Scope -> Scope -> Scope)
-> Ord Scope
Scope -> Scope -> Bool
Scope -> Scope -> Ordering
Scope -> Scope -> Scope
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scope -> Scope -> Ordering
compare :: Scope -> Scope -> Ordering
$c< :: Scope -> Scope -> Bool
< :: Scope -> Scope -> Bool
$c<= :: Scope -> Scope -> Bool
<= :: Scope -> Scope -> Bool
$c> :: Scope -> Scope -> Bool
> :: Scope -> Scope -> Bool
$c>= :: Scope -> Scope -> Bool
>= :: Scope -> Scope -> Bool
$cmax :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
min :: Scope -> Scope -> Scope
Ord  {- ^ Default instance -})

-- | A message emitted while matching a TOML value. The message is paired
-- with the path to the value that was in focus when the message was
-- generated. These message get used for both warnings and errors.
--
-- For a convenient way to render these to a string, see 'Toml.Pretty.prettyMatchMessage'.
data MatchMessage a = MatchMessage {
    forall a. MatchMessage a -> Maybe a
matchAnn :: Maybe a,
    forall a. MatchMessage a -> [Scope]
matchPath :: [Scope], -- ^ path to message location
    forall a. MatchMessage a -> String
matchMessage :: String -- ^ error and warning message body
    } deriving (
        ReadPrec [MatchMessage a]
ReadPrec (MatchMessage a)
Int -> ReadS (MatchMessage a)
ReadS [MatchMessage a]
(Int -> ReadS (MatchMessage a))
-> ReadS [MatchMessage a]
-> ReadPrec (MatchMessage a)
-> ReadPrec [MatchMessage a]
-> Read (MatchMessage a)
forall a. Read a => ReadPrec [MatchMessage a]
forall a. Read a => ReadPrec (MatchMessage a)
forall a. Read a => Int -> ReadS (MatchMessage a)
forall a. Read a => ReadS [MatchMessage a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (MatchMessage a)
readsPrec :: Int -> ReadS (MatchMessage a)
$creadList :: forall a. Read a => ReadS [MatchMessage a]
readList :: ReadS [MatchMessage a]
$creadPrec :: forall a. Read a => ReadPrec (MatchMessage a)
readPrec :: ReadPrec (MatchMessage a)
$creadListPrec :: forall a. Read a => ReadPrec [MatchMessage a]
readListPrec :: ReadPrec [MatchMessage a]
Read {- ^ Default instance -},
        Int -> MatchMessage a -> ShowS
[MatchMessage a] -> ShowS
MatchMessage a -> String
(Int -> MatchMessage a -> ShowS)
-> (MatchMessage a -> String)
-> ([MatchMessage a] -> ShowS)
-> Show (MatchMessage a)
forall a. Show a => Int -> MatchMessage a -> ShowS
forall a. Show a => [MatchMessage a] -> ShowS
forall a. Show a => MatchMessage a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> MatchMessage a -> ShowS
showsPrec :: Int -> MatchMessage a -> ShowS
$cshow :: forall a. Show a => MatchMessage a -> String
show :: MatchMessage a -> String
$cshowList :: forall a. Show a => [MatchMessage a] -> ShowS
showList :: [MatchMessage a] -> ShowS
Show {- ^ Default instance -},
        MatchMessage a -> MatchMessage a -> Bool
(MatchMessage a -> MatchMessage a -> Bool)
-> (MatchMessage a -> MatchMessage a -> Bool)
-> Eq (MatchMessage a)
forall a. Eq a => MatchMessage a -> MatchMessage a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => MatchMessage a -> MatchMessage a -> Bool
== :: MatchMessage a -> MatchMessage a -> Bool
$c/= :: forall a. Eq a => MatchMessage a -> MatchMessage a -> Bool
/= :: MatchMessage a -> MatchMessage a -> Bool
Eq   {- ^ Default instance -},
        Eq (MatchMessage a)
Eq (MatchMessage a) =>
(MatchMessage a -> MatchMessage a -> Ordering)
-> (MatchMessage a -> MatchMessage a -> Bool)
-> (MatchMessage a -> MatchMessage a -> Bool)
-> (MatchMessage a -> MatchMessage a -> Bool)
-> (MatchMessage a -> MatchMessage a -> Bool)
-> (MatchMessage a -> MatchMessage a -> MatchMessage a)
-> (MatchMessage a -> MatchMessage a -> MatchMessage a)
-> Ord (MatchMessage a)
MatchMessage a -> MatchMessage a -> Bool
MatchMessage a -> MatchMessage a -> Ordering
MatchMessage a -> MatchMessage a -> MatchMessage a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (MatchMessage a)
forall a. Ord a => MatchMessage a -> MatchMessage a -> Bool
forall a. Ord a => MatchMessage a -> MatchMessage a -> Ordering
forall a.
Ord a =>
MatchMessage a -> MatchMessage a -> MatchMessage a
$ccompare :: forall a. Ord a => MatchMessage a -> MatchMessage a -> Ordering
compare :: MatchMessage a -> MatchMessage a -> Ordering
$c< :: forall a. Ord a => MatchMessage a -> MatchMessage a -> Bool
< :: MatchMessage a -> MatchMessage a -> Bool
$c<= :: forall a. Ord a => MatchMessage a -> MatchMessage a -> Bool
<= :: MatchMessage a -> MatchMessage a -> Bool
$c> :: forall a. Ord a => MatchMessage a -> MatchMessage a -> Bool
> :: MatchMessage a -> MatchMessage a -> Bool
$c>= :: forall a. Ord a => MatchMessage a -> MatchMessage a -> Bool
>= :: MatchMessage a -> MatchMessage a -> Bool
$cmax :: forall a.
Ord a =>
MatchMessage a -> MatchMessage a -> MatchMessage a
max :: MatchMessage a -> MatchMessage a -> MatchMessage a
$cmin :: forall a.
Ord a =>
MatchMessage a -> MatchMessage a -> MatchMessage a
min :: MatchMessage a -> MatchMessage a -> MatchMessage a
Ord  {- ^ Default instance -},
        (forall a b. (a -> b) -> MatchMessage a -> MatchMessage b)
-> (forall a b. a -> MatchMessage b -> MatchMessage a)
-> Functor MatchMessage
forall a b. a -> MatchMessage b -> MatchMessage a
forall a b. (a -> b) -> MatchMessage a -> MatchMessage b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MatchMessage a -> MatchMessage b
fmap :: forall a b. (a -> b) -> MatchMessage a -> MatchMessage b
$c<$ :: forall a b. a -> MatchMessage b -> MatchMessage a
<$ :: forall a b. a -> MatchMessage b -> MatchMessage a
Functor, (forall m. Monoid m => MatchMessage m -> m)
-> (forall m a. Monoid m => (a -> m) -> MatchMessage a -> m)
-> (forall m a. Monoid m => (a -> m) -> MatchMessage a -> m)
-> (forall a b. (a -> b -> b) -> b -> MatchMessage a -> b)
-> (forall a b. (a -> b -> b) -> b -> MatchMessage a -> b)
-> (forall b a. (b -> a -> b) -> b -> MatchMessage a -> b)
-> (forall b a. (b -> a -> b) -> b -> MatchMessage a -> b)
-> (forall a. (a -> a -> a) -> MatchMessage a -> a)
-> (forall a. (a -> a -> a) -> MatchMessage a -> a)
-> (forall a. MatchMessage a -> [a])
-> (forall a. MatchMessage a -> Bool)
-> (forall a. MatchMessage a -> Int)
-> (forall a. Eq a => a -> MatchMessage a -> Bool)
-> (forall a. Ord a => MatchMessage a -> a)
-> (forall a. Ord a => MatchMessage a -> a)
-> (forall a. Num a => MatchMessage a -> a)
-> (forall a. Num a => MatchMessage a -> a)
-> Foldable MatchMessage
forall a. Eq a => a -> MatchMessage a -> Bool
forall a. Num a => MatchMessage a -> a
forall a. Ord a => MatchMessage a -> a
forall m. Monoid m => MatchMessage m -> m
forall a. MatchMessage a -> Bool
forall a. MatchMessage a -> Int
forall a. MatchMessage a -> [a]
forall a. (a -> a -> a) -> MatchMessage a -> a
forall m a. Monoid m => (a -> m) -> MatchMessage a -> m
forall b a. (b -> a -> b) -> b -> MatchMessage a -> b
forall a b. (a -> b -> b) -> b -> MatchMessage a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => MatchMessage m -> m
fold :: forall m. Monoid m => MatchMessage m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MatchMessage a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MatchMessage a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MatchMessage a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> MatchMessage a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> MatchMessage a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MatchMessage a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MatchMessage a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MatchMessage a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MatchMessage a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MatchMessage a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MatchMessage a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> MatchMessage a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> MatchMessage a -> a
foldr1 :: forall a. (a -> a -> a) -> MatchMessage a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MatchMessage a -> a
foldl1 :: forall a. (a -> a -> a) -> MatchMessage a -> a
$ctoList :: forall a. MatchMessage a -> [a]
toList :: forall a. MatchMessage a -> [a]
$cnull :: forall a. MatchMessage a -> Bool
null :: forall a. MatchMessage a -> Bool
$clength :: forall a. MatchMessage a -> Int
length :: forall a. MatchMessage a -> Int
$celem :: forall a. Eq a => a -> MatchMessage a -> Bool
elem :: forall a. Eq a => a -> MatchMessage a -> Bool
$cmaximum :: forall a. Ord a => MatchMessage a -> a
maximum :: forall a. Ord a => MatchMessage a -> a
$cminimum :: forall a. Ord a => MatchMessage a -> a
minimum :: forall a. Ord a => MatchMessage a -> a
$csum :: forall a. Num a => MatchMessage a -> a
sum :: forall a. Num a => MatchMessage a -> a
$cproduct :: forall a. Num a => MatchMessage a -> a
product :: forall a. Num a => MatchMessage a -> a
Foldable, Functor MatchMessage
Foldable MatchMessage
(Functor MatchMessage, Foldable MatchMessage) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> MatchMessage a -> f (MatchMessage b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MatchMessage (f a) -> f (MatchMessage a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MatchMessage a -> m (MatchMessage b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MatchMessage (m a) -> m (MatchMessage a))
-> Traversable MatchMessage
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MatchMessage (m a) -> m (MatchMessage a)
forall (f :: * -> *) a.
Applicative f =>
MatchMessage (f a) -> f (MatchMessage a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MatchMessage a -> m (MatchMessage b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MatchMessage a -> f (MatchMessage b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MatchMessage a -> f (MatchMessage b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MatchMessage a -> f (MatchMessage b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MatchMessage (f a) -> f (MatchMessage a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MatchMessage (f a) -> f (MatchMessage a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MatchMessage a -> m (MatchMessage b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MatchMessage a -> m (MatchMessage b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MatchMessage (m a) -> m (MatchMessage a)
sequence :: forall (m :: * -> *) a.
Monad m =>
MatchMessage (m a) -> m (MatchMessage a)
Traversable)

-- | List of strings that supports efficient left- and right-biased append
newtype DList a = DList (Endo [a])
    deriving (NonEmpty (DList a) -> DList a
DList a -> DList a -> DList a
(DList a -> DList a -> DList a)
-> (NonEmpty (DList a) -> DList a)
-> (forall b. Integral b => b -> DList a -> DList a)
-> Semigroup (DList a)
forall b. Integral b => b -> DList a -> DList a
forall a. NonEmpty (DList a) -> DList a
forall a. DList a -> DList a -> DList a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> DList a -> DList a
$c<> :: forall a. DList a -> DList a -> DList a
<> :: DList a -> DList a -> DList a
$csconcat :: forall a. NonEmpty (DList a) -> DList a
sconcat :: NonEmpty (DList a) -> DList a
$cstimes :: forall a b. Integral b => b -> DList a -> DList a
stimes :: forall b. Integral b => b -> DList a -> DList a
Semigroup, Semigroup (DList a)
DList a
Semigroup (DList a) =>
DList a
-> (DList a -> DList a -> DList a)
-> ([DList a] -> DList a)
-> Monoid (DList a)
[DList a] -> DList a
DList a -> DList a -> DList a
forall a. Semigroup (DList a)
forall a. DList a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [DList a] -> DList a
forall a. DList a -> DList a -> DList a
$cmempty :: forall a. DList a
mempty :: DList a
$cmappend :: forall a. DList a -> DList a -> DList a
mappend :: DList a -> DList a -> DList a
$cmconcat :: forall a. [DList a] -> DList a
mconcat :: [DList a] -> DList a
Monoid)

-- | Create a singleton list of strings
one :: a -> DList a
one :: forall a. a -> DList a
one a
x = Endo [a] -> DList a
forall a. Endo [a] -> DList a
DList (([a] -> [a]) -> Endo [a]
forall a. (a -> a) -> Endo a
Endo (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))

-- | Extract the list of strings
runDList :: DList a -> [a]
runDList :: forall a. DList a -> [a]
runDList (DList Endo [a]
x) = Endo [a]
x Endo [a] -> [a] -> [a]
forall a. Endo a -> a -> a
`appEndo` []

-- | Computation outcome with error and warning messages. Multiple error
-- messages can occur when multiple alternatives all fail. Resolving any
-- one of the error messages could allow the computation to succeed.
data Result e a
    = Failure [e]   -- ^ error messages
    | Success [e] a -- ^ warning messages and result
    deriving (
        ReadPrec [Result e a]
ReadPrec (Result e a)
Int -> ReadS (Result e a)
ReadS [Result e a]
(Int -> ReadS (Result e a))
-> ReadS [Result e a]
-> ReadPrec (Result e a)
-> ReadPrec [Result e a]
-> Read (Result e a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e a. (Read e, Read a) => ReadPrec [Result e a]
forall e a. (Read e, Read a) => ReadPrec (Result e a)
forall e a. (Read e, Read a) => Int -> ReadS (Result e a)
forall e a. (Read e, Read a) => ReadS [Result e a]
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (Result e a)
readsPrec :: Int -> ReadS (Result e a)
$creadList :: forall e a. (Read e, Read a) => ReadS [Result e a]
readList :: ReadS [Result e a]
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (Result e a)
readPrec :: ReadPrec (Result e a)
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [Result e a]
readListPrec :: ReadPrec [Result e a]
Read {- ^ Default instance -},
        Int -> Result e a -> ShowS
[Result e a] -> ShowS
Result e a -> String
(Int -> Result e a -> ShowS)
-> (Result e a -> String)
-> ([Result e a] -> ShowS)
-> Show (Result e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Result e a -> ShowS
forall e a. (Show e, Show a) => [Result e a] -> ShowS
forall e a. (Show e, Show a) => Result e a -> String
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Result e a -> ShowS
showsPrec :: Int -> Result e a -> ShowS
$cshow :: forall e a. (Show e, Show a) => Result e a -> String
show :: Result e a -> String
$cshowList :: forall e a. (Show e, Show a) => [Result e a] -> ShowS
showList :: [Result e a] -> ShowS
Show {- ^ Default instance -},
        Result e a -> Result e a -> Bool
(Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool) -> Eq (Result e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
== :: Result e a -> Result e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
/= :: Result e a -> Result e a -> Bool
Eq   {- ^ Default instance -},
        Eq (Result e a)
Eq (Result e a) =>
(Result e a -> Result e a -> Ordering)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Bool)
-> (Result e a -> Result e a -> Result e a)
-> (Result e a -> Result e a -> Result e a)
-> Ord (Result e a)
Result e a -> Result e a -> Bool
Result e a -> Result e a -> Ordering
Result e a -> Result e a -> Result e a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e a. (Ord e, Ord a) => Eq (Result e a)
forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Ordering
forall e a.
(Ord e, Ord a) =>
Result e a -> Result e a -> Result e a
$ccompare :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Ordering
compare :: Result e a -> Result e a -> Ordering
$c< :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
< :: Result e a -> Result e a -> Bool
$c<= :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
<= :: Result e a -> Result e a -> Bool
$c> :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
> :: Result e a -> Result e a -> Bool
$c>= :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
>= :: Result e a -> Result e a -> Bool
$cmax :: forall e a.
(Ord e, Ord a) =>
Result e a -> Result e a -> Result e a
max :: Result e a -> Result e a -> Result e a
$cmin :: forall e a.
(Ord e, Ord a) =>
Result e a -> Result e a -> Result e a
min :: Result e a -> Result e a -> Result e a
Ord  {- ^ Default instance -})

-- | Run a 'Matcher' with an empty scope.
runMatcher :: Matcher l a -> Result (MatchMessage l) a
runMatcher :: forall l a. Matcher l a -> Result (MatchMessage l) a
runMatcher (Matcher forall r.
[Scope]
-> DList (MatchMessage l)
-> (DList (MatchMessage l) -> r)
-> (DList (MatchMessage l) -> a -> r)
-> r
m) = [Scope]
-> DList (MatchMessage l)
-> (DList (MatchMessage l) -> Result (MatchMessage l) a)
-> (DList (MatchMessage l) -> a -> Result (MatchMessage l) a)
-> Result (MatchMessage l) a
forall r.
[Scope]
-> DList (MatchMessage l)
-> (DList (MatchMessage l) -> r)
-> (DList (MatchMessage l) -> a -> r)
-> r
m [] DList (MatchMessage l)
forall a. Monoid a => a
mempty ([MatchMessage l] -> Result (MatchMessage l) a
forall e a. [e] -> Result e a
Failure ([MatchMessage l] -> Result (MatchMessage l) a)
-> (DList (MatchMessage l) -> [MatchMessage l])
-> DList (MatchMessage l)
-> Result (MatchMessage l) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (MatchMessage l) -> [MatchMessage l]
forall a. DList a -> [a]
runDList) ([MatchMessage l] -> a -> Result (MatchMessage l) a
forall e a. [e] -> a -> Result e a
Success ([MatchMessage l] -> a -> Result (MatchMessage l) a)
-> (DList (MatchMessage l) -> [MatchMessage l])
-> DList (MatchMessage l)
-> a
-> Result (MatchMessage l) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (MatchMessage l) -> [MatchMessage l]
forall a. DList a -> [a]
runDList)

-- | Run 'Matcher' and ignore warnings.
runMatcherIgnoreWarn :: Matcher l a -> Either [MatchMessage l] a
runMatcherIgnoreWarn :: forall l a. Matcher l a -> Either [MatchMessage l] a
runMatcherIgnoreWarn Matcher l a
m =
    case Matcher l a -> Result (MatchMessage l) a
forall l a. Matcher l a -> Result (MatchMessage l) a
runMatcher Matcher l a
m of
        Failure [MatchMessage l]
err -> [MatchMessage l] -> Either [MatchMessage l] a
forall a b. a -> Either a b
Left [MatchMessage l]
err
        Success [MatchMessage l]
_ a
x -> a -> Either [MatchMessage l] a
forall a b. b -> Either a b
Right a
x

-- | Run 'Matcher' and treat warnings as errors.
runMatcherFatalWarn :: Matcher l a -> Either [MatchMessage l] a
runMatcherFatalWarn :: forall l a. Matcher l a -> Either [MatchMessage l] a
runMatcherFatalWarn Matcher l a
m =
    case Matcher l a -> Result (MatchMessage l) a
forall l a. Matcher l a -> Result (MatchMessage l) a
runMatcher Matcher l a
m of
        Success [] a
x   -> a -> Either [MatchMessage l] a
forall a b. b -> Either a b
Right a
x
        Success [MatchMessage l]
ws a
_   -> [MatchMessage l] -> Either [MatchMessage l] a
forall a b. a -> Either a b
Left [MatchMessage l]
ws
        Failure [MatchMessage l]
err    -> [MatchMessage l] -> Either [MatchMessage l] a
forall a b. a -> Either a b
Left [MatchMessage l]
err

-- | Run a 'Matcher' with a locally extended scope.
withScope :: Scope -> Matcher l a -> Matcher l a
withScope :: forall l a. Scope -> Matcher l a -> Matcher l a
withScope Scope
scope (Matcher forall r.
[Scope]
-> DList (MatchMessage l)
-> (DList (MatchMessage l) -> r)
-> (DList (MatchMessage l) -> a -> r)
-> r
m) = (forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
scopes -> [Scope]
-> DList (MatchMessage l)
-> (DList (MatchMessage l) -> r)
-> (DList (MatchMessage l) -> a -> r)
-> r
forall r.
[Scope]
-> DList (MatchMessage l)
-> (DList (MatchMessage l) -> r)
-> (DList (MatchMessage l) -> a -> r)
-> r
m (Scope
scope Scope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
: [Scope]
scopes))

-- | Get the current list of scopes.
getScope :: Matcher a [Scope]
getScope :: forall a. Matcher a [Scope]
getScope = (forall r.
 [Scope]
 -> DList (MatchMessage a)
 -> (DList (MatchMessage a) -> r)
 -> (DList (MatchMessage a) -> [Scope] -> r)
 -> r)
-> Matcher a [Scope]
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
env DList (MatchMessage a)
ws DList (MatchMessage a) -> r
_err DList (MatchMessage a) -> [Scope] -> r
ok -> DList (MatchMessage a) -> [Scope] -> r
ok DList (MatchMessage a)
ws ([Scope] -> [Scope]
forall a. [a] -> [a]
reverse [Scope]
env))

-- | Emit a warning without an annotation.
warn :: String -> Matcher a ()
warn :: forall a. String -> Matcher a ()
warn String
w =
    (forall r.
 [Scope]
 -> DList (MatchMessage a)
 -> (DList (MatchMessage a) -> r)
 -> (DList (MatchMessage a) -> () -> r)
 -> r)
-> Matcher a ()
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
scopes DList (MatchMessage a)
ws DList (MatchMessage a) -> r
_err DList (MatchMessage a) -> () -> r
ok -> DList (MatchMessage a) -> () -> r
ok (DList (MatchMessage a)
ws DList (MatchMessage a)
-> DList (MatchMessage a) -> DList (MatchMessage a)
forall a. Semigroup a => a -> a -> a
<> MatchMessage a -> DList (MatchMessage a)
forall a. a -> DList a
one (Maybe a -> [Scope] -> String -> MatchMessage a
forall a. Maybe a -> [Scope] -> String -> MatchMessage a
MatchMessage Maybe a
forall a. Maybe a
Nothing ([Scope] -> [Scope]
forall a. [a] -> [a]
reverse [Scope]
scopes) String
w)) ())

-- | Emit a warning mentioning the given annotation.
warnAt :: l -> String -> Matcher l ()
warnAt :: forall l. l -> String -> Matcher l ()
warnAt l
loc String
w =
    (forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> () -> r)
 -> r)
-> Matcher l ()
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
scopes DList (MatchMessage l)
ws DList (MatchMessage l) -> r
_err DList (MatchMessage l) -> () -> r
ok -> DList (MatchMessage l) -> () -> r
ok (DList (MatchMessage l)
ws DList (MatchMessage l)
-> DList (MatchMessage l) -> DList (MatchMessage l)
forall a. Semigroup a => a -> a -> a
<> MatchMessage l -> DList (MatchMessage l)
forall a. a -> DList a
one (Maybe l -> [Scope] -> String -> MatchMessage l
forall a. Maybe a -> [Scope] -> String -> MatchMessage a
MatchMessage (l -> Maybe l
forall a. a -> Maybe a
Just l
loc) ([Scope] -> [Scope]
forall a. [a] -> [a]
reverse [Scope]
scopes) String
w)) ())

-- | Fail with an error message without an annotation.
instance MonadFail (Matcher a) where
    fail :: forall a. String -> Matcher a a
fail String
e =
        (forall r.
 [Scope]
 -> DList (MatchMessage a)
 -> (DList (MatchMessage a) -> r)
 -> (DList (MatchMessage a) -> a -> r)
 -> r)
-> Matcher a a
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
scopes DList (MatchMessage a)
_warn DList (MatchMessage a) -> r
err DList (MatchMessage a) -> a -> r
_ok -> DList (MatchMessage a) -> r
err (MatchMessage a -> DList (MatchMessage a)
forall a. a -> DList a
one (Maybe a -> [Scope] -> String -> MatchMessage a
forall a. Maybe a -> [Scope] -> String -> MatchMessage a
MatchMessage Maybe a
forall a. Maybe a
Nothing ([Scope] -> [Scope]
forall a. [a] -> [a]
reverse [Scope]
scopes) String
e)))

-- | Terminate the match with an error mentioning the given annotation.
failAt :: l -> String -> Matcher l a
failAt :: forall l a. l -> String -> Matcher l a
failAt l
l String
e =
    (forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
forall l a.
(forall r.
 [Scope]
 -> DList (MatchMessage l)
 -> (DList (MatchMessage l) -> r)
 -> (DList (MatchMessage l) -> a -> r)
 -> r)
-> Matcher l a
Matcher (\[Scope]
scopes DList (MatchMessage l)
_warn DList (MatchMessage l) -> r
err DList (MatchMessage l) -> a -> r
_ok -> DList (MatchMessage l) -> r
err (MatchMessage l -> DList (MatchMessage l)
forall a. a -> DList a
one (Maybe l -> [Scope] -> String -> MatchMessage l
forall a. Maybe a -> [Scope] -> String -> MatchMessage a
MatchMessage (l -> Maybe l
forall a. a -> Maybe a
Just l
l) ([Scope] -> [Scope]
forall a. [a] -> [a]
reverse [Scope]
scopes) String
e)))

-- | Update the scope with the message corresponding to a table key
inKey :: Text -> Matcher l a -> Matcher l a
inKey :: forall l a. Text -> Matcher l a -> Matcher l a
inKey = Scope -> Matcher l a -> Matcher l a
forall l a. Scope -> Matcher l a -> Matcher l a
withScope (Scope -> Matcher l a -> Matcher l a)
-> (Text -> Scope) -> Text -> Matcher l a -> Matcher l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Scope
ScopeKey

-- | Update the scope with the message corresponding to an array index
inIndex :: Int -> Matcher l a -> Matcher l a
inIndex :: forall l a. Int -> Matcher l a -> Matcher l a
inIndex = Scope -> Matcher l a -> Matcher l a
forall l a. Scope -> Matcher l a -> Matcher l a
withScope (Scope -> Matcher l a -> Matcher l a)
-> (Int -> Scope) -> Int -> Matcher l a -> Matcher l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scope
ScopeIndex