{-|
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,
    ) 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)

-- | 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 -- warnings 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, 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, 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, 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)

-- | 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)))))