module Toml.FromValue.Matcher (
Matcher,
Result(..),
runMatcher,
withScope,
getScope,
warning,
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)
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)))))
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))
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
"]")