{-|
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.

-}
module Toml.FromValue.Matcher ( 
    Matcher,
    Result(..),
    runMatcher,
    withScope,
    getScope,
    warning,

    -- * Scope helpers
    inKey,
    inIndex,
    ) where

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

-- | 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 [String] (WriterT Strings (Except Strings)) 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)

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

-- | Create a singleton list of strings
string :: String -> Strings
string :: String -> Strings
string String
x = Endo [String] -> Strings
Strings (forall a. (a -> a) -> Endo a
Endo (String
xforall a. a -> [a] -> [a]
:))

-- | Extract the list of strings
runStrings :: Strings -> [String]
runStrings :: Strings -> [String]
runStrings (Strings Endo [String]
s) = Endo [String]
s 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 a
    = Failure [String]   -- ^ error messages
    | Success [String] a -- ^ warning messages and result
    deriving (
        ReadPrec [Result a]
ReadPrec (Result a)
ReadS [Result a]
forall a. Read a => ReadPrec [Result a]
forall a. Read a => ReadPrec (Result a)
forall a. Read a => Int -> ReadS (Result a)
forall a. Read a => ReadS [Result a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Result a]
$creadListPrec :: forall a. Read a => ReadPrec [Result a]
readPrec :: ReadPrec (Result a)
$creadPrec :: forall a. Read a => ReadPrec (Result a)
readList :: ReadS [Result a]
$creadList :: forall a. Read a => ReadS [Result a]
readsPrec :: Int -> ReadS (Result a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Result a)
Read {- ^ Default instance -},
        Int -> Result a -> ShowS
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show {- ^ Default instance -},
        Result a -> Result a -> Bool
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq   {- ^ Default instance -},
        Result a -> Result a -> Bool
Result a -> Result 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 {a}. Ord a => Eq (Result a)
forall a. Ord a => Result a -> Result a -> Bool
forall a. Ord a => Result a -> Result a -> Ordering
forall a. Ord a => Result a -> Result a -> Result a
min :: Result a -> Result a -> Result a
$cmin :: forall a. Ord a => Result a -> Result a -> Result a
max :: Result a -> Result a -> Result a
$cmax :: forall a. Ord a => Result a -> Result a -> Result a
>= :: Result a -> Result a -> Bool
$c>= :: forall a. Ord a => Result a -> Result a -> Bool
> :: Result a -> Result a -> Bool
$c> :: forall a. Ord a => Result a -> Result a -> Bool
<= :: Result a -> Result a -> Bool
$c<= :: forall a. Ord a => Result a -> Result a -> Bool
< :: Result a -> Result a -> Bool
$c< :: forall a. Ord a => Result a -> Result a -> Bool
compare :: Result a -> Result a -> Ordering
$ccompare :: forall a. Ord a => Result a -> Result a -> Ordering
Ord  {- ^ Default instance -})

-- | Run a 'Matcher' with an empty scope.
runMatcher :: Matcher a -> Result a
runMatcher :: forall a. Matcher a -> Result a
runMatcher (Matcher ReaderT [String] (WriterT Strings (Except Strings)) 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 [String] (WriterT Strings (Except Strings)) a
m [])) of
        Left Strings
e      -> forall a. [String] -> Result a
Failure (Strings -> [String]
runStrings Strings
e)
        Right (a
x,Strings
w) -> forall a. [String] -> a -> Result a
Success (Strings -> [String]
runStrings Strings
w) a
x

-- | Run a 'Matcher' with a locally extended scope.
withScope :: String -> Matcher a -> Matcher a
withScope :: forall a. String -> Matcher a -> Matcher a
withScope String
ctx (Matcher ReaderT [String] (WriterT Strings (Except Strings)) a
m) = forall a.
ReaderT [String] (WriterT Strings (Except Strings)) a -> Matcher a
Matcher (forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (String
ctxforall a. a -> [a] -> [a]
:) ReaderT [String] (WriterT Strings (Except Strings)) a
m)

-- | Get the current list of scopes.
getScope :: Matcher [String]
getScope :: Matcher [String]
getScope = forall a.
ReaderT [String] (WriterT Strings (Except Strings)) 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 [String]
loc <- Matcher [String]
getScope
    forall a.
ReaderT [String] (WriterT Strings (Except Strings)) 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 (String -> Strings
string (String
w forall a. [a] -> [a] -> [a]
++ String
" in top" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
loc))))

-- | Fail with an error message annotated to the current location.
instance MonadFail Matcher where
    fail :: forall a. String -> Matcher a
fail String
e =
     do [String]
loc <- Matcher [String]
getScope
        forall a.
ReaderT [String] (WriterT Strings (Except Strings)) 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 (String -> Strings
string (String
e forall a. [a] -> [a] -> [a]
++ String
" in top" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
loc)))))

-- | Update the scope with the message corresponding to a table key
--
-- @since 1.2.0.0
inKey :: String -> Matcher a -> Matcher a
inKey :: forall a. String -> Matcher a -> Matcher a
inKey String
key = forall a. String -> Matcher a -> Matcher a
withScope (Char
'.' forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show (forall a. String -> Doc a
prettySimpleKey String
key))

-- | Update the scope with the message corresponding to an array index
--
-- @since 1.2.0.0
inIndex :: Int -> Matcher a -> Matcher a
inIndex :: forall a. Int -> Matcher a -> Matcher a
inIndex Int
i = forall a. String -> Matcher a -> Matcher a
withScope (String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
"]")