module Toml.FromValue.Matcher (
Matcher,
Result(..),
MatchMessage(..),
runMatcher,
withScope,
getScope,
warning,
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(..))
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)
data Scope
= ScopeIndex Int
| ScopeKey String
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 ,
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 ,
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 ,
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 )
data MatchMessage = MatchMessage {
MatchMessage -> [Scope]
matchPath :: [Scope],
MatchMessage -> String
matchMessage :: String
} 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 ,
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 ,
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 ,
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 )
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)
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]
:))
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` []
data Result e a
= Failure [e]
| Success [e] a
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 ,
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 ,
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 ,
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 )
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
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)
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)
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))))
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)))))
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
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