{-|
Module      : Toml.FromValue.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.FromValue.Matcher (
    -- * Types
    Matcher,
    Result(..),
    MatchMessage(..),

    -- * Operations
    runMatcher,
    withScope,
    getScope,
    warning,

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

import Control.Applicative (Alternative(..))
import Control.Monad (MonadPlus)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (Except, runExcept, throwE)
import Control.Monad.Trans.Reader (asks, local, ReaderT(..))
import Control.Monad.Trans.Writer.CPS (runWriterT, tell, WriterT)
import Data.Monoid (Endo(..))

-- | 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 a = Matcher (ReaderT [Scope] (WriterT (DList MatchMessage) (Except (DList MatchMessage))) a)
    deriving (forall a b. a -> Matcher b -> Matcher a
forall a b. (a -> b) -> Matcher a -> Matcher b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Matcher b -> Matcher a
$c<$ :: forall a b. a -> Matcher b -> Matcher a
fmap :: forall a b. (a -> b) -> Matcher a -> Matcher b
$cfmap :: forall a b. (a -> b) -> Matcher a -> Matcher b
Functor, Functor Matcher
forall a. a -> Matcher a
forall a b. Matcher a -> Matcher b -> Matcher a
forall a b. Matcher a -> Matcher b -> Matcher b
forall a b. Matcher (a -> b) -> Matcher a -> Matcher b
forall a b c. (a -> b -> c) -> Matcher a -> Matcher b -> Matcher c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Matcher a -> Matcher b -> Matcher a
$c<* :: forall a b. Matcher a -> Matcher b -> Matcher a
*> :: forall a b. Matcher a -> Matcher b -> Matcher b
$c*> :: forall a b. Matcher a -> Matcher b -> Matcher b
liftA2 :: forall a b c. (a -> b -> c) -> Matcher a -> Matcher b -> Matcher c
$cliftA2 :: forall a b c. (a -> b -> c) -> Matcher a -> Matcher b -> Matcher c
<*> :: forall a b. Matcher (a -> b) -> Matcher a -> Matcher b
$c<*> :: forall a b. Matcher (a -> b) -> Matcher a -> Matcher b
pure :: forall a. a -> Matcher a
$cpure :: forall a. a -> Matcher a
Applicative, Applicative Matcher
forall a. a -> Matcher a
forall a b. Matcher a -> Matcher b -> Matcher b
forall a b. Matcher a -> (a -> Matcher b) -> Matcher b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Matcher a
$creturn :: forall a. a -> Matcher a
>> :: forall a b. Matcher a -> Matcher b -> Matcher b
$c>> :: forall a b. Matcher a -> Matcher b -> Matcher b
>>= :: forall a b. Matcher a -> (a -> Matcher b) -> Matcher b
$c>>= :: forall a b. Matcher a -> (a -> Matcher b) -> Matcher b
Monad, Applicative Matcher
forall a. Matcher a
forall a. Matcher a -> Matcher [a]
forall a. Matcher a -> Matcher a -> Matcher a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. Matcher a -> Matcher [a]
$cmany :: forall a. Matcher a -> Matcher [a]
some :: forall a. Matcher a -> Matcher [a]
$csome :: forall a. Matcher a -> Matcher [a]
<|> :: forall a. Matcher a -> Matcher a -> Matcher a
$c<|> :: forall a. Matcher a -> Matcher a -> Matcher a
empty :: forall a. Matcher a
$cempty :: forall a. Matcher a
Alternative, Monad Matcher
Alternative Matcher
forall a. Matcher a
forall a. Matcher a -> Matcher a -> Matcher a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. Matcher a -> Matcher a -> Matcher a
$cmplus :: forall a. Matcher a -> Matcher a -> Matcher a
mzero :: forall a. Matcher a
$cmzero :: forall a. Matcher a
MonadPlus)

-- | Scopes for TOML message.
--
-- @since 1.3.0.0
data Scope
    = ScopeIndex Int -- ^ zero-based array index
    | ScopeKey String -- ^ key in a table
    deriving (
        ReadPrec [Scope]
ReadPrec Scope
Int -> ReadS Scope
ReadS [Scope]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Scope]
$creadListPrec :: ReadPrec [Scope]
readPrec :: ReadPrec Scope
$creadPrec :: ReadPrec Scope
readList :: ReadS [Scope]
$creadList :: ReadS [Scope]
readsPrec :: Int -> ReadS Scope
$creadsPrec :: Int -> ReadS Scope
Read {- ^ Default instance -},
        Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show {- ^ Default instance -},
        Scope -> Scope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope -> Scope -> Bool
$c/= :: Scope -> Scope -> Bool
== :: Scope -> Scope -> Bool
$c== :: Scope -> Scope -> Bool
Eq   {- ^ Default instance -},
        Eq 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
min :: Scope -> Scope -> Scope
$cmin :: Scope -> Scope -> Scope
max :: Scope -> Scope -> Scope
$cmax :: Scope -> Scope -> Scope
>= :: Scope -> Scope -> Bool
$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
compare :: Scope -> Scope -> Ordering
$ccompare :: Scope -> Scope -> Ordering
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.
--
-- @since 1.3.0.0
data MatchMessage = MatchMessage {
    MatchMessage -> [Scope]
matchPath :: [Scope], -- ^ path to message location
    MatchMessage -> String
matchMessage :: String -- ^ error and warning message body
    } deriving (
        ReadPrec [MatchMessage]
ReadPrec MatchMessage
Int -> ReadS MatchMessage
ReadS [MatchMessage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MatchMessage]
$creadListPrec :: ReadPrec [MatchMessage]
readPrec :: ReadPrec MatchMessage
$creadPrec :: ReadPrec MatchMessage
readList :: ReadS [MatchMessage]
$creadList :: ReadS [MatchMessage]
readsPrec :: Int -> ReadS MatchMessage
$creadsPrec :: Int -> ReadS MatchMessage
Read {- ^ Default instance -},
        Int -> MatchMessage -> ShowS
[MatchMessage] -> ShowS
MatchMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchMessage] -> ShowS
$cshowList :: [MatchMessage] -> ShowS
show :: MatchMessage -> String
$cshow :: MatchMessage -> String
showsPrec :: Int -> MatchMessage -> ShowS
$cshowsPrec :: Int -> MatchMessage -> ShowS
Show {- ^ Default instance -},
        MatchMessage -> MatchMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchMessage -> MatchMessage -> Bool
$c/= :: MatchMessage -> MatchMessage -> Bool
== :: MatchMessage -> MatchMessage -> Bool
$c== :: MatchMessage -> MatchMessage -> Bool
Eq   {- ^ Default instance -},
        Eq MatchMessage
MatchMessage -> MatchMessage -> Bool
MatchMessage -> MatchMessage -> Ordering
MatchMessage -> MatchMessage -> MatchMessage
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
min :: MatchMessage -> MatchMessage -> MatchMessage
$cmin :: MatchMessage -> MatchMessage -> MatchMessage
max :: MatchMessage -> MatchMessage -> MatchMessage
$cmax :: MatchMessage -> MatchMessage -> MatchMessage
>= :: MatchMessage -> MatchMessage -> Bool
$c>= :: MatchMessage -> MatchMessage -> Bool
> :: MatchMessage -> MatchMessage -> Bool
$c> :: MatchMessage -> MatchMessage -> Bool
<= :: MatchMessage -> MatchMessage -> Bool
$c<= :: MatchMessage -> MatchMessage -> Bool
< :: MatchMessage -> MatchMessage -> Bool
$c< :: MatchMessage -> MatchMessage -> Bool
compare :: MatchMessage -> MatchMessage -> Ordering
$ccompare :: MatchMessage -> MatchMessage -> Ordering
Ord  {- ^ Default instance -})

-- | 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
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
stimes :: forall b. Integral b => b -> DList a -> DList a
$cstimes :: forall a b. Integral b => b -> DList a -> DList a
sconcat :: NonEmpty (DList a) -> DList a
$csconcat :: forall a. NonEmpty (DList a) -> DList a
<> :: DList a -> DList a -> DList a
$c<> :: forall a. DList a -> DList a -> DList a
Semigroup, 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
mconcat :: [DList a] -> DList a
$cmconcat :: forall a. [DList a] -> DList a
mappend :: DList a -> DList a -> DList a
$cmappend :: forall a. DList a -> DList a -> DList a
mempty :: DList a
$cmempty :: forall a. DList a
Monoid)

