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)
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)
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)
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]
:))
runStrings :: Strings -> [String]
runStrings :: Strings -> [String]
runStrings (Strings Endo [String]
s) = Endo [String]
s forall a. Endo a -> a -> a
`appEndo` []
data Result a
= Failure [String]
| Success [String] a
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)
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
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)
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)
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))))
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)))))