-- | Create a singleton list of strings
one :: a -> DList a
one :: forall a. a -> DList a
one a
x = forall a. Endo [a] -> DList a
DList (forall a. (a -> a) -> Endo a
Endo (a
xforall 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 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.
--
-- @since 1.3.0.0
data Result e a
    = Failure [e]   -- ^ error messages
    | Success [e] a -- ^ warning messages and result
    deriving (
        ReadPrec [Result e a]
ReadPrec (Result e a)
ReadS [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]
readListPrec :: ReadPrec [Result e a]
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [Result e a]
readPrec :: ReadPrec (Result e a)
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (Result e a)
readList :: ReadS [Result e a]
$creadList :: forall e a. (Read e, Read a) => ReadS [Result e a]
readsPrec :: Int -> ReadS (Result e a)
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (Result e a)
Read {- ^ Default instance -},
        Int -> Result e a -> ShowS
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
showList :: [Result e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Result e a] -> ShowS
show :: Result e a -> String
$cshow :: forall e a. (Show e, Show a) => Result e a -> String
showsPrec :: Int -> Result e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Result e a -> ShowS
Show {- ^ Default instance -},
        Result e a -> Result e a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall e a. (Eq e, Eq a) => Result e a -> Result e a -> Bool
Eq   {- ^ Default instance -},
        Result e a -> Result e a -> Bool
Result e a -> Result e a -> Ordering
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
min :: 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
max :: Result e a -> Result e a -> Result e a
$cmax :: forall e a.
(Ord e, Ord a) =>
Result e a -> Result e a -> Result e a
>= :: 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
$c< :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Bool
compare :: Result e a -> Result e a -> Ordering
$ccompare :: forall e a. (Ord e, Ord a) => Result e a -> Result e a -> Ordering
Ord  {- ^ Default instance -})

-- | Run a 'Matcher' with an empty scope.
--
-- @since 1.3.0.0
runMatcher :: Matcher a -> Result MatchMessage a
runMatcher :: forall a. Matcher a -> Result MatchMessage a
runMatcher (Matcher ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
m) =
    case forall e a. Except e a -> Either e a
runExcept (forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
m [])) of
        Left DList MatchMessage
e      -> forall e a. [e] -> Result e a
Failure (forall a. DList a -> [a]
runDList DList MatchMessage
e)
        Right (a
x,DList MatchMessage
w) -> forall e a. [e] -> a -> Result e a
Success (forall a. DList a -> [a]
runDList DList MatchMessage
w) a
x

-- | Run a 'Matcher' with a locally extended scope.
--
-- @since 1.3.0.0
withScope :: Scope -> Matcher a -> Matcher a
withScope :: forall a. Scope -> Matcher a -> Matcher a
withScope Scope
ctx (Matcher ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
m) = forall a.
ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
-> Matcher a
Matcher (forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Scope
ctx forall a. a -> [a] -> [a]
:) ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
m)

-- | Get the current list of scopes.
--
-- @since 1.3.0.0
getScope :: Matcher [Scope]
getScope :: Matcher [Scope]
getScope = forall a.
ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
-> Matcher a
Matcher (forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks forall a. [a] -> [a]
reverse)

-- | Emit a warning mentioning the current scope.
warning :: String -> Matcher ()
warning :: String -> Matcher ()
warning String
w =
 do [Scope]
loc <- Matcher [Scope]
getScope
    forall a.
ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
-> Matcher a
Matcher (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (forall a. a -> DList a
one ([Scope] -> String -> MatchMessage
MatchMessage [Scope]
loc String
w))))

-- | Fail with an error message annotated to the current location.
instance MonadFail Matcher where
    fail :: forall a. String -> Matcher a
fail String
e =
     do [Scope]
loc <- Matcher [Scope]
getScope
        forall a.
ReaderT
  [Scope]
  (WriterT (DList MatchMessage) (Except (DList MatchMessage)))
  a
-> Matcher a
Matcher (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (forall a. a -> DList a
one ([Scope] -> String -> MatchMessage
MatchMessage [Scope]
loc String
e)))))

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

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